home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume23 / abc / patch2 < prev    next >
Encoding:
Internet Message Format  |  1991-01-08  |  53.8 KB

  1. Subject:  v23i074:  ABC interactive programming environment, Patch2
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: 23861caa 621356e3 f52c08f0 1061c42c
  5.  
  6. Submitted-by: timo@cwi.nl
  7. Posting-number: Volume 23, Issue 74
  8. Archive-name: abc/patch2
  9.  
  10. This is the first patch from the authors for the ABC interactive
  11. programming environment. It contains 10 more files missing from the
  12. original posting to comp.sources.unix, apart from ./abc/bhdrs/bint.h that
  13. was already send by Rich Salz in patch1.  Our second patch will contain
  14. some minor bugfixes.
  15.  
  16. Note that patch0 from Rich is not actually needed; if the files
  17. abc/ex/generate/follower.cts and abc/ex/try/follower.cts are corrupted you
  18. can just delete them.  (You're right they should not have been included.
  19. :-).
  20.  
  21. Groetjes, Timo Krijnen (timo@cwi.nl).
  22.  
  23. -------
  24. : This is a shell archive.
  25. : Extract with 'sh this_file'.
  26. echo 'Start of first Authors patch for ABC system (omitted files):'
  27. if test -s 'abc/bed/e1help.c'
  28. then echo '*** I will not over-write existing file abc/bed/e1help.c'
  29. else
  30. echo 'x - abc/bed/e1help.c'
  31. sed 's/^X//' > 'abc/bed/e1help.c' << 'EOF'
  32. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  33. X
  34. X/*
  35. X * B editor -- Print help blurb.
  36. X */
  37. X
  38. X#include "b.h"
  39. X#include "bedi.h"
  40. X#include "feat.h"
  41. X#include "bmem.h"
  42. X#include "bfil.h"
  43. X#include "bobj.h"
  44. X#include "keys.h"
  45. X#include "getc.h"
  46. X
  47. X#ifdef HELPFUL
  48. X
  49. X#define SOBIT 0200
  50. X
  51. Xextern int winheight;
  52. Xextern int llength;
  53. Xextern int winstart;
  54. X/*
  55. X   The following array determines the order of the editor operations
  56. X   in the helpblurb.
  57. X   The names and keyrepresentations are taken from deftab in e1getc.c
  58. X   and ?1keys.c the first time help() is called.
  59. X   Thereafter the size is checked to determine whether printing in two
  60. X   columns is possible.
  61. X   Code NOTHING is used to produce an empty place in the second column.
  62. X */
  63. Xint helpcode[]= {
  64. X    WIDEN,        EXTEND,
  65. X    FIRST,        LAST,
  66. X    PREVIOUS,    NEXT,
  67. X    UPLINE,        DOWNLINE,
  68. X    UPARROW,    DOWNARROW,
  69. X    LEFTARROW,    RITEARROW,
  70. X#ifdef GOTOCURSOR
  71. X    GOTO,        NOTHING,
  72. X#endif
  73. X    ACCEPT,        NEWLINE,
  74. X    UNDO,        REDO,
  75. X    COPY,        DELETE,
  76. X    RECORD,        PLAYBACK,
  77. X    LOOK,        HELP,
  78. X#ifdef CANSUSPEND
  79. X    EXIT,        NOTHING,
  80. X    CANCEL,        SUSPEND
  81. X#else
  82. X    EXIT,        CANCEL
  83. X#endif
  84. X};
  85. X
  86. Xchar *helpitem[(sizeof(helpcode))/(sizeof(int))]; /* to save "[name]  repr" */
  87. Xint nitems= 0;
  88. X
  89. X#define GAPWIDTH 5        /* width between the two columns */
  90. XHidden int maxwidth= 0;        /* width of maximum helpitem */
  91. X
  92. X#define MAXBUFFER 81
  93. XHidden char buffer[MAXBUFFER];
  94. X
  95. X#define MORE MESS(6700, "Press [SPACE] for more, [RETURN] to exit help")
  96. X#define NO_MORE MESS(6701, "Press [SPACE] or [RETURN] to exit help")
  97. X#define NO_HELPFILE MESS(6702, "*** Cannot find or read help file [%s]")
  98. X
  99. XForward bool ask_for();
  100. X
  101. X/*
  102. X * Print help blurb.
  103. X * This is done through the standard screen interface.
  104. X * The user must type [RETURN] to continue.
  105. X */
  106. X
  107. XVisible bool
  108. Xhelp()
  109. X{
  110. X    int len = sizeof buffer;
  111. X    bool two_columns;
  112. X    int h;
  113. X    bool more= Yes;
  114. X    int nprinted= 0;
  115. X    
  116. X    if (nitems == 0)
  117. X        start_help();
  118. X    if (llength < (sizeof buffer)-1)
  119. X        len= llength+1;
  120. X    two_columns= len > 2*maxwidth+GAPWIDTH;
  121. X    for (h= 0; h < nitems && more /****&& !trminterrupt()*****/; h++) {
  122. X        trmputdata(winheight, winheight, 0, helpitem[h]);
  123. X        if (two_columns) {
  124. X            h++;
  125. X            trmputdata(winheight, winheight, 
  126. X                maxwidth+GAPWIDTH, helpitem[h]);
  127. X        }
  128. X        trmscrollup(0, winheight, 1);
  129. X        trmsync(winheight, 0);
  130. X        if (++nprinted >= winheight) {
  131. X            more= ask_for(MORE);
  132. X            nprinted= 0;
  133. X        }
  134. X    }
  135. X    if (nprinted > 0)
  136. X        more= ask_for(MORE);
  137. X    if (more) {
  138. X        more_help();
  139. X    }
  140. X    if (doctype == D_immcmd)
  141. X        cmdprompt(CMDPROMPT);
  142. X    else
  143. X        winstart= winheight;
  144. X    
  145. X    return Yes;
  146. X}
  147. X
  148. XVisible bool ask_for(nr) int nr; {
  149. X    string cp;
  150. X    int c;
  151. X
  152. X    trmputdata(winheight, winheight, 0, "");
  153. X    strcpy(buffer, getmess(nr));
  154. X    for (cp = buffer; *cp; )
  155. X        *cp++ |= SOBIT;
  156. X    trmputdata(winheight, winheight, 0, buffer);
  157. X    trmsync(winheight, cp - buffer);
  158. X    c = trminput();
  159. X    while (c != '\n' && c != '\r' && c != ' ' && c != EOF) {
  160. X        trmbell();
  161. X        c = trminput();
  162. X    }
  163. X    trmputdata(winheight, winheight, 0, "");
  164. X    trmsync(winheight, 0);
  165. X    return c == ' ' ? Yes : No;
  166. X}
  167. X
  168. XHidden Procedure start_help()
  169. X{
  170. X    int h;
  171. X    int code;
  172. X    int w;
  173. X    
  174. X    for (h= 0; h < ((sizeof(helpcode))/(sizeof(int))); h++) {
  175. X        code= helpcode[h];
  176. X        if (code == NOTHING) {
  177. X            strcpy(buffer, "");
  178. X        }
  179. X        else {
  180. X            getentryfor(code); /* result in buffer */
  181. X        }
  182. X        w= strlen(buffer);
  183. X        if (maxwidth < strlen(buffer))
  184. X            maxwidth= w;
  185. X        helpitem[nitems++]= (char*)savestr(buffer);
  186. X    }
  187. X}
  188. X
  189. XHidden Procedure getentryfor(code) int code; {
  190. X    int d;
  191. X    char *bufp= buffer;
  192. X    bool first= Yes;
  193. X    char *addstr();
  194. X    
  195. X    for (d=ndefs; d > 0; d--) {
  196. X        if (code == deftab[d].code) {
  197. X            if (bufp == buffer) {
  198. X                bufp= addstr(bufp, deftab[d].name, 13);
  199. X            }
  200. X            if (deftab[d].def != NULL
  201. X                &&
  202. X                deftab[d].def[0] != '\0')
  203. X            {
  204. X                if (first)
  205. X                    first= No;
  206. X                else
  207. X                    bufp= addstr(bufp, ", ", 0);
  208. X                bufp= addstr(bufp, deftab[d].rep, 0);
  209. X            }
  210. X        }
  211. X    }
  212. X    if (first)
  213. X        bufp= addstr(bufp, "", 0);
  214. X}
  215. X
  216. XHidden char *addstr(bp, s, minw) char * bp; string s; int minw; {
  217. X    while (*s && bp < buffer+MAXBUFFER) {
  218. X        *bp++= *s++;
  219. X        minw--;
  220. X    }
  221. X    while (minw > 0 && bp < buffer+MAXBUFFER) {
  222. X        *bp++= ' ';
  223. X        minw--;
  224. X    }
  225. X    if (bp >= buffer+MAXBUFFER)
  226. X        bp--;
  227. X    *bp= '\0';
  228. X    return bp;
  229. X}
  230. X
  231. XHidden FILE *helpfp= NULL;
  232. X
  233. XHidden Procedure more_help() {
  234. X    string cp;
  235. X    int nprinted= 0;
  236. X    bool more= Yes;
  237. X    bool len= (llength < sizeof buffer ? llength : sizeof buffer);
  238. X    
  239. X    if (helpfp == (FILE*) NULL) {
  240. X        if (helpfile) helpfp= fopen(helpfile, "r");
  241. X        if (helpfp == (FILE*) NULL) {
  242. X            ederrS(NO_HELPFILE, helpfile);
  243. X            return;
  244. X        }
  245. X    }
  246. X    while (fgets(buffer, len, helpfp) && more /***&& !trminterrupt()***/) {
  247. X        if ((cp= strchr(buffer, '\n')) != NULL) {
  248. X            *cp= '\0';
  249. X        }
  250. X        trmputdata(winheight, winheight, 0, buffer);
  251. X        trmscrollup(0, winheight, 1);
  252. X        trmsync(winheight, 0);
  253. X        if (++nprinted >= winheight) {
  254. X            more= ask_for(MORE);
  255. X            nprinted= 0;
  256. X        }
  257. X    }
  258. X    rewind(helpfp);
  259. X    if (nprinted > 0)
  260. X        more= ask_for(NO_MORE);
  261. X}
  262. X
  263. X#endif /* HELPFUL */
  264. EOF
  265. fi
  266. if test -s 'abc/bint1/i1com.c'
  267. then echo '*** I will not over-write existing file abc/bint1/i1com.c'
  268. else
  269. echo 'x - abc/bint1/i1com.c'
  270. sed 's/^X//' > 'abc/bint1/i1com.c' << 'EOF'
  271. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  272. X
  273. X/************************************************************************/
  274. X/* Hows Funs and other odd types that don't fit anywhere else           */
  275. X/* and are modelled as compounds                                        */
  276. X/*                                                                      */
  277. X/* Compounds are handled in bobj.h                                     */
  278. X/*                                                                      */
  279. X/************************************************************************/
  280. X
  281. X#include "b.h"
  282. X#include "bint.h"
  283. X#include "bobj.h"
  284. X#include "i2nod.h"
  285. X#include "i2gen.h" /* Must be after i2nod.h */
  286. X#include "i3env.h"
  287. X
  288. X/* Values */
  289. X
  290. X/* Rangebounds is a special compound of the 2 lwb..upb fields */
  291. X/* used for the evaluation of mixed list_displays like {a;b..z} */
  292. X/* More #define's for its interface are in bint.h */
  293. X
  294. X#define RANGE_ILLEGAL    MESS(1400, "in p..q, p is neither a text nor a number")
  295. X
  296. X#define NRANGE_L_INT    MESS(1401, "in p..q, p is a number but not an integer")
  297. X#define NRANGE_U_NUM    MESS(1402, "in p..q, p is a number, but q is not")
  298. X#define NRANGE_U_INT    MESS(1403, "in p..q, q is a number but not an integer")
  299. X
  300. X#define CRANGE_L_CHAR    MESS(1404, "in p..q, p is a text but not a character")
  301. X#define CRANGE_U_TEX    MESS(1405, "in p..q, p is a text, but q is not")
  302. X#define CRANGE_U_CHAR    MESS(1406, "in p..q, q is a text, but not a character")
  303. X
  304. XHidden bool bounds_ok(lo, hi) value lo, hi; {
  305. X    bool r= No;
  306. X    if (Is_text(lo)) {
  307. X        if (!character(lo)) interr(CRANGE_L_CHAR);
  308. X        else if (!Is_text(hi)) interr(CRANGE_U_TEX);
  309. X        else if (!character(hi)) interr(CRANGE_U_CHAR);
  310. X        else r= Yes;
  311. X    }
  312. X    else if (Is_number(lo)) {
  313. X        if (!integral(lo)) interr(NRANGE_L_INT);
  314. X        else if (!Is_number(hi)) interr(NRANGE_U_NUM);
  315. X        else if (!integral(hi)) interr(NRANGE_U_INT);
  316. X        else r= Yes;
  317. X    }
  318. X    else {
  319. X        interr(RANGE_ILLEGAL);
  320. X    }
  321. X    return r;
  322. X}
  323. X
  324. XVisible value mk_rbounds(l, u) value l, u; {
  325. X    value r, *p;
  326. X    if (bounds_ok(l, u)) {
  327. X        r= grab(Rangebounds, 2); p= Ats(r);
  328. X        *p++= copy(l); *p++= copy(u);
  329. X    }
  330. X    else
  331. X        r= Vnil;
  332. X    return r;
  333. X}
  334. X
  335. X/* NODES */
  336. X
  337. XVisible typenode nodetype(v) parsetree v; {
  338. X    return Is_node(v) ? Nodetype(v) : Nonode;
  339. X}
  340. X
  341. X/* make parsetree node */
  342. X
  343. XHidden value mk_ptn(type, len) typenode type; intlet len; {
  344. X    parsetree v= (parsetree) grab(Ptn, (len<<8) | type);
  345. X    *Branch(v, len)= *Branch(v, len+1)= NilTree;
  346. X    return v;
  347. X}
  348. X
  349. XVisible unsigned ptnsyze(len, nptrs) intlet len; int *nptrs; {
  350. X    len= _Nbranches(len);
  351. X    *nptrs= len;
  352. X    return (unsigned) ((len+2)*sizeof(value));
  353. X}
  354. X
  355. XVisible parsetree node1(type) typenode type; {
  356. X    return mk_ptn(type, 0);
  357. X}
  358. X
  359. XVisible parsetree node2(type, a1) typenode type; value a1; {
  360. X    parsetree v= mk_ptn(type, 1); value *p= Ats(v);
  361. X    *p++= a1;
  362. X    return v;
  363. X}
  364. X
  365. XVisible parsetree node3(type, a1, a2) typenode type; value a1, a2; {
  366. X    parsetree v= mk_ptn(type, 2); value *p= Ats(v);
  367. X    *p++= a1; *p++= a2;
  368. X    return v;
  369. X}
  370. X
  371. XVisible parsetree node4(type, a1, a2, a3) typenode type; value a1, a2, a3; {
  372. X    parsetree v= mk_ptn(type, 3); value *p= Ats(v);
  373. X    *p++= a1; *p++= a2; *p++= a3;
  374. X    return v;
  375. X}
  376. X
  377. XVisible parsetree node5(type, a1, a2, a3, a4) typenode type;
  378. X        value a1, a2, a3, a4; {
  379. X    parsetree v= mk_ptn(type, 4); value *p= Ats(v);
  380. X    *p++= a1; *p++= a2; *p++= a3; *p++= a4;
  381. X    return v;
  382. X}
  383. X
  384. XVisible parsetree node6(type, a1, a2, a3, a4,a5) typenode type;
  385. X        value a1, a2, a3, a4, a5; {
  386. X    parsetree v= mk_ptn(type, 5); value *p= Ats(v);
  387. X    *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5;
  388. X    return v;
  389. X}
  390. X
  391. XVisible parsetree node8(type, a1, a2, a3, a4, a5, a6, a7) typenode type;
  392. X        value a1, a2, a3, a4, a5, a6, a7; {
  393. X    parsetree v= mk_ptn(type, 7); value *p= Ats(v);
  394. X    *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5; *p++= a6; *p++= a7;
  395. X    return v;
  396. X}
  397. X
  398. XVisible parsetree node9(type, a1, a2, a3, a4, a5, a6, a7, a8) typenode type;
  399. X        value a1, a2, a3, a4, a5, a6, a7, a8; {
  400. X    parsetree v= mk_ptn(type, 8); value *p= Ats(v);
  401. X    *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5; *p++= a6;
  402. X    *p++= a7; *p++= a8;
  403. X    return v;
  404. X}
  405. X
  406. X/* OTHER TYPES */
  407. X
  408. XVisible loc mk_simploc(id, en) basidf id; env en; {
  409. X    loc l= (loc) grab(Sim, 0);
  410. X    (*Ats(l))= copy(id); (*(Ats(l)+1))= (value) en;
  411. X    return l;
  412. X}
  413. X
  414. XVisible loc mk_trimloc(R, B, C) loc R; value B, C; {
  415. X    loc l= (loc) grab(Tri, 0); trimloc *ll= (trimloc *)Ats(l);
  416. X    ll->R= copy(R); ll->B= copy(B); ll->C= copy(C);
  417. X    return l;
  418. X}
  419. X
  420. XVisible loc mk_tbseloc(R, K) loc R; value K; {
  421. X    loc l= (loc) grab(Tse, 0); tbseloc *ll= (tbseloc *)Ats(l);
  422. X    ll->R= copy(R); ll->K= copy(K);
  423. X    return l;
  424. X}
  425. X
  426. XVisible fun mk_fun(adic, pre, unit, filed) literal adic; intlet pre;
  427. X        parsetree unit; bool filed; {
  428. X    fun f= (fun) grab(Fun, 0); funprd *ff= (funprd *)Ats(f);
  429. X    ff->adic= adic; ff->pre= pre; ff->unit= unit;
  430. X    ff->unparsed= Yes; ff->filed= filed;
  431. X    ff->code= NilTree;
  432. X    return f;
  433. X}
  434. X
  435. XVisible prd mk_prd(adic, pre, unit, filed) literal adic; intlet pre;
  436. X        parsetree unit; bool filed; {
  437. X    prd p= (prd) grab(Prd, 0); funprd *pp= (funprd *)Ats(p);
  438. X    pp->adic= adic; pp->pre= pre; pp->unit= unit;
  439. X    pp->unparsed= Yes; pp->filed= filed;
  440. X    pp->code= NilTree;
  441. X    return p;
  442. X}
  443. X
  444. XVisible value mk_how(unit, filed) parsetree unit; bool filed; {
  445. X    value h= grab(How, 0); how *hh= (how *)Ats(h);
  446. X    hh->unit= unit; hh->unparsed= Yes; hh->filed= filed;
  447. X    hh->code= NilTree;
  448. X    return h;
  449. X}
  450. X
  451. XVisible value mk_ref(rp) parsetree rp; {
  452. X    value r= grab(Ref, 0);
  453. X    *Ats(r)= copy(rp);
  454. X    return r;
  455. X}
  456. X
  457. XVisible value mk_indirect(v) value v; {
  458. X    value p= grab(Ind, 0);
  459. X    *Ats(p)= copy(v);
  460. X    return p;
  461. X}
  462. EOF
  463. fi
  464. if test -s 'abc/bint1/i1nuq.c'
  465. then echo '*** I will not over-write existing file abc/bint1/i1nuq.c'
  466. else
  467. echo 'x - abc/bint1/i1nuq.c'
  468. sed 's/^X//' > 'abc/bint1/i1nuq.c' << 'EOF'
  469. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  470. X
  471. X#include "b.h"
  472. X#include "feat.h"     /* for EXT_RANGE */
  473. X#include "bobj.h"
  474. X#include "i1num.h"
  475. X
  476. X
  477. X/* Product of integer and single "digit" */
  478. X
  479. XVisible integer int1mul(v, n1) integer v; digit n1; {
  480. X    integer a;
  481. X    digit save, bigcarry, carry = 0;
  482. X    twodigit z, zz, n = n1;
  483. X    register int i;
  484. X    struct integer vv;
  485. X
  486. X    FreezeSmallInt(v, vv);
  487. X
  488. X    a = (integer) grab_num(Length(v)+2);
  489. X
  490. X    for (i = 0; i < Length(v); ++i) {
  491. X        z = Digit(v,i) * n;
  492. X        bigcarry = zz = (z/BASE);
  493. X        carry += z - zz*BASE;
  494. X        Digit(a,i) = save = Modulo(carry, BASE);
  495. X        carry = (carry-save)/BASE + bigcarry;
  496. X    }
  497. X
  498. X    Digit(a,i) = save = Modulo(carry, BASE);
  499. X    Digit(a,i+1) = (carry-save)/BASE;
  500. X
  501. X    return int_canon(a);
  502. X}
  503. X
  504. X
  505. X/* Quotient of positive integer and single "digit" > 0 */
  506. X
  507. XHidden integer int1div(v, n1, prem) integer v; digit n1, *prem; {
  508. X    integer q;
  509. X    twodigit r_over_n, r = 0, n = n1;
  510. X    register int i;
  511. X    struct integer vv;
  512. X
  513. X    FreezeSmallInt(v, vv);
  514. X
  515. X    q = (integer) grab_num(Length(v));
  516. X    for (i = Length(v)-1; i >= 0; --i) {
  517. X        r = r*BASE + Digit(v,i);
  518. X        Digit(q,i) = r_over_n = (r/n);
  519. X        r -= r_over_n * n;
  520. X    }
  521. X    if (prem)
  522. X        *prem = r;
  523. X    return int_canon(q);
  524. X}
  525. X
  526. X
  527. X/* Long division routine, gives access to division algorithm. */
  528. X
  529. XVisible digit int_ldiv(v1, w1, pquot, prem) integer v1, w1, *pquot, *prem; {
  530. X    integer a;
  531. X    int sign = 1, rel_v = 0, rel_w = 0;
  532. X    digit div, rem;
  533. X    struct integer vv1, ww1;
  534. X
  535. X    if (w1 == int_0) syserr(MESS(1100, "zero division (int_ldiv)"));
  536. X
  537. X    /* Make v, w positive */
  538. X    if (Msd(v1) < 0) {
  539. X        sign = -1;
  540. X        ++rel_v;
  541. X        v1 = int_neg(v1);
  542. X    }
  543. X
  544. X    if (Msd(w1) < 0) {
  545. X        sign *= -1;
  546. X        ++rel_w;
  547. X        w1 = int_neg(w1);
  548. X    }
  549. X    
  550. X    FreezeSmallInt(v1, vv1);
  551. X    FreezeSmallInt(w1, ww1);
  552. X
  553. X    div = sign;
  554. X
  555. X    /* Check v << w or single-digit w */
  556. X    if (Length(v1) < Length(w1)
  557. X        || Length(v1) == Length(w1)
  558. X            && Digit(v1, Length(v1)-1) < Digit(w1, Length(w1)-1)) {
  559. X        a = int_0;
  560. X        if (prem) {
  561. X            if (v1 == &vv1) *prem= (integer) MkSmallInt(Digit(v1,0));
  562. X            else *prem = (integer) Copy(v1);
  563. X        }
  564. X    }
  565. X    else if (Length(w1) == 1) {
  566. X        /* Single-precision division */
  567. X        a = int1div(v1, Digit(w1,0), &rem);
  568. X        if (prem) *prem = mk_int((double)rem);
  569. X    }
  570. X    else {
  571. X        /* Multi-precision division */
  572. X        /* Cf. Knuth II Sec. 4.3.1. Algorithm D */
  573. X        /* Note that we count in the reverse direction (not easier!) */
  574. X
  575. X        twodigit z, zz;
  576. X        digit carry, save, bigcarry;
  577. X        twodigit q, d = BASE/(Digit(w1, Length(w1)-1)+1);
  578. X        register int i, j, k;
  579. X        integer v, w;
  580. X        digit vj;
  581. X
  582. X        /* Normalize: make Msd(w) >= BASE/2 by multiplying
  583. X           both v and w by d */
  584. X
  585. X        v = int1mul(v1, (digit)d);
  586. X            /* v is used as accumulator, must make a copy */
  587. X            /* v cannot be int_1 */
  588. X            /* (then it would be one of the cases above) */
  589. X
  590. X        if (d == 1) w = (integer) Copy(w1);
  591. X        else w = int1mul(w1, (digit)d);
  592. X
  593. X        a = (integer) grab_num(Length(v1)-Length(w)+1);
  594. X
  595. X        /* Division loop */
  596. X
  597. X        for (j = Length(v1), k = Length(a)-1; k >= 0; --j, --k) {
  598. X            vj = j >= Length(v) ? 0 : Digit(v,j);
  599. X
  600. X            /* Find trial digit */
  601. X
  602. X            if (vj == Digit(w, Length(w)-1)) q = BASE-1;
  603. X            else q =  ((twodigit)vj*BASE + Digit(v,j-1)) /
  604. X                    Digit(w, Length(w)-1);
  605. X
  606. X            /* Correct trial digit */
  607. X
  608. X            while (Digit(w,Length(w)-2) * q >
  609. X                ((twodigit)vj*BASE + Digit(v,j-1)
  610. X                    - q*Digit(w, Length(w)-1)) *BASE + Digit(v,j-2))
  611. X                --q;
  612. X
  613. X            /* Subtract q*w from v */
  614. X
  615. X            carry = 0;
  616. X            for (i = 0; i < Length(w) && i+k < Length(v); ++i) {
  617. X                z = Digit(w,i) * q;
  618. X                bigcarry = zz = (z/BASE);
  619. X                carry += Digit(v,i+k) - z + zz*BASE;
  620. X                Digit(v,i+k) =
  621. X                    save = Modulo(carry, BASE);
  622. X                carry = (carry-save)/BASE - bigcarry;
  623. X            }
  624. X
  625. X            if (i+k < Length(v))
  626. X                carry += Digit(v, i+k), Digit(v, i+k) = 0;
  627. X
  628. X            /* Add back necessary? */
  629. X
  630. X                /* It is very difficult to find test cases
  631. X                   where add back is necessary if BASE is large.
  632. X                   Thanks to Arjen Lenstra, we have v=n*n-1, w=n,
  633. X                   where n = 8109636009903000000 (the last six
  634. X                   digits are not important). */
  635. X
  636. X            if (carry == 0)        /* No */
  637. X                Digit(a,k) = q;
  638. X            else {        /* Yes, add back */
  639. X                if (carry != -1) syserr(MESS(1101, "int_ldiv internal failure"));
  640. X                Digit(a,k) = q-1;
  641. X                carry = 0;
  642. X                for (i = 0; i < Length(w) && i+k < Length(v); ++i) {
  643. X                    carry += Digit(v, i+k) + Digit(w,i);
  644. X                    Digit(v,i+k) =
  645. X                        save = Modulo(carry, BASE);
  646. X                    carry = (carry-save)/BASE;
  647. X                }
  648. X            }
  649. X        }    /* End for(j) */
  650. X
  651. X        if (prem) *prem = int_canon(v);    /* Store remainder */
  652. X        else Release(v);
  653. X        div = sign*d;    /* Store normalization factor */
  654. X        Release(w);
  655. X        a = int_canon(a);
  656. X    }
  657. X
  658. X    if (rel_v) Release(v1);
  659. X    if (rel_w) Release(w1);
  660. X
  661. X    if (sign < 0) {
  662. X        integer temp = a;
  663. X        a = int_neg(a);
  664. X        Release(temp);
  665. X    }
  666. X
  667. X    if (pquot) *pquot = a;
  668. X    else Release(a);
  669. X    return div;
  670. X}
  671. X
  672. X
  673. XVisible integer int_quot(v, w) integer v, w; {
  674. X    integer quo;
  675. X    VOID int_ldiv(v, w, &quo, (integer*)0);
  676. X    return quo;
  677. X}
  678. X
  679. XVisible integer int_mod(v, w) integer v, w; {
  680. X    integer rem;
  681. X    digit div;
  682. X    bool flag;
  683. X    div = int_ldiv(v, w, (integer*)0, &rem); /* Rem. is always positive */
  684. X    if (rem == int_0)
  685. X        return rem; /* v mod w = 0 */
  686. X    flag = (div < 0);
  687. X    if (flag || Msd(w) < 0) div = -div;
  688. X    if (div != 1) {    /* Divide by div to get proper remainder back */
  689. X        v = int1div(rem, div, (digit*)0);
  690. X        Release(rem);
  691. X        rem = v;
  692. X    }
  693. X    if (flag) { /* Make same sign as w */
  694. X        if (Msd(w) < 0) v = int_sum(w, rem);
  695. X        else v = int_diff(w, rem);
  696. X        Release(rem);
  697. X        rem = v;
  698. X    }
  699. X    return rem;
  700. X}
  701. EOF
  702. fi
  703. if test -s 'abc/bint1/i1tra.c'
  704. then echo '*** I will not over-write existing file abc/bint1/i1tra.c'
  705. else
  706. echo 'x - abc/bint1/i1tra.c'
  707. sed 's/^X//' > 'abc/bint1/i1tra.c' << 'EOF'
  708. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1987. */
  709. X
  710. X/* Functions defined on train values. */
  711. X
  712. X/* This file should go into a train directory, that should receive the
  713. X * lin-btr independent part of these modules (especially tlt.c and
  714. X * obj.c contain common parts).
  715. X */
  716. X
  717. X#include "b.h"
  718. X#include "feat.h"     /* for EXT_RANGE */
  719. X#include "bobj.h"
  720. X#include "i0err.h"
  721. X#include "i1num.h"
  722. X
  723. X#define CHOICE_TLT    MESS(1600, "in choice t, t is not a text list or table")
  724. X#define CHOICE_EMPTY    MESS(1601, "in choice t, t is empty")
  725. X
  726. X/* make a B text out of a C char */
  727. X
  728. XVisible value mkchar(c) char c; {
  729. X    char buf[2];
  730. X    buf[0] = c;
  731. X    buf[1] = '\0';
  732. X    return mk_text(buf);
  733. X}
  734. X
  735. X/* report: t item j ?=? ' ' */
  736. XHidden bool is_space(t, i) value t, i; {
  737. X    value ti;
  738. X    char c;
  739. X    
  740. X    ti = item(t, i);
  741. X    c = charval(ti);
  742. X    release(ti);
  743. X    return c == ' ';
  744. X}
  745. X
  746. XHidden Procedure incr(pn) value* pn; {
  747. X    value n1;
  748. X    
  749. X    n1 = sum(*pn, one);
  750. X    release(*pn);
  751. X    *pn = n1;
  752. X}
  753. X
  754. XVisible value stripped(t) value t; {
  755. X    value a, b, i, j, k;
  756. X    
  757. X    i = one;
  758. X    j = size(t);
  759. X    while (numcomp(i, j) <= 0 && is_space(t, i)) {
  760. X        incr(&i);
  761. X    }
  762. X    while (numcomp(j, i) > 0 && is_space(t, j)) {
  763. X        k = diff(j, one);
  764. X        release(j);
  765. X        j = k;
  766. X    }
  767. X    if (numcomp(i, j) <= 0) {
  768. X        a = behead(t, i);
  769. X        k = diff(j, i);
  770. X        incr(&k);
  771. X        b = curtail(a, k);
  772. X        release(k); release(a);
  773. X    }
  774. X    else {
  775. X        b = mk_text("");
  776. X    }
  777. X    release(i); release(j);
  778. X    return b;
  779. X}
  780. X
  781. XVisible value split(t) value t; {
  782. X    value a, b, i, j, ij, r, ri, sizt;
  783. X    
  784. X    r = mk_elt();
  785. X    ri = one;
  786. X    i = one;
  787. X    sizt = size(t);
  788. X    while (numcomp(i, sizt) <= 0) {
  789. X        while (numcomp(i, sizt) <= 0 && is_space(t, i)) {
  790. X            incr(&i);
  791. X        }
  792. X        if (numcomp(i, sizt) > 0) {
  793. X            break;
  794. X        }
  795. X        j = one;
  796. X        ij = sum(i, j);
  797. X        while (numcomp(ij, sizt) <= 0 && !is_space(t, ij)) {
  798. X            incr(&j);
  799. X            incr(&ij);
  800. X        }
  801. X        a = behead(t, i);
  802. X        b = curtail(a, j);
  803. X        replace(b, &r, ri);
  804. X        incr(&ri);
  805. X        release(i); i = ij; /* PUT i+j IN i */
  806. X        release(j); release(a); release(b);
  807. X    }
  808. X    release(i); release(sizt);
  809. X    return r;
  810. X}
  811. X
  812. XHidden value uplower(t, islowupper, touplower)
  813. X    value t;
  814. X    int (*islowupper)();
  815. X    int (*touplower)();
  816. X{
  817. X    value i, sizt, r, ti, c;
  818. X    char s[2];
  819. X    
  820. X    s[1] = '\0';
  821. X    r = mk_text("");
  822. X    i = one;
  823. X    sizt = size(t);
  824. X    while (numcomp(i, sizt) <= 0) {
  825. X        ti = item(t, i);
  826. X        s[0] = charval(ti);
  827. X        if ((*islowupper)(s[0])) {
  828. X            release(ti);
  829. X            s[0] = (*touplower)(s[0]);
  830. X            ti = mk_text(s);
  831. X        }
  832. X        c = concat(r, ti);
  833. X        release(r); release(ti);
  834. X        r = c;
  835. X        incr(&i);
  836. X    }
  837. X    release(i); release(sizt);
  838. X    return r;
  839. X}
  840. X
  841. X/* terrible BSD patch: turn macroos into Functions */
  842. X#ifdef isupper
  843. Xint F_isupper(c) char c; { return isupper(c); }
  844. X#else
  845. X#define F_isupper isupper
  846. Xextern int isupper();
  847. X#endif
  848. X#ifdef islower
  849. Xint F_islower(c) char c; { return islower(c); }
  850. X#else
  851. X#define F_islower islower
  852. Xextern int islower();
  853. X#endif
  854. X#ifdef toupper
  855. Xint F_toupper(c) char c; { return toupper(c); }
  856. X#else
  857. X#define F_toupper toupper
  858. Xextern int toupper();
  859. X#endif
  860. X#ifdef tolower
  861. Xint F_tolower(c) char c; { return tolower(c); }
  862. X#else
  863. X#define F_tolower tolower
  864. Xextern int tolower();
  865. X#endif
  866. X
  867. XVisible value upper(t) value t; { return uplower(t, F_islower, F_toupper);}
  868. XVisible value lower(t) value t; { return uplower(t, F_isupper, F_tolower);}
  869. X
  870. X/* for RangeElem's */
  871. X
  872. XHidden Procedure insCrange(lwb, upb, pl) value lwb, upb; value *pl; {
  873. X    value w; char lwbchar= charval(lwb), upbchar= charval(upb);
  874. X    if (lwbchar > upbchar) return;
  875. X    uniql(pl);
  876. X    do {
  877. X        w= mkchar(lwbchar);
  878. X        insert(w, pl);
  879. X        release(w);
  880. X    } while (++lwbchar <= upbchar);
  881. X}
  882. X
  883. XHidden Procedure insIrange(lwb, upb, pl) value lwb, upb; value *pl; {
  884. X    value w= copy(lwb);
  885. X    uniql(pl);
  886. X    do {
  887. X        if (compare(lwb, upb) > 0) break;
  888. X        insert(lwb, pl);
  889. X        w= lwb;
  890. X        lwb= sum(lwb, one);
  891. X        release(w);
  892. X    } while (still_ok);
  893. X    release(lwb);
  894. X}
  895. X
  896. XVisible Procedure ins_range(lwb, upb, pl) value lwb, upb; value *pl; {
  897. X    if (Is_text(lwb))
  898. X        insCrange(lwb, upb, pl);
  899. X    else 
  900. X        insIrange(lwb, upb, pl);
  901. X}
  902. X
  903. X/* choice = train item (random * (1+floor(#train))), is tricky:
  904. X * random() only contains a limited number of bits.
  905. X * For very large trains, certain items would therefore never be chosen
  906. X * when the standard definition above is used.
  907. X * Therefore, if #train is greater than a save rndm_limit below which
  908. X * all bits in a number are random, we divide #train over rndm_limit
  909. X * sized chunks, and choose among one of these chunks. The last chunk
  910. X * may contain less than rndm_limit elements, each of which gets the same
  911. X * chance to be choosen as the elements in any other chunk. Hence the
  912. X * while in choice() below.
  913. X */
  914. X
  915. Xextern value rndm_limit;
  916. X    /* below this limit each number has a fair chance */
  917. X
  918. XHidden value numchoice(m) value m; {
  919. X    value p;
  920. X    value q;
  921. X    value r;
  922. X    value chunk;
  923. X    
  924. X    /* choose a number between 1 and limit*ceiling(m/limit) */
  925. X    if (numcomp(m, rndm_limit) <= 0) {
  926. X        /* standard def: 1 + floor(random*m) */
  927. X        r= random();
  928. X        p= prod(r, m);
  929. X        release(r);
  930. X        r= floorf(p);
  931. X        incr(&r);
  932. X        release(p);
  933. X    }
  934. X    else {
  935. X        /* choose chunk= choice{0..ceiling(m/limit)-1}
  936. X         * and return element r= limit*chunk + choice{1..limit}
  937. X         */
  938. X        q= quot(m, rndm_limit);
  939. X        p= ceilf(q);
  940. X        release(q);
  941. X        q= numchoice(p);
  942. X        release(p);
  943. X        chunk= diff(q, one);
  944. X        release(q);
  945. X        p= prod(rndm_limit, chunk);
  946. X        q= numchoice(rndm_limit);
  947. X        r= sum(p, q);
  948. X        release(p); release(q); release(chunk);
  949. X    }
  950. X    return r;
  951. X}
  952. X
  953. XVisible value choice(train) value train; {
  954. X    value nn;
  955. X    value n;
  956. X    
  957. X    nn= Vnil;
  958. X    if (!Is_tlt(train)) interr(CHOICE_TLT);
  959. X    else if (empty(train)) interr(CHOICE_EMPTY);
  960. X    else {
  961. X        nn= size(train);
  962. X        n= numchoice(nn);
  963. X        while (numcomp(n, nn) > 0) {
  964. X            /* in non-existing part of upper chunk */
  965. X            release(n);
  966. X            n= numchoice(nn);
  967. X        }
  968. X        release(nn);
  969. X        nn= item(train, n);
  970. X        release(n);
  971. X    }
  972. X    return nn;
  973. X}
  974. EOF
  975. fi
  976. if test -s 'abc/bint3/DEP'
  977. then echo '*** I will not over-write existing file abc/bint3/DEP'
  978. else
  979. echo 'x - abc/bint3/DEP'
  980. sed 's/^X//' > 'abc/bint3/DEP' << 'EOF'
  981. Xi3bws.o: i3bws.c
  982. Xi3bws.o: ../bhdrs/b.h
  983. Xi3bws.o: ../uhdrs/osconf.h
  984. Xi3bws.o: ../uhdrs/os.h
  985. Xi3bws.o: ../uhdrs/conf.h
  986. Xi3bws.o: ../uhdrs/config.h
  987. Xi3bws.o: ../bhdrs/bint.h
  988. Xi3bws.o: ../bhdrs/bfil.h
  989. Xi3bws.o: ../bhdrs/bmem.h
  990. Xi3bws.o: ../bhdrs/bobj.h
  991. Xi3bws.o: ../uhdrs/args.h
  992. Xi3bws.o: ../uhdrs/feat.h
  993. Xi3bws.o: ../ihdrs/i2par.h
  994. Xi3bws.o: ../ihdrs/i3bws.h
  995. Xi3bws.o: ../ihdrs/i3env.h
  996. Xi3bws.o: ../ihdrs/i3sou.h
  997. Xi3com.o: i3com.c
  998. Xi3com.o: ../bhdrs/b.h
  999. Xi3com.o: ../uhdrs/osconf.h
  1000. Xi3com.o: ../uhdrs/os.h
  1001. Xi3com.o: ../uhdrs/conf.h
  1002. Xi3com.o: ../uhdrs/config.h
  1003. Xi3com.o: ../bhdrs/bmem.h
  1004. Xi3com.o: ../bhdrs/bobj.h
  1005. Xi3com.o: ../bhdrs/bfil.h
  1006. Xi3com.o: ../bhdrs/bcom.h
  1007. Xi3com.o: ../ihdrs/i3scr.h
  1008. Xi3env.o: i3env.c
  1009. Xi3env.o: ../bhdrs/b.h
  1010. Xi3env.o: ../uhdrs/osconf.h
  1011. Xi3env.o: ../uhdrs/os.h
  1012. Xi3env.o: ../uhdrs/conf.h
  1013. Xi3env.o: ../uhdrs/config.h
  1014. Xi3env.o: ../bhdrs/bint.h
  1015. Xi3env.o: ../bhdrs/bobj.h
  1016. Xi3env.o: ../ihdrs/i3env.h
  1017. Xi3err.o: i3err.c
  1018. Xi3err.o: ../bhdrs/b.h
  1019. Xi3err.o: ../uhdrs/osconf.h
  1020. Xi3err.o: ../uhdrs/os.h
  1021. Xi3err.o: ../uhdrs/conf.h
  1022. Xi3err.o: ../uhdrs/config.h
  1023. Xi3err.o: ../bhdrs/bmem.h
  1024. Xi3err.o: ../bhdrs/bint.h
  1025. Xi3err.o: ../uhdrs/feat.h
  1026. Xi3err.o: ../bhdrs/bobj.h
  1027. Xi3err.o: ../ihdrs/i0err.h
  1028. Xi3err.o: ../ihdrs/i2par.h
  1029. Xi3err.o: ../ihdrs/i3env.h
  1030. Xi3err.o: ../ihdrs/i3scr.h
  1031. Xi3err.o: ../ihdrs/i3sou.h
  1032. Xi3fil.o: i3fil.c
  1033. Xi3fil.o: ../bhdrs/b.h
  1034. Xi3fil.o: ../uhdrs/osconf.h
  1035. Xi3fil.o: ../uhdrs/os.h
  1036. Xi3fil.o: ../uhdrs/conf.h
  1037. Xi3fil.o: ../uhdrs/config.h
  1038. Xi3fil.o: ../bhdrs/bmem.h
  1039. Xi3fil.o: ../bhdrs/bint.h
  1040. Xi3fil.o: ../bhdrs/bobj.h
  1041. Xi3fil.o: ../ihdrs/i2nod.h
  1042. Xi3fil.o: ../ihdrs/i2par.h
  1043. Xi3fil.o: ../ihdrs/i3scr.h
  1044. Xi3fil.o: ../ihdrs/i3sou.h
  1045. Xi3fpr.o: i3fpr.c
  1046. Xi3fpr.o: ../bhdrs/b.h
  1047. Xi3fpr.o: ../uhdrs/osconf.h
  1048. Xi3fpr.o: ../uhdrs/os.h
  1049. Xi3fpr.o: ../uhdrs/conf.h
  1050. Xi3fpr.o: ../uhdrs/config.h
  1051. Xi3fpr.o: ../bhdrs/bint.h
  1052. Xi3fpr.o: ../uhdrs/feat.h
  1053. Xi3fpr.o: ../bhdrs/bobj.h
  1054. Xi3fpr.o: ../ihdrs/i0err.h
  1055. Xi3fpr.o: ../bhdrs/b0lan.h
  1056. Xi3fpr.o: ../ihdrs/i1num.h
  1057. Xi3fpr.o: ../ihdrs/i2par.h
  1058. Xi3fpr.o: ../ihdrs/i3sou.h
  1059. Xi3gfx.o: i3gfx.c
  1060. Xi3gfx.o: ../bhdrs/b.h
  1061. Xi3gfx.o: ../uhdrs/osconf.h
  1062. Xi3gfx.o: ../uhdrs/os.h
  1063. Xi3gfx.o: ../uhdrs/conf.h
  1064. Xi3gfx.o: ../uhdrs/config.h
  1065. Xi3gfx.o: ../bhdrs/bobj.h
  1066. Xi3gfx.o: ../bhdrs/bgfx.h
  1067. Xi3imm.o: i3imm.c
  1068. Xi3imm.o: ../bhdrs/b.h
  1069. Xi3imm.o: ../uhdrs/osconf.h
  1070. Xi3imm.o: ../uhdrs/os.h
  1071. Xi3imm.o: ../uhdrs/conf.h
  1072. Xi3imm.o: ../uhdrs/config.h
  1073. Xi3imm.o: ../bhdrs/bint.h
  1074. Xi3imm.o: ../uhdrs/feat.h
  1075. Xi3imm.o: ../bhdrs/bobj.h
  1076. Xi3imm.o: ../bhdrs/b0lan.h
  1077. Xi3imm.o: ../ihdrs/i2par.h
  1078. Xi3imm.o: ../ihdrs/i3env.h
  1079. Xi3imm.o: ../ihdrs/i3scr.h
  1080. Xi3in2.o: i3in2.c
  1081. Xi3in2.o: ../bhdrs/b.h
  1082. Xi3in2.o: ../uhdrs/osconf.h
  1083. Xi3in2.o: ../uhdrs/os.h
  1084. Xi3in2.o: ../uhdrs/conf.h
  1085. Xi3in2.o: ../uhdrs/config.h
  1086. Xi3in2.o: ../bhdrs/bint.h
  1087. Xi3in2.o: ../bhdrs/bobj.h
  1088. Xi3in2.o: ../ihdrs/i0err.h
  1089. Xi3in2.o: ../ihdrs/i3env.h
  1090. Xi3in2.o: ../ihdrs/i3in2.h
  1091. Xi3in2.o: ../ihdrs/i3sou.h
  1092. Xi3ini.o: i3ini.c
  1093. Xi3ini.o: ../bhdrs/b.h
  1094. Xi3ini.o: ../uhdrs/osconf.h
  1095. Xi3ini.o: ../uhdrs/os.h
  1096. Xi3ini.o: ../uhdrs/conf.h
  1097. Xi3ini.o: ../uhdrs/config.h
  1098. Xi3ini.o: ../bhdrs/bint.h
  1099. Xi3ini.o: ../uhdrs/feat.h
  1100. Xi3ini.o: ../bhdrs/bobj.h
  1101. Xi3ini.o: ../bhdrs/bfil.h
  1102. Xi3ini.o: ../ihdrs/i3env.h
  1103. Xi3ini.o: ../ihdrs/i3scr.h
  1104. Xi3ini.o: ../bhdrs/release.h
  1105. Xi3int.o: i3int.c
  1106. Xi3int.o: ../bhdrs/b.h
  1107. Xi3int.o: ../uhdrs/osconf.h
  1108. Xi3int.o: ../uhdrs/os.h
  1109. Xi3int.o: ../uhdrs/conf.h
  1110. Xi3int.o: ../uhdrs/config.h
  1111. Xi3int.o: ../bhdrs/bint.h
  1112. Xi3int.o: ../uhdrs/feat.h
  1113. Xi3int.o: ../bhdrs/bmem.h
  1114. Xi3int.o: ../bhdrs/bobj.h
  1115. Xi3int.o: ../ihdrs/i0err.h
  1116. Xi3int.o: ../ihdrs/i2nod.h
  1117. Xi3int.o: ../ihdrs/i3env.h
  1118. Xi3int.o: ../ihdrs/i3int.h
  1119. Xi3int.o: ../ihdrs/i3in2.h
  1120. Xi3int.o: ../ihdrs/i3sou.h
  1121. Xi3int.o: ../ihdrs/i3sta.h
  1122. Xi3loc.o: i3loc.c
  1123. Xi3loc.o: ../bhdrs/b.h
  1124. Xi3loc.o: ../uhdrs/osconf.h
  1125. Xi3loc.o: ../uhdrs/os.h
  1126. Xi3loc.o: ../uhdrs/conf.h
  1127. Xi3loc.o: ../uhdrs/config.h
  1128. Xi3loc.o: ../bhdrs/bint.h
  1129. Xi3loc.o: ../bhdrs/bobj.h
  1130. Xi3loc.o: ../ihdrs/i0err.h
  1131. Xi3loc.o: ../ihdrs/i3env.h
  1132. Xi3loc.o: ../ihdrs/i3in2.h
  1133. Xi3scr.o: i3scr.c
  1134. Xi3scr.o: ../bhdrs/b.h
  1135. Xi3scr.o: ../uhdrs/osconf.h
  1136. Xi3scr.o: ../uhdrs/os.h
  1137. Xi3scr.o: ../uhdrs/conf.h
  1138. Xi3scr.o: ../uhdrs/config.h
  1139. Xi3scr.o: ../bhdrs/bint.h
  1140. Xi3scr.o: ../uhdrs/feat.h
  1141. Xi3scr.o: ../bhdrs/bmem.h
  1142. Xi3scr.o: ../bhdrs/bobj.h
  1143. Xi3scr.o: ../bhdrs/bcom.h
  1144. Xi3scr.o: ../ihdrs/i2nod.h
  1145. Xi3scr.o: ../ihdrs/i2par.h
  1146. Xi3scr.o: ../ihdrs/i3typ.h
  1147. Xi3scr.o: ../ihdrs/i3env.h
  1148. Xi3scr.o: ../ihdrs/i3in2.h
  1149. Xi3scr.o: ../ihdrs/i3scr.h
  1150. Xi3sou.o: i3sou.c
  1151. Xi3sou.o: ../bhdrs/b.h
  1152. Xi3sou.o: ../uhdrs/osconf.h
  1153. Xi3sou.o: ../uhdrs/os.h
  1154. Xi3sou.o: ../uhdrs/conf.h
  1155. Xi3sou.o: ../uhdrs/config.h
  1156. Xi3sou.o: ../bhdrs/bint.h
  1157. Xi3sou.o: ../uhdrs/feat.h
  1158. Xi3sou.o: ../bhdrs/bmem.h
  1159. Xi3sou.o: ../bhdrs/bobj.h
  1160. Xi3sou.o: ../bhdrs/bfil.h
  1161. Xi3sou.o: ../ihdrs/i2par.h
  1162. Xi3sou.o: ../ihdrs/i2nod.h
  1163. Xi3sou.o: ../ihdrs/i3env.h
  1164. Xi3sou.o: ../ihdrs/i3scr.h
  1165. Xi3sou.o: ../ihdrs/i3in2.h
  1166. Xi3sou.o: ../ihdrs/i3sou.h
  1167. Xi3sta.o: i3sta.c
  1168. Xi3sta.o: ../bhdrs/b.h
  1169. Xi3sta.o: ../uhdrs/osconf.h
  1170. Xi3sta.o: ../uhdrs/os.h
  1171. Xi3sta.o: ../uhdrs/conf.h
  1172. Xi3sta.o: ../uhdrs/config.h
  1173. Xi3sta.o: ../bhdrs/bint.h
  1174. Xi3sta.o: ../uhdrs/feat.h
  1175. Xi3sta.o: ../bhdrs/bmem.h
  1176. Xi3sta.o: ../bhdrs/bobj.h
  1177. Xi3sta.o: ../ihdrs/i0err.h
  1178. Xi3sta.o: ../ihdrs/i1num.h
  1179. Xi3sta.o: ../ihdrs/i2nod.h
  1180. Xi3sta.o: ../ihdrs/i3env.h
  1181. Xi3sta.o: ../ihdrs/i3int.h
  1182. Xi3sta.o: ../ihdrs/i3in2.h
  1183. Xi3sta.o: ../ihdrs/i3sou.h
  1184. Xi3typ.o: i3typ.c
  1185. Xi3typ.o: ../bhdrs/b.h
  1186. Xi3typ.o: ../uhdrs/osconf.h
  1187. Xi3typ.o: ../uhdrs/os.h
  1188. Xi3typ.o: ../uhdrs/conf.h
  1189. Xi3typ.o: ../uhdrs/config.h
  1190. Xi3typ.o: ../bhdrs/bint.h
  1191. Xi3typ.o: ../bhdrs/bobj.h
  1192. Xi3typ.o: ../ihdrs/i3env.h
  1193. Xi3typ.o: ../ihdrs/i3typ.h
  1194. EOF
  1195. fi
  1196. if test -s 'abc/boot/fill.c'
  1197. then echo '*** I will not over-write existing file abc/boot/fill.c'
  1198. else
  1199. echo 'x - abc/boot/fill.c'
  1200. sed 's/^X//' > 'abc/boot/fill.c' << 'EOF'
  1201. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
  1202. X
  1203. X/*
  1204. X * fill the read-in tables, checking their consistency.
  1205. X *
  1206. X * All references are still in terms of indices in namelist[],
  1207. X * and must be replaced by indices in classdef[] or symdef[].
  1208. X *
  1209. X * The lexical names are replaced by the enveloping class or Symbol,
  1210. X * if they occur in a Symbol definition, or a class definition, respectively.
  1211. X * The enveloping class and Symbol definitions themselves are still
  1212. X * nillified at the start of this process, and can be filled only
  1213. X * after the other definitions have been handled; otherwise, any filled-in
  1214. X * indices would be considered as indices in namelist[], and be subject
  1215. X * to the replacement above.
  1216. X *
  1217. X */
  1218. X
  1219. X#include "b.h"
  1220. X#include "main.h"
  1221. X
  1222. XHidden int errors;
  1223. X
  1224. XVisible Procedure fill_and_check_tables() {
  1225. X    
  1226. X    errors= 0;
  1227. X    
  1228. X    check_defined();
  1229. X    
  1230. X    check_representations();
  1231. X    
  1232. X    if (errors)
  1233. X        fatal("giving up");
  1234. X
  1235. X    fill_classdefinitions();
  1236. X    
  1237. X    fill_symboldefinitions();
  1238. X    
  1239. X    fill_lexicals();
  1240. X    
  1241. X    fill_special_definitions();
  1242. X}
  1243. X
  1244. XHidden Procedure check_defined() {
  1245. X    struct nameinfo *pn;
  1246. X    int iname;
  1247. X    
  1248. X    for (iname= 0; iname < nname; iname++) {
  1249. X        pn= &namelist[iname];
  1250. X        if (Isnilitem(pn->n_index)) {
  1251. X            message("name '%s' not defined by any rule", 
  1252. X                pn->n_name);
  1253. X            errors++;
  1254. X        }
  1255. X    }
  1256. X}
  1257. X
  1258. X/* Check the fixed-string representations in the grammar.
  1259. X * The code assumes that Optional and Hole are the last two in the table
  1260. X */
  1261. X
  1262. XHidden Procedure check_representations() {
  1263. X    struct syminfo *psym;
  1264. X    int isym;
  1265. X    int ich;
  1266. X    
  1267. X    for (isym= 0; isym < noptional; isym++) {
  1268. X        psym= &symdef[isym];
  1269. X        for (ich= 0; ich < MAXCHILD; ich++) {
  1270. X            checkstring(psym->s_repr[ich], ich, psym->s_name);
  1271. X            if (ich == MAXCHILD || Isnilitem(psym->s_class[ich]))
  1272. X                break;    /* for ich */
  1273. X        }
  1274. X    }
  1275. X}
  1276. X
  1277. X/*
  1278. X * Check a representation string.
  1279. X */
  1280. X
  1281. XHidden Procedure checkstring(s, ich, sname) string s; int ich; string sname; {
  1282. X    int i;
  1283. X    
  1284. X    if (s == NULL)
  1285. X        return;
  1286. X    for (i = 0; s[i] != '\0'; i++) {
  1287. X        switch (s[i]) {
  1288. X        case '\n':
  1289. X        case '\r':
  1290. X            if (i || ich) {
  1291. X                errors++;
  1292. X        message("badly placed \\n/\\r for symbol %s, child %d",
  1293. X                    sname, ich);
  1294. X            }
  1295. X            break;
  1296. X        case '\t':
  1297. X        case '\b':
  1298. X            if (s[i+1]) {
  1299. X                errors++;
  1300. X        message("badly placed \\t/\\b for symbol %s, child %d",
  1301. X                    sname, ich);
  1302. X            }
  1303. X            break;
  1304. X        default:
  1305. X            if (s[i] < ' ' || s[i] >= 0177) {
  1306. X                errors++;
  1307. X        message("illegal control char for symbol %s, child %d",
  1308. X                    sname, ich);
  1309. X            }
  1310. X        }
  1311. X    }
  1312. X}
  1313. X
  1314. XHidden Procedure fill_classdefinitions() {
  1315. X    struct classinfo *pclass;
  1316. X    int iclass;
  1317. X    int i;
  1318. X    int iname;
  1319. X    struct nameinfo *pname;
  1320. X    
  1321. X    for (iclass= 0; iclass < nclass; iclass++) {
  1322. X        pclass= &classdef[iclass];
  1323. X        for (i= 0; ; i++) {
  1324. X            iname= pclass->c_syms[i];
  1325. X            if (Isnilitem(iname))
  1326. X                break; /* for i */
  1327. X            pname= &namelist[iname];
  1328. X            switch (pname->n_type) {
  1329. X            case Sym:
  1330. X                /* replace by index in symdef[] */
  1331. X                pclass->c_syms[i]= pname->n_index;
  1332. X                break;
  1333. X            case Lex:
  1334. X                /* replace by enveloping Symbol definition */
  1335. X                pclass->c_syms[i]= lexdef[pname->n_index].l_sym;
  1336. X                break;
  1337. X            default:
  1338. X                message("can't happen");
  1339. X            }
  1340. X        }
  1341. X    }
  1342. X}
  1343. X
  1344. XHidden Procedure fill_symboldefinitions() {
  1345. X    struct syminfo *psym;
  1346. X    int isym;
  1347. X    int ich;
  1348. X    int iname;
  1349. X    struct nameinfo *pname;
  1350. X    
  1351. X    for (isym= 0; isym < nsym; isym++) {
  1352. X        psym= &symdef[isym];
  1353. X        for (ich= 0; ich < MAXCHILD; ich++) {
  1354. X            iname= psym->s_class[ich];
  1355. X            if (Isnilitem(iname))
  1356. X                break;    /* for ich */
  1357. X            pname= &namelist[iname];
  1358. X            switch (pname->n_type) {
  1359. X            case Class:
  1360. X                /* replace by index in classdef[] */
  1361. X                psym->s_class[ich]= pname->n_index;
  1362. X                break;
  1363. X            case Lex:
  1364. X                /* replace by enveloping class definition */
  1365. X                psym->s_class[ich]= 
  1366. X                    lexdef[pname->n_index].l_class;
  1367. X                break;
  1368. X            default:
  1369. X                message("can't happen");
  1370. X            }
  1371. X        }
  1372. X    }
  1373. X}
  1374. X
  1375. XHidden Procedure fill_lexicals() {
  1376. X    struct lexinfo *plex;
  1377. X    int ilex;
  1378. X    struct classinfo *pbody;
  1379. X    struct syminfo *psym;
  1380. X    struct classinfo *pclass;
  1381. X    
  1382. X    nlexical= nsym;    /* ensure lexicals > Symbols */
  1383. X    
  1384. X    /* The enveloping class- and Symbol-definitions have already
  1385. X     * been malloc'ed and filled with Nil's in getlexdef().
  1386. X     * Here we only fill the real indices.
  1387. X     */
  1388. X    for (ilex= 0; ilex < nlex; ilex++) {
  1389. X        plex= &lexdef[ilex];
  1390. X        
  1391. X        pbody= &classdef[plex->l_body];
  1392. X        pbody->c_syms[0]= nlexical + ilex;
  1393. X        
  1394. X        if (ilex == lsuggestion || ilex == lsugghowname)
  1395. X            continue; /* see comment in read.c in getlexdef()*/
  1396. X        
  1397. X        psym= &symdef[plex->l_sym];
  1398. X        psym->s_class[0]= plex->l_body;
  1399. X        
  1400. X        pclass= &classdef[plex->l_class];
  1401. X        pclass->c_syms[0]= plex->l_sym;
  1402. X    }
  1403. X}
  1404. X
  1405. XHidden Procedure fill_special_definitions() {
  1406. X
  1407. X    if (lsuggestion >= 0 )        /* SUGGESTION defined */
  1408. X        symdef[nsuggestion].s_class[0]= nsuggstnbody;
  1409. X    if (lsugghowname >= 0)        /* SUGGHOWNAME defined */
  1410. X        symdef[nsugghowname].s_class[0]= nsugghowbody;
  1411. X    
  1412. X    /* Optional and Hole need no further filling */
  1413. X}
  1414. EOF
  1415. fi
  1416. if test -s 'abc/boot/main.c'
  1417. then echo '*** I will not over-write existing file abc/boot/main.c'
  1418. else
  1419. echo 'x - abc/boot/main.c'
  1420. sed 's/^X//' > 'abc/boot/main.c' << 'EOF'
  1421. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
  1422. X
  1423. X/*
  1424. X * mktables -- Program to create tables for ABC editor from grammar
  1425. X *
  1426. X * mktables [-s maxsym] [-c maxclass] [-l maxlex] [grammar-file]
  1427. X */
  1428. X
  1429. X#include "b.h"
  1430. X#include "main.h"
  1431. X
  1432. XVisible string progname;
  1433. X
  1434. XFILE *gfp;        /* grammar file */
  1435. Xchar *gfile= GRAMMAR;
  1436. XFILE *tfp;        /* data file for grammar tables */
  1437. Xchar *tfile= TABLES;
  1438. XFILE *ifp;        /* include file for grammar table structure */
  1439. Xchar *ifile= INCLUDE;    /*  and Symbol to index-in-table mapping */
  1440. Xchar *hfile=HFILE;    /* ultimate include-file name to reference
  1441. X             * in datafile */
  1442. X
  1443. XVisible struct classinfo *classdef;    /* class definitions */
  1444. XVisible struct syminfo *symdef;        /* Symbol definitions */
  1445. XVisible struct lexinfo *lexdef;        /* LEXICAL definitions */
  1446. XVisible struct nameinfo *namelist;    /* class, Symbol or LEXICAL names */
  1447. X
  1448. Xint maxclass= MAXCLASS; /* max number of class definitions in grammar */
  1449. Xint maxsym= MAXSYM;    /* max number of Symbol definitions in grammar */
  1450. Xint maxlex= MAXLEX;    /* max number of LEXICAL definitions grammar */
  1451. Xint maxname= MAXNAME;    /* max number of names (Symbols, classes or LEXICALS) */
  1452. X
  1453. Xint nclass= 0;        /* actual number of definitions in grammar */
  1454. Xint nsym= 0;
  1455. Xint nlex= 0;
  1456. Xint nname= 0;
  1457. X
  1458. Xint lsuggestion= -1; /* index in lexdef[] of definition for SUGGESTION */
  1459. X        /* also used as bool to check presence of definition */
  1460. Xint lsugghowname= -1; /* idem for SUGGHOWNAME */
  1461. Xint nsuggstnbody;/* index in classdef[] of enveloped definition of SUGGESTION */
  1462. Xint nsugghowbody; /* idem ... */
  1463. X
  1464. Xint nsuggestion;/* index in symdef[] of symboldefinition for Suggestion */
  1465. Xint nsugghowname;/* index in symdef[] of symboldefinition for Sugghowname */
  1466. Xint noptional;    /* index in symdef[] of symboldefinition for Optional */
  1467. Xint nhole;    /* index in symdef[] of symboldefinition for Hole */
  1468. X
  1469. Xint nlexical;    /* to distinguish lexical items from Symbols;
  1470. X         * the latter will be represented by the index of their
  1471. X         * definition in symdef[], so we save the final value
  1472. X         * of 'nsym' in 'nlexical', and add it to the indices of
  1473. X         * the lexical items in lexdef[] to get their representation.
  1474. X         */
  1475. X
  1476. Xmain(argc, argv) int argc; char **argv; {
  1477. X    int errflg;
  1478. X    int c;
  1479. X    extern char *optarg;
  1480. X    extern int optind;
  1481. X    int getopt();
  1482. X    FILE *openfile();
  1483. X
  1484. X    progname= argv[0];
  1485. X    errflg= 0;
  1486. X    while ((c= getopt(argc, argv, "s:c:l:n:g:t:i:h:")) != EOF) {
  1487. X        switch (c) {
  1488. X        case 's':
  1489. X            maxsym= atoi(optarg);
  1490. X            break;
  1491. X        case 'c':
  1492. X            maxclass= atoi(optarg);
  1493. X            break;
  1494. X        case 'l':
  1495. X            maxlex= atoi(optarg);
  1496. X            break;
  1497. X        case 'n':
  1498. X            maxname= atoi(optarg);
  1499. X            break;
  1500. X        case 'g':
  1501. X            gfile= optarg;
  1502. X            break;
  1503. X        case 't':
  1504. X            tfile= optarg;
  1505. X            break;
  1506. X        case 'i':
  1507. X            ifile= optarg;
  1508. X            break;
  1509. X        case 'h':
  1510. X            hfile= optarg;
  1511. X            break;
  1512. X        case '?':
  1513. X        default:
  1514. X            errflg++;
  1515. X            break;
  1516. X        }
  1517. X    }
  1518. X    
  1519. X    if (argc > optind)
  1520. X        errflg++;
  1521. X    
  1522. X    if (errflg)
  1523. X        fatal(
  1524. X"usage: %s [-s maxsym] [-c maxclass] [-l maxlex] [-n maxname]\n\
  1525. X    [-g grammar-file] [-t table-file] [-i include-file]\n",
  1526. X             argv[0]);
  1527. X    
  1528. X    gfp= openfile(gfile, "r");
  1529. X    tfp= openfile(tfile, "w");
  1530. X    ifp= openfile(ifile, "w");
  1531. X    
  1532. X    process();
  1533. X    
  1534. X    fclose(gfp);
  1535. X    fclose(tfp);
  1536. X    fclose(ifp);
  1537. X    
  1538. X    exit(0);
  1539. X}
  1540. X
  1541. XHidden FILE *openfile(file, mode) string file; string mode; {
  1542. X    FILE *fp;
  1543. X    string s;
  1544. X    
  1545. X    switch (*mode) {
  1546. X    case 'r':
  1547. X        s= "read";
  1548. X        break;
  1549. X    case 'w':
  1550. X        s= "write";
  1551. X        break;
  1552. X    default:
  1553. X        fatal("wrong mode %s opening file %s", mode, file);
  1554. X    }
  1555. X    fp= fopen(file, mode);
  1556. X    if (fp == NULL) {
  1557. X        fatal("can't open file \"%s\" to %s it", file, s);
  1558. X    }
  1559. X    return fp;
  1560. X}
  1561. X
  1562. XHidden Procedure process() {
  1563. X
  1564. X    allocate_tables();
  1565. X    
  1566. X    read_grammar_into_tables(); /* check repr's immediately? */
  1567. X    
  1568. X    fill_and_check_tables();
  1569. X    
  1570. X    compute_classes();
  1571. X    
  1572. X    dump_files();
  1573. X}
  1574. X
  1575. X/* VARARGS 1 */
  1576. Xmessage(format, arg1, arg2, arg3, arg4, arg5)
  1577. X    char *format;
  1578. X    char *arg1, *arg2, *arg3, *arg4, *arg5;
  1579. X{
  1580. X    fprintf(stderr, "%s: ", progname);
  1581. X    fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5);
  1582. X    putc('\n', stderr);
  1583. X}
  1584. X
  1585. X/* VARARGS 1 */
  1586. Xfatal(format, arg1, arg2, arg3, arg4, arg5)
  1587. X    char *format;
  1588. X    char *arg1, *arg2, *arg3, *arg4, *arg5;
  1589. X{
  1590. X    fprintf(stderr, "%s: ", progname);
  1591. X    fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5);
  1592. X    putc('\n', stderr);
  1593. X    exit(1);
  1594. X}
  1595. X
  1596. Xchar *getmem(len) unsigned len; {
  1597. X    char *p;
  1598. X    char *malloc();
  1599. X    
  1600. X    p= malloc(len);
  1601. X    if (p == NULL)
  1602. X        fatal("no more memory");
  1603. X    return p;
  1604. X}
  1605. X
  1606. XVisible string savestr(s) string s; {
  1607. X    string p= (string) getmem((unsigned) (strlen((char*)s) + 1));
  1608. X    strcpy((char*)p, (char*)s);
  1609. X    return p;
  1610. X}
  1611. X
  1612. X/* return saved copy itemarray pi with ilen items, 
  1613. X * the last of which must be a Nilitem.
  1614. X */
  1615. X
  1616. XVisible itemptr savearray(pi, ilen) itemptr pi; int ilen; {
  1617. X    itemptr pp= (itemptr) getmem((unsigned) (ilen*sizeof(item)));
  1618. X    itemptr p= pp;
  1619. X    
  1620. X    while (--ilen > 0) {
  1621. X        *p++= *pi++;
  1622. X    }
  1623. X    Assert(*pi == Nilitem);
  1624. X    *p= Nilitem;
  1625. X    return pp;
  1626. X}
  1627. X
  1628. XVisible Procedure asserr(file, line) string file; int line; {
  1629. X    fatal("assertion error: file %s, line %d", file, line);
  1630. X}
  1631. EOF
  1632. fi
  1633. if test -s 'abc/tc/termcap.3X'
  1634. then echo '*** I will not over-write existing file abc/tc/termcap.3X'
  1635. else
  1636. echo 'x - abc/tc/termcap.3X'
  1637. sed 's/^X//' > 'abc/tc/termcap.3X' << 'EOF'
  1638. X.TH TERMCAP 3X "9 February 1983"
  1639. X.UC 4
  1640. X.SH NAME
  1641. Xtgetent, tgetnum, tgetflag, tgetstr, tgoto, tputs \- terminal independent operation routines
  1642. X.SH SYNOPSIS
  1643. X.nf
  1644. X.B char PC;
  1645. X.B char *BC;
  1646. X.B char *UP;
  1647. X.B short ospeed;
  1648. X.PP
  1649. X.B tgetent(bp, name)
  1650. X.B char *bp, *name;
  1651. X.PP
  1652. X.B tgetnum(id)
  1653. X.B char *id;
  1654. X.PP
  1655. X.B tgetflag(id)
  1656. X.B char *id;
  1657. X.PP
  1658. X.B char *
  1659. X.B tgetstr(id, area)
  1660. X.B char *id, **area;
  1661. X.PP
  1662. X.B char *
  1663. X.B tgoto(cm, destcol, destline)
  1664. X.B char *cm;
  1665. X.PP
  1666. X.B tputs(cp, affcnt, outc)
  1667. X.B register char *cp;
  1668. X.B int affcnt;
  1669. X.B int (*outc)();
  1670. X.fi
  1671. X.SH DESCRIPTION
  1672. XThese functions extract and use capabilities from the terminal capability data
  1673. Xbase
  1674. X.IR termcap (5).
  1675. XThese are low level routines;
  1676. Xsee
  1677. X.IR curses (3X)
  1678. Xfor a higher level package.
  1679. X.PP
  1680. X.I Tgetent
  1681. Xextracts the entry for terminal
  1682. X.I name
  1683. Xinto the buffer at
  1684. X.I bp.
  1685. X.I Bp
  1686. Xshould be a character buffer of size
  1687. X1024 and must be retained through all subsequent calls
  1688. Xto
  1689. X.I tgetnum,
  1690. X.I tgetflag,
  1691. Xand
  1692. X.I tgetstr.
  1693. X.I Tgetent
  1694. Xreturns \-1 if it cannot open the
  1695. X.I termcap
  1696. Xfile, 0 if the terminal name given does not have an entry,
  1697. Xand 1 if all goes well.
  1698. XIt will look in the environment for a TERMCAP variable.
  1699. XIf found, and the value does not begin with a slash,
  1700. Xand the terminal type
  1701. X.B name
  1702. Xis the same as the environment string TERM,
  1703. Xthe TERMCAP string is used instead of reading the termcap file.
  1704. XIf it does begin with a slash, the string is used as a path name rather than
  1705. X.I /etc/termcap.
  1706. XThis can speed up entry into programs that call
  1707. X.IR tgetent ,
  1708. Xas well as to help debug new terminal descriptions
  1709. Xor to make one for your terminal if you can't write the file
  1710. X.I /etc/termcap.
  1711. X.PP
  1712. X.I Tgetnum
  1713. Xgets the numeric value of capability
  1714. X.I id,
  1715. Xreturning \-1 if is not given for the terminal.
  1716. X.I Tgetflag
  1717. Xreturns 1 if the specified capability is present in
  1718. Xthe terminal's entry, 0 if it is not.
  1719. X.I Tgetstr
  1720. Xgets the string value of capability
  1721. X.I id,
  1722. Xplacing it in the buffer at
  1723. X.I area,
  1724. Xadvancing the
  1725. X.I area
  1726. Xpointer.
  1727. XIt decodes the abbreviations for this field described in
  1728. X.IR termcap (5),
  1729. Xexcept for cursor addressing and padding information.
  1730. X.PP
  1731. X.I Tgoto
  1732. Xreturns a cursor addressing string decoded from
  1733. X.I cm
  1734. Xto go to column
  1735. X.I destcol
  1736. Xin line
  1737. X.I destline.
  1738. XIt uses the external variables
  1739. X.B UP
  1740. X(from the \fBup\fR capability)
  1741. Xand
  1742. X.B BC
  1743. X(if \fBbc\fR is given rather than \fBbs\fR)
  1744. Xif necessary to avoid placing \fB\en\fR, \fB^D\fR or \fB^@\fR in
  1745. Xthe returned string.
  1746. X(Programs which call tgoto should be sure to turn off the XTABS bit(s),
  1747. Xsince
  1748. X.I tgoto
  1749. Xmay now output a tab.
  1750. XNote that programs using termcap should in general turn off XTABS
  1751. Xanyway since some terminals use control I for other functions,
  1752. Xsuch as nondestructive space.)
  1753. XIf a \fB%\fR sequence is given which is not understood, then
  1754. X.I tgoto
  1755. Xreturns \*(lqOOPS\*(rq.
  1756. X.PP
  1757. X.I Tputs
  1758. Xdecodes the leading padding information of the string
  1759. X.IR cp ;
  1760. X.I affcnt
  1761. Xgives the number of lines affected by the operation, or 1 if this is
  1762. Xnot applicable,
  1763. X.I outc
  1764. Xis a routine which is called with each character in turn.
  1765. XThe external variable
  1766. X.I ospeed
  1767. Xshould contain the output speed of the terminal as encoded by
  1768. X.IR stty (3).
  1769. XThe external variable
  1770. X.B PC
  1771. Xshould contain a pad character to be used (from the \fBpc\fR capability)
  1772. Xif a null (\fB^@\fR) is inappropriate.
  1773. X.SH FILES
  1774. X.ta \w'/usr/lib/libtermcap.a  'u
  1775. X/usr/lib/libtermcap.a    \-ltermcap library
  1776. X.br
  1777. X/etc/termcap    data base
  1778. X.DT
  1779. X.SH SEE ALSO
  1780. Xex(1), curses(3X), termcap(5)
  1781. X.SH AUTHOR
  1782. XWilliam Joy
  1783. EOF
  1784. fi
  1785. if test -s 'abc/unix/u1main.c'
  1786. then echo '*** I will not over-write existing file abc/unix/u1main.c'
  1787. else
  1788. echo 'x - abc/unix/u1main.c'
  1789. sed 's/^X//' > 'abc/unix/u1main.c' << 'EOF'
  1790. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1989. */
  1791. X
  1792. X#include "b.h"
  1793. X#include "bmem.h"
  1794. X#include "bfil.h"
  1795. X#include "getopt.h"
  1796. X#include "i3bws.h"
  1797. X
  1798. XHidden Procedure abc_usage() {
  1799. X    int m;
  1800. X    
  1801. X    /* dirty use of message numbers below: */
  1802. X    for (m= 6900; m <= 6915; m++)
  1803. X        putmess(errfile, m);
  1804. X    
  1805. X    exit(-1);
  1806. X}
  1807. X
  1808. X#define USE00 MESS(6900, "\nUsage:  abc [-W ws.group] [-w ws.name]\n")
  1809. X#define USE01 MESS(6901, "            [ -e | -i tab | -o tab | -l | -r | -R | file ...]\n")
  1810. X#define USE02 MESS(6902, "\nWorkspace Options:\n")
  1811. X#define USE03 MESS(6903, "     -W dir        use group of workspaces in 'dir' (default $HOME/abc)\n")
  1812. X#define USE04 MESS(6904, "     -w name       start in workspace 'name' (default: last workspace)\n")
  1813. X#define USE05 MESS(6905, "     -w path       use 'path' as current workspace (no -W option allowed)\n")
  1814. X#define USE06 MESS(6906, "\nOther Options:\n")
  1815. X#define USE07 MESS(6907, "     -e            Use ${EDITOR} as editor to edit definitions\n")
  1816. X#define USE08 MESS(6908, "     file ...      Read commands from file(s)\n")
  1817. X#define USE09 MESS(6909, "\nSpecial tasks:\n")
  1818. X#define USE10 MESS(6910, "     -i tab        Fill table 'tab' with text lines from standard input\n")
  1819. X#define USE11 MESS(6911, "     -o tab        Write text lines from table 'tab' to standard output\n")
  1820. X#define USE12 MESS(6912, "     -l            List the how-to's in a workspace on standard output\n")
  1821. X#define USE13 MESS(6913, "     -r            Recover a workspace when its index is lost\n")
  1822. X#define USE14 MESS(6914, "     -R            Recover the index of a group of workspaces\n")
  1823. X#define USE15 MESS(6915, "\nUse 'abckeys' to change key bindings\n")
  1824. X
  1825. X
  1826. X#define INCOMP_OPTIONS    MESS(6916, "*** incompatible workspace options\n")
  1827. X#define NO_EDITOR MESS(6917, "*** you have not set your environment variable EDITOR\n")
  1828. X
  1829. XVisible char *bws_arg= (char *) NULL;
  1830. X            /* -W bws_arg: group name workspaces */
  1831. XVisible char *wsp_arg= (char *) NULL;
  1832. X            /* -w wsp_arg: start workspace */
  1833. X
  1834. XVisible bool eflag= No;
  1835. X            /* -e: use ${EDITOR} instaed of ABC-editor */
  1836. XVisible bool is_gr_reccall= No;
  1837. X            /* -R: recover workspace group index */
  1838. X
  1839. XVisible bool slowterminal= No;
  1840. X            /* -S: do not tell "cannot insert" on slow terminal */
  1841. XVisible bool hushbaby= No;
  1842. X            /* -H: no audible bell if you're babysitting */
  1843. X
  1844. XVisible bool use_bed= Yes;
  1845. X            /* the abc editor will be used, so initbed() etc. */
  1846. X
  1847. X#ifndef NDEBUG
  1848. X
  1849. X/* use -DDUMPKEYS, -DMEMTRACE, -DEDITRACE, -DTYPETRACE -D VTRMTRACE during
  1850. X * compilation to enable these flags.
  1851. X */
  1852. X
  1853. XVisible bool dflag= No;
  1854. X        /* -d: debugging output wanted */
  1855. X
  1856. X#ifdef DUMPKEYS
  1857. XVisible bool kflag= No;
  1858. X        /* -k: dump keybindings at various stages */
  1859. X#endif
  1860. X
  1861. X#ifdef MEMTRACE
  1862. XHidden string memfile= NULL;
  1863. XVisible FILE *memfp= NULL;
  1864. X        /* -M memfile: trace memory allocations to memfile */
  1865. X#endif
  1866. X
  1867. X#ifdef EDITRACE
  1868. XVisible string dumpfile= NULL;
  1869. XVisible FILE *dumpfp= NULL;
  1870. X        /* -E dumpfile: dump editor environ-info to dumpfile */
  1871. X#endif
  1872. X
  1873. X#ifdef TYPETRACE
  1874. XVisible string stc_file= NULL;
  1875. XVisible FILE *stc_fp= NULL;
  1876. X        /* -T stc_file: trace typechecker on stc_file */
  1877. X#endif
  1878. X
  1879. X#ifdef VTRMTRACE
  1880. XVisible string vtrmfile= NULL;
  1881. XVisible FILE *vtrmfp= NULL;
  1882. X        /* -V vtrmfile: trace typechecker on vtrmfile */
  1883. X#endif
  1884. X
  1885. X#endif /*NDEBUG */
  1886. X
  1887. X#define NONE '\0'
  1888. X
  1889. Xmain(argc, argv) int argc; char **argv; {
  1890. X    int c;
  1891. X    char *sbuf;
  1892. X    char io_option= NONE;
  1893. X    char *io_table= (char *) NULL;
  1894. X    bool usage_error= No;
  1895. X
  1896. X#ifdef NDEBUG
  1897. X    while ((c= getopt(argc, argv, "W:w:ei:o:lrRSH")) != EOF) {
  1898. X#else
  1899. X    while ((c= getopt(argc, argv, "W:w:ei:o:lrRSHdkM:E:T:V:")) != EOF) {
  1900. X#endif
  1901. X        switch (c) {
  1902. X        case 'W':
  1903. X            if (bws_arg) usage_error= Yes;
  1904. X            else bws_arg= optarg;
  1905. X            break;
  1906. X        case 'w':
  1907. X            if (wsp_arg) usage_error= Yes;
  1908. X            else wsp_arg= optarg;
  1909. X            break;
  1910. X        case 'e':
  1911. X            if (eflag || io_option) usage_error= Yes;
  1912. X            else eflag= Yes;
  1913. X            break;
  1914. X        case 'i':
  1915. X        case 'o':
  1916. X            io_table= optarg;
  1917. X        case 'l':
  1918. X        case 'r':
  1919. X        case 'R':
  1920. X            if (eflag || io_option) usage_error= Yes;
  1921. X            else io_option= c;
  1922. X            if (c == 'R')
  1923. X                is_gr_reccall= Yes;
  1924. X            break;
  1925. X
  1926. X        case 'S':
  1927. X            slowterminal= Yes;
  1928. X            break;
  1929. X        case 'H':
  1930. X            hushbaby= Yes;
  1931. X            break;
  1932. X
  1933. X#ifndef NDEBUG
  1934. X        case 'd':
  1935. X            dflag= Yes;
  1936. X            break;
  1937. X#ifdef DUMPKEYS
  1938. X        case 'k':
  1939. X            kflag= Yes;
  1940. X            break;
  1941. X#endif
  1942. X#ifdef MEMTRACE
  1943. X        case 'M':
  1944. X            memfile= optarg;
  1945. X            break;
  1946. X#endif
  1947. X#ifdef EDITRACE
  1948. X        case 'E':
  1949. X            dumpfile= optarg;
  1950. X            break;
  1951. X#endif
  1952. X#ifdef TYPETRACE
  1953. X        case 'T':
  1954. X            stc_file= optarg;
  1955. X            break;
  1956. X#endif
  1957. X#ifdef VTRMTRACE
  1958. X        case 'V':
  1959. X            vtrmfile= optarg;
  1960. X            break;
  1961. X#endif
  1962. X#endif /* !NDEBUG */
  1963. X
  1964. X        default:
  1965. X            usage_error= Yes;
  1966. X            break;
  1967. X        }
  1968. X    }
  1969. X
  1970. X    argc -= optind;
  1971. X    argv += optind;
  1972. X    
  1973. X    if (argc > 0 && (eflag || io_option))
  1974. X        usage_error= Yes;
  1975. X    
  1976. X#ifndef NDEBUG
  1977. X#ifdef MEMTRACE
  1978. X    if (memfile != NULL)
  1979. X        memfp= fopen(memfile, "w");
  1980. X#endif
  1981. X#ifdef EDITRACE
  1982. X    if (dumpfile != NULL)
  1983. X        dumpfp= fopen(dumpfile, "w");
  1984. X#endif
  1985. X#ifdef TYPETRACE
  1986. X    if (stc_file != NULL)
  1987. X        stc_fp= fopen(stc_file, "w");
  1988. X#endif
  1989. X#ifdef VTRMTRACE
  1990. X    if (vtrmfile != NULL)
  1991. X        vtrmfp= fopen(vtrmfile, "w");
  1992. X#endif
  1993. X#endif
  1994. X
  1995. X    /* Setbuf must be called before any output is produced! */
  1996. X    sbuf= (char*) getmem((unsigned)BUFSIZ);
  1997. X    setbuf(stdout, sbuf);
  1998. X    
  1999. X    set_vars();    /* set messfile and errfile before using
  2000. X             * usage messages ! */
  2001. X    
  2002. X    if (is_path(wsp_arg) && bws_arg) {
  2003. X        putmess(errfile, INCOMP_OPTIONS);
  2004. X        usage_error= Yes;
  2005. X    }
  2006. X    
  2007. X    if (eflag) {
  2008. X        editor= (string) getenv("EDITOR");
  2009. X        if (editor == (string)NULL || *editor == NONE) {
  2010. X            putmess(errfile, NO_EDITOR);
  2011. X            usage_error= Yes;
  2012. X        }
  2013. X    }
  2014. X    
  2015. X    if (usage_error)
  2016. X        abc_usage();    /* exits */
  2017. X    
  2018. X    initcall(argc, argv);
  2019. X    
  2020. X    use_bed= rd_interactive && (io_option == NONE || io_option == 'i');
  2021. X    
  2022. X    init((bool) (io_option == NONE));
  2023. X    if (io_option)
  2024. X        abcio(io_option, io_table);
  2025. X    else
  2026. X        run_abc(argc, argv);
  2027. X
  2028. X    freemem((ptr) sbuf);
  2029. X
  2030. X    bye(0);
  2031. X}
  2032. EOF
  2033. fi
  2034. if test -s 'abc/unix/u1sig.c'
  2035. then echo '*** I will not over-write existing file abc/unix/u1sig.c'
  2036. else
  2037. echo 'x - abc/unix/u1sig.c'
  2038. sed 's/^X//' > 'abc/unix/u1sig.c' << 'EOF'
  2039. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  2040. X
  2041. X/*Handle interrupts and signals*/
  2042. X
  2043. X#include "b.h"
  2044. X
  2045. X#ifdef SIGNAL
  2046. X
  2047. X#include <signal.h>
  2048. X
  2049. X#include "feat.h"
  2050. X
  2051. X#ifdef SETJMP
  2052. X#include <setjmp.h>
  2053. X#endif
  2054. X
  2055. X/*The operating system provides a function signal(s,f)
  2056. X  that associates function f with the signal s, and returns
  2057. X  a pointer to the previous function associated with s.
  2058. X  Then, when signal s occurs, f is called and the function associated with s
  2059. X  may or may not be reset. Thus f may need to call signal(s,f) again to.
  2060. X  The code here doesn't depend on either interpretation, always being explicit
  2061. X  about which handler to use.
  2062. X
  2063. X  There are two signals that can come from the user: quit and interrupt.
  2064. X  Interrupt should just stop the interpreter and return to B command level;
  2065. X  quit should stop the B system completely.
  2066. X  All other signals are caused by errors (eg memory exhausted)
  2067. X  or come from outside the program, and are therefore fatal.
  2068. X
  2069. X  SIG_IGN is the system supplied routine to ignore a signal.
  2070. X  SIG_DFL is the system supplied default for a signal.
  2071. X  kill(getpid(), signal) kills the program according to 'signal'
  2072. X
  2073. X  On BSD systems, SIGTSTP and other signals causing the process to be
  2074. X  suspended, and SIGCONT and others that are ignored by default,
  2075. X  must not be caught.  It is assumed that all these are defined
  2076. X  when SIGTSTP is defined.
  2077. X*/
  2078. X
  2079. X#ifdef SIGTSTP
  2080. X
  2081. XHidden bool must_handle(sig) int sig; {
  2082. X    /* Shouldn't we enumerate the list of signals we *do* want to catch? */
  2083. X    /* It seems that new signals are all of the type that should be
  2084. X       ignored by most processes... */
  2085. X    switch (sig) {
  2086. X    case SIGURG:
  2087. X    case SIGSTOP:
  2088. X    case SIGTSTP:
  2089. X    case SIGCONT:
  2090. X    case SIGCHLD:
  2091. X    case SIGTTIN:
  2092. X    case SIGTTOU:
  2093. X    case SIGIO:
  2094. X#ifdef SIGWINCH
  2095. X    case SIGWINCH: /* Window size changed */
  2096. X#endif
  2097. X        return No;
  2098. X    default:
  2099. X        return Yes;
  2100. X    }
  2101. X}
  2102. X
  2103. X#else /* !SIGTSTP */
  2104. X
  2105. X#ifdef SIGCLD /* System V */
  2106. X
  2107. X#define must_handle(sig) ((sig) != SIGCLD)
  2108. X
  2109. X#else /* !SIGCLD */
  2110. X
  2111. X#define must_handle(sig) Yes
  2112. X
  2113. X#endif /* SIGCLD */
  2114. X#endif /* SIGTSTP */
  2115. X
  2116. Xextern bool in_vtrm;
  2117. X
  2118. XHidden Procedure oops(sig, m) int sig, m; {
  2119. X    signal(sig, SIG_DFL); /* Don't call handler recursive -- just die... */
  2120. X#ifdef sigmask /* 4.2 BSD */
  2121. X    sigsetmask(0); /* Don't block signals in handler -- just die... */
  2122. X#endif
  2123. X    putmess(stdout, m); /* implies fflush(stdout) */
  2124. X    crashend();
  2125. X    putmess(stdout, MESS(3900, "*** abc: killed by signal\n"));
  2126. X#ifndef NDEBUG
  2127. X    if (in_vtrm)
  2128. X        endterm(); /* resets terminal modes; doesn't belong here !!! */
  2129. X    kill(getpid(), sig);
  2130. X#else
  2131. X    immexit(-1);
  2132. X#endif
  2133. X}
  2134. X
  2135. XHidden SIGTYPE burp(sig) int sig; {
  2136. X    oops(sig, MESS(3901, "*** Oops, I feel suddenly (BURP!) indisposed. I'll call it a day. Sorry.\n"));
  2137. X}
  2138. X
  2139. XHidden SIGTYPE aog(sig) int sig; {
  2140. X    oops(sig, MESS(3902, "*** Oops, an act of God has occurred compelling me to discontinue service.\n"));
  2141. X}
  2142. X
  2143. XHidden SIGTYPE fpe_signal(sig) int sig; { /* sig == SIGFPE */
  2144. X    signal(sig, fpe_signal);
  2145. X    interr(MESS(3903, "unexpected arithmetic overflow"));
  2146. X}
  2147. X
  2148. X/* interrupt handlers: */
  2149. X
  2150. X/* for interpreter: */
  2151. X
  2152. X#ifdef SETJMP
  2153. Xextern jmp_buf readIinterrupt;
  2154. Xextern bool readIcontext;
  2155. X#endif
  2156. X
  2157. XHidden SIGTYPE intsig(sig) int sig; {    /* sig == SIGINT */
  2158. X    signal(sig, SIG_IGN);
  2159. X    int_signal();
  2160. X    signal(sig, intsig);
  2161. X#ifdef SETJMP
  2162. X    if (readIcontext)
  2163. X        longjmp(readIinterrupt, 1);
  2164. X#endif
  2165. X}
  2166. X
  2167. X/* for editor: */
  2168. X
  2169. X#ifdef SETJMP
  2170. Xextern jmp_buf readEinterrupt;
  2171. Xextern bool readEcontext;
  2172. X#endif
  2173. X
  2174. Xextern bool intrflag;
  2175. X
  2176. XHidden SIGTYPE intrhandler(sig) int sig; {
  2177. X    intrflag= Yes;
  2178. X#ifdef SETJMP
  2179. X    if (readEcontext)
  2180. X        longjmp(readEinterrupt, 1);
  2181. X#endif
  2182. X}
  2183. X
  2184. XHidden SIGTYPE (*oldhandler)();
  2185. X
  2186. XVisible Procedure setintrhandler() {
  2187. X    oldhandler= signal(SIGINT, intrhandler);
  2188. X}
  2189. X
  2190. XVisible Procedure resetintrhandler() {
  2191. X    signal(SIGINT, oldhandler);
  2192. X}
  2193. X
  2194. X/* suspend signal for interpreter and editor */
  2195. X
  2196. X#ifdef SIGTSTP
  2197. X
  2198. Xextern bool suspflag;
  2199. X#ifdef SETJMP
  2200. Xextern jmp_buf readEsuspend;
  2201. X#endif
  2202. X
  2203. XHidden SIGTYPE susphandler(sig) int sig; {
  2204. X    SIGTYPE (*oldsig)();
  2205. X    oldsig= signal(SIGTSTP, SIG_IGN);
  2206. X    if (oldsig == SIG_IGN)
  2207. X        return; /* or spawn subshell ?*/
  2208. X    endshow();
  2209. X    endterm();
  2210. X    kill(0, SIGSTOP);
  2211. X    initterm();
  2212. X    suspflag= Yes;
  2213. X    signal(sig, susphandler);
  2214. X#ifdef SETJMP
  2215. X    if (readEcontext)
  2216. X        longjmp(readEsuspend, 1);
  2217. X#endif
  2218. X}
  2219. X
  2220. X#endif /* SIGTSTP */
  2221. X
  2222. XHidden SIGTYPE (*setsig(sig, func))() int sig; SIGTYPE (*func)(); {
  2223. X    /*Set a signal, unless it's being ignored*/
  2224. X    SIGTYPE (*f)()= signal(sig, SIG_IGN);
  2225. X    if (f != SIG_IGN) signal(sig, func);
  2226. X    return f;
  2227. X}
  2228. X
  2229. XVisible Procedure initsig() {
  2230. X    int i;
  2231. X    for (i = 1; i<=NSIG; ++i)
  2232. X        if (must_handle(i)) VOID setsig(i, burp);
  2233. X    VOID setsig(SIGINT,  intsig);
  2234. X#ifdef SIGTSTP
  2235. X    VOID setsig(SIGTSTP, susphandler);
  2236. X#endif
  2237. X    VOID setsig(SIGTRAP, burp);
  2238. X    VOID setsig(SIGQUIT, aog);
  2239. X    VOID setsig(SIGTERM, aog);
  2240. X    VOID setsig(SIGFPE,  fpe_signal);
  2241. X}
  2242. X
  2243. X#endif /* SIGNAL */
  2244. EOF
  2245. fi
  2246. echo 'First Authors patch for ABC system (omitted files) complete.'
  2247. exit 0
  2248.  
  2249. exit 0 # Just in case...
  2250.