v23i107: ABC interactive programming environment, Patch2
Rich Salz
rsalz at bbn.com
Wed Jan 9 08:40:24 AEST 1991
Submitted-by: timo at cwi.nl
Posting-number: Volume 23, Issue 106
Archive-name: abc/patch2
This is the first patch from the authors for the ABC interactive
programming environment. It contains 10 more files missing from the
original posting to comp.sources.unix, apart from ./abc/bhdrs/bint.h that
was already send by Rich Salz in patch1. Our second patch will contain
some minor bugfixes.
Note that patch0 from Rich is not actually needed; if the files
abc/ex/generate/follower.cts and abc/ex/try/follower.cts are corrupted you
can just delete them. (You're right they should not have been included.
:-).
Groetjes, Timo Krijnen (timo at cwi.nl).
-------
: This is a shell archive.
: Extract with 'sh this_file'.
echo 'Start of first Authors patch for ABC system (omitted files):'
if test -s 'abc/bed/e1help.c'
then echo '*** I will not over-write existing file abc/bed/e1help.c'
else
echo 'x - abc/bed/e1help.c'
sed 's/^X//' > 'abc/bed/e1help.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Print help blurb.
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "feat.h"
X#include "bmem.h"
X#include "bfil.h"
X#include "bobj.h"
X#include "keys.h"
X#include "getc.h"
X
X#ifdef HELPFUL
X
X#define SOBIT 0200
X
Xextern int winheight;
Xextern int llength;
Xextern int winstart;
X/*
X The following array determines the order of the editor operations
X in the helpblurb.
X The names and keyrepresentations are taken from deftab in e1getc.c
X and ?1keys.c the first time help() is called.
X Thereafter the size is checked to determine whether printing in two
X columns is possible.
X Code NOTHING is used to produce an empty place in the second column.
X */
X
Xint helpcode[]= {
X WIDEN, EXTEND,
X FIRST, LAST,
X PREVIOUS, NEXT,
X UPLINE, DOWNLINE,
X UPARROW, DOWNARROW,
X LEFTARROW, RITEARROW,
X#ifdef GOTOCURSOR
X GOTO, NOTHING,
X#endif
X ACCEPT, NEWLINE,
X UNDO, REDO,
X COPY, DELETE,
X RECORD, PLAYBACK,
X LOOK, HELP,
X#ifdef CANSUSPEND
X EXIT, NOTHING,
X CANCEL, SUSPEND
X#else
X EXIT, CANCEL
X#endif
X};
X
Xchar *helpitem[(sizeof(helpcode))/(sizeof(int))]; /* to save "[name] repr" */
Xint nitems= 0;
X
X#define GAPWIDTH 5 /* width between the two columns */
XHidden int maxwidth= 0; /* width of maximum helpitem */
X
X#define MAXBUFFER 81
XHidden char buffer[MAXBUFFER];
X
X#define MORE MESS(6700, "Press [SPACE] for more, [RETURN] to exit help")
X#define NO_MORE MESS(6701, "Press [SPACE] or [RETURN] to exit help")
X#define NO_HELPFILE MESS(6702, "*** Cannot find or read help file [%s]")
X
XForward bool ask_for();
X
X/*
X * Print help blurb.
X * This is done through the standard screen interface.
X * The user must type [RETURN] to continue.
X */
X
XVisible bool
Xhelp()
X{
X int len = sizeof buffer;
X bool two_columns;
X int h;
X bool more= Yes;
X int nprinted= 0;
X
X if (nitems == 0)
X start_help();
X if (llength < (sizeof buffer)-1)
X len= llength+1;
X two_columns= len > 2*maxwidth+GAPWIDTH;
X for (h= 0; h < nitems && more /****&& !trminterrupt()*****/; h++) {
X trmputdata(winheight, winheight, 0, helpitem[h]);
X if (two_columns) {
X h++;
X trmputdata(winheight, winheight,
X maxwidth+GAPWIDTH, helpitem[h]);
X }
X trmscrollup(0, winheight, 1);
X trmsync(winheight, 0);
X if (++nprinted >= winheight) {
X more= ask_for(MORE);
X nprinted= 0;
X }
X }
X if (nprinted > 0)
X more= ask_for(MORE);
X if (more) {
X more_help();
X }
X if (doctype == D_immcmd)
X cmdprompt(CMDPROMPT);
X else
X winstart= winheight;
X
X return Yes;
X}
X
XVisible bool ask_for(nr) int nr; {
X string cp;
X int c;
X
X trmputdata(winheight, winheight, 0, "");
X strcpy(buffer, getmess(nr));
X for (cp = buffer; *cp; )
X *cp++ |= SOBIT;
X trmputdata(winheight, winheight, 0, buffer);
X trmsync(winheight, cp - buffer);
X c = trminput();
X while (c != '\n' && c != '\r' && c != ' ' && c != EOF) {
X trmbell();
X c = trminput();
X }
X trmputdata(winheight, winheight, 0, "");
X trmsync(winheight, 0);
X return c == ' ' ? Yes : No;
X}
X
XHidden Procedure start_help()
X{
X int h;
X int code;
X int w;
X
X for (h= 0; h < ((sizeof(helpcode))/(sizeof(int))); h++) {
X code= helpcode[h];
X if (code == NOTHING) {
X strcpy(buffer, "");
X }
X else {
X getentryfor(code); /* result in buffer */
X }
X w= strlen(buffer);
X if (maxwidth < strlen(buffer))
X maxwidth= w;
X helpitem[nitems++]= (char*)savestr(buffer);
X }
X}
X
XHidden Procedure getentryfor(code) int code; {
X int d;
X char *bufp= buffer;
X bool first= Yes;
X char *addstr();
X
X for (d=ndefs; d > 0; d--) {
X if (code == deftab[d].code) {
X if (bufp == buffer) {
X bufp= addstr(bufp, deftab[d].name, 13);
X }
X if (deftab[d].def != NULL
X &&
X deftab[d].def[0] != '\0')
X {
X if (first)
X first= No;
X else
X bufp= addstr(bufp, ", ", 0);
X bufp= addstr(bufp, deftab[d].rep, 0);
X }
X }
X }
X if (first)
X bufp= addstr(bufp, "", 0);
X}
X
XHidden char *addstr(bp, s, minw) char * bp; string s; int minw; {
X while (*s && bp < buffer+MAXBUFFER) {
X *bp++= *s++;
X minw--;
X }
X while (minw > 0 && bp < buffer+MAXBUFFER) {
X *bp++= ' ';
X minw--;
X }
X if (bp >= buffer+MAXBUFFER)
X bp--;
X *bp= '\0';
X return bp;
X}
X
XHidden FILE *helpfp= NULL;
X
XHidden Procedure more_help() {
X string cp;
X int nprinted= 0;
X bool more= Yes;
X bool len= (llength < sizeof buffer ? llength : sizeof buffer);
X
X if (helpfp == (FILE*) NULL) {
X if (helpfile) helpfp= fopen(helpfile, "r");
X if (helpfp == (FILE*) NULL) {
X ederrS(NO_HELPFILE, helpfile);
X return;
X }
X }
X while (fgets(buffer, len, helpfp) && more /***&& !trminterrupt()***/) {
X if ((cp= strchr(buffer, '\n')) != NULL) {
X *cp= '\0';
X }
X trmputdata(winheight, winheight, 0, buffer);
X trmscrollup(0, winheight, 1);
X trmsync(winheight, 0);
X if (++nprinted >= winheight) {
X more= ask_for(MORE);
X nprinted= 0;
X }
X }
X rewind(helpfp);
X if (nprinted > 0)
X more= ask_for(NO_MORE);
X}
X
X#endif /* HELPFUL */
EOF
fi
if test -s 'abc/bint1/i1com.c'
then echo '*** I will not over-write existing file abc/bint1/i1com.c'
else
echo 'x - abc/bint1/i1com.c'
sed 's/^X//' > 'abc/bint1/i1com.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/************************************************************************/
X/* Hows Funs and other odd types that don't fit anywhere else */
X/* and are modelled as compounds */
X/* */
X/* Compounds are handled in bobj.h */
X/* */
X/************************************************************************/
X
X#include "b.h"
X#include "bint.h"
X#include "bobj.h"
X#include "i2nod.h"
X#include "i2gen.h" /* Must be after i2nod.h */
X#include "i3env.h"
X
X/* Values */
X
X/* Rangebounds is a special compound of the 2 lwb..upb fields */
X/* used for the evaluation of mixed list_displays like {a;b..z} */
X/* More #define's for its interface are in bint.h */
X
X#define RANGE_ILLEGAL MESS(1400, "in p..q, p is neither a text nor a number")
X
X#define NRANGE_L_INT MESS(1401, "in p..q, p is a number but not an integer")
X#define NRANGE_U_NUM MESS(1402, "in p..q, p is a number, but q is not")
X#define NRANGE_U_INT MESS(1403, "in p..q, q is a number but not an integer")
X
X#define CRANGE_L_CHAR MESS(1404, "in p..q, p is a text but not a character")
X#define CRANGE_U_TEX MESS(1405, "in p..q, p is a text, but q is not")
X#define CRANGE_U_CHAR MESS(1406, "in p..q, q is a text, but not a character")
X
XHidden bool bounds_ok(lo, hi) value lo, hi; {
X bool r= No;
X if (Is_text(lo)) {
X if (!character(lo)) interr(CRANGE_L_CHAR);
X else if (!Is_text(hi)) interr(CRANGE_U_TEX);
X else if (!character(hi)) interr(CRANGE_U_CHAR);
X else r= Yes;
X }
X else if (Is_number(lo)) {
X if (!integral(lo)) interr(NRANGE_L_INT);
X else if (!Is_number(hi)) interr(NRANGE_U_NUM);
X else if (!integral(hi)) interr(NRANGE_U_INT);
X else r= Yes;
X }
X else {
X interr(RANGE_ILLEGAL);
X }
X return r;
X}
X
XVisible value mk_rbounds(l, u) value l, u; {
X value r, *p;
X if (bounds_ok(l, u)) {
X r= grab(Rangebounds, 2); p= Ats(r);
X *p++= copy(l); *p++= copy(u);
X }
X else
X r= Vnil;
X return r;
X}
X
X/* NODES */
X
XVisible typenode nodetype(v) parsetree v; {
X return Is_node(v) ? Nodetype(v) : Nonode;
X}
X
X/* make parsetree node */
X
XHidden value mk_ptn(type, len) typenode type; intlet len; {
X parsetree v= (parsetree) grab(Ptn, (len<<8) | type);
X *Branch(v, len)= *Branch(v, len+1)= NilTree;
X return v;
X}
X
XVisible unsigned ptnsyze(len, nptrs) intlet len; int *nptrs; {
X len= _Nbranches(len);
X *nptrs= len;
X return (unsigned) ((len+2)*sizeof(value));
X}
X
XVisible parsetree node1(type) typenode type; {
X return mk_ptn(type, 0);
X}
X
XVisible parsetree node2(type, a1) typenode type; value a1; {
X parsetree v= mk_ptn(type, 1); value *p= Ats(v);
X *p++= a1;
X return v;
X}
X
XVisible parsetree node3(type, a1, a2) typenode type; value a1, a2; {
X parsetree v= mk_ptn(type, 2); value *p= Ats(v);
X *p++= a1; *p++= a2;
X return v;
X}
X
XVisible parsetree node4(type, a1, a2, a3) typenode type; value a1, a2, a3; {
X parsetree v= mk_ptn(type, 3); value *p= Ats(v);
X *p++= a1; *p++= a2; *p++= a3;
X return v;
X}
X
XVisible parsetree node5(type, a1, a2, a3, a4) typenode type;
X value a1, a2, a3, a4; {
X parsetree v= mk_ptn(type, 4); value *p= Ats(v);
X *p++= a1; *p++= a2; *p++= a3; *p++= a4;
X return v;
X}
X
XVisible parsetree node6(type, a1, a2, a3, a4,a5) typenode type;
X value a1, a2, a3, a4, a5; {
X parsetree v= mk_ptn(type, 5); value *p= Ats(v);
X *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5;
X return v;
X}
X
XVisible parsetree node8(type, a1, a2, a3, a4, a5, a6, a7) typenode type;
X value a1, a2, a3, a4, a5, a6, a7; {
X parsetree v= mk_ptn(type, 7); value *p= Ats(v);
X *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5; *p++= a6; *p++= a7;
X return v;
X}
X
XVisible parsetree node9(type, a1, a2, a3, a4, a5, a6, a7, a8) typenode type;
X value a1, a2, a3, a4, a5, a6, a7, a8; {
X parsetree v= mk_ptn(type, 8); value *p= Ats(v);
X *p++= a1; *p++= a2; *p++= a3; *p++= a4; *p++= a5; *p++= a6;
X *p++= a7; *p++= a8;
X return v;
X}
X
X/* OTHER TYPES */
X
XVisible loc mk_simploc(id, en) basidf id; env en; {
X loc l= (loc) grab(Sim, 0);
X (*Ats(l))= copy(id); (*(Ats(l)+1))= (value) en;
X return l;
X}
X
XVisible loc mk_trimloc(R, B, C) loc R; value B, C; {
X loc l= (loc) grab(Tri, 0); trimloc *ll= (trimloc *)Ats(l);
X ll->R= copy(R); ll->B= copy(B); ll->C= copy(C);
X return l;
X}
X
XVisible loc mk_tbseloc(R, K) loc R; value K; {
X loc l= (loc) grab(Tse, 0); tbseloc *ll= (tbseloc *)Ats(l);
X ll->R= copy(R); ll->K= copy(K);
X return l;
X}
X
XVisible fun mk_fun(adic, pre, unit, filed) literal adic; intlet pre;
X parsetree unit; bool filed; {
X fun f= (fun) grab(Fun, 0); funprd *ff= (funprd *)Ats(f);
X ff->adic= adic; ff->pre= pre; ff->unit= unit;
X ff->unparsed= Yes; ff->filed= filed;
X ff->code= NilTree;
X return f;
X}
X
XVisible prd mk_prd(adic, pre, unit, filed) literal adic; intlet pre;
X parsetree unit; bool filed; {
X prd p= (prd) grab(Prd, 0); funprd *pp= (funprd *)Ats(p);
X pp->adic= adic; pp->pre= pre; pp->unit= unit;
X pp->unparsed= Yes; pp->filed= filed;
X pp->code= NilTree;
X return p;
X}
X
XVisible value mk_how(unit, filed) parsetree unit; bool filed; {
X value h= grab(How, 0); how *hh= (how *)Ats(h);
X hh->unit= unit; hh->unparsed= Yes; hh->filed= filed;
X hh->code= NilTree;
X return h;
X}
X
XVisible value mk_ref(rp) parsetree rp; {
X value r= grab(Ref, 0);
X *Ats(r)= copy(rp);
X return r;
X}
X
XVisible value mk_indirect(v) value v; {
X value p= grab(Ind, 0);
X *Ats(p)= copy(v);
X return p;
X}
EOF
fi
if test -s 'abc/bint1/i1nuq.c'
then echo '*** I will not over-write existing file abc/bint1/i1nuq.c'
else
echo 'x - abc/bint1/i1nuq.c'
sed 's/^X//' > 'abc/bint1/i1nuq.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "feat.h" /* for EXT_RANGE */
X#include "bobj.h"
X#include "i1num.h"
X
X
X/* Product of integer and single "digit" */
X
XVisible integer int1mul(v, n1) integer v; digit n1; {
X integer a;
X digit save, bigcarry, carry = 0;
X twodigit z, zz, n = n1;
X register int i;
X struct integer vv;
X
X FreezeSmallInt(v, vv);
X
X a = (integer) grab_num(Length(v)+2);
X
X for (i = 0; i < Length(v); ++i) {
X z = Digit(v,i) * n;
X bigcarry = zz = (z/BASE);
X carry += z - zz*BASE;
X Digit(a,i) = save = Modulo(carry, BASE);
X carry = (carry-save)/BASE + bigcarry;
X }
X
X Digit(a,i) = save = Modulo(carry, BASE);
X Digit(a,i+1) = (carry-save)/BASE;
X
X return int_canon(a);
X}
X
X
X/* Quotient of positive integer and single "digit" > 0 */
X
XHidden integer int1div(v, n1, prem) integer v; digit n1, *prem; {
X integer q;
X twodigit r_over_n, r = 0, n = n1;
X register int i;
X struct integer vv;
X
X FreezeSmallInt(v, vv);
X
X q = (integer) grab_num(Length(v));
X for (i = Length(v)-1; i >= 0; --i) {
X r = r*BASE + Digit(v,i);
X Digit(q,i) = r_over_n = (r/n);
X r -= r_over_n * n;
X }
X if (prem)
X *prem = r;
X return int_canon(q);
X}
X
X
X/* Long division routine, gives access to division algorithm. */
X
XVisible digit int_ldiv(v1, w1, pquot, prem) integer v1, w1, *pquot, *prem; {
X integer a;
X int sign = 1, rel_v = 0, rel_w = 0;
X digit div, rem;
X struct integer vv1, ww1;
X
X if (w1 == int_0) syserr(MESS(1100, "zero division (int_ldiv)"));
X
X /* Make v, w positive */
X if (Msd(v1) < 0) {
X sign = -1;
X ++rel_v;
X v1 = int_neg(v1);
X }
X
X if (Msd(w1) < 0) {
X sign *= -1;
X ++rel_w;
X w1 = int_neg(w1);
X }
X
X FreezeSmallInt(v1, vv1);
X FreezeSmallInt(w1, ww1);
X
X div = sign;
X
X /* Check v << w or single-digit w */
X if (Length(v1) < Length(w1)
X || Length(v1) == Length(w1)
X && Digit(v1, Length(v1)-1) < Digit(w1, Length(w1)-1)) {
X a = int_0;
X if (prem) {
X if (v1 == &vv1) *prem= (integer) MkSmallInt(Digit(v1,0));
X else *prem = (integer) Copy(v1);
X }
X }
X else if (Length(w1) == 1) {
X /* Single-precision division */
X a = int1div(v1, Digit(w1,0), &rem);
X if (prem) *prem = mk_int((double)rem);
X }
X else {
X /* Multi-precision division */
X /* Cf. Knuth II Sec. 4.3.1. Algorithm D */
X /* Note that we count in the reverse direction (not easier!) */
X
X twodigit z, zz;
X digit carry, save, bigcarry;
X twodigit q, d = BASE/(Digit(w1, Length(w1)-1)+1);
X register int i, j, k;
X integer v, w;
X digit vj;
X
X /* Normalize: make Msd(w) >= BASE/2 by multiplying
X both v and w by d */
X
X v = int1mul(v1, (digit)d);
X /* v is used as accumulator, must make a copy */
X /* v cannot be int_1 */
X /* (then it would be one of the cases above) */
X
X if (d == 1) w = (integer) Copy(w1);
X else w = int1mul(w1, (digit)d);
X
X a = (integer) grab_num(Length(v1)-Length(w)+1);
X
X /* Division loop */
X
X for (j = Length(v1), k = Length(a)-1; k >= 0; --j, --k) {
X vj = j >= Length(v) ? 0 : Digit(v,j);
X
X /* Find trial digit */
X
X if (vj == Digit(w, Length(w)-1)) q = BASE-1;
X else q = ((twodigit)vj*BASE + Digit(v,j-1)) /
X Digit(w, Length(w)-1);
X
X /* Correct trial digit */
X
X while (Digit(w,Length(w)-2) * q >
X ((twodigit)vj*BASE + Digit(v,j-1)
X - q*Digit(w, Length(w)-1)) *BASE + Digit(v,j-2))
X --q;
X
X /* Subtract q*w from v */
X
X carry = 0;
X for (i = 0; i < Length(w) && i+k < Length(v); ++i) {
X z = Digit(w,i) * q;
X bigcarry = zz = (z/BASE);
X carry += Digit(v,i+k) - z + zz*BASE;
X Digit(v,i+k) =
X save = Modulo(carry, BASE);
X carry = (carry-save)/BASE - bigcarry;
X }
X
X if (i+k < Length(v))
X carry += Digit(v, i+k), Digit(v, i+k) = 0;
X
X /* Add back necessary? */
X
X /* It is very difficult to find test cases
X where add back is necessary if BASE is large.
X Thanks to Arjen Lenstra, we have v=n*n-1, w=n,
X where n = 8109636009903000000 (the last six
X digits are not important). */
X
X if (carry == 0) /* No */
X Digit(a,k) = q;
X else { /* Yes, add back */
X if (carry != -1) syserr(MESS(1101, "int_ldiv internal failure"));
X Digit(a,k) = q-1;
X carry = 0;
X for (i = 0; i < Length(w) && i+k < Length(v); ++i) {
X carry += Digit(v, i+k) + Digit(w,i);
X Digit(v,i+k) =
X save = Modulo(carry, BASE);
X carry = (carry-save)/BASE;
X }
X }
X } /* End for(j) */
X
X if (prem) *prem = int_canon(v); /* Store remainder */
X else Release(v);
X div = sign*d; /* Store normalization factor */
X Release(w);
X a = int_canon(a);
X }
X
X if (rel_v) Release(v1);
X if (rel_w) Release(w1);
X
X if (sign < 0) {
X integer temp = a;
X a = int_neg(a);
X Release(temp);
X }
X
X if (pquot) *pquot = a;
X else Release(a);
X return div;
X}
X
X
XVisible integer int_quot(v, w) integer v, w; {
X integer quo;
X VOID int_ldiv(v, w, &quo, (integer*)0);
X return quo;
X}
X
XVisible integer int_mod(v, w) integer v, w; {
X integer rem;
X digit div;
X bool flag;
X div = int_ldiv(v, w, (integer*)0, &rem); /* Rem. is always positive */
X if (rem == int_0)
X return rem; /* v mod w = 0 */
X flag = (div < 0);
X if (flag || Msd(w) < 0) div = -div;
X if (div != 1) { /* Divide by div to get proper remainder back */
X v = int1div(rem, div, (digit*)0);
X Release(rem);
X rem = v;
X }
X if (flag) { /* Make same sign as w */
X if (Msd(w) < 0) v = int_sum(w, rem);
X else v = int_diff(w, rem);
X Release(rem);
X rem = v;
X }
X return rem;
X}
EOF
fi
if test -s 'abc/bint1/i1tra.c'
then echo '*** I will not over-write existing file abc/bint1/i1tra.c'
else
echo 'x - abc/bint1/i1tra.c'
sed 's/^X//' > 'abc/bint1/i1tra.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1987. */
X
X/* Functions defined on train values. */
X
X/* This file should go into a train directory, that should receive the
X * lin-btr independent part of these modules (especially tlt.c and
X * obj.c contain common parts).
X */
X
X#include "b.h"
X#include "feat.h" /* for EXT_RANGE */
X#include "bobj.h"
X#include "i0err.h"
X#include "i1num.h"
X
X#define CHOICE_TLT MESS(1600, "in choice t, t is not a text list or table")
X#define CHOICE_EMPTY MESS(1601, "in choice t, t is empty")
X
X/* make a B text out of a C char */
X
XVisible value mkchar(c) char c; {
X char buf[2];
X buf[0] = c;
X buf[1] = '\0';
X return mk_text(buf);
X}
X
X/* report: t item j ?=? ' ' */
XHidden bool is_space(t, i) value t, i; {
X value ti;
X char c;
X
X ti = item(t, i);
X c = charval(ti);
X release(ti);
X return c == ' ';
X}
X
XHidden Procedure incr(pn) value* pn; {
X value n1;
X
X n1 = sum(*pn, one);
X release(*pn);
X *pn = n1;
X}
X
XVisible value stripped(t) value t; {
X value a, b, i, j, k;
X
X i = one;
X j = size(t);
X while (numcomp(i, j) <= 0 && is_space(t, i)) {
X incr(&i);
X }
X while (numcomp(j, i) > 0 && is_space(t, j)) {
X k = diff(j, one);
X release(j);
X j = k;
X }
X if (numcomp(i, j) <= 0) {
X a = behead(t, i);
X k = diff(j, i);
X incr(&k);
X b = curtail(a, k);
X release(k); release(a);
X }
X else {
X b = mk_text("");
X }
X release(i); release(j);
X return b;
X}
X
XVisible value split(t) value t; {
X value a, b, i, j, ij, r, ri, sizt;
X
X r = mk_elt();
X ri = one;
X i = one;
X sizt = size(t);
X while (numcomp(i, sizt) <= 0) {
X while (numcomp(i, sizt) <= 0 && is_space(t, i)) {
X incr(&i);
X }
X if (numcomp(i, sizt) > 0) {
X break;
X }
X j = one;
X ij = sum(i, j);
X while (numcomp(ij, sizt) <= 0 && !is_space(t, ij)) {
X incr(&j);
X incr(&ij);
X }
X a = behead(t, i);
X b = curtail(a, j);
X replace(b, &r, ri);
X incr(&ri);
X release(i); i = ij; /* PUT i+j IN i */
X release(j); release(a); release(b);
X }
X release(i); release(sizt);
X return r;
X}
X
XHidden value uplower(t, islowupper, touplower)
X value t;
X int (*islowupper)();
X int (*touplower)();
X{
X value i, sizt, r, ti, c;
X char s[2];
X
X s[1] = '\0';
X r = mk_text("");
X i = one;
X sizt = size(t);
X while (numcomp(i, sizt) <= 0) {
X ti = item(t, i);
X s[0] = charval(ti);
X if ((*islowupper)(s[0])) {
X release(ti);
X s[0] = (*touplower)(s[0]);
X ti = mk_text(s);
X }
X c = concat(r, ti);
X release(r); release(ti);
X r = c;
X incr(&i);
X }
X release(i); release(sizt);
X return r;
X}
X
X/* terrible BSD patch: turn macroos into Functions */
X#ifdef isupper
Xint F_isupper(c) char c; { return isupper(c); }
X#else
X#define F_isupper isupper
Xextern int isupper();
X#endif
X#ifdef islower
Xint F_islower(c) char c; { return islower(c); }
X#else
X#define F_islower islower
Xextern int islower();
X#endif
X#ifdef toupper
Xint F_toupper(c) char c; { return toupper(c); }
X#else
X#define F_toupper toupper
Xextern int toupper();
X#endif
X#ifdef tolower
Xint F_tolower(c) char c; { return tolower(c); }
X#else
X#define F_tolower tolower
Xextern int tolower();
X#endif
X
XVisible value upper(t) value t; { return uplower(t, F_islower, F_toupper);}
XVisible value lower(t) value t; { return uplower(t, F_isupper, F_tolower);}
X
X/* for RangeElem's */
X
XHidden Procedure insCrange(lwb, upb, pl) value lwb, upb; value *pl; {
X value w; char lwbchar= charval(lwb), upbchar= charval(upb);
X if (lwbchar > upbchar) return;
X uniql(pl);
X do {
X w= mkchar(lwbchar);
X insert(w, pl);
X release(w);
X } while (++lwbchar <= upbchar);
X}
X
XHidden Procedure insIrange(lwb, upb, pl) value lwb, upb; value *pl; {
X value w= copy(lwb);
X uniql(pl);
X do {
X if (compare(lwb, upb) > 0) break;
X insert(lwb, pl);
X w= lwb;
X lwb= sum(lwb, one);
X release(w);
X } while (still_ok);
X release(lwb);
X}
X
XVisible Procedure ins_range(lwb, upb, pl) value lwb, upb; value *pl; {
X if (Is_text(lwb))
X insCrange(lwb, upb, pl);
X else
X insIrange(lwb, upb, pl);
X}
X
X/* choice = train item (random * (1+floor(#train))), is tricky:
X * random() only contains a limited number of bits.
X * For very large trains, certain items would therefore never be chosen
X * when the standard definition above is used.
X * Therefore, if #train is greater than a save rndm_limit below which
X * all bits in a number are random, we divide #train over rndm_limit
X * sized chunks, and choose among one of these chunks. The last chunk
X * may contain less than rndm_limit elements, each of which gets the same
X * chance to be choosen as the elements in any other chunk. Hence the
X * while in choice() below.
X */
X
Xextern value rndm_limit;
X /* below this limit each number has a fair chance */
X
XHidden value numchoice(m) value m; {
X value p;
X value q;
X value r;
X value chunk;
X
X /* choose a number between 1 and limit*ceiling(m/limit) */
X if (numcomp(m, rndm_limit) <= 0) {
X /* standard def: 1 + floor(random*m) */
X r= random();
X p= prod(r, m);
X release(r);
X r= floorf(p);
X incr(&r);
X release(p);
X }
X else {
X /* choose chunk= choice{0..ceiling(m/limit)-1}
X * and return element r= limit*chunk + choice{1..limit}
X */
X q= quot(m, rndm_limit);
X p= ceilf(q);
X release(q);
X q= numchoice(p);
X release(p);
X chunk= diff(q, one);
X release(q);
X p= prod(rndm_limit, chunk);
X q= numchoice(rndm_limit);
X r= sum(p, q);
X release(p); release(q); release(chunk);
X }
X return r;
X}
X
XVisible value choice(train) value train; {
X value nn;
X value n;
X
X nn= Vnil;
X if (!Is_tlt(train)) interr(CHOICE_TLT);
X else if (empty(train)) interr(CHOICE_EMPTY);
X else {
X nn= size(train);
X n= numchoice(nn);
X while (numcomp(n, nn) > 0) {
X /* in non-existing part of upper chunk */
X release(n);
X n= numchoice(nn);
X }
X release(nn);
X nn= item(train, n);
X release(n);
X }
X return nn;
X}
EOF
fi
if test -s 'abc/bint3/DEP'
then echo '*** I will not over-write existing file abc/bint3/DEP'
else
echo 'x - abc/bint3/DEP'
sed 's/^X//' > 'abc/bint3/DEP' << 'EOF'
Xi3bws.o: i3bws.c
Xi3bws.o: ../bhdrs/b.h
Xi3bws.o: ../uhdrs/osconf.h
Xi3bws.o: ../uhdrs/os.h
Xi3bws.o: ../uhdrs/conf.h
Xi3bws.o: ../uhdrs/config.h
Xi3bws.o: ../bhdrs/bint.h
Xi3bws.o: ../bhdrs/bfil.h
Xi3bws.o: ../bhdrs/bmem.h
Xi3bws.o: ../bhdrs/bobj.h
Xi3bws.o: ../uhdrs/args.h
Xi3bws.o: ../uhdrs/feat.h
Xi3bws.o: ../ihdrs/i2par.h
Xi3bws.o: ../ihdrs/i3bws.h
Xi3bws.o: ../ihdrs/i3env.h
Xi3bws.o: ../ihdrs/i3sou.h
Xi3com.o: i3com.c
Xi3com.o: ../bhdrs/b.h
Xi3com.o: ../uhdrs/osconf.h
Xi3com.o: ../uhdrs/os.h
Xi3com.o: ../uhdrs/conf.h
Xi3com.o: ../uhdrs/config.h
Xi3com.o: ../bhdrs/bmem.h
Xi3com.o: ../bhdrs/bobj.h
Xi3com.o: ../bhdrs/bfil.h
Xi3com.o: ../bhdrs/bcom.h
Xi3com.o: ../ihdrs/i3scr.h
Xi3env.o: i3env.c
Xi3env.o: ../bhdrs/b.h
Xi3env.o: ../uhdrs/osconf.h
Xi3env.o: ../uhdrs/os.h
Xi3env.o: ../uhdrs/conf.h
Xi3env.o: ../uhdrs/config.h
Xi3env.o: ../bhdrs/bint.h
Xi3env.o: ../bhdrs/bobj.h
Xi3env.o: ../ihdrs/i3env.h
Xi3err.o: i3err.c
Xi3err.o: ../bhdrs/b.h
Xi3err.o: ../uhdrs/osconf.h
Xi3err.o: ../uhdrs/os.h
Xi3err.o: ../uhdrs/conf.h
Xi3err.o: ../uhdrs/config.h
Xi3err.o: ../bhdrs/bmem.h
Xi3err.o: ../bhdrs/bint.h
Xi3err.o: ../uhdrs/feat.h
Xi3err.o: ../bhdrs/bobj.h
Xi3err.o: ../ihdrs/i0err.h
Xi3err.o: ../ihdrs/i2par.h
Xi3err.o: ../ihdrs/i3env.h
Xi3err.o: ../ihdrs/i3scr.h
Xi3err.o: ../ihdrs/i3sou.h
Xi3fil.o: i3fil.c
Xi3fil.o: ../bhdrs/b.h
Xi3fil.o: ../uhdrs/osconf.h
Xi3fil.o: ../uhdrs/os.h
Xi3fil.o: ../uhdrs/conf.h
Xi3fil.o: ../uhdrs/config.h
Xi3fil.o: ../bhdrs/bmem.h
Xi3fil.o: ../bhdrs/bint.h
Xi3fil.o: ../bhdrs/bobj.h
Xi3fil.o: ../ihdrs/i2nod.h
Xi3fil.o: ../ihdrs/i2par.h
Xi3fil.o: ../ihdrs/i3scr.h
Xi3fil.o: ../ihdrs/i3sou.h
Xi3fpr.o: i3fpr.c
Xi3fpr.o: ../bhdrs/b.h
Xi3fpr.o: ../uhdrs/osconf.h
Xi3fpr.o: ../uhdrs/os.h
Xi3fpr.o: ../uhdrs/conf.h
Xi3fpr.o: ../uhdrs/config.h
Xi3fpr.o: ../bhdrs/bint.h
Xi3fpr.o: ../uhdrs/feat.h
Xi3fpr.o: ../bhdrs/bobj.h
Xi3fpr.o: ../ihdrs/i0err.h
Xi3fpr.o: ../bhdrs/b0lan.h
Xi3fpr.o: ../ihdrs/i1num.h
Xi3fpr.o: ../ihdrs/i2par.h
Xi3fpr.o: ../ihdrs/i3sou.h
Xi3gfx.o: i3gfx.c
Xi3gfx.o: ../bhdrs/b.h
Xi3gfx.o: ../uhdrs/osconf.h
Xi3gfx.o: ../uhdrs/os.h
Xi3gfx.o: ../uhdrs/conf.h
Xi3gfx.o: ../uhdrs/config.h
Xi3gfx.o: ../bhdrs/bobj.h
Xi3gfx.o: ../bhdrs/bgfx.h
Xi3imm.o: i3imm.c
Xi3imm.o: ../bhdrs/b.h
Xi3imm.o: ../uhdrs/osconf.h
Xi3imm.o: ../uhdrs/os.h
Xi3imm.o: ../uhdrs/conf.h
Xi3imm.o: ../uhdrs/config.h
Xi3imm.o: ../bhdrs/bint.h
Xi3imm.o: ../uhdrs/feat.h
Xi3imm.o: ../bhdrs/bobj.h
Xi3imm.o: ../bhdrs/b0lan.h
Xi3imm.o: ../ihdrs/i2par.h
Xi3imm.o: ../ihdrs/i3env.h
Xi3imm.o: ../ihdrs/i3scr.h
Xi3in2.o: i3in2.c
Xi3in2.o: ../bhdrs/b.h
Xi3in2.o: ../uhdrs/osconf.h
Xi3in2.o: ../uhdrs/os.h
Xi3in2.o: ../uhdrs/conf.h
Xi3in2.o: ../uhdrs/config.h
Xi3in2.o: ../bhdrs/bint.h
Xi3in2.o: ../bhdrs/bobj.h
Xi3in2.o: ../ihdrs/i0err.h
Xi3in2.o: ../ihdrs/i3env.h
Xi3in2.o: ../ihdrs/i3in2.h
Xi3in2.o: ../ihdrs/i3sou.h
Xi3ini.o: i3ini.c
Xi3ini.o: ../bhdrs/b.h
Xi3ini.o: ../uhdrs/osconf.h
Xi3ini.o: ../uhdrs/os.h
Xi3ini.o: ../uhdrs/conf.h
Xi3ini.o: ../uhdrs/config.h
Xi3ini.o: ../bhdrs/bint.h
Xi3ini.o: ../uhdrs/feat.h
Xi3ini.o: ../bhdrs/bobj.h
Xi3ini.o: ../bhdrs/bfil.h
Xi3ini.o: ../ihdrs/i3env.h
Xi3ini.o: ../ihdrs/i3scr.h
Xi3ini.o: ../bhdrs/release.h
Xi3int.o: i3int.c
Xi3int.o: ../bhdrs/b.h
Xi3int.o: ../uhdrs/osconf.h
Xi3int.o: ../uhdrs/os.h
Xi3int.o: ../uhdrs/conf.h
Xi3int.o: ../uhdrs/config.h
Xi3int.o: ../bhdrs/bint.h
Xi3int.o: ../uhdrs/feat.h
Xi3int.o: ../bhdrs/bmem.h
Xi3int.o: ../bhdrs/bobj.h
Xi3int.o: ../ihdrs/i0err.h
Xi3int.o: ../ihdrs/i2nod.h
Xi3int.o: ../ihdrs/i3env.h
Xi3int.o: ../ihdrs/i3int.h
Xi3int.o: ../ihdrs/i3in2.h
Xi3int.o: ../ihdrs/i3sou.h
Xi3int.o: ../ihdrs/i3sta.h
Xi3loc.o: i3loc.c
Xi3loc.o: ../bhdrs/b.h
Xi3loc.o: ../uhdrs/osconf.h
Xi3loc.o: ../uhdrs/os.h
Xi3loc.o: ../uhdrs/conf.h
Xi3loc.o: ../uhdrs/config.h
Xi3loc.o: ../bhdrs/bint.h
Xi3loc.o: ../bhdrs/bobj.h
Xi3loc.o: ../ihdrs/i0err.h
Xi3loc.o: ../ihdrs/i3env.h
Xi3loc.o: ../ihdrs/i3in2.h
Xi3scr.o: i3scr.c
Xi3scr.o: ../bhdrs/b.h
Xi3scr.o: ../uhdrs/osconf.h
Xi3scr.o: ../uhdrs/os.h
Xi3scr.o: ../uhdrs/conf.h
Xi3scr.o: ../uhdrs/config.h
Xi3scr.o: ../bhdrs/bint.h
Xi3scr.o: ../uhdrs/feat.h
Xi3scr.o: ../bhdrs/bmem.h
Xi3scr.o: ../bhdrs/bobj.h
Xi3scr.o: ../bhdrs/bcom.h
Xi3scr.o: ../ihdrs/i2nod.h
Xi3scr.o: ../ihdrs/i2par.h
Xi3scr.o: ../ihdrs/i3typ.h
Xi3scr.o: ../ihdrs/i3env.h
Xi3scr.o: ../ihdrs/i3in2.h
Xi3scr.o: ../ihdrs/i3scr.h
Xi3sou.o: i3sou.c
Xi3sou.o: ../bhdrs/b.h
Xi3sou.o: ../uhdrs/osconf.h
Xi3sou.o: ../uhdrs/os.h
Xi3sou.o: ../uhdrs/conf.h
Xi3sou.o: ../uhdrs/config.h
Xi3sou.o: ../bhdrs/bint.h
Xi3sou.o: ../uhdrs/feat.h
Xi3sou.o: ../bhdrs/bmem.h
Xi3sou.o: ../bhdrs/bobj.h
Xi3sou.o: ../bhdrs/bfil.h
Xi3sou.o: ../ihdrs/i2par.h
Xi3sou.o: ../ihdrs/i2nod.h
Xi3sou.o: ../ihdrs/i3env.h
Xi3sou.o: ../ihdrs/i3scr.h
Xi3sou.o: ../ihdrs/i3in2.h
Xi3sou.o: ../ihdrs/i3sou.h
Xi3sta.o: i3sta.c
Xi3sta.o: ../bhdrs/b.h
Xi3sta.o: ../uhdrs/osconf.h
Xi3sta.o: ../uhdrs/os.h
Xi3sta.o: ../uhdrs/conf.h
Xi3sta.o: ../uhdrs/config.h
Xi3sta.o: ../bhdrs/bint.h
Xi3sta.o: ../uhdrs/feat.h
Xi3sta.o: ../bhdrs/bmem.h
Xi3sta.o: ../bhdrs/bobj.h
Xi3sta.o: ../ihdrs/i0err.h
Xi3sta.o: ../ihdrs/i1num.h
Xi3sta.o: ../ihdrs/i2nod.h
Xi3sta.o: ../ihdrs/i3env.h
Xi3sta.o: ../ihdrs/i3int.h
Xi3sta.o: ../ihdrs/i3in2.h
Xi3sta.o: ../ihdrs/i3sou.h
Xi3typ.o: i3typ.c
Xi3typ.o: ../bhdrs/b.h
Xi3typ.o: ../uhdrs/osconf.h
Xi3typ.o: ../uhdrs/os.h
Xi3typ.o: ../uhdrs/conf.h
Xi3typ.o: ../uhdrs/config.h
Xi3typ.o: ../bhdrs/bint.h
Xi3typ.o: ../bhdrs/bobj.h
Xi3typ.o: ../ihdrs/i3env.h
Xi3typ.o: ../ihdrs/i3typ.h
EOF
fi
if test -s 'abc/boot/fill.c'
then echo '*** I will not over-write existing file abc/boot/fill.c'
else
echo 'x - abc/boot/fill.c'
sed 's/^X//' > 'abc/boot/fill.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X/*
X * fill the read-in tables, checking their consistency.
X *
X * All references are still in terms of indices in namelist[],
X * and must be replaced by indices in classdef[] or symdef[].
X *
X * The lexical names are replaced by the enveloping class or Symbol,
X * if they occur in a Symbol definition, or a class definition, respectively.
X * The enveloping class and Symbol definitions themselves are still
X * nillified at the start of this process, and can be filled only
X * after the other definitions have been handled; otherwise, any filled-in
X * indices would be considered as indices in namelist[], and be subject
X * to the replacement above.
X *
X */
X
X#include "b.h"
X#include "main.h"
X
XHidden int errors;
X
XVisible Procedure fill_and_check_tables() {
X
X errors= 0;
X
X check_defined();
X
X check_representations();
X
X if (errors)
X fatal("giving up");
X
X fill_classdefinitions();
X
X fill_symboldefinitions();
X
X fill_lexicals();
X
X fill_special_definitions();
X}
X
XHidden Procedure check_defined() {
X struct nameinfo *pn;
X int iname;
X
X for (iname= 0; iname < nname; iname++) {
X pn= &namelist[iname];
X if (Isnilitem(pn->n_index)) {
X message("name '%s' not defined by any rule",
X pn->n_name);
X errors++;
X }
X }
X}
X
X/* Check the fixed-string representations in the grammar.
X * The code assumes that Optional and Hole are the last two in the table
X */
X
XHidden Procedure check_representations() {
X struct syminfo *psym;
X int isym;
X int ich;
X
X for (isym= 0; isym < noptional; isym++) {
X psym= &symdef[isym];
X for (ich= 0; ich < MAXCHILD; ich++) {
X checkstring(psym->s_repr[ich], ich, psym->s_name);
X if (ich == MAXCHILD || Isnilitem(psym->s_class[ich]))
X break; /* for ich */
X }
X }
X}
X
X/*
X * Check a representation string.
X */
X
XHidden Procedure checkstring(s, ich, sname) string s; int ich; string sname; {
X int i;
X
X if (s == NULL)
X return;
X for (i = 0; s[i] != '\0'; i++) {
X switch (s[i]) {
X case '\n':
X case '\r':
X if (i || ich) {
X errors++;
X message("badly placed \\n/\\r for symbol %s, child %d",
X sname, ich);
X }
X break;
X case '\t':
X case '\b':
X if (s[i+1]) {
X errors++;
X message("badly placed \\t/\\b for symbol %s, child %d",
X sname, ich);
X }
X break;
X default:
X if (s[i] < ' ' || s[i] >= 0177) {
X errors++;
X message("illegal control char for symbol %s, child %d",
X sname, ich);
X }
X }
X }
X}
X
XHidden Procedure fill_classdefinitions() {
X struct classinfo *pclass;
X int iclass;
X int i;
X int iname;
X struct nameinfo *pname;
X
X for (iclass= 0; iclass < nclass; iclass++) {
X pclass= &classdef[iclass];
X for (i= 0; ; i++) {
X iname= pclass->c_syms[i];
X if (Isnilitem(iname))
X break; /* for i */
X pname= &namelist[iname];
X switch (pname->n_type) {
X case Sym:
X /* replace by index in symdef[] */
X pclass->c_syms[i]= pname->n_index;
X break;
X case Lex:
X /* replace by enveloping Symbol definition */
X pclass->c_syms[i]= lexdef[pname->n_index].l_sym;
X break;
X default:
X message("can't happen");
X }
X }
X }
X}
X
XHidden Procedure fill_symboldefinitions() {
X struct syminfo *psym;
X int isym;
X int ich;
X int iname;
X struct nameinfo *pname;
X
X for (isym= 0; isym < nsym; isym++) {
X psym= &symdef[isym];
X for (ich= 0; ich < MAXCHILD; ich++) {
X iname= psym->s_class[ich];
X if (Isnilitem(iname))
X break; /* for ich */
X pname= &namelist[iname];
X switch (pname->n_type) {
X case Class:
X /* replace by index in classdef[] */
X psym->s_class[ich]= pname->n_index;
X break;
X case Lex:
X /* replace by enveloping class definition */
X psym->s_class[ich]=
X lexdef[pname->n_index].l_class;
X break;
X default:
X message("can't happen");
X }
X }
X }
X}
X
XHidden Procedure fill_lexicals() {
X struct lexinfo *plex;
X int ilex;
X struct classinfo *pbody;
X struct syminfo *psym;
X struct classinfo *pclass;
X
X nlexical= nsym; /* ensure lexicals > Symbols */
X
X /* The enveloping class- and Symbol-definitions have already
X * been malloc'ed and filled with Nil's in getlexdef().
X * Here we only fill the real indices.
X */
X for (ilex= 0; ilex < nlex; ilex++) {
X plex= &lexdef[ilex];
X
X pbody= &classdef[plex->l_body];
X pbody->c_syms[0]= nlexical + ilex;
X
X if (ilex == lsuggestion || ilex == lsugghowname)
X continue; /* see comment in read.c in getlexdef()*/
X
X psym= &symdef[plex->l_sym];
X psym->s_class[0]= plex->l_body;
X
X pclass= &classdef[plex->l_class];
X pclass->c_syms[0]= plex->l_sym;
X }
X}
X
XHidden Procedure fill_special_definitions() {
X
X if (lsuggestion >= 0 ) /* SUGGESTION defined */
X symdef[nsuggestion].s_class[0]= nsuggstnbody;
X if (lsugghowname >= 0) /* SUGGHOWNAME defined */
X symdef[nsugghowname].s_class[0]= nsugghowbody;
X
X /* Optional and Hole need no further filling */
X}
EOF
fi
if test -s 'abc/boot/main.c'
then echo '*** I will not over-write existing file abc/boot/main.c'
else
echo 'x - abc/boot/main.c'
sed 's/^X//' > 'abc/boot/main.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X/*
X * mktables -- Program to create tables for ABC editor from grammar
X *
X * mktables [-s maxsym] [-c maxclass] [-l maxlex] [grammar-file]
X */
X
X#include "b.h"
X#include "main.h"
X
XVisible string progname;
X
XFILE *gfp; /* grammar file */
Xchar *gfile= GRAMMAR;
XFILE *tfp; /* data file for grammar tables */
Xchar *tfile= TABLES;
XFILE *ifp; /* include file for grammar table structure */
Xchar *ifile= INCLUDE; /* and Symbol to index-in-table mapping */
Xchar *hfile=HFILE; /* ultimate include-file name to reference
X * in datafile */
X
XVisible struct classinfo *classdef; /* class definitions */
XVisible struct syminfo *symdef; /* Symbol definitions */
XVisible struct lexinfo *lexdef; /* LEXICAL definitions */
XVisible struct nameinfo *namelist; /* class, Symbol or LEXICAL names */
X
Xint maxclass= MAXCLASS; /* max number of class definitions in grammar */
Xint maxsym= MAXSYM; /* max number of Symbol definitions in grammar */
Xint maxlex= MAXLEX; /* max number of LEXICAL definitions grammar */
Xint maxname= MAXNAME; /* max number of names (Symbols, classes or LEXICALS) */
X
Xint nclass= 0; /* actual number of definitions in grammar */
Xint nsym= 0;
Xint nlex= 0;
Xint nname= 0;
X
Xint lsuggestion= -1; /* index in lexdef[] of definition for SUGGESTION */
X /* also used as bool to check presence of definition */
Xint lsugghowname= -1; /* idem for SUGGHOWNAME */
Xint nsuggstnbody;/* index in classdef[] of enveloped definition of SUGGESTION */
Xint nsugghowbody; /* idem ... */
X
Xint nsuggestion;/* index in symdef[] of symboldefinition for Suggestion */
Xint nsugghowname;/* index in symdef[] of symboldefinition for Sugghowname */
Xint noptional; /* index in symdef[] of symboldefinition for Optional */
Xint nhole; /* index in symdef[] of symboldefinition for Hole */
X
Xint nlexical; /* to distinguish lexical items from Symbols;
X * the latter will be represented by the index of their
X * definition in symdef[], so we save the final value
X * of 'nsym' in 'nlexical', and add it to the indices of
X * the lexical items in lexdef[] to get their representation.
X */
X
Xmain(argc, argv) int argc; char **argv; {
X int errflg;
X int c;
X extern char *optarg;
X extern int optind;
X int getopt();
X FILE *openfile();
X
X progname= argv[0];
X errflg= 0;
X while ((c= getopt(argc, argv, "s:c:l:n:g:t:i:h:")) != EOF) {
X switch (c) {
X case 's':
X maxsym= atoi(optarg);
X break;
X case 'c':
X maxclass= atoi(optarg);
X break;
X case 'l':
X maxlex= atoi(optarg);
X break;
X case 'n':
X maxname= atoi(optarg);
X break;
X case 'g':
X gfile= optarg;
X break;
X case 't':
X tfile= optarg;
X break;
X case 'i':
X ifile= optarg;
X break;
X case 'h':
X hfile= optarg;
X break;
X case '?':
X default:
X errflg++;
X break;
X }
X }
X
X if (argc > optind)
X errflg++;
X
X if (errflg)
X fatal(
X"usage: %s [-s maxsym] [-c maxclass] [-l maxlex] [-n maxname]\n\
X [-g grammar-file] [-t table-file] [-i include-file]\n",
X argv[0]);
X
X gfp= openfile(gfile, "r");
X tfp= openfile(tfile, "w");
X ifp= openfile(ifile, "w");
X
X process();
X
X fclose(gfp);
X fclose(tfp);
X fclose(ifp);
X
X exit(0);
X}
X
XHidden FILE *openfile(file, mode) string file; string mode; {
X FILE *fp;
X string s;
X
X switch (*mode) {
X case 'r':
X s= "read";
X break;
X case 'w':
X s= "write";
X break;
X default:
X fatal("wrong mode %s opening file %s", mode, file);
X }
X fp= fopen(file, mode);
X if (fp == NULL) {
X fatal("can't open file \"%s\" to %s it", file, s);
X }
X return fp;
X}
X
XHidden Procedure process() {
X
X allocate_tables();
X
X read_grammar_into_tables(); /* check repr's immediately? */
X
X fill_and_check_tables();
X
X compute_classes();
X
X dump_files();
X}
X
X/* VARARGS 1 */
Xmessage(format, arg1, arg2, arg3, arg4, arg5)
X char *format;
X char *arg1, *arg2, *arg3, *arg4, *arg5;
X{
X fprintf(stderr, "%s: ", progname);
X fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5);
X putc('\n', stderr);
X}
X
X/* VARARGS 1 */
Xfatal(format, arg1, arg2, arg3, arg4, arg5)
X char *format;
X char *arg1, *arg2, *arg3, *arg4, *arg5;
X{
X fprintf(stderr, "%s: ", progname);
X fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5);
X putc('\n', stderr);
X exit(1);
X}
X
Xchar *getmem(len) unsigned len; {
X char *p;
X char *malloc();
X
X p= malloc(len);
X if (p == NULL)
X fatal("no more memory");
X return p;
X}
X
XVisible string savestr(s) string s; {
X string p= (string) getmem((unsigned) (strlen((char*)s) + 1));
X strcpy((char*)p, (char*)s);
X return p;
X}
X
X/* return saved copy itemarray pi with ilen items,
X * the last of which must be a Nilitem.
X */
X
XVisible itemptr savearray(pi, ilen) itemptr pi; int ilen; {
X itemptr pp= (itemptr) getmem((unsigned) (ilen*sizeof(item)));
X itemptr p= pp;
X
X while (--ilen > 0) {
X *p++= *pi++;
X }
X Assert(*pi == Nilitem);
X *p= Nilitem;
X return pp;
X}
X
XVisible Procedure asserr(file, line) string file; int line; {
X fatal("assertion error: file %s, line %d", file, line);
X}
EOF
fi
if test -s 'abc/tc/termcap.3X'
then echo '*** I will not over-write existing file abc/tc/termcap.3X'
else
echo 'x - abc/tc/termcap.3X'
sed 's/^X//' > 'abc/tc/termcap.3X' << 'EOF'
X.TH TERMCAP 3X "9 February 1983"
X.UC 4
X.SH NAME
Xtgetent, tgetnum, tgetflag, tgetstr, tgoto, tputs \- terminal independent operation routines
X.SH SYNOPSIS
X.nf
X.B char PC;
X.B char *BC;
X.B char *UP;
X.B short ospeed;
X.PP
X.B tgetent(bp, name)
X.B char *bp, *name;
X.PP
X.B tgetnum(id)
X.B char *id;
X.PP
X.B tgetflag(id)
X.B char *id;
X.PP
X.B char *
X.B tgetstr(id, area)
X.B char *id, **area;
X.PP
X.B char *
X.B tgoto(cm, destcol, destline)
X.B char *cm;
X.PP
X.B tputs(cp, affcnt, outc)
X.B register char *cp;
X.B int affcnt;
X.B int (*outc)();
X.fi
X.SH DESCRIPTION
XThese functions extract and use capabilities from the terminal capability data
Xbase
X.IR termcap (5).
XThese are low level routines;
Xsee
X.IR curses (3X)
Xfor a higher level package.
X.PP
X.I Tgetent
Xextracts the entry for terminal
X.I name
Xinto the buffer at
X.I bp.
X.I Bp
Xshould be a character buffer of size
X1024 and must be retained through all subsequent calls
Xto
X.I tgetnum,
X.I tgetflag,
Xand
X.I tgetstr.
X.I Tgetent
Xreturns \-1 if it cannot open the
X.I termcap
Xfile, 0 if the terminal name given does not have an entry,
Xand 1 if all goes well.
XIt will look in the environment for a TERMCAP variable.
XIf found, and the value does not begin with a slash,
Xand the terminal type
X.B name
Xis the same as the environment string TERM,
Xthe TERMCAP string is used instead of reading the termcap file.
XIf it does begin with a slash, the string is used as a path name rather than
X.I /etc/termcap.
XThis can speed up entry into programs that call
X.IR tgetent ,
Xas well as to help debug new terminal descriptions
Xor to make one for your terminal if you can't write the file
X.I /etc/termcap.
X.PP
X.I Tgetnum
Xgets the numeric value of capability
X.I id,
Xreturning \-1 if is not given for the terminal.
X.I Tgetflag
Xreturns 1 if the specified capability is present in
Xthe terminal's entry, 0 if it is not.
X.I Tgetstr
Xgets the string value of capability
X.I id,
Xplacing it in the buffer at
X.I area,
Xadvancing the
X.I area
Xpointer.
XIt decodes the abbreviations for this field described in
X.IR termcap (5),
Xexcept for cursor addressing and padding information.
X.PP
X.I Tgoto
Xreturns a cursor addressing string decoded from
X.I cm
Xto go to column
X.I destcol
Xin line
X.I destline.
XIt uses the external variables
X.B UP
X(from the \fBup\fR capability)
Xand
X.B BC
X(if \fBbc\fR is given rather than \fBbs\fR)
Xif necessary to avoid placing \fB\en\fR, \fB^D\fR or \fB^@\fR in
Xthe returned string.
X(Programs which call tgoto should be sure to turn off the XTABS bit(s),
Xsince
X.I tgoto
Xmay now output a tab.
XNote that programs using termcap should in general turn off XTABS
Xanyway since some terminals use control I for other functions,
Xsuch as nondestructive space.)
XIf a \fB%\fR sequence is given which is not understood, then
X.I tgoto
Xreturns \*(lqOOPS\*(rq.
X.PP
X.I Tputs
Xdecodes the leading padding information of the string
X.IR cp ;
X.I affcnt
Xgives the number of lines affected by the operation, or 1 if this is
Xnot applicable,
X.I outc
Xis a routine which is called with each character in turn.
XThe external variable
X.I ospeed
Xshould contain the output speed of the terminal as encoded by
X.IR stty (3).
XThe external variable
X.B PC
Xshould contain a pad character to be used (from the \fBpc\fR capability)
Xif a null (\fB^@\fR) is inappropriate.
X.SH FILES
X.ta \w'/usr/lib/libtermcap.a 'u
X/usr/lib/libtermcap.a \-ltermcap library
X.br
X/etc/termcap data base
X.DT
X.SH SEE ALSO
Xex(1), curses(3X), termcap(5)
X.SH AUTHOR
XWilliam Joy
EOF
fi
if test -s 'abc/unix/u1main.c'
then echo '*** I will not over-write existing file abc/unix/u1main.c'
else
echo 'x - abc/unix/u1main.c'
sed 's/^X//' > 'abc/unix/u1main.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1989. */
X
X#include "b.h"
X#include "bmem.h"
X#include "bfil.h"
X#include "getopt.h"
X#include "i3bws.h"
X
XHidden Procedure abc_usage() {
X int m;
X
X /* dirty use of message numbers below: */
X for (m= 6900; m <= 6915; m++)
X putmess(errfile, m);
X
X exit(-1);
X}
X
X#define USE00 MESS(6900, "\nUsage: abc [-W ws.group] [-w ws.name]\n")
X#define USE01 MESS(6901, " [ -e | -i tab | -o tab | -l | -r | -R | file ...]\n")
X#define USE02 MESS(6902, "\nWorkspace Options:\n")
X#define USE03 MESS(6903, " -W dir use group of workspaces in 'dir' (default $HOME/abc)\n")
X#define USE04 MESS(6904, " -w name start in workspace 'name' (default: last workspace)\n")
X#define USE05 MESS(6905, " -w path use 'path' as current workspace (no -W option allowed)\n")
X#define USE06 MESS(6906, "\nOther Options:\n")
X#define USE07 MESS(6907, " -e Use ${EDITOR} as editor to edit definitions\n")
X#define USE08 MESS(6908, " file ... Read commands from file(s)\n")
X#define USE09 MESS(6909, "\nSpecial tasks:\n")
X#define USE10 MESS(6910, " -i tab Fill table 'tab' with text lines from standard input\n")
X#define USE11 MESS(6911, " -o tab Write text lines from table 'tab' to standard output\n")
X#define USE12 MESS(6912, " -l List the how-to's in a workspace on standard output\n")
X#define USE13 MESS(6913, " -r Recover a workspace when its index is lost\n")
X#define USE14 MESS(6914, " -R Recover the index of a group of workspaces\n")
X#define USE15 MESS(6915, "\nUse 'abckeys' to change key bindings\n")
X
X
X#define INCOMP_OPTIONS MESS(6916, "*** incompatible workspace options\n")
X#define NO_EDITOR MESS(6917, "*** you have not set your environment variable EDITOR\n")
X
XVisible char *bws_arg= (char *) NULL;
X /* -W bws_arg: group name workspaces */
XVisible char *wsp_arg= (char *) NULL;
X /* -w wsp_arg: start workspace */
X
XVisible bool eflag= No;
X /* -e: use ${EDITOR} instaed of ABC-editor */
XVisible bool is_gr_reccall= No;
X /* -R: recover workspace group index */
X
XVisible bool slowterminal= No;
X /* -S: do not tell "cannot insert" on slow terminal */
XVisible bool hushbaby= No;
X /* -H: no audible bell if you're babysitting */
X
XVisible bool use_bed= Yes;
X /* the abc editor will be used, so initbed() etc. */
X
X#ifndef NDEBUG
X
X/* use -DDUMPKEYS, -DMEMTRACE, -DEDITRACE, -DTYPETRACE -D VTRMTRACE during
X * compilation to enable these flags.
X */
X
XVisible bool dflag= No;
X /* -d: debugging output wanted */
X
X#ifdef DUMPKEYS
XVisible bool kflag= No;
X /* -k: dump keybindings at various stages */
X#endif
X
X#ifdef MEMTRACE
XHidden string memfile= NULL;
XVisible FILE *memfp= NULL;
X /* -M memfile: trace memory allocations to memfile */
X#endif
X
X#ifdef EDITRACE
XVisible string dumpfile= NULL;
XVisible FILE *dumpfp= NULL;
X /* -E dumpfile: dump editor environ-info to dumpfile */
X#endif
X
X#ifdef TYPETRACE
XVisible string stc_file= NULL;
XVisible FILE *stc_fp= NULL;
X /* -T stc_file: trace typechecker on stc_file */
X#endif
X
X#ifdef VTRMTRACE
XVisible string vtrmfile= NULL;
XVisible FILE *vtrmfp= NULL;
X /* -V vtrmfile: trace typechecker on vtrmfile */
X#endif
X
X#endif /*NDEBUG */
X
X#define NONE '\0'
X
Xmain(argc, argv) int argc; char **argv; {
X int c;
X char *sbuf;
X char io_option= NONE;
X char *io_table= (char *) NULL;
X bool usage_error= No;
X
X#ifdef NDEBUG
X while ((c= getopt(argc, argv, "W:w:ei:o:lrRSH")) != EOF) {
X#else
X while ((c= getopt(argc, argv, "W:w:ei:o:lrRSHdkM:E:T:V:")) != EOF) {
X#endif
X switch (c) {
X case 'W':
X if (bws_arg) usage_error= Yes;
X else bws_arg= optarg;
X break;
X case 'w':
X if (wsp_arg) usage_error= Yes;
X else wsp_arg= optarg;
X break;
X case 'e':
X if (eflag || io_option) usage_error= Yes;
X else eflag= Yes;
X break;
X case 'i':
X case 'o':
X io_table= optarg;
X case 'l':
X case 'r':
X case 'R':
X if (eflag || io_option) usage_error= Yes;
X else io_option= c;
X if (c == 'R')
X is_gr_reccall= Yes;
X break;
X
X case 'S':
X slowterminal= Yes;
X break;
X case 'H':
X hushbaby= Yes;
X break;
X
X#ifndef NDEBUG
X case 'd':
X dflag= Yes;
X break;
X#ifdef DUMPKEYS
X case 'k':
X kflag= Yes;
X break;
X#endif
X#ifdef MEMTRACE
X case 'M':
X memfile= optarg;
X break;
X#endif
X#ifdef EDITRACE
X case 'E':
X dumpfile= optarg;
X break;
X#endif
X#ifdef TYPETRACE
X case 'T':
X stc_file= optarg;
X break;
X#endif
X#ifdef VTRMTRACE
X case 'V':
X vtrmfile= optarg;
X break;
X#endif
X#endif /* !NDEBUG */
X
X default:
X usage_error= Yes;
X break;
X }
X }
X
X argc -= optind;
X argv += optind;
X
X if (argc > 0 && (eflag || io_option))
X usage_error= Yes;
X
X#ifndef NDEBUG
X#ifdef MEMTRACE
X if (memfile != NULL)
X memfp= fopen(memfile, "w");
X#endif
X#ifdef EDITRACE
X if (dumpfile != NULL)
X dumpfp= fopen(dumpfile, "w");
X#endif
X#ifdef TYPETRACE
X if (stc_file != NULL)
X stc_fp= fopen(stc_file, "w");
X#endif
X#ifdef VTRMTRACE
X if (vtrmfile != NULL)
X vtrmfp= fopen(vtrmfile, "w");
X#endif
X#endif
X
X /* Setbuf must be called before any output is produced! */
X sbuf= (char*) getmem((unsigned)BUFSIZ);
X setbuf(stdout, sbuf);
X
X set_vars(); /* set messfile and errfile before using
X * usage messages ! */
X
X if (is_path(wsp_arg) && bws_arg) {
X putmess(errfile, INCOMP_OPTIONS);
X usage_error= Yes;
X }
X
X if (eflag) {
X editor= (string) getenv("EDITOR");
X if (editor == (string)NULL || *editor == NONE) {
X putmess(errfile, NO_EDITOR);
X usage_error= Yes;
X }
X }
X
X if (usage_error)
X abc_usage(); /* exits */
X
X initcall(argc, argv);
X
X use_bed= rd_interactive && (io_option == NONE || io_option == 'i');
X
X init((bool) (io_option == NONE));
X if (io_option)
X abcio(io_option, io_table);
X else
X run_abc(argc, argv);
X
X freemem((ptr) sbuf);
X
X bye(0);
X}
EOF
fi
if test -s 'abc/unix/u1sig.c'
then echo '*** I will not over-write existing file abc/unix/u1sig.c'
else
echo 'x - abc/unix/u1sig.c'
sed 's/^X//' > 'abc/unix/u1sig.c' << 'EOF'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*Handle interrupts and signals*/
X
X#include "b.h"
X
X#ifdef SIGNAL
X
X#include <signal.h>
X
X#include "feat.h"
X
X#ifdef SETJMP
X#include <setjmp.h>
X#endif
X
X/*The operating system provides a function signal(s,f)
X that associates function f with the signal s, and returns
X a pointer to the previous function associated with s.
X Then, when signal s occurs, f is called and the function associated with s
X may or may not be reset. Thus f may need to call signal(s,f) again to.
X The code here doesn't depend on either interpretation, always being explicit
X about which handler to use.
X
X There are two signals that can come from the user: quit and interrupt.
X Interrupt should just stop the interpreter and return to B command level;
X quit should stop the B system completely.
X All other signals are caused by errors (eg memory exhausted)
X or come from outside the program, and are therefore fatal.
X
X SIG_IGN is the system supplied routine to ignore a signal.
X SIG_DFL is the system supplied default for a signal.
X kill(getpid(), signal) kills the program according to 'signal'
X
X On BSD systems, SIGTSTP and other signals causing the process to be
X suspended, and SIGCONT and others that are ignored by default,
X must not be caught. It is assumed that all these are defined
X when SIGTSTP is defined.
X*/
X
X#ifdef SIGTSTP
X
XHidden bool must_handle(sig) int sig; {
X /* Shouldn't we enumerate the list of signals we *do* want to catch? */
X /* It seems that new signals are all of the type that should be
X ignored by most processes... */
X switch (sig) {
X case SIGURG:
X case SIGSTOP:
X case SIGTSTP:
X case SIGCONT:
X case SIGCHLD:
X case SIGTTIN:
X case SIGTTOU:
X case SIGIO:
X#ifdef SIGWINCH
X case SIGWINCH: /* Window size changed */
X#endif
X return No;
X default:
X return Yes;
X }
X}
X
X#else /* !SIGTSTP */
X
X#ifdef SIGCLD /* System V */
X
X#define must_handle(sig) ((sig) != SIGCLD)
X
X#else /* !SIGCLD */
X
X#define must_handle(sig) Yes
X
X#endif /* SIGCLD */
X#endif /* SIGTSTP */
X
Xextern bool in_vtrm;
X
XHidden Procedure oops(sig, m) int sig, m; {
X signal(sig, SIG_DFL); /* Don't call handler recursive -- just die... */
X#ifdef sigmask /* 4.2 BSD */
X sigsetmask(0); /* Don't block signals in handler -- just die... */
X#endif
X putmess(stdout, m); /* implies fflush(stdout) */
X crashend();
X putmess(stdout, MESS(3900, "*** abc: killed by signal\n"));
X#ifndef NDEBUG
X if (in_vtrm)
X endterm(); /* resets terminal modes; doesn't belong here !!! */
X kill(getpid(), sig);
X#else
X immexit(-1);
X#endif
X}
X
XHidden SIGTYPE burp(sig) int sig; {
X oops(sig, MESS(3901, "*** Oops, I feel suddenly (BURP!) indisposed. I'll call it a day. Sorry.\n"));
X}
X
XHidden SIGTYPE aog(sig) int sig; {
X oops(sig, MESS(3902, "*** Oops, an act of God has occurred compelling me to discontinue service.\n"));
X}
X
XHidden SIGTYPE fpe_signal(sig) int sig; { /* sig == SIGFPE */
X signal(sig, fpe_signal);
X interr(MESS(3903, "unexpected arithmetic overflow"));
X}
X
X/* interrupt handlers: */
X
X/* for interpreter: */
X
X#ifdef SETJMP
Xextern jmp_buf readIinterrupt;
Xextern bool readIcontext;
X#endif
X
XHidden SIGTYPE intsig(sig) int sig; { /* sig == SIGINT */
X signal(sig, SIG_IGN);
X int_signal();
X signal(sig, intsig);
X#ifdef SETJMP
X if (readIcontext)
X longjmp(readIinterrupt, 1);
X#endif
X}
X
X/* for editor: */
X
X#ifdef SETJMP
Xextern jmp_buf readEinterrupt;
Xextern bool readEcontext;
X#endif
X
Xextern bool intrflag;
X
XHidden SIGTYPE intrhandler(sig) int sig; {
X intrflag= Yes;
X#ifdef SETJMP
X if (readEcontext)
X longjmp(readEinterrupt, 1);
X#endif
X}
X
XHidden SIGTYPE (*oldhandler)();
X
XVisible Procedure setintrhandler() {
X oldhandler= signal(SIGINT, intrhandler);
X}
X
XVisible Procedure resetintrhandler() {
X signal(SIGINT, oldhandler);
X}
X
X/* suspend signal for interpreter and editor */
X
X#ifdef SIGTSTP
X
Xextern bool suspflag;
X#ifdef SETJMP
Xextern jmp_buf readEsuspend;
X#endif
X
XHidden SIGTYPE susphandler(sig) int sig; {
X SIGTYPE (*oldsig)();
X oldsig= signal(SIGTSTP, SIG_IGN);
X if (oldsig == SIG_IGN)
X return; /* or spawn subshell ?*/
X endshow();
X endterm();
X kill(0, SIGSTOP);
X initterm();
X suspflag= Yes;
X signal(sig, susphandler);
X#ifdef SETJMP
X if (readEcontext)
X longjmp(readEsuspend, 1);
X#endif
X}
X
X#endif /* SIGTSTP */
X
XHidden SIGTYPE (*setsig(sig, func))() int sig; SIGTYPE (*func)(); {
X /*Set a signal, unless it's being ignored*/
X SIGTYPE (*f)()= signal(sig, SIG_IGN);
X if (f != SIG_IGN) signal(sig, func);
X return f;
X}
X
XVisible Procedure initsig() {
X int i;
X for (i = 1; i<=NSIG; ++i)
X if (must_handle(i)) VOID setsig(i, burp);
X VOID setsig(SIGINT, intsig);
X#ifdef SIGTSTP
X VOID setsig(SIGTSTP, susphandler);
X#endif
X VOID setsig(SIGTRAP, burp);
X VOID setsig(SIGQUIT, aog);
X VOID setsig(SIGTERM, aog);
X VOID setsig(SIGFPE, fpe_signal);
X}
X
X#endif /* SIGNAL */
EOF
fi
echo 'First Authors patch for ABC system (omitted files) complete.'
exit 0
exit 0 # Just in case...
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list