home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / unix / volume23 / abc / part21 < prev    next >
Text File  |  1991-01-08  |  55KB  |  2,313 lines
  1. Subject:  v23i100:  ABC interactive programming environment, Part21/25
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: d73a1361 3a7e8a3b 2431f210 e98c90fe
  5.  
  6. Submitted-by: Steven Pemberton <steven@cwi.nl>
  7. Posting-number: Volume 23, Issue 100
  8. Archive-name: abc/part21
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then feed it
  12. # into a shell via "sh file" or similar.  To overwrite existing files,
  13. # type "sh file -c".
  14. # The tool that generated this appeared in the comp.sources.unix newsgroup;
  15. # send mail to comp-sources-unix@uunet.uu.net if you want that tool.
  16. # Contents:  abc/b/b1grab.c abc/b/b1outp.c abc/bed/e1comm.c
  17. #   abc/bed/e1spos.c abc/bhdrs/bobj.h abc/bint2/i2fix.c
  18. #   abc/bint2/i2tes.c abc/bint3/i3env.c abc/boot/comp.c
  19. #   abc/btr/i1btr.c abc/lin/i1tex.c abc/tc/tgoto.c
  20. #   abc/ukeys/abckeys_924
  21. # Wrapped by rsalz@litchi.bbn.com on Mon Dec 17 13:28:21 1990
  22. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  23. echo If this archive is complete, you will see the following message:
  24. echo '          "shar: End of archive 21 (of 25)."'
  25. if test -f 'abc/b/b1grab.c' -a "${1}" != "-c" ; then 
  26.   echo shar: Will not clobber existing file \"'abc/b/b1grab.c'\"
  27. else
  28.   echo shar: Extracting \"'abc/b/b1grab.c'\" \(4068 characters\)
  29.   sed "s/^X//" >'abc/b/b1grab.c' <<'END_OF_FILE'
  30. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
  31. X
  32. X/* memory handling for ABC values: grabbing, copying and releasing */
  33. X
  34. X#include "b.h"
  35. X#include "bint.h"
  36. X#include "bedi.h"
  37. X#include "bmem.h"
  38. X#include "bobj.h"
  39. X
  40. X#define Adj(s) (unsigned) (Hdrsize+(s))
  41. X#define Unadj(s) (unsigned) ((s)-Hdrsize)
  42. X
  43. X#define Grabber() {if(len>Maxintlet)syserr(MESS(1500, "big grabber"));}
  44. X#define Regrabber() {if(len>Maxintlet)syserr(MESS(1501, "big regrabber"));}
  45. X
  46. X#define Offset(type) (type == Nod ? NodOffset : 0)
  47. X
  48. X/******************************* Grabbing **********************************/
  49. X
  50. XHidden unsigned getsyze(type, len, pnptrs) literal type; intlet len;
  51. X        int *pnptrs; {
  52. X    register unsigned syze= 0;
  53. X    int nptrs= 0;
  54. X    switch (type) {
  55. X        case Tex:
  56. X        case ELT:
  57. X        case Lis:
  58. X        case Ran:
  59. X        case Tab:
  60. X            syze= tltsyze(type, len, &nptrs);
  61. X            break;
  62. X        case Num:
  63. X            syze= numsyze(len, &nptrs);
  64. X            break;
  65. X        case Ptn:
  66. X            syze= ptnsyze(len, &nptrs);
  67. X            break;
  68. X        case Rangebounds:
  69. X        case Com:
  70. X            syze= len*sizeof(value); nptrs= len;
  71. X            break;
  72. X        case Sim:
  73. X            syze= sizeof(simploc); nptrs= 1;
  74. X            break;
  75. X        case Tri:
  76. X            syze= sizeof(trimloc); nptrs= 3;
  77. X            break;
  78. X        case Tse:
  79. X            syze= sizeof(tbseloc); nptrs= 2;
  80. X            break;
  81. X        case How:
  82. X            syze= sizeof(how); nptrs= 1;
  83. X            break;
  84. X        case Ind:
  85. X            syze= sizeof(indirect); nptrs= 1;
  86. X            break;
  87. X        case Fun:
  88. X        case Prd:
  89. X            syze= sizeof(funprd); nptrs= 1;
  90. X            break;
  91. X        case Ref:
  92. X            syze= sizeof(ref); nptrs= 1;
  93. X            break;
  94. X        case Nod:
  95. X            syze= sizeof(struct node) - Hdrsize - sizeof(node)
  96. X                + len*sizeof(node);
  97. X            nptrs= len;
  98. X            break;
  99. X        case Pat:
  100. X            syze= sizeof(struct path) - Hdrsize; nptrs= 2;
  101. X            break;
  102. X        case Etex:
  103. X            syze= (len+1)*sizeof(char); nptrs= 0;
  104. X            break;
  105. X        default:
  106. X#ifndef NDEBUG
  107. X            putCstr(stdout, "\ngetsyze{%c}\n", type);
  108. X#endif
  109. X            syserr(MESS(1502, "getsyze called with unknown type"));
  110. X    }
  111. X    if (pnptrs != NULL) *pnptrs= nptrs;
  112. X    return syze;
  113. X}
  114. X
  115. XVisible value grab(type, len) literal type; intlet len; {
  116. X    unsigned syze= getsyze(type, len, (int*)NULL);
  117. X    value v;
  118. X    Grabber();
  119. X    v= (value) getmem(Adj(syze));
  120. X    v->type= type; v->len= len; v->refcnt= 1;
  121. X    return v;
  122. X}
  123. X
  124. XVisible Procedure regrab(v, len) value *v; intlet len; {
  125. X    literal type= (*v)->type;
  126. X    unsigned syze= getsyze(type, len, (int*)NULL);
  127. X    Regrabber();
  128. X    regetmem((ptr *) v, Adj(syze));
  129. X    (*v)->len= len;
  130. X}
  131. X
  132. X/******************************* Copying and releasing *********************/
  133. X
  134. XVisible value copy(v) value v; {
  135. X    if (v != Vnil && !IsSmallInt(v) && Refcnt(v) < Maxrefcnt) 
  136. X        ++Refcnt(v);
  137. X    return v;
  138. X}
  139. X
  140. XVisible Procedure release(v) value v; {
  141. X    if (v == Vnil || IsSmallInt(v)) return;
  142. X    if (Refcnt(v) == 0)
  143. X        syserr(MESS(1503, "releasing unreferenced value"));
  144. X    if (Refcnt(v) < Maxrefcnt && --Refcnt(v) == 0)
  145. X        rel_subvalues(v);
  146. X}
  147. X
  148. XHidden value ccopy(v) value v; {
  149. X    literal type= v->type; intlet len; value w;
  150. X    int nptrs; unsigned syze; register string from, to, end;
  151. X    register value *pp, *pend;
  152. X    len= Length(v);
  153. X    syze= getsyze(type, len, &nptrs);
  154. X    Grabber();
  155. X    w= (value) getmem(Adj(syze));
  156. X    w->type= type; w->len= len; w->refcnt= 1;
  157. X    from= Str(v); to= Str(w); end= to+syze;
  158. X    while (to < end) *to++ = *from++;
  159. X    pp= (value*) ((char*)Ats(w) + Offset(type));
  160. X    pend= pp+nptrs;
  161. X    for (; pp < pend; pp++) VOID copy(*pp);
  162. X    return w;
  163. X}
  164. X
  165. XVisible Procedure uniql(ll) value *ll; {
  166. X    if (*ll != Vnil && !IsSmallInt(*ll) && Refcnt(*ll) > 1) {
  167. X        value c= ccopy(*ll);
  168. X        release(*ll);
  169. X        *ll= c;
  170. X    }
  171. X}
  172. X
  173. XVisible Procedure rrelease(v) value v; {
  174. X    literal type= v->type; intlet len= Length(v);
  175. X    int nptrs; register value *pp, *pend;
  176. X    VOID getsyze(type, len, &nptrs);
  177. X    pp= (value*) ((char*)Ats(v) + Offset(type));
  178. X    pend= pp+nptrs;
  179. X    while (pp < pend) release(*pp++);
  180. X    v->type= '\0';
  181. X    freemem((ptr) v);
  182. X}
  183. X
  184. X/************************************************************************/
  185. X
  186. Xchar *malloc();
  187. X
  188. XVisible bool enough_space(type, len) literal type; intlet len; {
  189. X    unsigned syze= getsyze(type, len, (int*)NULL);
  190. X    char *p= (char *) malloc((unsigned) (Hdrsize + syze));
  191. X    bool ok;
  192. X
  193. X    ok= p != NULL;
  194. X    free(p);
  195. X    return ok;
  196. X}
  197. X
  198. X/************************************************************************/
  199. END_OF_FILE
  200.   if test 4068 -ne `wc -c <'abc/b/b1grab.c'`; then
  201.     echo shar: \"'abc/b/b1grab.c'\" unpacked with wrong size!
  202.   fi
  203.   # end of 'abc/b/b1grab.c'
  204. fi
  205. if test -f 'abc/b/b1outp.c' -a "${1}" != "-c" ; then 
  206.   echo shar: Will not clobber existing file \"'abc/b/b1outp.c'\"
  207. else
  208.   echo shar: Extracting \"'abc/b/b1outp.c'\" \(3566 characters\)
  209.   sed "s/^X//" >'abc/b/b1outp.c' <<'END_OF_FILE'
  210. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1989. */
  211. X
  212. X#include "b.h"
  213. X#include "bmem.h"
  214. X
  215. Xextern bool in_vtrm;
  216. Xextern bool raw_newline;
  217. X
  218. X#ifdef KEYS
  219. X#define f_interactive(file) (isatty(fileno(file)))
  220. X#endif
  221. X
  222. X#define LINELENGTH 200
  223. X
  224. XVisible Procedure putstr(file, s) FILE *file; string s; {
  225. X    char buf[LINELENGTH];
  226. X    char *nl;
  227. X    char *line;
  228. X    int len;
  229. X
  230. X    if (!f_interactive(file) || !raw_newline) {
  231. X        fputs(s, file);
  232. X        return;
  233. X    }
  234. X    for (; *s; s= ++nl) {
  235. X        if ((nl= strchr(s, '\n')) == NULL) {
  236. X            fputs(s, file);
  237. X            break;
  238. X        }
  239. X        len= nl-s;
  240. X        if (len > 0) {
  241. X            if (len >= LINELENGTH)
  242. X                line= (char *) getmem((unsigned) (len+1));
  243. X            else
  244. X                line= buf;
  245. X            strncpy(line, s, len);
  246. X            line[len]= '\0';
  247. X            fputs(line, file);
  248. X            if (len >= LINELENGTH)
  249. X                freestr(line);
  250. X        }
  251. X        fputs("\n\r", file);
  252. X    }
  253. X}
  254. X
  255. XVisible Procedure putchr(file, c) FILE *file; char c; {
  256. X    if (c == '\n')
  257. X        putnewline(file);
  258. X    else
  259. X        putc(c, file);
  260. X}
  261. X
  262. XVisible Procedure putnewline(file) FILE *file; {
  263. X    putc('\n', file);
  264. X    if (f_interactive(file) && raw_newline)
  265. X        putc('\r', file);
  266. X}
  267. X
  268. X/***************************************************************************/
  269. X
  270. X#define FMTLENGTH 600
  271. X
  272. XHidden char *fmtbuf;
  273. X
  274. XVisible Procedure initfmt() {
  275. X    fmtbuf= (char *) getmem(FMTLENGTH);
  276. X}
  277. X
  278. X#define FMTINTLEN 100 /* space allocated for int's in formats */
  279. X
  280. XHidden char *getfmtbuf(fmt, n) string fmt; int n; {
  281. X    static char *fmtstr= NULL;
  282. X
  283. X    n+= strlen(fmt);
  284. X    if (fmtstr != NULL)
  285. X        freestr(fmtstr);
  286. X    if (n >= FMTLENGTH)
  287. X        return fmtstr= (char *) getmem((unsigned) n+1);
  288. X    return fmtbuf;
  289. X}
  290. X
  291. X/***************************************************************************/
  292. X
  293. XVisible Procedure putSstr(file, fmt, s) FILE *file; string fmt, s; {
  294. X    char *str= getfmtbuf(fmt, strlen(s));
  295. X    sprintf(str, fmt, s);
  296. X    putstr(file, str);
  297. X}
  298. X
  299. XVisible Procedure putSDstr(file, fmt, s, d) FILE *file; string fmt, s; int d; {
  300. X    char *str= getfmtbuf(fmt, strlen(s)+FMTINTLEN);
  301. X    sprintf(str, fmt, s, d);    
  302. X    putstr(file, str);
  303. X}
  304. X
  305. XVisible Procedure putDSstr(file, fmt, d, s) FILE *file; string fmt, s; int d; {
  306. X    char *str= getfmtbuf(fmt, FMTINTLEN+strlen(s));
  307. X    sprintf(str, fmt, d, s);    
  308. X    putstr(file, str);
  309. X}
  310. X
  311. XVisible Procedure putDstr(file, fmt, d) FILE *file; string fmt; int d; {
  312. X    putDSstr(file, fmt, d, "");
  313. X}
  314. X
  315. XVisible Procedure put3DSstr(file, fmt, d1, d2, d3, s)
  316. X        FILE *file; string fmt; int d1, d2, d3; string s; {
  317. X    char *str= getfmtbuf(fmt, 3*FMTINTLEN+strlen(s));
  318. X    sprintf(str, fmt, d1, d2, d3, s);
  319. X    putstr(file, str);
  320. X}
  321. X
  322. XVisible Procedure put3Dstr(file, fmt, d1, d2, d3)
  323. X        FILE *file; string fmt; int d1, d2, d3; {
  324. X    put3DSstr(file, fmt, d1, d2, d3, "");
  325. X}
  326. X
  327. XVisible Procedure put2Dstr(file, fmt, d1, d2)
  328. X        FILE *file; string fmt; int d1, d2; {
  329. X    put3DSstr(file, fmt, d1, d2, 0, "");
  330. X}
  331. X
  332. XVisible Procedure put2Cstr(file, fmt, c1, c2)
  333. X        FILE *file; string fmt; char c1, c2; {
  334. X    char *str= getfmtbuf(fmt, 1+1);
  335. X    sprintf(str, fmt, c1, c2);
  336. X    putstr(file, str);
  337. X}
  338. X
  339. XVisible Procedure putCstr(file, fmt, c) FILE *file; string fmt; char c; {
  340. X    put2Cstr(file, fmt, c, '\0');
  341. X}
  342. X
  343. X/***************************************************************************/
  344. X
  345. XVisible Procedure putmess(file, m) FILE *file; int m; {
  346. X    putstr(file, getmess(m));
  347. X    fflush(file);
  348. X}
  349. X
  350. XVisible Procedure putSmess(file, m, s) FILE *file; int m; string s; {
  351. X    putSstr(file, getmess(m), s);
  352. X    fflush(file);
  353. X}
  354. X
  355. XVisible Procedure putDSmess(file, m, d, s) FILE *file; int m; int d; string s; {
  356. X    putDSstr(file, getmess(m), d, s);
  357. X    fflush(file);
  358. X}
  359. X
  360. XVisible Procedure put2Cmess(file, m, c1, c2) FILE *file; int m; char c1, c2; {
  361. X    put2Cstr(file, getmess(m), c1, c2);
  362. X    fflush(file);
  363. X}
  364. X
  365. END_OF_FILE
  366.   if test 3566 -ne `wc -c <'abc/b/b1outp.c'`; then
  367.     echo shar: \"'abc/b/b1outp.c'\" unpacked with wrong size!
  368.   fi
  369.   # end of 'abc/b/b1outp.c'
  370. fi
  371. if test -f 'abc/bed/e1comm.c' -a "${1}" != "-c" ; then 
  372.   echo shar: Will not clobber existing file \"'abc/bed/e1comm.c'\"
  373. else
  374.   echo shar: Extracting \"'abc/bed/e1comm.c'\" \(3288 characters\)
  375.   sed "s/^X//" >'abc/bed/e1comm.c' <<'END_OF_FILE'
  376. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  377. X
  378. X/*
  379. X * B editor -- Editor command processor.
  380. X */
  381. X
  382. X#include "b.h"
  383. X#include "bedi.h"
  384. X#include "feat.h"       /* for SAVEBUF, SAVEPOS, USERSUGG */
  385. X#include "bfil.h"
  386. X#include "bcom.h"
  387. X#include "node.h"
  388. X#include "supr.h"       /* for environ */
  389. X#include "tabl.h"
  390. X#ifdef GFX
  391. X#include "bgfx.h"
  392. X#endif
  393. X#ifdef MENUS
  394. X#include "abcmenus.h"
  395. X#endif
  396. X
  397. X#ifdef SIGNAL
  398. X#include <signal.h>
  399. X#endif
  400. X
  401. Xvalue editqueue();
  402. X
  403. XVisible int doctype;
  404. X
  405. XVisible environ *tobesaved;
  406. XVisible string savewhere;
  407. X
  408. Xenviron top_env, *top_ep;
  409. X
  410. XVisible Procedure initbed() {
  411. X    top_ep= &top_env;
  412. X
  413. X    savewhere = (string)NULL;
  414. X    tobesaved = (environ*)NULL;
  415. X    clrenv(top_ep);
  416. X#ifdef SAVEBUF
  417. X    top_ep->copybuffer = editqueue(buffile);
  418. X    if (top_ep->copybuffer)
  419. X        top_ep->copyflag = Yes;
  420. X#endif /* SAVEBUF */
  421. X}
  422. X
  423. XVisible Procedure endbed() {
  424. X    register environ *ep = tobesaved;
  425. X
  426. X    tobesaved = (environ*)NULL;
  427. X        /* To avoid loops if saving is cancelled. */
  428. X    if (savewhere && ep) {
  429. X        if (ep->generation > 0) {
  430. X            VOID save(ep->focus, savewhere);
  431. X#ifdef USERSUGG
  432. X            writesugg(ep->focus);
  433. X#endif /* USERSUGG */
  434. X        }
  435. X#ifdef SAVEBUF
  436. X        if (ep->copyflag)
  437. X            VOID savequeue(ep->copybuffer, buffile);
  438. X        else
  439. X            VOID savequeue(Vnil, buffile);
  440. X#endif /* SAVEBUF */
  441. X#ifdef SAVEPOS
  442. X        savpos(savewhere, ep);
  443. X#endif /* SAVEPOS */
  444. X    }
  445. X#ifdef SAVEBUF
  446. X    if (top_ep->copyflag)
  447. X        VOID savequeue(top_ep->copybuffer, buffile);
  448. X    else
  449. X        VOID savequeue(Vnil, buffile);
  450. X#endif /* SAVEBUF */
  451. X    Erelease(*top_ep);
  452. X}
  453. X
  454. XVisible bool intrflag= No; /* interrupt flag editor */
  455. X#ifdef SIGTSTP
  456. XVisible bool suspflag= No;
  457. X#endif
  458. X
  459. XHidden Procedure initintr() {
  460. X    intrflag= No;
  461. X#ifdef SIGTSTP
  462. X    suspflag= No; /* do not propagate suspend from interpreter */
  463. X#endif
  464. X#ifdef SIGNAL
  465. X    setintrhandler();
  466. X#endif
  467. X}
  468. X
  469. X#define INTRMESS    MESS(4700, "*** Interrupted\n")
  470. X
  471. XHidden Procedure endintr() {
  472. X#ifdef SIGNAL
  473. X    resetintrhandler();
  474. X#endif
  475. X    if (interrupted)
  476. X        putmess(errfile, INTRMESS);
  477. X}
  478. X
  479. XVisible Procedure abced_file(filename, errline, kind, creating)
  480. X        string filename; intlet errline; literal kind; bool creating; {
  481. X    environ *ep= top_ep;
  482. X
  483. X    initintr();
  484. X#ifdef GFX
  485. X    if (gfx_mode != TEXT_MODE)
  486. X        exit_gfx();
  487. X#endif
  488. X    setindent(0);
  489. X    doctype= D_perm;
  490. X    VOID dofile(ep, filename, errline, kind, creating);
  491. X    endshow();
  492. X    top(&ep->focus);
  493. X    ep->mode = WHOLE;
  494. X    VOID deltext(ep);
  495. X    if (!ep->copyflag) {
  496. X        release(ep->copybuffer);
  497. X        ep->copybuffer = Vnil;
  498. X    }
  499. X    endintr();
  500. X}
  501. X
  502. XVisible char *ed_line(kind, indent) literal kind; int indent; {
  503. X    char *buf= (char *) NULL;
  504. X    environ *ep= top_ep;
  505. X#ifdef MENUS
  506. X    int savemenusstat;
  507. X#endif
  508. X    char *send();
  509. X
  510. X    initintr();
  511. X
  512. X    if (kind == R_cmd)
  513. X        setroot(Imm_cmd);
  514. X    else if (kind == R_expr)
  515. X        setroot(Expression);
  516. X    else
  517. X        setroot(Raw_input);
  518. X    delfocus(&ep->focus);
  519. X    if (kind == R_cmd) {
  520. X        cmdprompt(CMDPROMPT);
  521. X        doctype= D_immcmd;
  522. X    }
  523. X    else if (kind == R_expr || kind == R_raw || kind == R_ioraw)
  524. X        setindent(indent);
  525. X    else
  526. X        setindent(0);
  527. X    if (kind != R_cmd) {
  528. X        doctype= D_input;
  529. X#ifdef MENUS
  530. X        savemenusstat= curmenusstat;
  531. X        adjust_menus(Editor_menus);
  532. X#endif
  533. X    }
  534. X    VOID editdocument(ep, No);
  535. X#ifdef MENUS
  536. X    if (doctype == D_input)
  537. X        adjust_menus(savemenusstat);
  538. X#endif
  539. X    endshow();
  540. X    top(&ep->focus);
  541. X    ep->mode = WHOLE;
  542. X    if (!interrupted)
  543. X        buf= send(ep->focus);
  544. X    VOID deltext(ep);
  545. X
  546. X    endintr();
  547. X
  548. X    return buf;
  549. X}
  550. X
  551. X
  552. END_OF_FILE
  553.   if test 3288 -ne `wc -c <'abc/bed/e1comm.c'`; then
  554.     echo shar: \"'abc/bed/e1comm.c'\" unpacked with wrong size!
  555.   fi
  556.   # end of 'abc/bed/e1comm.c'
  557. fi
  558. if test -f 'abc/bed/e1spos.c' -a "${1}" != "-c" ; then 
  559.   echo shar: Will not clobber existing file \"'abc/bed/e1spos.c'\"
  560. else
  561.   echo shar: Extracting \"'abc/bed/e1spos.c'\" \(3439 characters\)
  562.   sed "s/^X//" >'abc/bed/e1spos.c' <<'END_OF_FILE'
  563. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1987. */
  564. X
  565. X/*
  566. X * B editor -- Save focus position.
  567. X */
  568. X
  569. X#include "b.h"
  570. X#include "feat.h"
  571. X
  572. X#ifdef SAVEPOS
  573. X
  574. X#include "bedi.h"
  575. X#include "bobj.h"
  576. X#include "bfil.h"
  577. X#include "node.h"
  578. X#include "supr.h"
  579. X#include "bmem.h"
  580. X
  581. X/*
  582. X * Keep a simple database of file name vs. line number.
  583. X * The database is kept in most-recently-used-first order.
  584. X */
  585. X
  586. Xtypedef struct pc { char *fname; int line; struct pc *next; } poschain;
  587. Xtypedef poschain *pos;
  588. X
  589. X#define PNULL ((pos) NULL)
  590. X
  591. XHidden pos poshead= PNULL;
  592. X
  593. XHidden bool poschanges;
  594. X
  595. XHidden pos new_pos(fname, line) char *fname; int line; {
  596. X    pos new= (pos) getmem((unsigned) sizeof(poschain));
  597. X    new->fname= (char *) savestr(fname);
  598. X    new->line= line;
  599. X    new->next= PNULL;
  600. X    return new;
  601. X}
  602. X
  603. XHidden Procedure free_pos(filpos) pos filpos; {
  604. X    freestr(filpos->fname);
  605. X    freemem((ptr) filpos);
  606. X}
  607. X
  608. XHidden int del_pos(fname) char *fname; {
  609. X    pos filpos= poshead;
  610. X    pos prev= PNULL;
  611. X    int line= 1;
  612. X    
  613. X    while (filpos != PNULL) {
  614. X        if (strcmp(fname, filpos->fname) == 0) {
  615. X            line= filpos->line;
  616. X            if (prev)
  617. X                prev->next= filpos->next;
  618. X            else
  619. X                poshead= filpos->next;
  620. X            free_pos(filpos);
  621. X            poschanges= Yes;
  622. X            break;
  623. X        }
  624. X        prev= filpos;
  625. X        filpos= filpos->next;
  626. X    }
  627. X    return line;
  628. X}
  629. X
  630. XHidden Procedure sav_pos(fname, line) char *fname; int line; {
  631. X    pos new;
  632. X    
  633. X    VOID del_pos(fname);
  634. X    new= new_pos(fname, line);
  635. X    new->next= poshead;
  636. X    poshead= new;
  637. X    poschanges= Yes;
  638. X}
  639. X
  640. XHidden char *filebase(fname) char *fname; {
  641. X    char *base= strrchr(fname, DELIM);
  642. X    
  643. X    return base != NULL ? ++base : fname;
  644. X}
  645. X
  646. XVisible Procedure initpos() {
  647. X    FILE *file;
  648. X    char *buffer, *name;
  649. X    char *fname;
  650. X    int line;
  651. X    pos tail, new;
  652. X    
  653. X    poshead= tail= PNULL;
  654. X    poschanges= No;
  655. X    file= fopen(posfile, "r");
  656. X    if (!file)
  657. X        return;
  658. X    while ((buffer= f_getline(file)) != NULL) {
  659. X        name= (char *) getmem((unsigned) (strlen(buffer) + 1));
  660. X
  661. X        if (sscanf(buffer, "%s\t%d", name, &line) == 2) {
  662. X            fname= filebase(name);
  663. X            if (F_exists(fname)) {
  664. X                new= new_pos(fname, line);
  665. X                if (!tail)
  666. X                    poshead= tail= new;
  667. X                else {
  668. X                    tail->next= new;
  669. X                    tail= new;
  670. X                }
  671. X            }
  672. X        }
  673. X        freemem((ptr) name);
  674. X        freemem((ptr) buffer);
  675. X    }
  676. X    fclose(file);
  677. X}
  678. X
  679. XHidden Procedure wripos() {
  680. X    FILE *fp;
  681. X    pos filpos;
  682. X    
  683. X    if (!poschanges)
  684. X        return;
  685. X    poschanges= No;
  686. X    if (poshead == PNULL) {
  687. X        unlink(posfile);
  688. X        return;
  689. X    }
  690. X    fp= fopen(posfile, "w");
  691. X    if (!fp)
  692. X        return;
  693. X    filpos= poshead;
  694. X    while (filpos != PNULL) {
  695. X        fprintf(fp, "%s\t%d\n", filpos->fname, filpos->line);
  696. X        filpos= filpos->next;
  697. X    }
  698. X    fclose(fp);
  699. X}
  700. X
  701. XVisible Procedure endpos() {
  702. X    pos prev;
  703. X
  704. X    wripos();
  705. X    while (poshead != PNULL) {
  706. X        prev= poshead;
  707. X        poshead= poshead->next;
  708. X        free_pos(prev);
  709. X    }
  710. X}
  711. X
  712. X/* getpos() is called from editor */
  713. X
  714. XVisible int getpos(fname) char *fname; {
  715. X    pos filpos= poshead;
  716. X    
  717. X    fname= filebase(fname);
  718. X    while (filpos != PNULL) {
  719. X        if (strcmp(fname, filpos->fname) == 0)
  720. X            return filpos->line;
  721. X        filpos= filpos->next;
  722. X    }
  723. X    return 0; /* editor expects 0 as default */
  724. X}
  725. X
  726. X/* savpos() is called from editor */
  727. X
  728. XVisible bool savpos(fname, ep) char *fname; environ *ep; {
  729. X    sav_pos(filebase(fname), lineno(ep) + 1);
  730. X}
  731. X
  732. X/* delpos() is called from interpreter */
  733. X
  734. XVisible Procedure delpos(fname) char *fname; {
  735. X    VOID del_pos(filebase(fname));
  736. X}
  737. X
  738. X/* movpos() is called from interpreter */
  739. X
  740. XVisible Procedure movpos(ofname, nfname) char *ofname, *nfname; {
  741. X    int n_line= del_pos(filebase(ofname));
  742. X    sav_pos(filebase(nfname), n_line);
  743. X}
  744. X    
  745. X#endif /* SAVEPOS */
  746. END_OF_FILE
  747.   if test 3439 -ne `wc -c <'abc/bed/e1spos.c'`; then
  748.     echo shar: \"'abc/bed/e1spos.c'\" unpacked with wrong size!
  749.   fi
  750.   # end of 'abc/bed/e1spos.c'
  751. fi
  752. if test -f 'abc/bhdrs/bobj.h' -a "${1}" != "-c" ; then 
  753.   echo shar: Will not clobber existing file \"'abc/bhdrs/bobj.h'\"
  754. else
  755.   echo shar: Extracting \"'abc/bhdrs/bobj.h'\" \(3659 characters\)
  756.   sed "s/^X//" >'abc/bhdrs/bobj.h' <<'END_OF_FILE'
  757. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  758. X
  759. X/* B values, locations, environments: the B abstract machine */
  760. X
  761. X/* Avoid name conflicts with standard header files: */
  762. X#define power b_power
  763. X#define exp1 b_exp1
  764. X#define log1 b_log1
  765. X#define log2 b_log2
  766. X#define pi b_pi
  767. X#define random b_random
  768. X
  769. X/****************************** general ******************************/
  770. X
  771. Xtypedef int relation; /* < 0, == 0, > 0 */
  772. Xrelation compare();
  773. X
  774. X/*************************************************************************/
  775. X
  776. Xvalue grab();
  777. Xunsigned tltsyze();
  778. Xunsigned numsyze();
  779. Xunsigned ptnsyze();
  780. Xbool enough_space();
  781. X
  782. Xdouble hash();
  783. X
  784. Xbool is_abcname();
  785. X
  786. X/****************************** Texts ******************************/
  787. X
  788. Xbool character();
  789. X
  790. Xvalue mkchar();
  791. Xvalue mk_text();
  792. Xchar charval();
  793. Xchar ncharval();
  794. Xstring strval();
  795. Xstring sstrval();
  796. X
  797. Xvalue concat();
  798. Xvalue behead();
  799. Xvalue curtail();
  800. Xvalue repeat();
  801. X
  802. Xvalue stripped();
  803. Xvalue split();
  804. Xvalue upper();
  805. Xvalue lower();
  806. X
  807. Xvalue adjleft();
  808. Xvalue centre();
  809. Xvalue adjright();
  810. X
  811. Xvalue convert();
  812. X
  813. X/****************************** Numbers ******************************/
  814. X
  815. X/* Predicates */
  816. Xbool integral();        /* is the value an integer? */
  817. Xbool large();        /* can a number be represented by a C int? */
  818. X#ifdef RANGEPRINT
  819. Xbool is_increment();    /* a = b+1 ? */
  820. X#endif
  821. X
  822. X/* Constants */
  823. X#define zero MkSmallInt(0)
  824. X#define one MkSmallInt(1)
  825. X
  826. X/* Conversion of abstract values to concrete objects */
  827. Xdouble numval();     /* numeric value of any number */
  828. Xint intval();        /* numeric value of integral number */
  829. Xint propintlet();    /* checks int for fitting in intlet */
  830. Xstring convnum();    /* character string approximation of any number */
  831. Xrelation numcomp();  /* comparison of two numbers: yields -1, 0 or 1 */
  832. Xdouble numhash();    /* hashes any abstract number to a 'double' */
  833. X
  834. X/* Conversion of concrete objects to abstract numbers */
  835. Xvalue numconst();    /* string argument */
  836. Xvalue mk_integer();  /* int argument */
  837. X
  838. X/* Functions on numbers */
  839. Xvalue sum();
  840. Xvalue diff();
  841. Xvalue negated();
  842. Xvalue prod();
  843. Xvalue quot();
  844. Xvalue modulo();
  845. Xvalue floorf();
  846. Xvalue ceilf();
  847. Xvalue round1();
  848. Xvalue round2();
  849. Xvalue mod();
  850. Xvalue power();
  851. Xvalue absval();
  852. Xvalue signum();
  853. Xvalue numerator();
  854. Xvalue denominator();
  855. Xvalue approximate();
  856. Xvalue random();
  857. Xvalue root1();
  858. Xvalue sin1();
  859. Xvalue cos1();
  860. Xvalue tan1();
  861. Xvalue arctan1();
  862. Xvalue angle1();
  863. Xvalue sin2();
  864. Xvalue cos2();
  865. Xvalue tan2();
  866. Xvalue arctan2();
  867. Xvalue angle2();
  868. Xvalue radius();
  869. Xvalue exp1();
  870. Xvalue log1();
  871. Xvalue root2();
  872. Xvalue log2();
  873. Xvalue pi();
  874. Xvalue e();
  875. Xvalue nowisthetime();
  876. Xvalue exactly();
  877. Xbool exact();
  878. X
  879. X/****************************** Compounds ******************************/
  880. X#define Nfields(c) Length(c)
  881. X#define Field(c, i) ((Ats(c)+(i)))
  882. X#define k_Overfields for (k= 0; k < len; k++)
  883. X#define Lastfield(k) ((k) == len-1)
  884. X
  885. X#define mk_compound(len) grab(Com, len)
  886. X
  887. X/****************************** Lists ******************************/
  888. Xvalue mk_range();
  889. Xbool is_rangelist();
  890. X
  891. X/* Procedure insert(); */
  892. X/* Procedure remove(); */
  893. X
  894. X/****************************** Tables ******************************/
  895. X
  896. Xvalue keys();
  897. Xbool in_keys();
  898. Xvalue associate();
  899. X
  900. X/* Procedure replace(); */
  901. X/* Procedure delete(); */
  902. X
  903. Xvalue* adrassoc();
  904. Xvalue* key();
  905. Xvalue* assoc();
  906. X
  907. X/****************************** Texts, Lists, and Tables *******************/
  908. Xvalue mk_elt();
  909. X
  910. Xbool in();
  911. X
  912. Xvalue size();
  913. Xvalue size2();
  914. Xvalue min1();
  915. Xvalue min2();
  916. Xvalue max1();
  917. Xvalue max2();
  918. X#ifdef B_COMPAT
  919. Xvalue th_of();
  920. X#endif
  921. Xvalue thof();
  922. Xvalue item();
  923. Xvalue choice();
  924. X
  925. Xint length(); /* The same as size, temporary until part2 is written in B */
  926. Xbool empty(); /* whether #v=0: also temporary */
  927. X
  928. X
  929. X
  930. END_OF_FILE
  931.   if test 3659 -ne `wc -c <'abc/bhdrs/bobj.h'`; then
  932.     echo shar: \"'abc/bhdrs/bobj.h'\" unpacked with wrong size!
  933.   fi
  934.   # end of 'abc/bhdrs/bobj.h'
  935. fi
  936. if test -f 'abc/bint2/i2fix.c' -a "${1}" != "-c" ; then 
  937.   echo shar: Will not clobber existing file \"'abc/bint2/i2fix.c'\"
  938. else
  939.   echo shar: Extracting \"'abc/bint2/i2fix.c'\" \(3651 characters\)
  940.   sed "s/^X//" >'abc/bint2/i2fix.c' <<'END_OF_FILE'
  941. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  942. X
  943. X/* Fix unparsed expr/test */
  944. X
  945. X#include "b.h"
  946. X#include "bint.h"
  947. X#include "bobj.h"
  948. X#include "i0err.h"
  949. X#include "i2exp.h"
  950. X#include "i2nod.h"
  951. X#include "i2gen.h" /* Must be after i2nod.h */
  952. X#include "i2par.h"
  953. X#include "i3env.h"
  954. X
  955. X#define S_elmt '1'
  956. X#define S_dya  '2'
  957. X#define S_mon  '3'
  958. X
  959. XHidden Procedure f_unparsed(pt, fct) parsetree *pt, (*fct)(); {
  960. X    parsetree t= *pt;
  961. X    expadm adm;
  962. X    struct state v;
  963. X
  964. X    /* Ignore visits done during resolving UNPARSED: */
  965. X    hold(&v);
  966. X    initexp(&adm, N_EXP_STACK, FIXER);
  967. X    t= (*fct)(&adm, *Branch(t, UNP_SEQ));
  968. X    release(*pt);
  969. X    *pt= t;
  970. X    endstack(&adm);
  971. X    jumpto(NilTree);
  972. X    let_go(&v);
  973. X}
  974. X
  975. XHidden parsetree fix_expr(adm, root) expadm *adm; parsetree root; {
  976. X    parsetree w;
  977. X    value *p_i, i, f;
  978. X    int state= S_dya;
  979. X
  980. X    for (; Nfld(adm) < Nfields(root); ++Nfld(adm)) {
  981. X        p_i= Field(root, Nfld(adm));
  982. X        i= copy(*p_i);
  983. X        if (!Valid(i)) {
  984. X            if (state == S_dya || state == S_mon)
  985. X                fixerr(NO_EXPR);
  986. X            else if (Prop(adm))
  987. X                break;
  988. X            else
  989. X                fixerr(UPTO_EXPR);
  990. X            return NilTree;
  991. X        }
  992. X        else if (state == S_dya || state == S_mon) {
  993. X            if (Is_parsetree(i)) {
  994. X                f_expr(p_i);
  995. X                release(i); i= copy(*p_i);
  996. X                push_item(adm, (parsetree) i);
  997. X                state= S_elmt;
  998. X            }
  999. X            else if (modify_tag(i, &w)) {
  1000. X                push_item(adm, w);
  1001. X                state= S_elmt;
  1002. X            }
  1003. X            else if (is_monfun(i, &f)) {
  1004. X                push_item(adm, (parsetree) i);
  1005. X                state= S_mon;
  1006. X            }
  1007. X            else {
  1008. X                if (is_name(i))
  1009. X                    fixerrV(NO_INIT_OR_DEF, i);
  1010. X                else
  1011. X                    fixerr(NO_EXPR);
  1012. X                release(i);
  1013. X                return NilTree;
  1014. X            }
  1015. X        }
  1016. X        else {                /* state == S_elmt */
  1017. X            if (Dya_opr(i)) {
  1018. X                release(i);
  1019. X                i= copy(*Field(i, 0));
  1020. X            }
  1021. X            if (is_dyafun(i, &f)) {
  1022. X                do_dya(adm, i);
  1023. X                state= S_dya;
  1024. X            }
  1025. X            else {
  1026. X                release(i);
  1027. X                if (Prop(adm)) break;
  1028. X                else {
  1029. X                    fixerr(UPTO_EXPR);
  1030. X                    return NilTree;
  1031. X                }
  1032. X            }
  1033. X        }
  1034. X    }
  1035. X    if (state == S_dya || state == S_mon) {
  1036. X        fixerr(NO_EXPR);
  1037. X        return NilTree;
  1038. X    }
  1039. X    while ((Sp(adm) - Stack(adm)) > 2)
  1040. X        reduce(adm);
  1041. X    return Pop(adm);
  1042. X}
  1043. X
  1044. XHidden parsetree fix_test(adm, root) expadm *adm; parsetree root; {
  1045. X    parsetree v, w;
  1046. X    value i, f, *aa;
  1047. X    int lastn= Nfields(root) - 1;
  1048. X    
  1049. X    if (Nfld(adm) > lastn) {
  1050. X        fixerr(NO_TEST);
  1051. X        return NilTree;
  1052. X    }
  1053. X    i= *Field(root, Nfld(adm));
  1054. X    if (!Valid(i))
  1055. X        ;
  1056. X    else if (is_zerprd(i, &f)) {
  1057. X        if (Nfld(adm) < lastn) {
  1058. X            fixerr(UPTO_TEST);
  1059. X            return NilTree;
  1060. X        }
  1061. X        return node3(TAGzerprd, copy(i), copydef(f));
  1062. X    }
  1063. X    else if (Is_text(i) && (aa= envassoc(refinements, i))) {
  1064. X        if (Nfld(adm) == lastn) 
  1065. X            return node3(TAGrefinement, copy(i), copy(*aa));
  1066. X    }
  1067. X    else if (is_monprd(i, &f)) {
  1068. X        ++Nfld(adm);
  1069. X        v= fix_expr(adm, root);
  1070. X        return node4(MONPRD, copy(i), v, copydef(f));
  1071. X    }
  1072. X    Prop(adm)= Yes;
  1073. X    v= fix_expr(adm, root);
  1074. X    Prop(adm)= No;
  1075. X    i= Nfld(adm) <= lastn ? *Field(root, Nfld(adm)) : Vnil;
  1076. X    if (!Valid(i)) {
  1077. X        fixerr(NO_TEST);
  1078. X        release(v);
  1079. X        return NilTree;
  1080. X    }
  1081. X    if (Dya_opr(i))
  1082. X        i= *Field(i, 0);
  1083. X    if (!is_dyaprd(i, &f)) {
  1084. X        if (is_name(i))
  1085. X            fixerrV(NO_DEFINITION, i);
  1086. X        else
  1087. X            fixerr(NO_TEST);
  1088. X        release(v);
  1089. X        return NilTree;
  1090. X    }
  1091. X    ++Nfld(adm);
  1092. X    w= fix_expr(adm, root);
  1093. X    return node5(DYAPRD, v, copy(i), w, copydef(f));
  1094. X}
  1095. X
  1096. XVisible Procedure f_eunparsed(pt) parsetree *pt; {
  1097. X    f_unparsed(pt, fix_expr);
  1098. X}
  1099. X
  1100. XVisible Procedure f_cunparsed(pt) parsetree *pt; {
  1101. X    f_unparsed(pt, fix_test);
  1102. X}
  1103. X
  1104. XVisible Procedure f_trim_target(v, trim) parsetree v; char trim; {
  1105. X    parsetree w= *Branch(v, TRIM_RIGHT);
  1106. X    struct prio *ptrim, *pdya;
  1107. X    value name;
  1108. X
  1109. X    if (nodetype(w) == DYAF) {
  1110. X        pdya= dprio(*Branch(w, DYA_NAME));
  1111. X        name= mk_text(trim == '@' ? S_BEHEAD : S_CURTAIL);
  1112. X        ptrim= dprio(name);
  1113. X        if (!(pdya->L > ptrim->H))
  1114. X            fixerr(NO_TRIM_TARG);
  1115. X        release(name);
  1116. X    }
  1117. X}
  1118. END_OF_FILE
  1119.   if test 3651 -ne `wc -c <'abc/bint2/i2fix.c'`; then
  1120.     echo shar: \"'abc/bint2/i2fix.c'\" unpacked with wrong size!
  1121.   fi
  1122.   # end of 'abc/bint2/i2fix.c'
  1123. fi
  1124. if test -f 'abc/bint2/i2tes.c' -a "${1}" != "-c" ; then 
  1125.   echo shar: Will not clobber existing file \"'abc/bint2/i2tes.c'\"
  1126. else
  1127.   echo shar: Extracting \"'abc/bint2/i2tes.c'\" \(3883 characters\)
  1128.   sed "s/^X//" >'abc/bint2/i2tes.c' <<'END_OF_FILE'
  1129. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  1130. X
  1131. X#include "b.h"
  1132. X#include "bint.h"
  1133. X#include "bobj.h"
  1134. X#include "i0err.h"
  1135. X#include "b0lan.h"
  1136. X#include "i2par.h"
  1137. X#include "i2nod.h"
  1138. X
  1139. X#ifdef macintosh
  1140. X/* Avoid name conflict with standard header files: */
  1141. X#define relop b_relop
  1142. X#endif
  1143. X
  1144. XForward parsetree right_test();
  1145. X
  1146. XVisible parsetree test(q) txptr q; {
  1147. X    parsetree v;
  1148. X    skipsp(&tx);
  1149. X    if (!(conjunction(q, &v) || disjunction(q, &v))) v= right_test(q);
  1150. X    return v;
  1151. X}
  1152. X
  1153. XForward parsetree tight_test();
  1154. X
  1155. XHidden parsetree right_test(q) txptr q; {
  1156. X    parsetree v;
  1157. X    char *kw;
  1158. X    txptr tx0= tx;
  1159. X    
  1160. X    skipsp(&tx);
  1161. X    if (Text(q) && is_keyword(&kw)) {
  1162. X        if (negation(kw, q, &v) || quantification(kw, q, &v))
  1163. X            return v;
  1164. X        else tx= tx0;
  1165. X    }
  1166. X    return tight_test(q);
  1167. X}
  1168. X
  1169. XHidden bool conjunction(q, v) txptr q; parsetree *v; {
  1170. X    txptr ftx, ttx;
  1171. X    if (find(K_AND, q, &ftx, &ttx)) {
  1172. X        parsetree t;
  1173. X        t= tight_test(ftx); tx= ttx;
  1174. X        if (!conjunction(q, v)) *v= right_test(q);
  1175. X        *v= node3(AND, t, *v);
  1176. X        return Yes;
  1177. X    }
  1178. X    return No;
  1179. X}
  1180. X
  1181. XHidden bool disjunction(q, v) txptr q; parsetree *v; {
  1182. X    txptr ftx, ttx;
  1183. X    if (find(K_OR, q, &ftx, &ttx)) {
  1184. X        parsetree t;
  1185. X        t= tight_test(ftx); tx= ttx;
  1186. X        if (!disjunction(q, v)) *v= right_test(q);
  1187. X        *v= node3(OR, t, *v);
  1188. X        return Yes;
  1189. X    }
  1190. X    return No;
  1191. X}
  1192. X
  1193. XHidden bool negation(kw, q, v) char *kw; txptr q; parsetree *v; {
  1194. X    if (not_keyword(kw)) {
  1195. X        *v= node2(NOT, right_test(q));
  1196. X        return Yes;
  1197. X    }
  1198. X    return No;
  1199. X}
  1200. X
  1201. XHidden bool quantification(kw, q, v) char *kw; txptr q; parsetree *v; {
  1202. X    bool some, each;
  1203. X    if ((some= some_keyword(kw)) || (each= each_keyword(kw)) || 
  1204. X            no_keyword(kw)) {
  1205. X        parsetree t, w; 
  1206. X        typenode type;
  1207. X        txptr utx, vtx, ftx, ttx;
  1208. X        
  1209. X        req(K_HAS, ceol, &utx, &vtx);
  1210. X        if (utx > q) {
  1211. X            parerr(MESS(2700, "HAS follows colon"));
  1212. X            /* as in: SOME i IN x: SHOW i HAS a */
  1213. X            utx= tx; vtx= q;
  1214. X        }
  1215. X        req(K_IN_quant, utx, &ftx, &ttx);
  1216. X        idf_cntxt= In_ranger;
  1217. X        t= idf(ftx); tx= ttx;
  1218. X        w= expr(utx); tx= vtx;
  1219. X        type= some ? SOME_IN : each ? EACH_IN : NO_IN;
  1220. X        *v= node4(type, t, w, right_test(q));
  1221. X        return Yes;
  1222. X    }
  1223. X    return No;
  1224. X}
  1225. X
  1226. XForward parsetree ref_or_prop();
  1227. X
  1228. XHidden parsetree tight_test(q) txptr q; {
  1229. X    parsetree v;
  1230. X    skipsp(&tx);
  1231. X    if (nothing(q, MESS(2701, "nothing instead of expected test"))) 
  1232. X        v= NilTree;
  1233. X    else if (!(cl_test(q, &v) || order_test(q, &v))) {
  1234. X        if (Isexpr(Char(tx))) v= ref_or_prop(q);
  1235. X        else {
  1236. X            parerr(NO_TEST);
  1237. X            v= NilTree;
  1238. X        }
  1239. X    }
  1240. X    upto_test(q);
  1241. X    return v;
  1242. X}
  1243. X
  1244. XHidden bool cl_test(q, v) txptr q; parsetree *v; {
  1245. X    txptr tx0= tx;
  1246. X    if (open_sign) { /* (expr) or (test) */
  1247. X        txptr ftx, ttx, tx1;
  1248. X        tx1= tx;
  1249. X        req(S_CLOSE, q, &ftx, &ttx); tx= ttx;
  1250. X        skipsp(&tx);
  1251. X        if (!Text(q)) {
  1252. X            tx= tx1;
  1253. X            *v= compound(ttx, test);
  1254. X            return Yes;
  1255. X        }
  1256. X    }
  1257. X    tx= tx0;
  1258. X    return No;
  1259. X}
  1260. X
  1261. XForward typenode relop();
  1262. X
  1263. XHidden bool order_test(q, v) txptr q; parsetree *v; {
  1264. X    txptr ftx;
  1265. X    if (findrel(q, &ftx)) {
  1266. X        typenode r;
  1267. X        *v= singexpr(ftx);
  1268. X        do {
  1269. X            r= relop();
  1270. X            if (!findrel(q, &ftx)) ftx= q;
  1271. X            *v= node3(r, *v, singexpr(ftx));
  1272. X        }
  1273. X        while (ftx < q);
  1274. X        return Yes;
  1275. X    }
  1276. X    return No;
  1277. X}
  1278. X
  1279. XHidden typenode relop() {
  1280. X    skipsp(&tx);
  1281. X    return
  1282. X        at_most_sign        ? AT_MOST :
  1283. X        unequal_sign        ? UNEQUAL :
  1284. X        at_least_sign        ? AT_LEAST :
  1285. X        equals_sign        ? EQUAL :
  1286. X        less_than_sign        ? LESS_THAN :
  1287. X        greater_than_sign    ? GREATER_THAN :
  1288. X        /* psyserr */          Nonode;
  1289. X}
  1290. X
  1291. X/* refined_test or proposition */
  1292. X
  1293. XHidden parsetree ref_or_prop(q) txptr q; {
  1294. X    value t1, t2;
  1295. X    txptr tx0= tx;
  1296. X    
  1297. X    if (tag_operator(q, &t1)) {
  1298. X        skipsp(&tx);
  1299. X        if (!Text(q))
  1300. X            return node2(TAG, t1);
  1301. X        if (tag_operator(q, &t2)) {
  1302. X            skipsp(&tx);
  1303. X            if (!Text(q))
  1304. X                return node4(MONPRD, t1, node2(TAG, t2), Vnil);
  1305. X            release(t2);
  1306. X        }
  1307. X        release(t1);
  1308. X    }
  1309. X    tx= tx0;
  1310. X    return unp_test(q);
  1311. X} 
  1312. X
  1313. XHidden Procedure upto_test(q) txptr q; {
  1314. X    skipsp(&tx);
  1315. X    if (Text(q)) {
  1316. X        txptr ftx, ttx;
  1317. X        if (find(K_AND, q, &ftx, &ttx) || find(K_OR, q, &ftx, &ttx)) {
  1318. X            tx= ftx;
  1319. X            parerr(PRIO);
  1320. X        }
  1321. X        else parerr(UPTO_TEST);
  1322. X        tx= q;
  1323. X    }
  1324. X}
  1325. END_OF_FILE
  1326.   if test 3883 -ne `wc -c <'abc/bint2/i2tes.c'`; then
  1327.     echo shar: \"'abc/bint2/i2tes.c'\" unpacked with wrong size!
  1328.   fi
  1329.   # end of 'abc/bint2/i2tes.c'
  1330. fi
  1331. if test -f 'abc/bint3/i3env.c' -a "${1}" != "-c" ; then 
  1332.   echo shar: Will not clobber existing file \"'abc/bint3/i3env.c'\"
  1333. else
  1334.   echo shar: Extracting \"'abc/bint3/i3env.c'\" \(3806 characters\)
  1335.   sed "s/^X//" >'abc/bint3/i3env.c' <<'END_OF_FILE'
  1336. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  1337. X
  1338. X/* Environments */
  1339. X
  1340. X#include "b.h"
  1341. X#include "bint.h"
  1342. X#include "bobj.h"
  1343. X#include "i3env.h"     /* for curline, curlino  */
  1344. X
  1345. XVisible envtab prmnvtab;
  1346. XVisible envchain prmnvchain;
  1347. XVisible env prmnv;
  1348. X
  1349. X/* context: */
  1350. X/* The bound tags for the current environment are stored in *bndtgs */
  1351. X/* A new bound tag list is created on evaluating a refined test or expression */
  1352. X
  1353. XVisible env curnv;
  1354. XVisible value *bndtgs;
  1355. XHidden value bndtglist;
  1356. XVisible literal cntxt, resexp;
  1357. XVisible value uname= Vnil;
  1358. XVisible intlet lino;
  1359. XVisible intlet f_lino;
  1360. XVisible intlet i_lino;
  1361. X
  1362. XVisible context read_context;
  1363. X
  1364. XVisible Procedure sv_context(sc) context *sc; {
  1365. X    sc->curnv= curnv;
  1366. X    sc->bndtgs= bndtgs;
  1367. X    sc->cntxt= cntxt;
  1368. X    sc->resexp= resexp;
  1369. X    sc->uname= copy(uname);
  1370. X    sc->cur_line= curline;
  1371. X    sc->cur_lino= curlino;
  1372. X}
  1373. X
  1374. XVisible Procedure set_context(sc) context *sc; {
  1375. X    curnv= sc->curnv;
  1376. X    bndtgs= sc->bndtgs;
  1377. X    cntxt= sc->cntxt;
  1378. X    resexp= sc->resexp;
  1379. X    release(uname); uname= sc->uname;
  1380. X    curline= sc->cur_line;
  1381. X    curlino= sc->cur_lino;
  1382. X}
  1383. X
  1384. XVisible Procedure initprmnv()
  1385. X{
  1386. X    prmnv= &prmnvchain;
  1387. X    prmnv->tab= Vnil;
  1388. X    prmnv->inv_env= Enil;
  1389. X}
  1390. X
  1391. XVisible Procedure initenv() {
  1392. X    /* The following invariant must be maintained:
  1393. X       EITHER:
  1394. X          the original permanent-environment table resides in prmnv->tab
  1395. X          and prmnvtab == Vnil
  1396. X       OR:
  1397. X          the original permanent-environment table resides in prmnvtab
  1398. X          and prmnv->tab contains a scratch-pad copy.
  1399. X    */
  1400. X    prmnv->tab= mk_elt(); prmnvtab= Vnil;
  1401. X    prmnv->inv_env= Enil;
  1402. X    bndtglist= mk_elt();
  1403. X}
  1404. X
  1405. XVisible Procedure endenv() {
  1406. X    release(prmnv->tab); prmnv->tab= Vnil;
  1407. X    release(bndtglist); bndtglist= Vnil;
  1408. X    release(uname); uname= Vnil;
  1409. X}
  1410. X
  1411. XVisible Procedure re_env() {
  1412. X    setprmnv(); bndtgs= &bndtglist;
  1413. X}
  1414. X
  1415. XVisible Procedure setprmnv() {
  1416. X    /* the current and permanent environment are reset
  1417. X       to the original permanent environment */
  1418. X    if (prmnvtab != Vnil) {
  1419. X        prmnv->tab= prmnvtab;
  1420. X        prmnvtab= Vnil;
  1421. X    }
  1422. X    curnv= prmnv;
  1423. X}
  1424. X
  1425. XVisible Procedure e_replace(v, t, k) value v, *t, k; {
  1426. X    if (Is_compound(*t)) {
  1427. X        int n= SmallIntVal(k);
  1428. X        uniql(t);
  1429. X        if (*Field(*t, n) != Vnil) release(*Field(*t, n));
  1430. X        *Field(*t, n)= copy(v);
  1431. X    }
  1432. X    else if (!Is_table(*t)) syserr(MESS(3000, "replacing in non-environment"));
  1433. X    else replace(v, t, k);
  1434. X}
  1435. X
  1436. XVisible Procedure e_delete(t, k) value *t, k; {
  1437. X    if (Is_compound(*t) && IsSmallInt(k)) {
  1438. X        int n= SmallIntVal(k);
  1439. X        if (*Field(*t, n) != Vnil) {
  1440. X            uniql(t); release(*Field(*t, n));
  1441. X            *Field(*t, n)= Vnil;
  1442. X        }
  1443. X    }
  1444. X    else if (!Is_table(*t)) syserr(MESS(3001, "deleting from non-environment"));
  1445. X    else if (in_keys(k, *t)) delete(t, k);
  1446. X}
  1447. X
  1448. XVisible value* envassoc(t, ke) value t, ke; {
  1449. X    if (Is_compound(t) && IsSmallInt(ke)) {
  1450. X        int n= SmallIntVal(ke);
  1451. X        if (*Field(t, n) == Vnil) return Pnil;
  1452. X        return Field(t, n);
  1453. X    }
  1454. X    if (!Is_table(t)) syserr(MESS(3002, "selection on non-environment"));
  1455. X    return adrassoc(t, ke);
  1456. X}
  1457. X
  1458. XVisible bool in_env(tab, ke, aa) value tab, ke, **aa; {
  1459. X    /* IF ke in keys tab:
  1460. X        PUT tab[ke] IN aa
  1461. X        SUCCEED
  1462. X       FAIL
  1463. X    */
  1464. X    *aa= envassoc(tab, ke);
  1465. X    return (*aa != Pnil);
  1466. X}
  1467. X
  1468. XVisible Procedure extbnd_tags(btl, et) value btl; envtab et; {
  1469. X    /* Copy bound targets to the invoking environment */
  1470. X    /* FOR tag IN btl: \ btl is the bound tag list
  1471. X           IF tag in keys et: \ et is the environment we're just leaving
  1472. X               PUT et[tag] IN curnv[tag] \ curnv is the invoking environment
  1473. X    */
  1474. X    value *aa, tag;
  1475. X    int len= length(btl), k;
  1476. X    for (k= 1; k <= len; k++) {
  1477. X        tag= thof(k, btl);
  1478. X        if (in_env(et, tag, &aa)) {
  1479. X            e_replace(*aa, &(curnv->tab), tag);
  1480. X            if (*bndtgs != Vnil) insert(tag, bndtgs);
  1481. X        }
  1482. X        release(tag);
  1483. X    }
  1484. X}
  1485. X
  1486. XVisible Procedure lst_ttgs() {
  1487. X    int k, len;
  1488. X    len= length(prmnv->tab);
  1489. X    for (k= 0; k < len; k++) {
  1490. X        writ(*key(prmnv->tab, k));
  1491. X        wri_space();
  1492. X    }
  1493. X    if (len > 0)
  1494. X        newline();
  1495. X}
  1496. END_OF_FILE
  1497.   if test 3806 -ne `wc -c <'abc/bint3/i3env.c'`; then
  1498.     echo shar: \"'abc/bint3/i3env.c'\" unpacked with wrong size!
  1499.   fi
  1500.   # end of 'abc/bint3/i3env.c'
  1501. fi
  1502. if test -f 'abc/boot/comp.c' -a "${1}" != "-c" ; then 
  1503.   echo shar: Will not clobber existing file \"'abc/boot/comp.c'\"
  1504. else
  1505.   echo shar: Extracting \"'abc/boot/comp.c'\" \(4152 characters\)
  1506.   sed "s/^X//" >'abc/boot/comp.c' <<'END_OF_FILE'
  1507. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
  1508. X
  1509. X/*
  1510. X * Compute classinfo from filled-in tables.
  1511. X */
  1512. X
  1513. X#include "b.h"
  1514. X#include "main.h"
  1515. X#include "code.h"
  1516. X
  1517. XVisible Procedure compute_classes() {
  1518. X    
  1519. X    initcodes();
  1520. X    
  1521. X    comp_classes();
  1522. X}
  1523. X
  1524. X/*
  1525. X * Initialization routine for the 'struct classinfo' stuff.
  1526. X *
  1527. X * Now that the c_syms[] array of each class has been read and replaced
  1528. X * by the correct index in the symdef[] table, we can compute the c_insert,
  1529. X * c_append and c_join arrays.
  1530. X *
  1531. X * Classes "suggestion-body" and "sugghowname-body" are skipped:
  1532. X * what can be inserted there is not computed from this table.
  1533. X */
  1534. X
  1535. XHidden Procedure comp_classes()
  1536. X{
  1537. X    int iclass;
  1538. X    struct classinfo *pclass;
  1539. X
  1540. X    for (iclass= 0; iclass < nclass; iclass++) {
  1541. X        pclass = &classdef[iclass];
  1542. X        if (iclass == nsuggstnbody || iclass == nsugghowbody)
  1543. X            continue; /* Dead entry */
  1544. X        defclass(pclass);
  1545. X    }
  1546. X}
  1547. X
  1548. XForward int fwidth();
  1549. X
  1550. XHidden Procedure defclass(pclass) struct classinfo *pclass; {
  1551. X    itemptr psymbol;
  1552. X    struct syminfo *psym;
  1553. X    string rep0;
  1554. X    item class0;
  1555. X    string rep1;
  1556. X    int fw1;
  1557. X    itemptr psubsym;
  1558. X    item insert[1024];
  1559. X    item append[1024];
  1560. X    item join[1024];
  1561. X    int inslen = 0;
  1562. X    int applen = 0;
  1563. X    int joinlen = 0;
  1564. X    int c;
  1565. X
  1566. X
  1567. X    psymbol= pclass->c_syms;
  1568. X
  1569. X    for (; !Isnilitem(*psymbol); ++psymbol) {
  1570. X        if (*psymbol == noptional)
  1571. X            continue;
  1572. X        if (*psymbol >= nlexical) { /* Insert direct lexical item */
  1573. X            for (c= 1; c <= lastcode; c++) {
  1574. X                if (maystart(Invcode(c), *psymbol)) {
  1575. X        Assert(inslen+3 < sizeof insert / sizeof insert[0]);
  1576. X                    insert[inslen] = c;
  1577. X                    insert[inslen+1] = *psymbol;
  1578. X                    inslen += 2;
  1579. X                }
  1580. X            }
  1581. X            continue;
  1582. X        }
  1583. X        /* else: Sym: "rep0", class0, "rep1", class1, ... */
  1584. X        psym= &symdef[*psymbol];
  1585. X        rep0= psym->s_repr[0];
  1586. X        if (rep0 != 0 && strchr("\b\t", rep0[0]) == NULL) {
  1587. X            /* Insert fixed text */
  1588. X            c = Code(rep0[0]);
  1589. X        Assert(inslen+3 < sizeof insert / sizeof insert[0]);
  1590. X            insert[inslen] = c;
  1591. X            insert[inslen+1] = *psymbol;
  1592. X            inslen += 2;
  1593. X            continue;
  1594. X        }
  1595. X        /* else: "rep0" was empty; try start of class0 */
  1596. X        Assert(!Isnilitem(psym->s_class[0]));
  1597. X        class0= psym->s_class[0];
  1598. X        psubsym= classdef[class0].c_syms;
  1599. X        for (; !Isnilitem(*psubsym); psubsym++) {
  1600. X            if (*psubsym < nlexical)
  1601. X                continue;
  1602. X            for (c= 1; c <= lastcode; ++c) { 
  1603. X                /* Insert indirect lexical items */
  1604. X                if (maystart(Invcode(c), *psubsym)) {
  1605. X        Assert(inslen+3 < sizeof insert / sizeof insert[0]);
  1606. X                    insert[inslen]= c;
  1607. X                    insert[inslen+1]= *psymbol;
  1608. X                    inslen += 2;
  1609. X                }
  1610. X            }
  1611. X        }
  1612. X        rep1= psym->s_repr[1];
  1613. X        fw1= (rep1 == 0 ? 0 : fwidth(rep1));
  1614. X        if (fw1) { /* Append */
  1615. X            c= rep1[0];
  1616. X            Assert(c > 0 && c < RANGE);
  1617. X            if (c == ' ') {
  1618. X                c= rep1[1];
  1619. X                if (!c || c == '\b' || c == '\t')
  1620. X                    c= ' ';
  1621. X                else
  1622. X                    c|= 0200;
  1623. X            }
  1624. X            Assert(applen+3 < sizeof append / sizeof append[0]);
  1625. X            append[applen]= c;
  1626. X            append[applen+1]= *psymbol;
  1627. X            applen += 2;
  1628. X        }
  1629. X        if ((!fw1 || fw1 == 1 && rep1[0] == ' ')
  1630. X            &&
  1631. X            !Isnilitem(psym->s_class[1]))
  1632. X        { /* Join */
  1633. X            Assert(joinlen+3 < sizeof join / sizeof join[0]);
  1634. X            join[joinlen]= 1 + fw1;
  1635. X            join[joinlen+1]= *psymbol;
  1636. X            joinlen += 2;
  1637. X        }
  1638. X    }
  1639. X
  1640. X    Assert(inslen); /* Dead alley */
  1641. X    insert[inslen]= Nilitem;
  1642. X    pclass->c_insert= savearray(insert, inslen + 1);
  1643. X    if (applen) {
  1644. X        append[applen]= Nilitem;
  1645. X        pclass->c_append= savearray(append, applen + 1);
  1646. X    }
  1647. X    if (joinlen) {
  1648. X        join[joinlen]= Nilitem;
  1649. X        pclass->c_join= savearray(join, joinlen + 1);
  1650. X    }
  1651. X}
  1652. X
  1653. XVisible bool maystart(c, ilex) char c; item ilex; {
  1654. X    string cp;
  1655. X
  1656. X    ilex -= nlexical;
  1657. X    Assert(ilex >= 0);
  1658. X    if (ilex >= nlex || !isascii(c) || c != ' ' && !isprint(c))
  1659. X        return No;
  1660. X    cp= lexdef[ilex].l_start;
  1661. X    if (*cp == '^')
  1662. X        return !strchr(cp+1, c);
  1663. X    return strchr(cp, c) != 0;
  1664. X}
  1665. X
  1666. X/*
  1667. X * Yield the width of a piece of fixed text, excluding \b or \t.
  1668. X * If \n or \r is found, -1 is returned.
  1669. X * It assumes that \n or \r only occur as first
  1670. X * character, and \b or \t only as last.
  1671. X */
  1672. X
  1673. XHidden int fwidth(str) string str; {
  1674. X    register int c;
  1675. X    register int n = 0;
  1676. X
  1677. X    if (!str)
  1678. X        return 0;
  1679. X    c = str[0];
  1680. X    if (c == '\r' || c == '\n')
  1681. X        return -1;
  1682. X    for (; c; c = *++str)
  1683. X        ++n;
  1684. X    if (n > 0) {
  1685. X        c = str[-1];
  1686. X        if (c == '\t' || c == '\b')
  1687. X            --n;
  1688. X    }
  1689. X    return n;
  1690. X}
  1691. END_OF_FILE
  1692.   if test 4152 -ne `wc -c <'abc/boot/comp.c'`; then
  1693.     echo shar: \"'abc/boot/comp.c'\" unpacked with wrong size!
  1694.   fi
  1695.   # end of 'abc/boot/comp.c'
  1696. fi
  1697. if test -f 'abc/btr/i1btr.c' -a "${1}" != "-c" ; then 
  1698.   echo shar: Will not clobber existing file \"'abc/btr/i1btr.c'\"
  1699. else
  1700.   echo shar: Extracting \"'abc/btr/i1btr.c'\" \(3536 characters\)
  1701.   sed "s/^X//" >'abc/btr/i1btr.c' <<'END_OF_FILE'
  1702. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  1703. X
  1704. X#include "b.h"
  1705. X#include "bmem.h"
  1706. X#include "i1btr.h"
  1707. X#include "i1tlt.h"
  1708. X
  1709. X/*********************************************************************/
  1710. X/* grab, copy, release of btree(node)s
  1711. X/*********************************************************************/
  1712. X
  1713. XVisible btreeptr
  1714. Xgrabbtreenode(flag, it)
  1715. X    literal flag; literal it;
  1716. X{
  1717. X    btreeptr pnode; unsigned syz;
  1718. X    static intlet isize[]= {
  1719. X        sizeof(itexnode), sizeof(ilisnode),
  1720. X        sizeof(itabnode), sizeof(itabnode)};
  1721. X    static intlet bsize[]= {
  1722. X        sizeof(btexnode), sizeof(blisnode),
  1723. X        sizeof(btabnode), sizeof(btabnode)};
  1724. X    switch (flag) {
  1725. X    case Inner:
  1726. X        syz= isize[it];
  1727. X        break;
  1728. X    case Bottom:
  1729. X        syz= bsize[it];
  1730. X        break;
  1731. X    case Irange:
  1732. X    case Crange:
  1733. X        syz = sizeof(rangenode);
  1734. X        break;
  1735. X    }
  1736. X    pnode = (btreeptr) getmem((unsigned) syz);
  1737. X    Refcnt(pnode) = 1;
  1738. X    Flag(pnode) = flag;
  1739. X    return(pnode);
  1740. X}
  1741. X
  1742. X/* ----------------------------------------------------------------- */
  1743. X
  1744. XVisible btreeptr copybtree(pnode) btreeptr pnode; {
  1745. X    if (pnode != Bnil && Refcnt(pnode) < Maxrefcnt) ++Refcnt(pnode);
  1746. X    return(pnode);
  1747. X}
  1748. X
  1749. XVisible Procedure uniqlbtreenode(pptr, it) btreeptr *pptr; literal it; {
  1750. X    if (*pptr NE Bnil && Refcnt(*pptr) > 1) {
  1751. X        btreeptr qnode = *pptr;
  1752. X        *pptr = ccopybtreenode(*pptr, it);
  1753. X        relbtree(qnode, it);
  1754. X    }
  1755. X}
  1756. X
  1757. XVisible btreeptr ccopybtreenode(pnode, it) btreeptr pnode; literal it; {
  1758. X    intlet limp;
  1759. X    btreeptr qnode;
  1760. X    intlet iw;
  1761. X    
  1762. X    iw = Itemwidth(it);
  1763. X    qnode = grabbtreenode(Flag(pnode), it);
  1764. X    Lim(qnode) = limp = Lim(pnode);
  1765. X    Size(qnode) = Size(pnode);
  1766. X    switch (Flag(qnode)) {
  1767. X    case Inner:
  1768. X        cpynitms(Piitm(qnode, 0, iw), Piitm(pnode, 0, iw), limp, it);
  1769. X        cpynptrs(&Ptr(qnode, 0), &Ptr(pnode, 0), limp+1);
  1770. X        break;
  1771. X     case Bottom:
  1772. X        cpynitms(Pbitm(qnode, 0, iw), Pbitm(pnode, 0, iw), limp, it);
  1773. X        break;
  1774. X    case Irange:
  1775. X    case Crange:
  1776. X        Lwbval(qnode) = copy(Lwbval(pnode));
  1777. X        Upbval(qnode) = copy(Upbval(pnode));
  1778. X        break;
  1779. X    default:
  1780. X        syserr(MESS(400, "unknown flag in ccopybtreenode"));
  1781. X    }
  1782. X    return(qnode);
  1783. X}
  1784. X
  1785. X/* make a new root (after the old ptr0 split) */
  1786. X
  1787. XVisible btreeptr mknewroot(ptr0, pitm0, ptr1, it)
  1788. X    btreeptr ptr0, ptr1; itemptr pitm0; literal it;
  1789. X{
  1790. X    int r;
  1791. X    intlet iw = Itemwidth(it);
  1792. X    btreeptr qnode = grabbtreenode(Inner, it);
  1793. X    Ptr(qnode, 0) = ptr0;
  1794. X    movnitms(Piitm(qnode, 0, iw), pitm0, 1, iw);
  1795. X    Ptr(qnode, 1) = ptr1;
  1796. X    Lim(qnode) = 1;
  1797. X    r= Sincr(Size(ptr0));
  1798. X    Size(qnode) = Ssum(r, Size(ptr1));
  1799. X    return(qnode);
  1800. X}
  1801. X
  1802. X/* ----------------------------------------------------------------- */
  1803. X
  1804. X/* release btree */
  1805. X
  1806. XVisible Procedure relbtree(pnode, it) btreeptr pnode; literal it; {
  1807. X    width iw;
  1808. X    
  1809. X    iw = Itemwidth(it);
  1810. X    if (pnode EQ Bnil)
  1811. X        return;
  1812. X    if (Refcnt(pnode) EQ 0) {
  1813. X        syserr(MESS(401, "releasing unreferenced btreenode"));
  1814. X        return;
  1815. X    }
  1816. X    if (Refcnt(pnode) < Maxrefcnt && --Refcnt(pnode) EQ 0) {
  1817. X        intlet l;
  1818. X        switch (Flag(pnode)) {
  1819. X        case Inner:
  1820. X            for (l = 0; l < Lim(pnode); l++) {
  1821. X                relbtree(Ptr(pnode, l), it);
  1822. X                switch (it) {
  1823. X                case Tt:
  1824. X                case Kt:
  1825. X                    release(Ascval(Piitm(pnode, l, iw)));
  1826. X                case Lt:
  1827. X                    release(Keyval(Piitm(pnode, l, iw)));
  1828. X                }
  1829. X            }
  1830. X            relbtree(Ptr(pnode, l), it);
  1831. X            break;
  1832. X        case Bottom:
  1833. X            for (l = 0; l < Lim(pnode); l++) {
  1834. X                switch (it) {
  1835. X                case Tt:
  1836. X                case Kt:
  1837. X                    release(Ascval(Pbitm(pnode, l, iw)));
  1838. X                case Lt:
  1839. X                    release(Keyval(Pbitm(pnode, l, iw)));
  1840. X                }
  1841. X            }
  1842. X            break;
  1843. X        case Irange:
  1844. X        case Crange:
  1845. X            release(Lwbval(pnode));
  1846. X            release(Upbval(pnode));
  1847. X            break;
  1848. X        default:
  1849. X            syserr(MESS(402, "wrong flag in relbtree()"));
  1850. X        }
  1851. X        freemem((ptr) pnode);
  1852. X    }
  1853. X}
  1854. X
  1855. END_OF_FILE
  1856.   if test 3536 -ne `wc -c <'abc/btr/i1btr.c'`; then
  1857.     echo shar: \"'abc/btr/i1btr.c'\" unpacked with wrong size!
  1858.   fi
  1859.   # end of 'abc/btr/i1btr.c'
  1860. fi
  1861. if test -f 'abc/lin/i1tex.c' -a "${1}" != "-c" ; then 
  1862.   echo shar: Will not clobber existing file \"'abc/lin/i1tex.c'\"
  1863. else
  1864.   echo shar: Extracting \"'abc/lin/i1tex.c'\" \(3957 characters\)
  1865.   sed "s/^X//" >'abc/lin/i1tex.c' <<'END_OF_FILE'
  1866. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  1867. X
  1868. X/* B texts */
  1869. X
  1870. X#include "b.h"
  1871. X#include "bmem.h"
  1872. X#include "bobj.h"
  1873. X#include "i1tlt.h"
  1874. X
  1875. X#define CURTAIL_TEX    MESS(200, "in t|n, t is not a text")
  1876. X#define CURTAIL_NUM    MESS(201, "in t|n, n is not a number")
  1877. X#define CURTAIL_INT    MESS(202, "in t|n, n is not an integer")
  1878. X#define CURTAIL_BND    MESS(203, "in t|n, n is < 0")
  1879. X
  1880. X#define BEHEAD_TEX    MESS(204, "in t@n, t is not a text")
  1881. X#define BEHEAD_NUM    MESS(205, "in t@n, n is not a number")
  1882. X#define BEHEAD_INT    MESS(206, "in t@n, n is not an integer")
  1883. X#define BEHEAD_BND    MESS(207, "in t@n, n is > #t + 1")
  1884. X
  1885. X#define CONCAT_TEX    MESS(208, "in t^u, t or u is not a text")
  1886. X#define CONCAT_LONG    MESS(209, "in t^u, the result is too long")
  1887. X
  1888. X#define REPEAT_TEX    MESS(210, "in t^^n, t is not a text")
  1889. X#define REPEAT_NUM    MESS(211, "in t^^n, n is not a number")
  1890. X#define REPEAT_INT    MESS(212, "in t^^n, n is not an integer")
  1891. X#define REPEAT_NEG    MESS(213, "in t^^n, n is negative")
  1892. X#define REPEAT_LONG    MESS(214, "in t^^n, the result is too long")
  1893. X
  1894. XVisible value mk_text(m) string m; {
  1895. X    value v; intlet len= strlen(m);
  1896. X    v= grab(Tex, len);
  1897. X    strcpy(Str(v), m);
  1898. X    return v;
  1899. X}
  1900. X
  1901. XVisible bool character(v) value v; {
  1902. X    if (Is_text(v) && Length(v) == 1) return Yes;
  1903. X    else return No;
  1904. X}
  1905. X
  1906. XVisible char charval(v) value v; {
  1907. X    if (!Is_text(v) || Length(v) != 1) 
  1908. X        interr(MESS(215, "value not a character"));
  1909. X    return *Str(v);
  1910. X}
  1911. X
  1912. XVisible char ncharval(n, v) int n; value v; {
  1913. X    return *(Str(v)+n-1);
  1914. X}
  1915. X
  1916. XVisible string strval(v) value v; {
  1917. X    return Str(v);
  1918. X}
  1919. X
  1920. XVisible string sstrval(v) value v; {
  1921. X    return savestr((string) Str(v));
  1922. X}
  1923. X
  1924. XVisible Procedure fstrval(s) string s; {
  1925. X    freestr(s);
  1926. X}
  1927. X
  1928. XVisible value concat(s, t) value s, t; {
  1929. X    if (Type(s) != Tex || Type(t) != Tex)
  1930. X        interr(CONCAT_TEX);
  1931. X    else {
  1932. X        value c= grab(Tex, Length(s)+Length(t));
  1933. X        strcpy(Str(c), Str(s)); strcpy(Str(c)+Length(s), Str(t));
  1934. X        return c;
  1935. X    }
  1936. X    return grab(Tex, 0);
  1937. X}
  1938. X
  1939. XVisible Procedure concato(s, t) value *s, t; {
  1940. X    value v= *s;
  1941. X    *s= concat(*s, t);
  1942. X    release(v);
  1943. X}
  1944. X
  1945. XVisible value icurtail(v, k) value v; int k; {
  1946. X    if (k >= Length(v))
  1947. X        return copy(v);
  1948. X    else {
  1949. X        value w= grab(Tex, k);
  1950. X        strncpy(Str(w), Str(v), k);
  1951. X        *(Str(w) + k)= '\0';
  1952. X        return w;
  1953. X    }
  1954. X}
  1955. X
  1956. XVisible value curtail(v, n) value v, n; {
  1957. X    if (!Is_text(v))
  1958. X        interr(CURTAIL_TEX);
  1959. X    else if (!Is_number(n))
  1960. X        interr(CURTAIL_NUM);
  1961. X    else if (!integral(n))
  1962. X        interr(CURTAIL_INT);
  1963. X    else {
  1964. X        intlet k= intval(n);
  1965. X        if (k < 0) interr(CURTAIL_BND);
  1966. X        else return icurtail(v, k);
  1967. X    }
  1968. X    return grab(Tex, 0);
  1969. X}
  1970. X
  1971. XVisible value ibehead(v, k) value v; int k; {
  1972. X    if (k <= 1)
  1973. X        return copy(v);
  1974. X    else {
  1975. X        value w= grab(Tex, Length(v) - (k - 1));
  1976. X        strcpy(Str(w), Str(v) + k - 1);
  1977. X        return w;
  1978. X    }
  1979. X}
  1980. X
  1981. XVisible value behead(v, n) value v, n; {
  1982. X    if (!Is_text(v))
  1983. X        interr(BEHEAD_TEX);
  1984. X    else if (!Is_number(n))
  1985. X        interr(BEHEAD_NUM);
  1986. X    else if (!integral(n))
  1987. X        interr(BEHEAD_INT);
  1988. X    else {
  1989. X        intlet b= intval(n);
  1990. X        if (b > Length(v) + 1) interr(BEHEAD_BND);
  1991. X        else return ibehead(v, b);
  1992. X    }
  1993. X    return grab(Tex, 0);
  1994. X}
  1995. X
  1996. XVisible value repeat(x, y) value x, y; {
  1997. X    intlet i;
  1998. X    if (Type(x) != Tex) {
  1999. X        interr(REPEAT_TEX);
  2000. X        return grab(Tex, 0);
  2001. X    }
  2002. X    if (!Is_number(y)) {
  2003. X        interr(REPEAT_NUM);
  2004. X        return grab(Tex, 0);
  2005. X    }
  2006. X    i= propintlet(intval(y));
  2007. X    if (i < 0)
  2008. X        interr(REPEAT_NEG);
  2009. X    else {
  2010. X        value r; string xp, rp; intlet p, q, xl= Length(x);
  2011. X        intlet ixl= propintlet(i*xl);
  2012. X#ifdef IBMPC
  2013. X        bool enough_space();
  2014. X        if (!enough_space(Tex, ixl)) {
  2015. X            interr(REPEAT_LONG);
  2016. X            return grab(Tex, 0);
  2017. X        }
  2018. X#endif
  2019. X        r= grab(Tex, ixl);
  2020. X        rp= Str(r);
  2021. X        for (p= 0; p < i; p++) {
  2022. X            xp= Str(x);
  2023. X            for (q= 0; q < xl; q++) *rp++= *xp++;
  2024. X        }
  2025. X        *rp= '\0';
  2026. X        return r;
  2027. X    }
  2028. X    return grab(Tex, 0);
  2029. X}
  2030. X
  2031. XVisible Procedure wrtext(putch, v, quote) int (*putch)(); value v; char quote; {
  2032. X        char c; int k, len= Length(v);
  2033. X        if (quote) (*putch)(quote);
  2034. X        for (k=0; k<len && still_ok; k++) {
  2035. X            c= ncharval(k+1, v);
  2036. X            (*putch)(c);
  2037. X            if (quote && (c == quote || c == '`'))
  2038. X                (*putch)(c);
  2039. X        }
  2040. X        if (quote) (*putch)(quote);
  2041. X}
  2042. END_OF_FILE
  2043.   if test 3957 -ne `wc -c <'abc/lin/i1tex.c'`; then
  2044.     echo shar: \"'abc/lin/i1tex.c'\" unpacked with wrong size!
  2045.   fi
  2046.   # end of 'abc/lin/i1tex.c'
  2047. fi
  2048. if test -f 'abc/tc/tgoto.c' -a "${1}" != "-c" ; then 
  2049.   echo shar: Will not clobber existing file \"'abc/tc/tgoto.c'\"
  2050. else
  2051.   echo shar: Extracting \"'abc/tc/tgoto.c'\" \(3539 characters\)
  2052.   sed "s/^X//" >'abc/tc/tgoto.c' <<'END_OF_FILE'
  2053. X#define    CTRL(c)    ('c' & 037)
  2054. X
  2055. X#define MAXRETURNSIZE 64
  2056. X
  2057. Xchar    *UP;
  2058. Xchar    *BC;
  2059. X
  2060. X/*
  2061. X * Routine to perform cursor addressing.
  2062. X * CM is a string containing printf type escapes to allow
  2063. X * cursor addressing.  We start out ready to print the destination
  2064. X * line, and switch each time we print row or column.
  2065. X * The following escapes are defined for substituting row/column:
  2066. X *
  2067. X *    %d    as in printf
  2068. X *    %2    like %2d
  2069. X *    %3    like %3d
  2070. X *    %.    gives %c hacking special case characters
  2071. X *    %+x    like %c but adding x first
  2072. X *
  2073. X *    The codes below affect the state but don't use up a value.
  2074. X *
  2075. X *    %>xy    if value > x add y
  2076. X *    %r    reverses row/column
  2077. X *    %i    increments row/column (for one origin indexing)
  2078. X *    %%    gives %
  2079. X *    %B    BCD (2 decimal digits encoded in one byte)
  2080. X *    %D    Delta Data (backwards bcd)
  2081. X *
  2082. X * all other characters are ``self-inserting''.
  2083. X */
  2084. Xchar *
  2085. Xtgoto(CM, destcol, destline)
  2086. X    char *CM;
  2087. X    int destcol, destline;
  2088. X{
  2089. X    static char result[MAXRETURNSIZE];
  2090. X    static char added[10];
  2091. X    char *cp = CM;
  2092. X    register char *dp = result;
  2093. X    register int c;
  2094. X    int oncol = 0;
  2095. X    register int which = destline;
  2096. X
  2097. X    if (cp == 0) {
  2098. Xtoohard:
  2099. X        /*
  2100. X         * ``We don't do that under BOZO's big top''
  2101. X         */
  2102. X        return ("OOPS");
  2103. X    }
  2104. X    added[0] = 0;
  2105. X    while (c = *cp++) {
  2106. X        if (c != '%') {
  2107. X            *dp++ = c;
  2108. X            continue;
  2109. X        }
  2110. X        switch (c = *cp++) {
  2111. X
  2112. X#ifdef CM_N
  2113. X        case 'n':
  2114. X            destcol ^= 0140;
  2115. X            destline ^= 0140;
  2116. X            goto setwhich;
  2117. X#endif
  2118. X
  2119. X        case 'd':
  2120. X            if (which < 10)
  2121. X                goto one;
  2122. X            if (which < 100)
  2123. X                goto two;
  2124. X            /* fall into... */
  2125. X
  2126. X        case '3':
  2127. X            *dp++ = (which / 100) | '0';
  2128. X            which %= 100;
  2129. X            /* fall into... */
  2130. X
  2131. X        case '2':
  2132. Xtwo:    
  2133. X            *dp++ = which / 10 | '0';
  2134. Xone:
  2135. X            *dp++ = which % 10 | '0';
  2136. Xswap:
  2137. X            oncol = 1 - oncol;
  2138. Xsetwhich:
  2139. X            which = oncol ? destcol : destline;
  2140. X            continue;
  2141. X
  2142. X#ifdef CM_GT
  2143. X        case '>':
  2144. X            if (which > *cp++)
  2145. X                which += *cp++;
  2146. X            else
  2147. X                cp++;
  2148. X            continue;
  2149. X#endif
  2150. X
  2151. X        case '+':
  2152. X            which += *cp++;
  2153. X            /* fall into... */
  2154. X
  2155. X        case '.':
  2156. Xcasedot:
  2157. X            /*
  2158. X             * This code is worth scratching your head at for a
  2159. X             * while.  The idea is that various weird things can
  2160. X             * happen to nulls, EOT's, tabs, and newlines by the
  2161. X             * tty driver, arpanet, and so on, so we don't send
  2162. X             * them if we can help it.
  2163. X             *
  2164. X             * Tab is taken out to get Ann Arbors to work, otherwise
  2165. X             * when they go to column 9 we increment which is wrong
  2166. X             * because bcd isn't continuous.  We should take out
  2167. X             * the rest too, or run the thing through more than
  2168. X             * once until it doesn't make any of these, but that
  2169. X             * would make termlib (and hence pdp-11 ex) bigger,
  2170. X             * and also somewhat slower.  This requires all
  2171. X             * programs which use termlib to stty tabs so they
  2172. X             * don't get expanded.  They should do this anyway
  2173. X             * because some terminals use ^I for other things,
  2174. X             * like nondestructive space.
  2175. X             */
  2176. X            if (which == 0 || which == CTRL(d) || /* which == '\t' || */ which == '\n') {
  2177. X                if (oncol || UP) /* Assumption: backspace works */
  2178. X                    /*
  2179. X                     * Loop needed because newline happens
  2180. X                     * to be the successor of tab.
  2181. X                     */
  2182. X                    do {
  2183. X                        strcat(added, oncol ? (BC ? BC : "\b") : UP);
  2184. X                        which++;
  2185. X                    } while (which == '\n');
  2186. X            }
  2187. X            *dp++ = which;
  2188. X            goto swap;
  2189. X
  2190. X        case 'r':
  2191. X            oncol = 1;
  2192. X            goto setwhich;
  2193. X
  2194. X        case 'i':
  2195. X            destcol++;
  2196. X            destline++;
  2197. X            which++;
  2198. X            continue;
  2199. X
  2200. X        case '%':
  2201. X            *dp++ = c;
  2202. X            continue;
  2203. X
  2204. X#ifdef CM_B
  2205. X        case 'B':
  2206. X            which = (which/10 << 4) + which%10;
  2207. X            continue;
  2208. X#endif
  2209. X
  2210. X#ifdef CM_D
  2211. X        case 'D':
  2212. X            which = which - 2 * (which%16);
  2213. X            continue;
  2214. X#endif
  2215. X
  2216. X        default:
  2217. X            goto toohard;
  2218. X        }
  2219. X    }
  2220. X    strcpy(dp, added);
  2221. X    return (result);
  2222. X}
  2223. END_OF_FILE
  2224.   if test 3539 -ne `wc -c <'abc/tc/tgoto.c'`; then
  2225.     echo shar: \"'abc/tc/tgoto.c'\" unpacked with wrong size!
  2226.   fi
  2227.   # end of 'abc/tc/tgoto.c'
  2228. fi
  2229. if test -f 'abc/ukeys/abckeys_924' -a "${1}" != "-c" ; then 
  2230.   echo shar: Will not clobber existing file \"'abc/ukeys/abckeys_924'\"
  2231. else
  2232.   echo shar: Extracting \"'abc/ukeys/abckeys_924'\" \(1720 characters\)
  2233.   sed "s/^X//" >'abc/ukeys/abckeys_924' <<'END_OF_FILE'
  2234. X# B key definitions file for Televideo 924.
  2235. X#
  2236. X# reprogram left arrow as different from BACKSPACE, then rebind LEFT and UNDO
  2237. X[term_init] = "\e0C\eKL" = ""
  2238. X[term_done] = "\e0C\b\200\200" = ""
  2239. X[left] = "\eKL" = "Left-Arrow"
  2240. X[undo] = "\b" = "BACKSPACE"
  2241. X
  2242. X# Define the other arrow keys if not already defined by termcap
  2243. X[down] = "\026" = "Down-Arrow"
  2244. X[up] = "\013" = "Up-Arrow"
  2245. X[right] = "\014" = "Right-Arrow"
  2246. X# this last ones overwrites REDRAW; so REDRAW goes to CLEAR/HOME key
  2247. X# (unshifted: ^^; shifted is ^Z, so impossible to catch)
  2248. X[look] = "\036" = "CLEAR/HOME"
  2249. X
  2250. X# Unshifted function keys send ^A @ ^M, ^A A ^M through ^A O ^M
  2251. X
  2252. X[widen]    = "\001@\015" = "F1"
  2253. X[extend]   = "\001A\015" = "F2"
  2254. X[first]    = "\001B\015" = "F3"
  2255. X[last]     = "\001C\015" = "F4"
  2256. X[previous] = "\001D\015" = "F5"
  2257. X[next]     = "\001E\015" = "F6"
  2258. X[upline]   = "\001F\015" = "f7"
  2259. X[downline] = "\001G\015" = "f8"
  2260. X[copy]     = "\001H\015" = "F9"
  2261. X[delete]   = "\001I\015" = "F10"
  2262. X[record]   = "\001J\015" = "F11"
  2263. X[playback] = "\001K\015" = "F12"
  2264. X[ignore]   = "\001L\015" = "F13"
  2265. X[look]       = "\001M\015" = "F14"
  2266. X[help]       = "\001N\015" = "F15"
  2267. X[redo]     = "\001O\015" = "F16"
  2268. X
  2269. X# Shifted function keys send ^A ` ^M through ^A o ^M
  2270. X
  2271. X[ignore] = "\001`\015" = ""
  2272. X[ignore] = "\001a\015" = ""
  2273. X[ignore] = "\001b\015" = ""
  2274. X[ignore] = "\001c\015" = ""
  2275. X[ignore] = "\001d\015" = ""
  2276. X[ignore] = "\001e\015" = ""
  2277. X[ignore] = "\001f\015" = ""
  2278. X[ignore] = "\001g\015" = ""
  2279. X[ignore] = "\001h\015" = ""
  2280. X[ignore] = "\001i\015" = ""
  2281. X[ignore] = "\001j\015" = ""
  2282. X[ignore] = "\001k\015" = ""
  2283. X[ignore] = "\001l\015" = ""
  2284. X[ignore] = "\001m\015" = ""
  2285. X[ignore] = "\001n\015" = ""
  2286. X[ignore] = "\001o\015" = ""
  2287. X
  2288. X# unbind GOTO operation
  2289. X[ignore] = "\033g" = ""
  2290. X[ignore] = "\007" = ""
  2291. END_OF_FILE
  2292.   if test 1720 -ne `wc -c <'abc/ukeys/abckeys_924'`; then
  2293.     echo shar: \"'abc/ukeys/abckeys_924'\" unpacked with wrong size!
  2294.   fi
  2295.   # end of 'abc/ukeys/abckeys_924'
  2296. fi
  2297. echo shar: End of archive 21 \(of 25\).
  2298. cp /dev/null ark21isdone
  2299. MISSING=""
  2300. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ; do
  2301.     if test ! -f ark${I}isdone ; then
  2302.     MISSING="${MISSING} ${I}"
  2303.     fi
  2304. done
  2305. if test "${MISSING}" = "" ; then
  2306.     echo You have unpacked all 25 archives.
  2307.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  2308. else
  2309.     echo You still must unpack the following archives:
  2310.     echo "        " ${MISSING}
  2311. fi
  2312. exit 0 # Just in case...
  2313.