home *** CD-ROM | disk | FTP | other *** search
- Subject: v23i074: ABC interactive programming environment, Patch2
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: 23861caa 621356e3 f52c08f0 1061c42c
-
- Submitted-by: timo@cwi.nl
- Posting-number: Volume 23, Issue 74
- 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@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...
-