v23i090: ABC interactive programming environment, Part11/25
Rich Salz
rsalz at bbn.com
Wed Dec 19 06:38:23 AEST 1990
Submitted-by: Steven Pemberton <steven at cwi.nl>
Posting-number: Volume 23, Issue 90
Archive-name: abc/part11
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix at uunet.uu.net if you want that tool.
# Contents: abc/Problems abc/bed/e1deco.c abc/bint2/i2syn.c
# abc/boot/read.c
# Wrapped by rsalz at litchi.bbn.com on Mon Dec 17 13:28:02 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
echo If this archive is complete, you will see the following message:
echo ' "shar: End of archive 11 (of 25)."'
if test -f 'abc/Problems' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/Problems'\"
else
echo shar: Extracting \"'abc/Problems'\" \(8788 characters\)
sed "s/^X//" >'abc/Problems' <<'END_OF_FILE'
XCopyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988.
X
XHOW TO TACKLE PROBLEMS DURING ABC INSTALLATION
X
XThis file contains some detailed advice in case you run into problems while
Xinstalling the ABC system.
X
XTHE SETUP PROCEDURE
X
XYour best bet if the "Setup" script fails is to read it, locate the
Xproblem, change it and run it again. You can always shorten its runtime by
Xchanging long pieces into the simple setting of a shell variable. For
Xinstance, once you are sure your floating point is allright, you might
Xreplace the whole section titled "Floating point arithmetic ok?" by a
Xsimple "fflag=".
X
XNormally you should not edit the files that Setup creates (./Makefile,
X./uhdrs/os.h ./unix/abc.sh and ./scripts/mkdep) directly, but their
Xancestors (./Makefile.unix, ./uhdrs/os.h.gen, ./unix/abc.sh.gen and
X./scripts/mkdep.gen, respectively) and run Setup to incorporate your
Xchanges. If you really want to change them directly, also change Setup to
Xwork on them or remove Setup completely.
X
XWHEN "MAKE MAKEFILES" OR "MAKE DEPEND" FAIL
X
XWhen "make makefiles" fails to create the makefiles */Mf in the relevant
Xsubdirectories, first try to edit the shell commands in Makefile.unix (and
Xrun Setup again; see above).
X
XLikewise, if "make depend" fails to create the */Dep files in the
Xsubdirectories, try to fix ./scripts/mkdep (and incorporate the changes in
X./scripts/mkdep.gen before running Setup again).
X
XHowever, if either of these is not succesful, you can use the already
Xconstructed makefiles */MF and */DEP. To do this, redefine "MF=Mf" to
X"MF=MF" and "DEP=Dep" to "DEP=DEP" in Makefile.unix. You can then call
X"make all" immediately, without "make makefiles" and "make depend".
X
XThe makefiles */MF and */DEP were created on a machine running 4.3 BSD
XUNIX. The dependencies in the */DEP files on system include files
X(embedded in <>) were stripped to make them more portable. On a different
Xsystem the real dependencies may differ in some details, however. This may
Xcause a second "make" after some editing to not see all dependencies on
Xinclude files properly. You can always use "make clean all" to force all
Xobjects to be recompiled if you suspect you ran into this.
X
XMACHINE CONFIGURATION
X
XThe file ./uhdrs/config.h is created by compiling "mkconfig.c" and running
X"mkconfig" on your target machine, since it tries to establish some facts
Xabout the hardware configuration. (If you are cross-compiling you should
Xdo that before "make depend" since that would run mkconfig on the local
X(compiling) machine. If Setup went alright, DESTROOT will be set in the
XMakefile and you will be warned accordingly.)
X
XIf you really have to edit uhdrs/config.h, you should edit the Makefile (or
XMakefile.unix) so that it will not overwrite it anymore.
X
XThe problem most encountered with mkconfig is "unexpected over/underflow".
XThis is usually caused by a bug in "printf", where it can't print very
Xlarge or very small numbers. Look at the last line produced by mkconfig
Xbefore it failed, and then locate the printf after the one that printed
Xthat line. If it is trying to print a comment (rather than a #define),
Xyou can safely comment out the printf and try again. (You might also want
Xto report the bug to your UNIX supplier.)
X
XOTHER UNIX's
X
XThe installation of the ABC system has been tested under 4.3 BSD UNIX on
XTahoe, Vax and Sun machines, under ATT System V Release 3.0 UNIX on an
XIntel 80386, and under MINIX, which is supposed to be VERSION 7 UNIX
Xcompatible. The Setup script tries to find out whether your UNIX is one of
Xthese, and creates ./uhdrs/os.h from ./uhdrs/os.h.gen accordingly. We
Xexpect you will have no problems compiling the ABC system in this case.
X
XIf your UNIX is different, the Setup script will create a file ./uhdrs/os.h
Xwith most defaults setup for a VERSION 7 UNIX system, since that makes a
Xminimum number of assumptions. Examine the resulting file, and change the
Xnames of system include files if they are different on your system. Also
Xcheck the definitions and UNIX specific flags in this file. See the
Xcomments, and use your systems manual to find out how to set them. Don't
Xforget that this file is created by running Setup; change Setup if you want
Xto edit uhdrs/os.h directly, or edit uhdrs/os.h.gen and run Setup again.
X
XIf your machine's memory is not that big, you might examine ./uhdrs/feat.h
Xto turn off some features in an attempt to make the ABC editor-interpreter
Xsmaller.
X
XWe have tried to gather the operating system dependent parts in ./unix/*.c
Xand ./uhdrs/*.h. Examine these if any problems in compilation remain.
X
XEDITOR PROBLEMS
X
XOnce the ABC system is compiled, you may encounter problems when you use
Xthe ABC editor. Our experience is that most of these problems are caused
Xby erroneous or insufficiently detailed termcap entries, which decribe your
Xterminal's capabilities; so first check the "termcap(5)" manual entry (or
X"terminfo(4)" for terminfo systems). Ask your system's guru to give you a
Xhand if you are not familiar with these.
X
XWe use the following entries from the termcap database if they are defined
Xfor your terminal:
X
X Name Type Description
X
X AL str add n new blank lines
X CM str screen-relative cursor motion
X DL str delete n lines
X al str add new blank line
X am bool has automatic margins
X bc str backspace character
X bs bool terminal can backspace
X cd str clear to end of display
X ce str clear to end of line
X cl str cursor home and clear screen
X cm str cursor motion
X co num number of columns in a line
X cp str cursor position sense reply
X cr str carriage return
X cs str change scrolling region
X da bool display may be retained above screen
X db bool display may be retained below screen
X dc str delete character
X dl str delete line
X dm str enter delete mode
X do str cursor down one line
X ed str end delete mode
X ei str end insert mode
X hc bool hardcopy terminal
X ho str cursor home
X ic str insert character (if necessary; may pad)
X im str enter insert mode
X in bool not save to have null chars on the screen
X ke str keypad mode end
X ks str keypad mode start
X le str cursor left
X li num number of lines on screen
X mi bool move safely in insert (and delete?) mode
X ms bool move safely in standout mode
X nd str cursor right (non-destructive space)
X nl str newline
X pc str pad character
X se str end standout mode
X sf str scroll text up (from bottom of region)
X sg num number of garbage characters left by so or se (default 0)
X so str begin standout mode
X sp str sense cursor position
X sr str scroll text down (from top of region)
X te str end termcap
X ti str start termcap
X ue str end underscore mode
X up str cursor up
X us str start underscore mode
X vb str visible bell
X ve str make cursor visible again
X vi str make cursor invisible
X xn bool newline ignored after 80 cols (VT100 / Concept glitch)
X xs bool standout not erased by overwriting
X
XOf these your termcap entry should at least define the following:
X
X le OR bc OR bs
X up
X cm OR CM OR (ho AND do AND nd)
X (al AND dl) OR (cs AND sr)
X ce
X (so AND se AND sg = 0 [or not defined]) OR (us AND ue)
X
XIf either of these requirements is not fulfilled, the ABC editor will
Xcomplain that your terminal is too dumb.
X
XOne common problem on terminals with resizeable windows is that the ABC
Xprompt shows up like
X
X >>>
X ?
X
Xon two lines instead of one. This means that the "li#" entry in your
XTERMCAP does not accurately reflect the number of lines actually in the
Xwindow. This can be remedied by changing the setting of your TERMCAP
Xenvironment variable, using the output of "stty size" (see stty(1)). (On
Xsystems that have the TIOCGWINSZ ioctl, we use it to get the proper window
Xsize; see tty(4) on BSD UNIX systems).
X
XERROR MESSAGES
X
XThe error messages that ABC displays are all gathered in a file and only
Xread when necessary. This was done to diminish the store used for all
Xthese strings and to enhance the adaptability of ABC to another natural
Xlanguage.
X
XIf you want the error messages in another language, for example French, you
Xonly have to replace the file ./abc.msg by a French version.
END_OF_FILE
if test 8788 -ne `wc -c <'abc/Problems'`; then
echo shar: \"'abc/Problems'\" unpacked with wrong size!
fi
# end of 'abc/Problems'
fi
if test -f 'abc/bed/e1deco.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bed/e1deco.c'\"
else
echo shar: Extracting \"'abc/bed/e1deco.c'\" \(15039 characters\)
sed "s/^X//" >'abc/bed/e1deco.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Delete and copy commands.
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "etex.h"
X#include "bobj.h"
X#include "feat.h"
X#include "erro.h"
X#include "node.h"
X#include "gram.h"
X#include "supr.h"
X#include "queu.h"
X#include "tabl.h"
X
Xvalue copyout(); /* Forward */
Xextern bool lefttorite;
X/*
X * DELETE and COPY currently share a buffer, called the copy buffer.
X * (Physically, there is one such a buffer in each environment.)
X * In ordinary use, the copy buffer receives the text deleted by the
X * last DELETE command (unless it just removed a hole); the COPY command
X * can then be used (with the focus on a hole) to copy it back.
X * When some portion of text must be held while other text is deleted,
X * the COPY command again, but now with the focus on the text to be held,
X * copies it to the buffer and deleted text won't overwrite the buffer
X * until it is copied back at least once.
X * If the buffer holds text that was explicitly copied out but not yet
X * copied back in, it is saved on a file when the editor exits, so it can
X * be used in the next session; but this is not true for text implicitly
X * placed in the buffer through DELETE.
X */
X
X/*
X * Delete command -- delete the text in the focus, or delete the hole
X * if it is only a hole.
X */
X
XVisible bool
Xdeltext(ep)
X register environ *ep;
X{
X higher(ep);
X shrink(ep);
X if (ishole(ep))
X return delhole(ep);
X if (!ep->copyflag) {
X release(ep->copybuffer);
X ep->copybuffer = copyout(ep);
X }
X return delbody(ep);
X}
X
X
X/*
X * Delete the focus under the assumption that it contains some text.
X */
X
XVisible bool
Xdelbody(ep)
X register environ *ep;
X{
X ep->changed = Yes;
X
X subgrow(ep, No, Yes); /* Don't ignore spaces */
X switch (ep->mode) {
X
X case SUBRANGE:
X if (ep->s1&1)
X return delfixed(ep);
X return delvarying(ep);
X
X case SUBSET:
X return delsubset(ep, Yes);
X
X case SUBLIST:
X return delsublist(ep);
X
X case WHOLE:
X return delwhole(ep);
X
X default:
X Abort();
X /* NOTREACHED */
X }
X}
X
X
X/*
X * Delete portion (ep->mode == SUBRANGE) of varying text ((ep->s1&1) == 0).
X */
X
XHidden bool
Xdelvarying(ep)
X register environ *ep;
X{
X auto queue q = Qnil;
X register node n = tree(ep->focus);
X auto value v;
X value t1, t2;
X
X v = (value) child(n, ep->s1/2);
X Assert(ep->mode == SUBRANGE && !(ep->s1&1)); /* Wrong call */
X Assert(Is_etext(v)); /* Inconsistent parse tree */
X if (ep->s2 == 0) {
X /* strval(v)[ep->s3 + 1] */
X if (!mayinsert(tree(ep->focus), ep->s1/2, 0, e_ncharval(ep->s3 + 2, v))) {
X /* Cannot do simple substring deletion. */
X/* stringtoqueue(strval(v) + ep->s3 + 1, &q); */
X t1= e_ibehead(v, ep->s3 + 2);
X preptoqueue((node) t1, &q);
X release(t1);
X delfocus(&ep->focus);
X ep->mode = WHOLE;
X return app_queue(ep, &q);
X }
X }
X v = copy(v);
X /* putintrim(&v, ep->s2, len - ep->s3 - 1, ""); */
X t1= e_icurtail(v, ep->s2);
X t2= e_ibehead(v, ep->s3 + 2);
X release(v);
X v= e_concat(t1, t2);
X release(t1); release(t2);
X s_downi(ep, ep->s1/2);
X treereplace(&ep->focus, (node) v);
X s_up(ep);
X ep->mode = VHOLE;
X return Yes;
X}
X
X
X/*
X * Delete portion (ep->mode == SUBRANGE) of fixed text ((ep->s1&1) == 1).
X */
X
XHidden bool
Xdelfixed(ep)
X register environ *ep;
X{
X register node n = tree(ep->focus);
X char buf[15]; /* Long enough for all fixed texts */
X string *nr= noderepr(n);
X register string repr = nr[ep->s1/2];
X register int len;
X queue q = Qnil;
X bool ok;
X
X Assert(ep->mode == SUBRANGE && (ep->s1&1));
X if (ep->s1 > 1) {
X ep->mode = FHOLE;
X return Yes;
X }
X else if (symbol(n) == Select && ep->s2 == 0 && repr[ep->s3+1] == ':') {
X /* hack to prevent asserr in app_queue below */
X ep->s3++;
X }
X Assert(fwidth(repr) < sizeof buf - 1);
X len = ep->s2;
X ep->s2 = ep->s3 + 1;
X ep->mode = FHOLE;
X nosuggtoqueue(ep, &q);
X strcpy(buf, repr);
X if (nchildren(tree(ep->focus)) > 0)
X buf[len] = 0;
X else
X strcpy(buf+len, buf+ep->s2);
X delfocus(&ep->focus);
X ep->mode = WHOLE;
X markpath(&ep->focus, 1);
X ok = ins_string(ep, buf, &q, 0);
X if (!ok) {
X qrelease(q);
X return No;
X }
X if (!firstmarked(&ep->focus, 1)) Abort();
X unmkpath(&ep->focus, 1);
X fixfocus(ep, len);
X return app_queue(ep, &q);
X}
X
X/*
X * refinement for delsubset and delsublist
X * to delete an initial KEYWORDS part before an expression
X * (the latter being sent to qq)
X */
X
XHidden bool hole_ify_keywords(ep, qq)
X register environ *ep;
X queue *qq;
X{
X treereplace(&ep->focus, gram(Kw_plus));
X ep->mode= VHOLE;
X ep->s1= 4;
X ep->s2= 0;
X if (app_queue(ep, qq)) {
X ep->mode= FHOLE;
X ep->s1= 1;
X ep->s2= 0;
X return Yes;
X }
X return No;
X}
X
X/*
X * Delete focus if ep->mode == SUBSET.
X */
X
XHidden bool
Xdelsubset(ep, hack)
X register environ *ep;
X bool hack;
X{
X auto queue q = Qnil;
X auto queue q2 = Qnil;
X register node n = tree(ep->focus);
X register node nn;
X register string *rp = noderepr(n);
X register int nch = nchildren(n);
X register int i;
X bool res;
X int sym= symbol(n);
X
X if (hack) {
X shrsubset(ep);
X if (ep->s1 == ep->s2 && !(ep->s1&1)) {
X nn = child(tree(ep->focus), ep->s1/2);
X if (fwidth(noderepr(nn)[0]) < 0) {
X /* It starts with a newline, leave the newline */
X s_downi(ep, ep->s1/2);
X ep->mode = SUBSET;
X ep->s1 = 2;
X ep->s2 = 2*nchildren(nn) + 1;
X return delsubset(ep, hack);
X }
X }
X subgrsubset(ep, No); /* Undo shrsubset */
X if (ep->s2 == 3 && rp[1] && !strcmp(rp[1], "\t"))
X --ep->s2; /* Hack for deletion of unit-head or if/for/wh. head */
X }
X if (ep->s1 == 1 && Fw_negative(rp[0]))
X ++ep->s1; /* Hack for deletion of test-suite or refinement head */
X
X if (Fw_zero(rp[0]) ? (ep->s2 < 3 || ep->s1 > 3) : ep->s1 > 1) {
X /* No deep structural change */
X for (i = (ep->s1+1)/2; i <= ep->s2/2; ++i) {
X s_downi(ep, i);
X delfocus(&ep->focus);
X s_up(ep);
X }
X if (ep->s1&1) {
X ep->mode = FHOLE;
X ep->s2 = 0;
X }
X else if (Is_etext(child(tree(ep->focus), ep->s1/2))) {
X ep->mode = VHOLE;
X ep->s2 = 0;
X }
X else {
X s_downi(ep, ep->s1/2);
X ep->mode = ATBEGIN;
X }
X return Yes;
X }
X
X balance(ep); /* Make balanced \t - \b pairs */
X subsettoqueue(n, 1, ep->s1-1, &q);
X subsettoqueue(n, ep->s2+1, 2*nch+1, &q2);
X nonewline(&q2); /* Wonder what will happen...? */
X
X if (ep->s1 == 1 && Fw_positive(rp[0]) && allowed(ep->focus, Kw_plus)
X && (sym != If && sym != While && sym != For && sym != Select))
X {
X Assert(emptyqueue(q));
X return hole_ify_keywords(ep, &q2);
X }
X delfocus(&ep->focus);
X ep->mode = ATBEGIN;
X leftvhole(ep);
X if (!ins_queue(ep, &q, &q2)) {
X qrelease(q2);
X return No;
X }
X res= app_queue(ep, &q2);
X#ifdef USERSUGG
X if (symbol(tree(ep->focus)) == Suggestion)
X killsugg(ep, (string*)NULL);
X#endif
X return res;
X}
X
X
X/*
X * Delete the focus if ep->mode == SUBLIST.
X */
X
Xdelsublist(ep)
X register environ *ep;
X{
X register node n;
X register int i;
X register int sym;
X queue q = Qnil;
X bool flag;
X
X Assert(ep->mode == SUBLIST);
X n = tree(ep->focus);
X flag = fwidth(noderepr(n)[0]) < 0;
X for (i = ep->s3; i > 0; --i) {
X n = lastchild(n);
X Assert(n);
X }
X if (flag) {
X n = nodecopy(n);
X s_down(ep);
X do {
X delfocus(&ep->focus);
X } while (rite(&ep->focus));
X if (!allowed(ep->focus, symbol(n))) {
X ederr(0); /* The remains wouldn't fit */
X noderelease(n);
X return No;
X }
X treereplace(&ep->focus, n);
X s_up(ep);
X s_down(ep); /* I.e., to leftmost sibling */
X ep->mode = WHOLE;
X return Yes;
X }
X sym = symbol(n);
X if (sym == Optional || sym == Hole) {
X delfocus(&ep->focus);
X ep->mode = WHOLE;
X }
X else if (!allowed(ep->focus, sym)) {
X preptoqueue(n, &q);
X if (symbol(tree(ep->focus)) == Kw_plus) {
X return hole_ify_keywords(ep, &q);
X }
X delfocus(&ep->focus);
X ep->mode = WHOLE;
X return app_queue(ep, &q);
X }
X else {
X treereplace(&ep->focus, nodecopy(n));
X ep->mode = ATBEGIN;
X }
X return Yes;
X}
X
X
X/*
X * Delete the focus if ep->mode == WHOLE.
X */
X
XHidden bool
Xdelwhole(ep)
X register environ *ep;
X{
X register int sym = symbol(tree(ep->focus));
X
X Assert(ep->mode == WHOLE);
X if (sym == Optional || sym == Hole)
X return No;
X delfocus(&ep->focus);
X return Yes;
X}
X
X
X/*
X * Delete the focus if it is only a hole.
X * Assume shrink() has been called before!
X */
X
XHidden bool
Xdelhole(ep)
X register environ *ep;
X{
X node n;
X int sym;
X bool flag = No;
X
X switch (ep->mode) {
X
X case ATBEGIN:
X case VHOLE:
X case FHOLE:
X case ATEND:
X return widen(ep, Yes);
X
X case WHOLE:
X Assert((sym = symbol(tree(ep->focus))) == Optional || sym == Hole);
X if (ichild(ep->focus) != 1)
X break;
X if (!up(&ep->focus))
X return No;
X higher(ep);
X ep->mode = SUBSET;
X ep->s1 = 2;
X ep->s2 = 2;
X if (fwidth(noderepr(tree(ep->focus))[0]) < 0) {
X flag = Yes;
X ep->s2 = 3; /* Extend to rest of line */
X }
X }
X
X ep->changed = Yes;
X grow(ep, Yes);
X
X if (!parent(ep->focus) && colonhack(ep, Yes))
X ep->mode= WHOLE; /* to delete a sequence of hole's below */
X
X switch (ep->mode) {
X
X case SUBSET:
X if (!delsubset(ep, No))
X return No;
X if (!flag)
X return widen(ep, Yes);
X leftvhole(ep);
X oneline(ep);
X return Yes;
X
X case SUBLIST:
X n = tree(ep->focus);
X n = lastchild(n);
X sym = symbol(n);
X if (!allowed(ep->focus, sym)
X && sym != Exp_plus && symbol(tree(ep->focus)) != Kw_plus) {
X /* previous line enables deletion of emptied KEYWORD */
X ederr(0); /* The remains wouldn't fit */
X return No;
X }
X flag = samelevel(sym, symbol(tree(ep->focus)));
X treereplace(&ep->focus, nodecopy(n));
X if (flag) {
X ep->mode = SUBLIST;
X ep->s3 = 1;
X }
X else
X ep->mode = WHOLE;
X return Yes;
X
X case WHOLE:
X Assert(!parent(ep->focus)); /* Must be at root! */
X sym= symbol(tree(ep->focus));
X if (sym != Optional && sym != Hole) {
X /* delete sequence of Hole's */
X delfocus(&ep->focus);
X return Yes;
X }
X return No;
X
X default:
X Abort();
X /* NOTREACHED */
X
X }
X}
X
X
X/*
X * Subroutine to delete the focus.
X */
X
XVisible Procedure
Xdelfocus(pp)
X register path *pp;
X{
X register path pa = parent(*pp);
X register int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
X
X treereplace(pp, child(gram(sympa), ichild(*pp)));
X}
X
X
X/*
X * Copy command -- copy the focus to the copy buffer if it contains
X * some text, copy the copy buffer into the focus if the focus is
X * empty (just a hole).
X */
X
XVisible bool
Xcopyinout(ep)
X register environ *ep;
X{
X shrink(ep);
X if (!ishole(ep)) {
X release(ep->copybuffer);
X ep->copybuffer = copyout(ep);
X ep->copyflag = !!ep->copybuffer;
X return ep->copyflag;
X }
X else {
X fixit(ep); /* Make sure it looks like a hole now */
X if (!copyin(ep, (queue) ep->copybuffer))
X return No;
X ep->copyflag = No;
X return Yes;
X }
X}
X
X
X/*
X * Copy the focus to the copy buffer.
X */
X
XVisible value
Xcopyout(ep)
X register environ *ep;
X{
X auto queue q = Qnil;
X auto path p;
X register node n;
X register value v;
X char buf[15];
X register string *rp;
X register int i;
X value w;
X
X switch (ep->mode) {
X case WHOLE:
X preptoqueue(tree(ep->focus), &q);
X break;
X case SUBLIST:
X p = pathcopy(ep->focus);
X for (i = ep->s3; i > 0; --i)
X if (!downrite(&p)) Abort();
X for (i = ep->s3; i > 0; --i) {
X if (!up(&p)) Abort();
X n = tree(p);
X subsettoqueue(n, 1, 2*nchildren(n) - 1, &q);
X }
X pathrelease(p);
X break;
X case SUBSET:
X balance(ep);
X subsettoqueue(tree(ep->focus), ep->s1, ep->s2, &q);
X break;
X case SUBRANGE:
X Assert(ep->s3 >= ep->s2);
X if (ep->s1&1) { /* Fixed text */
X Assert(ep->s3 - ep->s2 + 1 < sizeof buf);
X rp = noderepr(tree(ep->focus));
X Assert(ep->s2 < Fwidth(rp[ep->s1/2]));
X strncpy(buf, rp[ep->s1/2] + ep->s2, ep->s3 - ep->s2 + 1);
X buf[ep->s3 - ep->s2 + 1] = 0;
X stringtoqueue(buf, &q);
X }
X else { /* Varying text */
X v = (value) child(tree(ep->focus), ep->s1/2);
X Assert(Is_etext(v));
X/* v = trim(v, ep->s2, Length(v) - ep->s3 - 1); */
X w= e_icurtail(v, ep->s3 + 1);
X v= e_ibehead(w, ep->s2 + 1);
X release(w);
X preptoqueue((node)v, &q);
X release(v);
X }
X break;
X default:
X Abort();
X }
X nonewline(&q);
X return (value)q;
X}
X
X
X/*
X * Subroutine to ensure the copy buffer doesn't start with a newline.
X */
X
XHidden Procedure
Xnonewline(pq)
X register queue *pq;
X{
X register node n;
X register int c;
X
X if (!emptyqueue(*pq)) {
X for (;;) {
X n = queuebehead(pq);
X if (Is_etext(n)) {
X if (e_ncharval(1, (value)n) != '\n')
X preptoqueue(n, pq);
X noderelease(n);
X break;
X }
X else {
X c = nodechar(n);
X if (c != '\n')
X preptoqueue(n, pq);
X else
X splitnode(n, pq);
X noderelease(n);
X if (c != '\n')
X break;
X }
X }
X }
X}
X
X
X/*
X * Refinement for copyout, case SUBSET: make sure that \t is balanced with \b.
X * Actually it can only handle the case where a \t is in the subset and the
X * matching \b is immediately following.
X */
X
XHidden Procedure
Xbalance(ep)
X environ *ep;
X{
X string *rp = noderepr(tree(ep->focus));
X int i;
X int level = 0;
X
X Assert(ep->mode == SUBSET);
X for (i = ep->s1/2; i*2 < ep->s2; ++i) {
X if (rp[i]) {
X if (strchr(rp[i], '\t'))
X ++level;
X else if (strchr(rp[i], '\b'))
X --level;
X }
X }
X if (level > 0 && i*2 == ep->s2 && rp[i] && strchr(rp[i], '\b'))
X ep->s2 = 2*i + 1;
X}
X
X
X/*
X * Copy the copy buffer to the focus.
X */
X
XHidden bool
Xcopyin(ep, q)
X register environ *ep;
X /*auto*/ queue q;
X{
X auto queue q2 = Qnil;
X bool res;
X
X if (!q) {
X ederr(COPY_EMPTY); /* Empty copy buffer */
X return No;
X }
X ep->changed = Yes;
X q = qcopy(q);
X lefttorite= Yes;
X if (!ins_queue(ep, &q, &q2)) {
X qrelease(q2);
X lefttorite= No;
X return No;
X }
X res= app_queue(ep, &q2);
X lefttorite= No;
X#ifdef USERSUGG
X if (symbol(tree(ep->focus)) == Suggestion)
X killsugg(ep, (string*)NULL);
X#endif
X return res;
X}
X
X
X/*
X * Find out whether the focus looks like a hole or if it has some real
X * text in it.
X * Assumes shrink(ep) has already been performed.
X */
X
XVisible bool
Xishole(ep)
X register environ *ep;
X{
X register int sym;
X
X switch (ep->mode) {
X
X case ATBEGIN:
X case ATEND:
X case VHOLE:
X case FHOLE:
X return Yes;
X
X case SUBLIST:
X case SUBRANGE:
X return No;
X
X case SUBSET:
X return colonhack(ep, No);
X
X case WHOLE:
X sym = symbol(tree(ep->focus));
X return sym == Optional || sym == Hole;
X
X default:
X Abort();
X /* NOTREACHED */
X }
X}
X
X
X/*
X * Amendment to ishole so that it categorizes '?: ?' as a hole.
X * This makes deletion of empty refinements / alternative-suites
X * easier (Steven).
X * Hacked to enable deletion of sequence of hole's at outer level.
X */
X
XHidden bool
Xcolonhack(ep, all)
X environ *ep;
X{
X node n = tree(ep->focus);
X node n1;
X string *rp = noderepr(n);
X int i0, ii, i;
X int sym;
X
X if (all) {
X /* hack to delete sequence of hole's on outer level */
X i0= 1; ii= 2*nchildren(n) + 1;
X }
X else {
X /* original code: */
X i0= ep->s1; ii= ep->s2;
X }
X for (i = i0; i <= ii; ++i) {
X if (i&1) {
X if (!allright(rp[i/2]))
X return No;
X }
X else {
X n1 = child(n, i/2);
X if (Is_etext(n1))
X return No;
X sym = symbol(n1);
X if (sym != Hole && sym != Optional)
X return No;
X }
X }
X return Yes;
X}
X
X
X/*
X * Refinement for colonhack. Recognize strings that are almost blank
X * (i.e. containing only spaces, colons and the allowed control characters).
X */
X
XHidden bool
Xallright(repr)
X string repr;
X{
X if (repr) {
X for (; *repr; ++repr) {
X if (!strchr(": \t\b\n\r", *repr))
X return No;
X }
X }
X return Yes;
X}
END_OF_FILE
if test 15039 -ne `wc -c <'abc/bed/e1deco.c'`; then
echo shar: \"'abc/bed/e1deco.c'\" unpacked with wrong size!
fi
# end of 'abc/bed/e1deco.c'
fi
if test -f 'abc/bint2/i2syn.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/bint2/i2syn.c'\"
else
echo shar: Extracting \"'abc/bint2/i2syn.c'\" \(13202 characters\)
sed "s/^X//" >'abc/bint2/i2syn.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "b0lan.h"
X#include "i2par.h"
X#include "i3scr.h"
X#include "i3env.h"
X
X#define TABSIZE 8 /* Number of spaces assumed for a tab on a file.
X (Some editors insist on emitting tabs wherever
X they can, and always assume 8 spaces for a tab.
X Even when the editor can be instructed not to
X do this, beginning users won't know about this,
X so we'll always assume the default tab size.
X Advanced users who used to instruct their editor
X to set tab stops every 4 spaces will have to
X unlearn this habit. But that's the price for
X over-cleverness :-)
X The indent increment is still 4 spaces!
X When the B interpreter outputs text, it never uses
X tabs but always emits 4 spaces for each indent level.
X Note that the B editor also has a #defined constant
X which sets the number of spaces for a tab on a file.
X Finally the B editor *displays* indents as 3 spaces,
X but *writes* them to the file as 4, so a neat
X lay-out on the screen may look a bit garbled
X when the file is printed. Sorry. */
X
XVisible txptr tx, ceol;
X
XVisible Procedure skipsp(tx0) txptr *tx0; {
X while(Space(Char(*tx0))) (*tx0)++;
X}
X
X#define Keyletmark(c) \
X (Cap(c) || Dig(c) || (c) == C_APOSTROPHE || (c) == C_QUOTE)
X
XHidden bool keymark(tx) txptr tx; {
X if (Keyletmark(Char(tx)))
X return Yes;
X else if (Char(tx) == C_POINT &&
X Keyletmark(Char(tx-1)) && Keyletmark(Char(tx+1)))
X return Yes;
X return No;
X}
X
X/* ******************************************************************** */
X/* cr_text */
X/* ******************************************************************** */
X
XVisible value cr_text(p, q) txptr p, q; {
X /* Messes with the input line, which is a bit nasty,
X but considered preferable to copying to a separate buffer */
X value t;
X char save= Char(q);
X Char(q)= '\0';
X t= mk_text(p);
X Char(q)= save;
X return t;
X}
X
X/* ******************************************************************** */
X/* find, findceol, req, findrel */
X/* ******************************************************************** */
X
X#define Txnil ((txptr) NULL)
X
XHidden bool search(find_kw, s, q, ftx, ttx) bool find_kw; string s;
X txptr q, *ftx, *ttx; {
X intlet parcnt= 0; bool outs= Yes, kw= No; char aq;
X txptr lctx= Txnil;
X
X while (*ftx < q) {
X if (outs) {
X if (parcnt == 0) {
X if (find_kw) {
X if (Cap(Char(*ftx)))
X return Yes;
X }
X else if (Char(*ftx) == *s) {
X string t= s+1;
X *ttx= (*ftx)+1;
X while (*t && *ttx < q) {
X if (*t != Char(*ttx)) break;
X else { t++; (*ttx)++; }
X }
X if (*t);
X else if (Cap(*s) &&
X (kw || keymark(*ttx) ));
X else return Yes;
X }
X }
X switch (Char(*ftx)) {
X case C_OPEN:
X case C_CUROPEN:
X case C_SUB:
X parcnt++; break;
X case C_CLOSE:
X case C_CURCLOSE:
X case C_BUS:
X if (parcnt > 0) parcnt--; break;
X case C_APOSTROPHE:
X case C_QUOTE:
X if (lctx == Txnil || !Keytagmark(lctx)) {
X outs= No; aq= Char(*ftx);
X }
X break;
X default:
X break;
X }
X lctx= *ftx;
X if (kw)
X kw= keymark(*ftx);
X else
X kw= Cap(Char(lctx));
X }
X else {
X if (Char(*ftx) == aq)
X { outs= Yes; kw= No; lctx= Txnil; }
X else if (Char(*ftx) == C_CONVERT) {
X (*ftx)++;
X if (!search(No, S_CONVERT, q, ftx, ttx))
X return No;
X }
X }
X (*ftx)++;
X }
X return No;
X}
X
X/* ******************************************************************** */
X
XVisible bool find(s, q, ftx, ttx) string s; txptr q, *ftx, *ttx; {
X return search(No, s, q, (*ftx= tx, ftx), ttx);
X}
X
XForward txptr lcol();
X
XVisible Procedure findceol() {
X txptr q= lcol(), ttx;
X if (!find(S_COMMENT, q, &ceol, &ttx)) ceol= q;
X}
X
XVisible Procedure req(s, q, ftx, ttx) string s; txptr q, *ftx, *ttx; {
X if (!find(s, q, ftx, ttx)) {
X value v= mk_text(s);
X parerrV(MESS(2400, "cannot find expected %s"), v);
X release(v);
X *ftx= tx; *ttx= q;
X }
X}
X
XHidden bool relsearch(s, q, ftx) string s; txptr q, *ftx; {
X txptr ttx;
X *ftx= tx;
X while (search(No, s, q, ftx, &ttx))
X switch (Char(*ftx)) {
X case C_LESS:
X if (Char(*ftx+1) == C_LESS)
X *ftx= ++ttx;
X else if (Char((*ftx)-1) == C_GREATER)
X *ftx= ttx;
X else return Yes;
X break;
X case C_GREATER:
X if (Char((*ftx)+1) == C_LESS)
X *ftx= ++ttx;
X else if (Char((*ftx)+1) == C_GREATER)
X *ftx= ++ttx;
X else return Yes;
X break;
X case C_EQUAL:
X return Yes;
X default:
X return No;
X }
X return No;
X}
X
XVisible bool findrel(q, ftx) txptr q, *ftx; {
X txptr ttx;
X *ftx= q;
X if (relsearch(S_LESS, *ftx, &ttx)) *ftx= ttx;
X if (relsearch(S_GREATER, *ftx, &ttx)) *ftx= ttx;
X if (relsearch(S_EQUAL, *ftx, &ttx)) *ftx= ttx;
X return *ftx < q;
X}
X
XVisible bool findtrim(q, first) txptr q, *first; {
X txptr ftx, ttx;
X *first= q;
X if (find(S_BEHEAD, *first, &ftx, &ttx)) *first= ftx;
X if (find(S_CURTAIL, *first, &ftx, &ttx)) *first= ftx;
X return *first < q;
X}
X
X/* ******************************************************************** */
X/* tag, keyword, findkw */
X/* ******************************************************************** */
X
XHidden value tag() {
X txptr tx0= tx;
X if (!Letter(Char(tx))) parerr(MESS(2401, "no name where expected"));
X else while (Tagmark(tx)) tx++;
X return cr_text(tx0, tx);
X}
X
XVisible bool is_tag(v) value *v; {
X if (!Letter(Char(tx))) return No;
X *v= tag();
X return Yes;
X}
X
XVisible bool is_abcname(name) value name; {
X string s= strval(name);
X
X if (!Letter(*s))
X return No;
X for (; *s != '\0'; ++s) {
X if (!Tagmark(s))
X return No;
X }
X return Yes;
X}
X
XVisible char *keyword() {
X txptr tx0= tx;
X static char *kwbuf;
X int len;
X
X if (!Cap(Char(tx))) parerr(MESS(2402, "no keyword where expected"));
X else while (keymark(tx)) tx++;
X len= tx-tx0;
X if (kwbuf) freemem((ptr) kwbuf);
X kwbuf= (char *) getmem((unsigned) (len+1));
X strncpy(kwbuf, tx0, len);
X kwbuf[len]= '\0';
X return kwbuf;
X}
X
XVisible bool is_keyword(kw) char **kw; {
X if (!Cap(Char(tx))) return No;
X *kw= keyword();
X return Yes;
X}
X
XVisible bool is_cmdname(q, name) txptr q; char **name; {
X static char *cmdbuf;
X char *kw;
X int len;
X
X if (!is_keyword(&kw)) return No;
X if (cmdbuf) freemem((ptr) cmdbuf);
X cmdbuf= (char *) savestr(kw);
X if (!spec_firstkeyword(kw)) {
X while (NEXT_keyword(q, &kw)) {
X len= strlen(cmdbuf) + 1 + strlen(kw);
X regetmem((ptr *) &cmdbuf, (unsigned) (len+1));
X strcat(cmdbuf, " ");
X strcat(cmdbuf, kw);
X }
X }
X *name= cmdbuf;
X return Yes;
X}
X
X/* only those immediately following the FIRST keyword */
X
XHidden bool NEXT_keyword(q, kw) txptr q; char **kw; {
X txptr ftx;
X skipsp(&tx);
X if (!findkw(q, &ftx))
X return No;
X if (Text(ftx)) /* there is a parameter */
X return No;
X return is_keyword(kw);
X}
X
X/* The reserved keywords that a user command may not begin with:
X * e.g. HOW TO HOW ARE YOU isn't allowed
X */
X
XHidden char *firstkw[] = {
X K_IF, K_WHILE, K_CHECK, K_HOW, K_RETURN, K_REPORT,
X ""
X};
X
XHidden bool spec_firstkeyword(fkw) char *fkw; {
X char **kw;
X for (kw= firstkw; **kw != '\0'; kw++) {
X if (strcmp(fkw, *kw) == 0)
X return Yes;
X }
X return No;
X}
X
XVisible bool findkw(q, ftx) txptr q, *ftx; {
X txptr ttx;
X *ftx= tx;
X return search(Yes, "", q, ftx, &ttx);
X}
X
X/* ******************************************************************** */
X/* upto, nothing, ateol, need */
X/* ******************************************************************** */
X
XVisible Procedure upto(q, s) txptr q; string s; {
X skipsp(&tx);
X if (Text(q)) {
X value v= mk_text(s);
X parerrV(MESS(2403, "something unexpected following %s"), v);
X release(v);
X tx= q;
X }
X}
X
XVisible Procedure upto1(q, m) txptr q; int m; {
X skipsp(&tx);
X if (Text(q)) {
X parerr(m);
X tx= q;
X }
X}
X
XVisible bool nothing(q, m) txptr q; int m; {
X if (!Text(q)) {
X if (Char(tx-1) == ' ') tx--;
X parerr(m);
X return Yes;
X }
X return No;
X}
X
XVisible bool i_looked_ahead= No;
XHidden bool o_looked_ahead= No;
X
XVisible intlet cur_ilev;
X
XVisible bool ateol() {
X if ((ifile == sv_ifile && i_looked_ahead)
X || (ifile != sv_ifile && o_looked_ahead)) return Yes;
X skipsp(&tx);
X return Eol(tx);
X}
X
XVisible Procedure need(s) string s; {
X string t= s;
X skipsp(&tx);
X while (*t)
X if (*t++ != Char(tx++)) {
X value v= mk_text(s);
X tx--;
X parerrV(MESS(2404, "according to the syntax I expected %s"), v);
X release(v);
X return;
X }
X}
X
X/* ******************************************************************** */
X/* buffer handling */
X/* ******************************************************************** */
X
XVisible txptr first_col;
X
XVisible txptr fcol() { /* the first position of the current line */
X return first_col;
X}
X
XHidden txptr lcol() { /* the position beyond the last character of the line */
X txptr ax= tx;
X while (!Eol(ax)) ax++;
X return ax;
X}
X
XVisible intlet ilev() {
X intlet i;
X if (ifile == sv_ifile && i_looked_ahead) {
X if (!interactive && ifile == sv_ifile)
X f_lino++;
X i_looked_ahead= No;
X return cur_ilev;
X }
X else if (ifile != sv_ifile && o_looked_ahead) {
X o_looked_ahead= No;
X return cur_ilev;
X }
X else {
X first_col= tx= getline();
X if (ifile == sv_ifile)
X i_looked_ahead= No;
X else
X o_looked_ahead= No;
X lino++;
X if (!interactive && ifile == sv_ifile)
X f_lino++;
X i= 0;
X while (Space(Char(tx))) {
X if (Char(tx++) == ' ') i++;
X else i= (i/TABSIZE+1)*TABSIZE;
X }
X if (Char(tx) == C_COMMENT) return cur_ilev= 0;
X if (Char(tx) == '\n') return cur_ilev= 0;
X return cur_ilev= i;
X }
X}
X
XVisible Procedure veli() { /* After a look-ahead call of ilev */
X if (!interactive && ifile == sv_ifile)
X f_lino--;
X if (ifile == sv_ifile)
X i_looked_ahead= Yes;
X else
X o_looked_ahead= Yes;
X}
X
XVisible Procedure first_ilev() { /* initialise read buffer for new input */
X o_looked_ahead= No;
X VOID ilev();
X findceol();
X}
X
X/* ******************************************************************** */
X
XVisible value res_cmdnames;
X
X/* The reserved command names;
X * e.g. HOW TO PUT IN x is allowed, but HOW TO PUT x OUT isn't
X */
X
XHidden string reserved[] = {
X K_SHARE, K_CHECK, K_DELETE, K_FAIL, K_FOR,
X K_HOW, K_IF, K_INSERT, K_PASS, K_PUT, K_QUIT, K_READ, K_REMOVE,
X K_REPORT, K_RETURN, K_SELECT, K_SETRANDOM, K_SUCCEED,
X K_WHILE, K_WRITE,
X#ifdef GFX
X K_SPACEFROM, K_LINEFROM, K_CLEARSCREEN,
X#endif
X ""
X};
X
XVisible Procedure initsyn() {
X value v;
X string *kw;
X
X res_cmdnames= mk_elt();
X for (kw= reserved; **kw != '\0'; kw++) {
X insert(v= mk_text(*kw), &res_cmdnames);
X release(v);
X }
X}
X
XVisible Procedure endsyn() {
X release(res_cmdnames); res_cmdnames= Vnil;
X}
X
X/* ******************************************************************** */
X/* signs */
X/* ******************************************************************** */
X
XHidden bool la_denum(tx0) txptr tx0; {
X char l, r;
X switch (l= Char(++tx0)) {
X case C_OVER: r= C_TIMES; break;
X case C_TIMES: r= C_OVER; break;
X default: return Yes;
X }
X do if (Char(++tx0) != r) return No; while (Char(++tx0) == l);
X return Yes;
X}
X
XVisible bool _nwl_sign() {
X if (_sign_is(C_NEWLINE))
X return !la_denum(tx-2) ? Yes : (tx--, No);
X return No;
X}
X
XVisible bool _times_sign() {
X if (_sign_is(C_TIMES))
X return la_denum(tx-1) ? Yes : (tx--, No);
X return No;
X}
X
XVisible bool _over_sign() {
X if (_sign_is(C_OVER))
X return la_denum(tx-1) ? Yes : (tx--, No);
X return No;
X}
X
XVisible bool _power_sign() {
X if (_sign2_is(S_POWER))
X return la_denum(tx-1) ? Yes : (tx-= 2, No);
X return No;
X}
X
XVisible bool _numtor_sign() {
X if (_sign2_is(S_NUMERATOR))
X return la_denum(tx-1) ? Yes : (tx-= 2, No);
X return No;
X}
X
XVisible bool _denomtor_sign() {
X if (_sign2_is(S_DENOMINATOR))
X return la_denum(tx-1) ? Yes : (tx-= 2, No);
X return No;
X}
X
XVisible bool _join_sign() {
X if (_sign_is(C_JOIN))
X return !_sign_is(C_JOIN) ? Yes : (tx-= 2, No);
X return No;
X}
X
XVisible bool _less_than_sign() {
X if (_sign_is(C_LESS))
X return !_sign_is(C_LESS) && !_sign_is(C_EQUAL)
X && !_sign_is(C_GREATER) ? Yes : (tx--, No);
X return No;
X}
X
XVisible bool _greater_than_sign() {
X if (_sign_is(C_GREATER))
X return !_sign_is(C_LESS) && !_sign_is(C_EQUAL)
X && !_sign_is(C_GREATER) ? Yes : (tx--, No);
X return No;
X}
X
XVisible bool dyamon_sign(v) value *v; {
X string s;
X if (plus_sign) s= S_PLUS;
X else if (minus_sign) s= S_MINUS;
X else if (number_sign) s= S_NUMBER;
X else return No;
X *v= mk_text(s);
X return Yes;
X}
X
XVisible bool dya_sign(v) value *v; {
X string s;
X if (times_sign) s= S_TIMES;
X else if (over_sign) s= S_OVER;
X else if (power_sign) s= S_POWER;
X else if (behead_sign) s= S_BEHEAD;
X else if (curtl_sign) s= S_CURTAIL;
X else if (join_sign) s= S_JOIN;
X else if (reptext_sign) s= S_REPEAT;
X else if (leftadj_sign) s= S_LEFT_ADJUST;
X else if (center_sign) s= S_CENTER;
X else if (rightadj_sign) s= S_RIGHT_ADJUST;
X else return No;
X *v= mk_text(s);
X return Yes;
X}
X
XVisible bool mon_sign(v) value *v; {
X string s;
X if (about_sign) s= S_ABOUT;
X else if (numtor_sign) s= S_NUMERATOR;
X else if (denomtor_sign) s= S_DENOMINATOR;
X else return No;
X *v= mk_text(s);
X return Yes;
X}
X
XVisible bool texdis_sign(v) value *v; {
X string s;
X if (apostrophe_sign) s= S_APOSTROPHE;
X else if (quote_sign) s= S_QUOTE;
X else return No;
X *v= mk_text(s);
X return Yes;
X}
END_OF_FILE
if test 13202 -ne `wc -c <'abc/bint2/i2syn.c'`; then
echo shar: \"'abc/bint2/i2syn.c'\" unpacked with wrong size!
fi
# end of 'abc/bint2/i2syn.c'
fi
if test -f 'abc/boot/read.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'abc/boot/read.c'\"
else
echo shar: Extracting \"'abc/boot/read.c'\" \(13315 characters\)
sed "s/^X//" >'abc/boot/read.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X/*
X * read grammar from file into tables.
X *
X * There's a little parser here, to read the grammar from the file.
X * See the file "grammar.abc" for the possible formats.
X *
X * We use namelist[] to store all names. At the end of the reading process
X * the cross-references between classdef[] and symdef[] will be in terms
X * of indices in namelist[]. In fill.c they will be replaced by indices
X * directly into the other one.
X * This organisation is necessary to keep the order of the Symbol-definitions
X * the same as in the input file.
X *
X * Definitions for "Suggestion", "Sugghowname", "Optional" and "Hole" are
X * added at the end; see comment below.
X */
X
X#include "b.h"
X#include "main.h"
X
X#define COMMENT '#' /* Not ABC-like but very UNIX-like, and we used cpp ... */
X#define QUOTE '"'
X
XHidden char nextc; /* Next character to be analyzed */
XHidden bool eof; /* EOF seen? */
XHidden int lcount; /* Current line number */
XHidden int errcount; /* Number of errors detected */
X
XHidden string dname= NULL; /* name currently being defined (at linestart) */
X/* VARARGS 1 */
XHidden Procedure error(format, arg1, arg2, arg3, arg4, arg5)
X char *format;
X char *arg1, *arg2, *arg3, *arg4, *arg5;
X{
X fprintf(stderr,
X "%s: error in grammar file %s, line %d, defining name %s\n\t",
X progname, gfile, lcount, (dname==NULL ? "???" : dname));
X fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5);
X putc('\n', stderr);
X errcount++;
X}
X
XVisible Procedure read_grammar_into_tables() {
X errcount= 0;
X lcount= 1;
X eof= No;
X do {
X adv();
X skipspace();
X if (nextc != COMMENT && nextc != '\n')
X getdefinition();
X while (nextc != '\n')
X adv();
X lcount++;
X } while (!eof);
X
X if (errcount > 0) {
X fatal("You 'd better fix that grammar description first");
X }
X
X add_special_definitions();
X}
X
XHidden Procedure adv()
X{
X int c;
X
X if (eof)
X return;
X c= getc(gfp);
X if (c == EOF) {
X nextc= '\n';
X eof= Yes;
X }
X else {
X nextc= c;
X }
X}
X
XHidden Procedure skipspace()
X{
X while (nextc == ' ' || nextc == '\t')
X adv();
X}
X
XHidden Procedure skipwhite()
X{
X while (nextc == ' ' || nextc == '\t' || nextc == '\n') {
X if (nextc == '\n')
X lcount++;
X adv();
X }
X}
X
XHidden Procedure skipdef() /* to synchronize after error in def */
X{ /* assumes at least points are allright */
X while (nextc != '.') {
X adv();
X }
X}
X
XHidden Procedure skipstring() /* idem for string, must end with '"' */
X{
X while (nextc != '\"') {
X adv();
X }
X}
X
XHidden string getname() {
X char buffer[NAMELEN];
X string bp;
X
X if (!isascii(nextc) || !isalpha(nextc)) {
X if (!isascii(nextc) || (!isprint(nextc) && nextc != ' '))
X sprintf(buffer, "\\%03o", nextc);
X else
X sprintf(buffer, "'%c'", nextc);
X error("illegal character at start of name: %s", buffer);
X return NULL;
X }
X bp= buffer;
X *bp++= nextc;
X adv();
X while (isascii(nextc)
X &&
X (isalnum(nextc) || nextc == '_')
X ) {
X if (bp < buffer + sizeof buffer - 1)
X *bp++= nextc;
X adv();
X }
X *bp= '\0';
X return savestr((string)buffer);
X}
X
XHidden string getstring()
X{
X char buf[STRINGLEN]; /* Arbitrary limit */
X char c;
X int len= 0;
X
X if (nextc != QUOTE) {
X return NULL;
X }
X adv();
X while (nextc != QUOTE) {
X if (nextc == '\n') {
X error("end of line in string");
X skipstring();
X break;
X }
X if (nextc != '\\') {
X c= nextc;
X adv();
X }
X else {
X adv();
X switch (nextc) {
X
X case 'r': c= '\r'; adv(); break;
X case 'n': c= '\n'; adv(); break;
X case 'b': c= '\b'; adv(); break;
X case 't': c= '\t'; adv(); break;
X case 'f': c= '\f'; adv(); break;
X case 'v': c= '\v'; adv(); break;
X /* '\\', '\'' and '\"' handled by default below */
X
X case '0': case '1': case '2': case '3':
X case '4': case '5': case '6': case '7':
X c= nextc-'0';
X adv();
X if (nextc >= '0' && nextc < '8') {
X c= 8*c + nextc-'0';
X adv();
X if (nextc >= '0' && nextc < '8') {
X c= 8*c + nextc-'0';
X adv();
X }
X }
X break;
X
X default: c=nextc; adv(); break;
X
X }
X }
X if (len >= (sizeof(buf)-1)) {
X error("string too long");
X skipstring();
X len= sizeof(buf)-1;
X break;
X }
X buf[len++]= c;
X }
X adv();
X buf[len]= '\0';
X return savestr((string)buf);
X}
X
XHidden Procedure storename(name, pi, pt) string name; item *pi; char *pt; {
X int iname;
X struct nameinfo *pname;
X char *pc;
X char type;
X
X for (iname= 0; iname < nname; iname++) {
X pname= &namelist[iname];
X if (strcmp(name, pname->n_name) == 0) {
X /* stored already */
X *pi= (item) iname;
X *pt= pname->n_type;
X return;
X }
X }
X /* not stored yet; reserve entry and check type */
X Assert(nname < maxname);
X type= Errtype;
X if (isupper(name[0]) && isupper(name[1])) {
X for (pc= &name[2]; *pc != '\0'; pc++)
X if (isalpha(*pc) && !isupper(*pc))
X break;
X if (*pc == '\0')
X type= Lex;
X }
X if (isupper(name[0]) && islower(name[1])) {
X for (pc= &name[2]; *pc != '\0'; pc++)
X if (isalpha(*pc) && !islower(*pc))
X break;
X if (*pc == '\0')
X type= Sym;
X }
X if (islower(name[0])) {
X for (pc= &name[1]; *pc != '\0'; pc++)
X if (isalpha(*pc) && !islower(*pc))
X break;
X if (*pc == '\0')
X type= Class;
X }
X *pt= type;
X if (type == Errtype)
X error("cannot determine type of name '%s'", name);
X pname= &namelist[nname];
X pname->n_name= name;
X pname->n_type= type;
X pname->n_index= Nilitem; /* filled in iff definition found */
X *pi= (item) nname;
X nname++;
X}
X
XHidden Procedure getdefinition()
X{
X string defname;
X item defitem;
X char deftype;
X
X defname= getname();
X if (defname == NULL)
X return;
X dname= defname;
X
X storename(defname, &defitem, &deftype);
X
X skipwhite();
X if (nextc != ':') {
X error("defined name not followed by ':'");
X dname= NULL;
X return;
X }
X adv();
X skipwhite();
X
X switch (deftype) {
X case Class:
X getclassdef(defname, defitem);
X break;
X case Sym:
X getsymdef(defname, defitem);
X break;
X case Lex:
X getlexdef(defname, defitem);
X break;
X case Errtype:
X default:
X error("skipping definition");
X break;
X }
X
X dname= NULL;
X}
X
XHidden Procedure getclassdef(defname, defitem) string defname; item defitem; {
X int iclass;
X string sname;
X item sitem;
X char stype;
X item symarray[SYMLEN];
X int s;
X
X iclass= nclass++;
X namelist[defitem].n_index= iclass;
X classdef[iclass].c_name= defname;
X
X for (s= 0; s < SYMLEN-1; s++) {
X sname= getname();
X if (sname == NULL) {
X error("giving up this definition");
X skipdef();
X break;
X }
X storename(sname, &sitem, &stype);
X if (stype == Sym || stype == Lex) {
X symarray[s]= sitem;
X }
X else if (stype == Class) {
X error("class '%s' used in class definition", sname);
X }
X
X skipwhite();
X if (nextc == '.') {
X break;
X }
X else if (nextc != ';') {
X error("missing ';'");
X }
X else {
X adv();
X }
X skipwhite();
X }
X if (s == SYMLEN-1 && nextc != '.') {
X error("too many alternatives in rule; skipping tail of definition");
X skipdef();
X }
X else {
X s++;
X }
X adv(); /* skip '.' */
X symarray[s]= Nilitem;
X classdef[iclass].c_syms= savearray(symarray, s+1);
X classdef[iclass].c_insert= NULL;
X classdef[iclass].c_append= NULL;
X classdef[iclass].c_join= NULL;
X}
X
XHidden Procedure getsymdef(defname, defitem) string defname; item defitem; {
X int isym;
X struct syminfo *psym;
X string str;
X string cname;
X item citem;
X char ctype;
X int ich;
X
X isym= nsym++;
X namelist[defitem].n_index= isym;
X
X psym= &symdef[isym];
X psym->s_name= defname;
X
X for (ich= 0; ich <= MAXCHILD; ich++) {
X str= getstring();
X psym->s_repr[ich]= str;
X
X if (str != NULL) {
X skipwhite();
X if (nextc == '.')
X break; /* for ich */
X else if (nextc == ',') {
X adv();
X skipwhite();
X }
X else {
X error("missing ','");
X }
X }
X
X if (ich == MAXCHILD) {
X error("too many children in Symbol definition");
X skipdef();
X break;
X }
X
X cname= getname();
X if (cname == NULL) {
X error("missing class name");
X skipdef();
X break;
X }
X storename(cname, &citem, &ctype);
X if (ctype == Class || ctype == Lex) {
X psym->s_class[ich]= citem;
X }
X else if (ctype == Sym) {
X error("Symbol '%s' used in Symbol definition", cname);
X }
X
X skipwhite();
X if (nextc == '.') {
X /* ich < MAXCHILD */
X ich++;
X psym->s_repr[ich]= NULL;
X break;
X }
X else if (nextc != ',') {
X error("missing ','");
X }
X else {
X adv();
X skipwhite();
X }
X }
X
X if (nextc == '.') {
X adv();
X }
X while (ich < MAXCHILD) {
X psym->s_class[ich]= Nilitem;
X ich++;
X psym->s_repr[ich]= NULL;
X }
X}
X
XHidden item nilarray[]= {Nilitem, Nilitem};
X
XForward string bodyname();
X
XHidden Procedure getlexdef(defname, defitem) string defname; item defitem; {
X int ilex;
X struct lexinfo *plex;
X string str1;
X string str2;
X struct classinfo *pclass;
X struct syminfo *psym;
X int ich;
X
X ilex= nlex++;
X namelist[defitem].n_index= ilex;
X
X plex= &lexdef[ilex];
X plex->l_name= defname;
X
X str1= getstring();
X if (str1 == NULL) {
X error("no string of start chars in lexical definition");
X skipdef();
X return;
X }
X plex->l_start= str1;
X skipwhite();
X if (nextc != ',') {
X error("missing ',' between start and continuation string");
X }
X else {
X adv();
X skipwhite();
X }
X str2= getstring();
X if (str2 == NULL) {
X error("no string of continuation chars in lexical definition");
X skipdef();
X return;
X }
X plex->l_cont= str2;
X skipwhite();
X if (nextc != '.') {
X error("missing '.' after lexical definition");
X }
X else {
X adv();
X }
X /* And now the tricky part:
X * the lexical will be enveloped in the following definitions:
X * l_body: LEXICAL.
X * L_sym: l_body.
X * l_class: L_sym.
X * Wherever the lexical is used in a class or symbol definition
X * the latter two definitions will be used.
X * The first is only referenced indirectly.
X * Even Guido forgot why this was necessary for the ABC editor.
X *
X * Here we only reserve the space, and keep the indexes.
X * The names must be converted into legal C identifiers
X * differing from the original one. (they will show up
X * in a generated headerfile as debugging info).
X * The definitions must be filled with Nil's to prevent them
X * from being interpreted as namelist-indices in the replacement
X * process in fill.c. There the correct definitions will be filled in.
X *
X * For "SUGGESTION" we only do the first step; an entry for
X * Suggestion: suggestion_body.
X * will be added below in add_special_definitions().
X * Idem for "SUGGHOWNAME".
X */
X pclass= &classdef[nclass];
X pclass->c_name= bodyname(defname);
X pclass->c_syms= savearray(nilarray, 2);
X pclass->c_insert= NULL;
X pclass->c_append= NULL;
X pclass->c_join= NULL;
X plex->l_body= nclass++;
X
X if (strcmp(defname, "SUGGESTION") == 0) {
X lsuggestion= ilex; /* later needed for filling in */
X nsuggstnbody= nclass-1; /* also used to check presence */
X return;
X }
X if (strcmp(defname, "SUGGHOWNAME") == 0) {
X lsugghowname= ilex; /* later needed for filling in */
X nsugghowbody= nclass-1; /* also used to check presence */
X return;
X }
X
X psym= &symdef[nsym];
X psym->s_name= savestr(defname);
X symname(psym->s_name);
X for (ich= 0; ; ich++) {
X psym->s_repr[ich]= NULL;
X if (ich == MAXCHILD)
X break;
X psym->s_class[ich]= Nilitem;
X }
X plex->l_sym= nsym++;
X
X pclass= &classdef[nclass];
X pclass->c_name= savestr(defname);
X classname(pclass->c_name);
X pclass->c_syms= savearray(nilarray, 2);
X pclass->c_insert= NULL;
X pclass->c_append= NULL;
X pclass->c_join= NULL;
X plex->l_class= nclass++;
X}
X
XHidden string bodyname(s) string s; {
X char lexbuffer[NAMELEN];
X
X strcpy(lexbuffer, s);
X classname(lexbuffer);
X strcat(lexbuffer, "-body");
X return savestr((string)lexbuffer);
X}
X
XHidden Procedure symname(s) string s; {
X string t= s+1;
X char c;
X
X while (*t) {
X if (isupper(*t)) {
X c= tolower(*t);
X *t= c;
X }
X t++;
X }
X}
X
XHidden Procedure classname(s) string s; {
X string t= s;
X char c;
X
X while (*t) {
X if (isupper(*t)) {
X c= tolower(*t);
X *t= c;
X }
X t++;
X }
X}
X
X/* At the end we must add two Symbol definitions
X * that could not be entered in the grammar:
X * Optional: .
X * Hole: "?".
X * The ABC editor expects these to be at the end of the symdef[] table.
X *
X * Just before that entries for:
X * Suggestion: suggestion_body.
X * Sugghowname: sugghowname_body.
X * will be defined iff the corresponding lexical symbol has
X * been defined in the grammar.
X *
X * 'Suggestion', 'Sugghowname' and 'Optional' are already in the namelist[],
X * but still undefined.
X * To replace the references made to them (later, in fill_and_check_tables())
X * we must add their definitions here first, mimicking the reading procedure.
X *
X * 'Hole' should not be used, only by the ABC editor, so we don't
X * bother about any links to it. (check_defined() will fail if this
X * is violated).
X */
X
XHidden Procedure add_special_definitions() {
X
X if (lsuggestion >= 0) { /* SUGGESTION defined */
X add_symbol("Suggestion", &nsuggestion, Yes);
X }
X if (lsugghowname >= 0) { /* SUGGHOWNAME defined */
X add_symbol("Sugghowname", &nsugghowname, Yes);
X }
X
X add_symbol("Optional", &noptional, Yes);
X add_symbol("Hole", &nhole, No);
X symdef[nhole].s_repr[0]= "?";
X}
X
XHidden Procedure add_symbol(name, pn, referenced)
Xstring name; int *pn; bool referenced;
X{
X struct syminfo *psym;
X item i;
X char t;
X int ich;
X
X *pn= nsym++;
X if (referenced) {
X storename(name, &i, &t);
X namelist[i].n_index= *pn;
X }
X psym= &symdef[*pn];
X psym->s_name= name;
X for (ich= 0; ; ich++) {
X psym->s_repr[ich]= NULL;
X if (ich == MAXCHILD)
X break;
X psym->s_class[ich]= Nilitem;
X }
X}
END_OF_FILE
if test 13315 -ne `wc -c <'abc/boot/read.c'`; then
echo shar: \"'abc/boot/read.c'\" unpacked with wrong size!
fi
# end of 'abc/boot/read.c'
fi
echo shar: End of archive 11 \(of 25\).
cp /dev/null ark11isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 25 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still must unpack the following archives:
echo " " ${MISSING}
fi
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