home *** CD-ROM | disk | FTP | other *** search
- Subject: v23i095: ABC interactive programming environment, Part16/25
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: bd584991 f7c001ad a3094268 61dee307
-
- Submitted-by: Steven Pemberton <steven@cwi.nl>
- Posting-number: Volume 23, Issue 95
- Archive-name: abc/part16
-
- #! /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@uunet.uu.net if you want that tool.
- # Contents: abc/bint1/i1nuc.c abc/bint2/i2ana.c abc/bint3/i3err.c
- # abc/doc/abcintro.doc abc/ihdrs/i2par.h abc/lin/i1lta.c
- # Wrapped by rsalz@litchi.bbn.com on Mon Dec 17 13:28:11 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 16 (of 25)."'
- if test -f 'abc/bint1/i1nuc.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/bint1/i1nuc.c'\"
- else
- echo shar: Extracting \"'abc/bint1/i1nuc.c'\" \(8704 characters\)
- sed "s/^X//" >'abc/bint1/i1nuc.c' <<'END_OF_FILE'
- X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
- X
- X#include "b.h"
- X#include "feat.h"
- X#include "bmem.h"
- X#include "bobj.h"
- X#include "i1num.h"
- X
- X#define MAXDIGITS (MAXNUMDIG)
- X /* Max precision for non-integral, non-rounded numbers */
- X#define MAXNUMSIZE (MAXDIGITS+MAXNUMDIG+10)
- X /* Maximum width of non-rounded number in convnum;
- X * occurs for e.g. -0.xxxxxxe-yyy:
- X * MAXDIGITS x's and MAXNUMDIG (with EXT_RANGE on) y's
- X * 10 is a few extra, not a holy number, but guard against evil:-) */
- X
- X
- X/* Convert an integer to a C character string.
- X The character string is overwritten on each next call.
- X It assumes BASE is a power of 10. */
- X
- XHidden char *convint(v) register integer v; {
- X static char *buffer, shortbuffer[tenlogBASE+3];
- X static char fmt[10];
- X register char *cp;
- X register int i;
- X bool neg = No;
- X
- X if (IsSmallInt(v)) {
- X sprintf(shortbuffer, "%d", SmallIntVal(v));
- X return shortbuffer;
- X }
- X
- X if (Digit(v, Length(v)-1) < 0) {
- X neg = Yes;
- X v = int_neg(v);
- X }
- X if (buffer) freemem((ptr)buffer);
- X buffer = getmem((unsigned)(Length(v)*tenlogBASE + 1 + neg));
- X cp = buffer;
- X if (neg) *cp++ = '-';
- X sprintf(cp, "%d", Msd(v));
- X if (!IsSmallInt(v)) {
- X if (!*fmt) sprintf(fmt, "%%0%dd", tenlogBASE);
- X while (*cp) ++cp;
- X for (i = Length(v)-2; i >= 0; --i, cp += tenlogBASE)
- X sprintf(cp, fmt, Digit(v, i));
- X if (neg) Release(v);
- X }
- X return buffer;
- X}
- X
- XHidden value tento_d(x) double x; {
- X if (x > Maxint || x < -Maxint) {
- X value n= (value) mk_int(x);
- X value v= power((value) int_10, n);
- X release(n);
- X return v;
- X }
- X else return tento((int) x);
- X}
- X
- X/* return number of digits before decimal point,
- X * or minus the number of zero's after the decimal point
- X */
- X
- XHidden int digits_in(v) value v; {
- X integer p, q;
- X struct integer pp, qq;
- X double x;
- X value t1= Vnil, t2= Vnil;
- X
- X if (numcomp(v, zero) == 0)
- X return 0;
- X
- X v= absval(v);
- X if (Integral(v)) {
- X p= (integer) v;
- X q= (integer) one;
- X }
- X else {
- X p= Numerator((rational) v);
- X q= Denominator((rational) v);
- X }
- X FreezeSmallInt(p, pp); FreezeSmallInt(q, qq);
- X
- X x = log10((double) Msd(p));
- X x-= log10((double) Msd(q));
- X x+= (double) ((Length(p) - Length(q)) * tenlogBASE);
- X x= floor(x) + 1;
- X
- X /* it can be +1 or -1 off!!! */
- X if (numcomp(v, t1 = tento_d(x)) >= 0) /* one too low */
- X ++x;
- X else if (numcomp(v, t2 = tento_d(x-1)) < 0) /* one too high */
- X --x;
- X
- X release(t1); release(t2);
- X release(v);
- X
- X if (x > Maxint)
- X return Maxint;
- X else if (x < -Maxint)
- X return -Maxint;
- X else
- X return (int) x;
- X}
- X
- X/* Convert a numeric value to a C character string.
- X * The character string is released on each next call.
- X *
- X * prod10n() is a routine with does a fast multiplication with a ten power
- X * and does not normalize a rational result sometimes.
- X */
- X
- XVisible string convnum(v) register value v; {
- X value r, re, rre;
- X int rndsize= 0;
- X int num;
- X int ndigits;
- X int precision= MAXDIGITS;
- X register string txt;
- X int txtlen;
- X static char *numbuf;
- X register char *str;
- X bool remainder;
- X bool rndflag;
- X int buflen= MAXNUMSIZE;
- X
- X if (Integral(v)) return convint((integer)v);
- X
- X /* Aproximates and rationale are treated alike,
- X * using MAXDIGITS precision, and e-notation when
- X * necessary.
- X * However, rationals resulting from 'n round x' are
- X * transformed to f-format, printing n=Roundsize digits
- X * after the decimal point. */
- X
- X if (Rational(v) && Roundsize(v) > 0)
- X rndsize= Roundsize(v);
- X
- X r= Approximate(v) ? exactly(v) : copy(v);
- X
- X if ((num=numcomp(r, zero)) == 0 && rndsize == 0) {
- X release(r);
- X return "0";
- X }
- X else if (num < 0) {
- X r= negated(v= r);
- X release(v);
- X }
- X
- X ndigits= digits_in(r);
- X rndflag= rndsize > 0 && (rndsize > precision - ndigits || num == 0);
- X
- X re= prod10n(r, rndflag ? rndsize : precision - ndigits, No);
- X rre= round1(re);
- X txt= convint((integer) rre);
- X txtlen= strlen(txt);
- X
- X if (rndflag) {
- X ndigits= txtlen - rndsize;
- X precision= (ndigits > 0 ? txtlen : rndsize);
- X remainder= No;
- X }
- X else {
- X if (txtlen > precision) {
- X /* rounding caused extra digit, e.g. 999.9 ->1000 */
- X txtlen--;
- X txt[txtlen]= '\0';
- X ndigits++;
- X }
- X remainder= (numcomp(re, rre) != 0);
- X if (!remainder) {
- X /* delete trailing zero's after decimal point */
- X int headlen= ndigits + rndsize;
- X int minlen= headlen;
- X
- X if (headlen <= 0 || headlen > precision)
- X minlen= 1;
- X while (txtlen > minlen && txt[txtlen-1] == '0') {
- X txtlen--;
- X }
- X txt[txtlen]= '\0';
- X if (rndsize > 0 && txtlen == headlen)
- X rndflag= Yes;
- X }
- X }
- X
- X release(r); release(re); release(rre);
- X
- X /* now copy to buffer */
- X if (numbuf) freemem(numbuf);
- X if (rndflag)
- X buflen= txtlen + (ndigits < 0 ? -ndigits : ndigits) + 10;
- X
- X numbuf= getmem((unsigned) buflen);
- X
- X str= numbuf;
- X if (num<0) *str++= '-';
- X
- X if (ndigits > precision || (ndigits == precision && remainder)) {
- X *str++= *txt++;
- X if (txtlen > 1) {
- X *str++= '.';
- X while (*txt) *str++ = *txt++;
- X }
- X sprintf(str, "e+%d", ndigits-1);
- X }
- X else if (ndigits == precision && !remainder) {
- X while (*txt) *str++ = *txt++;
- X *str= '\0';
- X }
- X else if (ndigits > 0) {
- X /* we end up here too for rndflag == Yes, r > 1 */
- X while (ndigits-- > 0) *str++ = *txt++;
- X if (*txt) *str++= '.';
- X while (*txt) *str++ = *txt++;
- X *str= '\0';
- X }
- X else if (ndigits >= -3 || rndflag) {
- X /* 3 is about size of exponent,
- X * therefore allow upto 3 0's after decimal point
- X * giving 0.000ddddd instead
- X * of 0.ddddde-3 notation below;
- X *
- X * also handle rndflag == Yes, 1>r>0 here
- X */
- X
- X *str++= '0'; *str++= '.';
- X while (ndigits++ < 0) *str++= '0';
- X while (*txt) *str++ = *txt++;
- X *str= '\0';
- X }
- X else {
- X *str++= '0'; *str++= '.';
- X while (*txt) *str++ = *txt++;
- X sprintf(str, "e%d", ndigits); /* ndigits < 0, %d gives -nnn */
- X }
- X
- X return numbuf;
- X}
- X
- X#define E_EXACT ABC
- X
- X/* Convert a text to a number (assume it's syntactically correct!).
- X Again, BASE must be a power of 10.
- X ********** NEW **********
- X If E_EXACT is undefined, numbers in e-notation are made
- X approximate.
- X*/
- X
- XVisible value numconst(v) register value v; {
- X string txt, txt0;
- X register string tp;
- X register int numdigs, fraclen;
- X integer a;
- X register digit accu;
- X value c;
- X
- X txt= sstrval(v);
- X if (*txt == 'e') a = int_1;
- X else {
- X txt0= txt;
- X while (*txt0 && *txt0=='0') ++txt0; /* Skip leading zeros */
- X
- X for (tp = txt0; isdigit(*tp); ++tp)
- X ; /* Count integral digits */
- X numdigs = tp-txt0;
- X fraclen = 0;
- X if (*tp=='.') {
- X ++tp;
- X for (; isdigit(*tp); ++tp)
- X ++fraclen; /* Count fractional digits */
- X numdigs += fraclen;
- X }
- X a = (integer) grab_num((numdigs+tenlogBASE-1) / tenlogBASE);
- X if (!a) goto recover;
- X accu = 0;
- X /* Integer part: */
- X for (tp = txt0; isdigit(*tp); ++tp) {
- X accu = accu*10 + *tp - '0';
- X --numdigs;
- X if (numdigs%tenlogBASE == 0) {
- X Digit(a, numdigs/tenlogBASE) = accu;
- X accu = 0;
- X }
- X }
- X /* Fraction: */
- X if (*tp == '.') {
- X ++tp;
- X for (; isdigit(*tp); ++tp) {
- X accu = accu*10 + *tp - '0';
- X --numdigs;
- X if (numdigs%tenlogBASE == 0) {
- X Digit(a, numdigs/tenlogBASE) = accu;
- X accu = 0;
- X }
- X }
- X }
- X if (numdigs != 0) syserr(MESS(800, "numconst: can't happen"));
- X a = int_canon(a);
- X }
- X
- X /* Exponent: */
- X if (*tp != 'e') {
- X integer b = int_tento(fraclen);
- X if (!b) {
- X /* Can't happen now; for robustness */
- X Release(a);
- X goto recover;
- X }
- X c = mk_exact(a, b, fraclen);
- X Release(b);
- X }
- X else {
- X double expo = 0;
- X int sign = 1;
- X value b;
- X ++tp;
- X if (*tp == '+') ++tp;
- X else if (*tp == '-') {
- X ++tp;
- X sign = -1;
- X }
- X for (; isdigit(*tp); ++tp) {
- X expo = expo*10 + *tp - '0';
- X if (expo > Maxint) {
- X interr(MESS(801, "excessive exponent in e-notation"));
- X expo = 0;
- X break;
- X }
- X }
- X b = tento((int)expo * sign - fraclen);
- X if (!b) {
- X Release(a);
- X goto recover;
- X }
- X#ifndef E_EXACT
- X /* Make approximate number if e-notation used */
- X c = approximate(b);
- X Release(b);
- X b = c;
- X#endif
- X if (a == int_1) c = b;
- X else c = prod((value)a, b), Release(b);
- X }
- X Release(a);
- X fstrval(txt);
- X return c;
- X
- Xrecover:
- X /* from failure of grab_num, also indirect (int_tento);
- X an error has already been reported */
- X fstrval(txt);
- X return Vnil;
- X}
- X
- X
- X/*
- X * printnum(f, v) writes a number v on file f in such a way that it
- X * can be read back identically.
- X */
- X
- XVisible Procedure printnum(fp, v) FILE *fp; value v; {
- X if (Approximate(v)) {
- X app_print(fp, (real) v);
- X return;
- X }
- X if (Rational(v) && Denominator((rational)v) != int_1) {
- X int i = Roundsize(v);
- X fputs(convnum((value)Numerator((rational)v)), fp);
- X if (i > 0) {
- X /* The assumption here is that in u/v, the Roundsize
- X of the result is the sum of that of the operands. */
- X putc('.', fp);
- X do putc('0', fp); while (--i > 0);
- X }
- X putc('/', fp);
- X v = (value) Denominator((rational)v);
- X }
- X fputs(convnum(v), fp);
- X}
- END_OF_FILE
- if test 8704 -ne `wc -c <'abc/bint1/i1nuc.c'`; then
- echo shar: \"'abc/bint1/i1nuc.c'\" unpacked with wrong size!
- fi
- # end of 'abc/bint1/i1nuc.c'
- fi
- if test -f 'abc/bint2/i2ana.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/bint2/i2ana.c'\"
- else
- echo shar: Extracting \"'abc/bint2/i2ana.c'\" \(8705 characters\)
- sed "s/^X//" >'abc/bint2/i2ana.c' <<'END_OF_FILE'
- X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
- X
- X/* Prepare for code generation -- find out which tags are targets */
- X
- X#include "b.h"
- X#include "bint.h"
- X#include "bobj.h"
- X#include "i0err.h"
- X#include "i2nod.h"
- X#include "i2gen.h" /* Must be after i2nod.h */
- X#include "i3env.h"
- X#include "i3sou.h"
- X
- X
- XVisible int nextvarnumber; /* Counts local targets (including formals) */
- XHidden int nformals; /* nr of formals */
- XHidden bool bound; /* flag to recognise bound tags */
- X
- XVisible value locals, globals, mysteries, refinements;
- X
- X
- XVisible value *setup(t) parsetree t; {
- X typenode n= Nodetype(t);
- X bool in_prmnv= !Unit(n);
- X nextvarnumber= 0;
- X mysteries= mk_elt();
- X if (in_prmnv) {
- X globals= copy(prmnv->tab);
- X locals= Vnil;
- X refinements= mk_elt();
- X return Command(n) ? &globals : Pnil;
- X } else {
- X globals= mk_elt();
- X locals= mk_elt();
- X refinements= *Branch(t, n == HOW_TO ? HOW_R_NAMES : FPR_R_NAMES);
- X VOID copy(refinements);
- X unit_context(t);
- X return &locals;
- X }
- X}
- X
- XHidden Procedure unit_context(t) parsetree t; {
- X cntxt= In_unit;
- X release(uname); uname= get_pname(t);
- X}
- X
- XVisible Procedure cleanup() {
- X release(locals);
- X release(globals);
- X release(mysteries);
- X release(refinements);
- X}
- X
- X/* ******************************************************************** */
- X
- X/* Analyze parse tree, finding the targets and formal parameters.
- X Formal parameters are found in the heading and stored as local targets.
- X Global targets are also easily found: they are mentioned in a SHARE command.
- X Local targets appear on their own or in collateral forms after PUT IN
- X or as bound tags after FOR, SOME, EACH or NO.
- X Note that DELETE x, REMOVE e FROM x, or PUT e IN x[k] (etc.) don't
- X introduce local targets, because in all these cases x must have been
- X initialized first. This speeds up our task of finding targets,
- X since we don't have to visit all nodes: only nodes that may contain
- X commands or tests, and the positions mentioned here, need be visited.
- X (And of course unit headings).
- X We don't have to look for refinements since these are already known
- X from the unit heading.
- X */
- X
- XHidden Procedure a_tag(name, targs) value name; value *targs; {
- X value *aa; int varnumber;
- X if (locals != Vnil && envassoc(locals, name) != Pnil);
- X else if (envassoc(globals, name) != Pnil);
- X else if (envassoc(refinements, name) != Pnil) {
- X if (targs != &mysteries)
- X fixerr(REF_NO_TARGET);
- X }
- X else {
- X aa= envassoc(mysteries, name);
- X if (aa != Pnil && targs == &mysteries);
- X else {
- X if (aa != Pnil) {
- X varnumber= SmallIntVal(*aa);
- X e_delete(&mysteries, name);
- X }
- X else if (targs != &globals)
- X varnumber= nextvarnumber++;
- X else varnumber= 0;
- X e_replace(MkSmallInt(varnumber), targs, name);
- X }
- X }
- X if (bound && locals != Vnil) {
- X aa= envassoc(locals, name);
- X if (aa == Pnil || SmallIntVal(*aa) < nformals)
- X fixerr(MESS(4400, "in ... i IN e, i contains a non-local name"));
- X }
- X}
- X
- XHidden Procedure a_fpr_formals(t) parsetree t; {
- X typenode n= nodetype(t);
- X switch (n) {
- X case TAG:
- X break;
- X case MONF: case MONPRD:
- X analyze(*Branch(t, MON_RIGHT), &locals);
- X break;
- X case DYAF: case DYAPRD:
- X analyze(*Branch(t, DYA_LEFT), &locals);
- X analyze(*Branch(t, DYA_RIGHT), &locals);
- X break;
- X default: syserr(MESS(1900, "a_fpr_formals"));
- X }
- X}
- X
- XVisible Procedure analyze(t, targs) parsetree t; value *targs; {
- X typenode nt; string s; char c; int n, k, len; value v;
- X if (!Is_node(t) || !still_ok) return;
- X nt= Nodetype(t);
- X if (nt < 0 || nt >= NTYPES) syserr(MESS(1901, "analyze bad tree"));
- X s= gentab[nt];
- X if (s == NULL) return;
- X n= First_fieldnr;
- X while ((c= *s++) != '\0' && still_ok) {
- X switch (c) {
- X case '0':
- X case '1':
- X case '2':
- X case '3':
- X case '4':
- X case '5':
- X case '6':
- X case '7':
- X case '8':
- X case '9':
- X n= (c - '0') + First_fieldnr;
- X break;
- X case 'c':
- X v= *Branch(t, n);
- X if (v != Vnil) {
- X len= Nfields(v);
- X for (k= 0; k < len; ++k)
- X analyze(*Field(v, k), targs);
- X }
- X ++n;
- X break;
- X case '#':
- X curlino= *Branch(t, n);
- X /* Fall through */
- X case 'l':
- X case 'v':
- X ++n;
- X break;
- X case 'm':
- X analyze(*Branch(t, n), &mysteries);
- X ++n;
- X break;
- X case 'g':
- X analyze(*Branch(t, n), &globals);
- X ++n;
- X break;
- X case 'b':
- X bound= Yes;
- X analyze(*Branch(t, n),
- X locals != Vnil ? &locals : &globals);
- X bound= No;
- X ++n;
- X break;
- X case 'x':
- X curline= *Branch(t, n);
- X /* Fall through */
- X case 'a':
- X case 'u':
- X analyze(*Branch(t, n), targs);
- X ++n;
- X break;
- X case 't':
- X analyze(*Branch(t, n), Pnil);
- X ++n;
- X break;
- X case 'f':
- X a_fpr_formals(*Branch(t, n));
- X nformals= nextvarnumber;
- X ++n;
- X break;
- X case 'h':
- X v= *Branch(t, n);
- X analyze(v, &locals);
- X nformals= nextvarnumber;
- X ++n;
- X break;
- X case '=':
- X *Branch(t, n)= MkSmallInt(nextvarnumber);
- X ++n;
- X break;
- X case ':': /* code for WHILE loop */
- X curlino= *Branch(t, WHL_LINO);
- X analyze(*Branch(t, WHL_TEST), Pnil);
- X v= *Branch(t, WHL_SUITE);
- X if (nodetype((parsetree) v) != COLON_NODE)
- X syserr(BAD_WHILE);
- X analyze(*Branch(v, COLON_SUITE), targs);
- X break;
- X case ';': /* code for TEST_SUITE */
- X curlino= *Branch(t, TSUI_LINO);
- X curline= *Branch(t, TSUI_TEST);
- X analyze(curline, Pnil);
- X v= *Branch(t, TSUI_SUITE);
- X if (nodetype((parsetree) v) != COLON_NODE)
- X syserr(BAD_TESTSUITE);
- X analyze(*Branch(v, COLON_SUITE), targs);
- X analyze(*Branch(t, TSUI_NEXT), targs);
- X break;
- X case 'T':
- X if (targs != Pnil)
- X a_tag((value)*Branch(t, TAG_NAME), targs);
- X break;
- X }
- X }
- X}
- X
- X/* ******************************************************************** */
- X
- X/* Table describing the actions of the fixer for each node type */
- X
- X
- X/*
- X LIST OF CODES AND THEIR MEANING
- X
- X char fix n? analyze
- X
- X 0-9 n= c-'0'
- X
- X # set curlino ++n set curlino
- X = ++n set to nextvarnum
- X a locate ++n analyze
- X b locate ++n analyze bound tags
- X c collateral ++n analyze collateral
- X f fpr_formals ++n a_fpr_formals
- X g ++n global
- X h ++n how'to formal
- X l locate ++n
- X m actual param ++n mystery
- X t test ++n analyze; set targs= 0
- X u unit ++n analyze
- X v evaluate ++n
- X x execute ++n analyze
- X
- X : special code for WHILE loop
- X ; special code for TEST_SUITE
- X ? special code for UNPARSED
- X @ special check for BEHEAD target
- X | special check for CURTAIL target
- X C special code for comparison
- X D special code for DYAF
- X E special code for DYAPRD
- X F make number
- X G jumpto(l1)
- X H here(&l1)
- X I if (*Branch(t, n) != NilTree) jump2here(t)
- X J jump2here(t)
- X K hold(&st)
- X L let_go(&st)
- X M special code for MONF
- X N special code for MONPRD
- X Q if (*Branch(t, n) != NilTree) visit(t);
- X R if (!reachable()) "command cannot be reached"
- X S jumpto(Stop)
- X T special code for TAG
- X U special code for user-defined-command
- X V visit(t)
- X W visit2(t, seterr(1))
- X X visit(t) or lvisit(t) depending on flag
- X Y special code for YIELD/TEST
- X Z special code for refinement
- X
- X*/
- X
- X
- XVisible string gentab[NTYPES]= {
- X
- X /* HOW_TO */ "1h3xSu6=",
- X /* YIELD */ "2fV4xYu7=",
- X /* TEST */ "2fV4xYu7=",
- X /* REFINEMENT */ "H2xZSu",
- X
- X /* Commands */
- X
- X /* SUITE */ "#RQx3x",
- X /* PUT */ "vaV",
- X /* INSERT */ "vlV",
- X /* REMOVE */ "vlV",
- X /* SET_RANDOM */ "vV",
- X /* DELETE */ "lV",
- X /* CHECK */ "tV",
- X /* SHARE */ "g",
- X /* PASS */ "",
- X
- X /* WRITE */ "1vV",
- X /* WRITE1 */ "1vV",
- X /* READ */ "avV",
- X /* READ_RAW */ "aV",
- X
- X /* IF */ "tV2xJ",
- X /* WHILE */ ":", /* old: "HtV2xGJ" */
- X /* FOR */ "bvHV3xGJ",
- X
- X /* SELECT */ "1x",
- X /* TEST_SUITE */ ";", /* old: "#tW3xKIxL" */
- X /* ELSE */ "#2x",
- X
- X /* QUIT */ "VS",
- X /* RETURN */ "vVS",
- X /* REPORT */ "tVS",
- X /* SUCCEED */ "VS",
- X /* FAIL */ "VS",
- X
- X /* USER_COMMAND */ "1mUV",
- X /* EXTENDED_COMMAND */ "1cV",
- X
- X /* Expressions, targets, tests */
- X
- X /* TAG */ "T",
- X /* COMPOUND */ "a",
- X
- X /* Expressions, targets */
- X
- X /* COLLATERAL */ "cX",
- X /* SELECTION */ "lvX",
- X /* BEHEAD */ "lv@X",
- X /* CURTAIL */ "lv|X",
- X
- X /* Expressions, tests */
- X
- X /* UNPARSED */ "?",
- X
- X /* Expressions */
- X
- X /* MONF */ "M1vV",
- X /* DYAF */ "Dv2vV",
- X /* NUMBER */ "FV",
- X /* TEXT_DIS */ "1v",
- X /* TEXT_LIT */ "1vV",
- X /* TEXT_CONV */ "vvV",
- X /* ELT_DIS */ "V",
- X /* LIST_DIS */ "cV",
- X /* RANGE_ELEM */ "vvV",
- X /* TAB_DIS */ "cV",
- X
- X /* Tests */
- X
- X /* AND */ "tVtJ",
- X /* OR */ "tVtJ",
- X /* NOT */ "tV",
- X /* SOME_IN */ "bvHVtGJ",
- X /* EACH_IN */ "bvHVtGJ",
- X /* NO_IN */ "bvHVtGJ",
- X /* MONPRD */ "N1vV",
- X /* DYAPRD */ "Ev2vV",
- X /* LESS_THAN */ "vvCV",
- X /* AT_MOST */ "vvCV",
- X /* GREATER_THAN */ "vvCV",
- X /* AT_LEAST */ "vvCV",
- X /* EQUAL */ "vvCV",
- X /* UNEQUAL */ "vvCV",
- X /* Nonode */ "",
- X
- X /* TAGformal */ "T",
- X /* TAGlocal */ "T",
- X /* TAGglobal */ "T",
- X /* TAGrefinement */ "T",
- X /* TAGzerfun */ "T",
- X /* TAGzerprd */ "T",
- X
- X /* ACTUAL */ "1mm",
- X /* FORMAL */ "1hh",
- X
- X#ifdef GFX
- X /* SPACE */ "vvV",
- X /* LINE */ "vvV",
- X /* CLEAR */ "V",
- X#endif
- X
- X /* COLON_NODE */ ""
- X};
- END_OF_FILE
- if test 8705 -ne `wc -c <'abc/bint2/i2ana.c'`; then
- echo shar: \"'abc/bint2/i2ana.c'\" unpacked with wrong size!
- fi
- # end of 'abc/bint2/i2ana.c'
- fi
- if test -f 'abc/bint3/i3err.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/bint3/i3err.c'\"
- else
- echo shar: Extracting \"'abc/bint3/i3err.c'\" \(8453 characters\)
- sed "s/^X//" >'abc/bint3/i3err.c' <<'END_OF_FILE'
- X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
- X
- X/* B error message handling */
- X
- X/* There are two kinds of errors:
- X 1) parsing, when the line in error is in a buffer
- X 2) execution, when the line in error is a parse-tree, and must
- X therefore be reconstructed.
- X*/
- X
- X#include "b.h"
- X#include "bmem.h"
- X#include "bint.h"
- X#include "feat.h"
- X#include "bobj.h"
- X#include "i0err.h"
- X#include "i2par.h"
- X#include "i3env.h"
- X#include "i3scr.h"
- X#include "i3sou.h"
- X
- X#ifdef GFX
- X#include "bgfx.h"
- X#endif
- X
- XVisible bool still_ok= Yes;
- XVisible bool mess_ok= Yes; /* if Yes print error message */
- XVisible bool interrupted= No;
- XVisible bool can_interrupt= Yes;
- X
- XVisible parsetree curline= Vnil;
- XVisible value curlino;
- X
- XVisible FILE *errfile= stderr; /* may be changed in initerr() */
- X
- X/*********************************************************************/
- X
- XHidden Procedure nline() {
- X fflush(stdout); /* should be i3scr.c's ofile, but doesnot matter */
- X if (cntxt == In_read && rd_interactive)
- X at_nwl= Yes;
- X if (!at_nwl)
- X putnewline(errfile);
- X at_nwl= Yes;
- X}
- X
- XVisible intlet errlino= 0;
- X
- XHidden intlet pr_line(at) bool at; {
- X /*prints the line that tx is in, with an arrow pointing to the column
- X that tx is at.
- X */
- X txptr lx= fcol(); intlet ap= -1, p= 0; char c;
- X txptr ax= tx;
- X
- X if (!at) do ax--; while (Space(Char(ax)));
- X while (!Eol(lx) && Char(lx) != Eotc) {
- X if (lx == ax) ap= p;
- X c= *lx++;
- X if (c == '\t') {
- X do { putchr(errfile, ' '); } while (((++p)%4)!=0);
- X } else { putchr(errfile, c); p++; }
- X }
- X putnewline(errfile);
- X if (ap < 0) ap= p;
- X for (p= 0; p < ap+4; p++) putchr(errfile, ' ');
- X putstr(errfile, "^\n");
- X}
- X
- X#define IN_COMMAND MESS(3100, " in your command\n")
- X#define IN_READ MESS(3101, " in your expression to be read\n")
- X#define IN_EDVAL MESS(3102, " in your edited value\n")
- X#define IN_TARVAL MESS(3103, " in your location %s\n")
- X#define IN_PRMNV MESS(3104, " in your permanent environment\n")
- X#define IN_WSGROUP MESS(3105, " in your workspace index\n")
- X#define IN_UNIT MESS(3106, " in your how-to %s\n")
- X#define IN_UNIT_LINE MESS(3107, " in line %d of your how-to %s\n")
- X#define IN_INPUT MESS(3108, "*** (detected after reading 1 line of your input file standard input)\n")
- X#define IN_INPUT_LINE MESS(3109, "*** (detected after reading %d lines of your input file standard input)\n")
- X#define IN_FILE MESS(3110, "*** (detected after reading 1 line of your input file %s)\n")
- X#define IN_FILE_LINE MESS(3111, "*** (detected after reading %d lines of your input file %s)\n")
- X
- XHidden Procedure show_where(in_node, at, node)
- X bool in_node, at; parsetree node; {
- X
- X int line_no= in_node ? intval(curlino) : lino;
- X show_line(in_node, at, node, line_no);
- X if (!interactive && ifile == sv_ifile && !unit_file())
- X show_f_line();
- X}
- X
- XHidden Procedure show_line(in_node, at, node, line_no)
- X bool in_node, at; parsetree node; int line_no; {
- X
- X switch (cntxt) {
- X case In_command: putmess(errfile, IN_COMMAND); break;
- X case In_read: putmess(errfile, IN_READ); break;
- X case In_edval: putmess(errfile, IN_EDVAL); break;
- X case In_tarval:
- X putSmess(errfile, IN_TARVAL, strval(errtname));
- X break;
- X case In_prmnv: putmess(errfile, IN_PRMNV); break;
- X case In_wsgroup: putmess(errfile, IN_WSGROUP); break;
- X case In_unit: show_howto(line_no); break;
- X default:
- X putstr(errfile, "???\n");
- X return;
- X }
- X if (!in_node || Valid(node)) putstr(errfile, " ");
- X if (in_node) display(errfile, node, Yes);
- X else pr_line(at);
- X}
- X
- XHidden value unitname(line_no) int line_no; {
- X if (Valid(uname) && Is_text(uname)) {
- X def_perm(last_unit, uname);
- X errlino= line_no;
- X return Permname(uname);
- X }
- X else free_perm(last_unit);
- X return mk_text("");
- X}
- X
- XHidden Procedure show_howto(line_no) int line_no; {
- X value name= unitname(line_no);
- X if (line_no == 1)
- X putSmess(errfile, IN_UNIT, strval(name));
- X else
- X putDSmess(errfile, IN_UNIT_LINE, line_no, strval(name));
- X release(name);
- X}
- X
- XHidden bool unit_file() {
- X value *aa;
- X return cntxt == In_unit &&
- X Valid(uname) && Is_text(uname) && p_exists(uname, &aa);
- X}
- X
- XHidden Procedure show_f_line() {
- X if (f_lino == 1 && iname == Vnil)
- X putmess(errfile, IN_INPUT);
- X else if (f_lino == 1)
- X putSmess(errfile, IN_FILE, strval(iname));
- X else if (iname == Vnil)
- X putDSmess(errfile, IN_INPUT_LINE, f_lino, "");
- X else
- X putDSmess(errfile, IN_FILE_LINE, f_lino, strval(iname));
- X if (iname != Vnil && i_lino > 0) {
- X if (i_lino == 1)
- X putmess(errfile, IN_INPUT);
- X else
- X putDSmess(errfile, IN_INPUT_LINE, i_lino, "");
- X }
- X}
- X
- X#define PROBLEM MESS(3112, "*** The problem is:")
- X
- XVisible Procedure syserr(m) int m; {
- X static bool beenhere= No;
- X if (beenhere) immexit(-1);
- X beenhere= Yes;
- X nline();
- X#ifdef DEBUG
- X#ifdef macintosh
- X Debugger();
- X#endif
- X#endif
- X putmess(errfile, MESS(3113, "*** Sorry, ABC system malfunction\n"));
- X putmess(errfile, PROBLEM);
- X putstr(errfile, " ");
- X putmess(errfile, m);
- X putnewline(errfile);
- X bye(-1);
- X}
- X
- X#ifndef macintosh
- X /* MacABC uses an alert to make sure the user gets the message */
- X
- XVisible Procedure memexh() {
- X static bool beenhere= No;
- X if (beenhere) immexit(-1);
- X beenhere= Yes;
- X nline();
- X putmess(errfile, MESS(3114, "*** Sorry, memory exhausted"));
- X/* show_where(Yes, Yes); don't know if in node or not; to fix */
- X putnewline(errfile);
- X bye(-1);
- X}
- X
- X#endif /*macintosh*/
- X
- XHidden Procedure message(m1, m2, in_node, at, arg)
- X int m1, m2;
- X bool in_node, at;
- X value arg;
- X{
- X still_ok= No;
- X if (!mess_ok)
- X return;
- X nline();
- X putmess(errfile, m1);
- X show_where(in_node, at, curline);
- X putmess(errfile, PROBLEM);
- X putstr(errfile, " ");
- X putSmess(errfile, m2, Valid(arg) ? strval(arg) : "");
- X putnewline(errfile);
- X fflush(errfile);
- X at_nwl=Yes;
- X}
- X
- X#define UNDERSTAND MESS(3115, "*** There's something I don't understand")
- X
- X#define RESOLVE MESS(3116, "*** There's something I can't resolve")
- X
- X#define COPE MESS(3117, "*** Can't cope with problem")
- X
- X#define RECONCILE MESS(3118, "*** Cannot reconcile the types")
- X
- XVisible Procedure pprerrV(m, v) int m; value v; {
- X if (still_ok)
- X message(UNDERSTAND, m, No, No, v);
- X}
- X
- XVisible Procedure pprerr(m) int m; {
- X if (still_ok)
- X message(UNDERSTAND, m, No, No, Vnil);
- X}
- X
- XVisible Procedure parerrV(m, v) int m; value v; {
- X if (still_ok)
- X message(UNDERSTAND, m, No, Yes, v);
- X}
- X
- XVisible Procedure parerr(m) int m; {
- X if (still_ok)
- X message(UNDERSTAND, m, No, Yes, Vnil);
- X}
- X
- XVisible Procedure fixerrV(m, v) int m; value v; {
- X if (still_ok)
- X message(RESOLVE, m, Yes, Yes, v);
- X}
- X
- XVisible Procedure fixerr(m) int m; {
- X if (still_ok)
- X message(RESOLVE, m, Yes, Yes, Vnil);
- X}
- X
- XVisible Procedure typerrV(m, v) int m; value v; {
- X if (still_ok)
- X message(RECONCILE, m, Yes, Yes, v);
- X}
- X
- XVisible Procedure interrV(m, v) int m; value v; {
- X if (still_ok)
- X message(COPE, m, Yes, No, v);
- X}
- X
- XVisible Procedure interr(m) int m; {
- X if (still_ok)
- X message(COPE, m, Yes, No, Vnil);
- X}
- X
- XVisible Procedure checkerr() {
- X still_ok= No;
- X nline();
- X putmess(errfile, MESS(3119, "*** Your check failed"));
- X show_where(Yes, No, curline);
- X fflush(errfile);
- X at_nwl= Yes;
- X}
- X
- XVisible Procedure int_signal() {
- X if (can_interrupt) {
- X interrupted= Yes; still_ok= No;
- X if (cntxt == In_wsgroup || cntxt == In_prmnv)
- X immexit(-1);
- X }
- X if (!interactive) {
- X if (ifile != stdin) fclose(ifile);
- X bye(1);
- X }
- X nline();
- X putmess(errfile, MESS(3120, "*** interrupted\n"));
- X fflush(errfile);
- X if (can_interrupt) {
- X if (cntxt == In_read) {
- X set_context(&read_context);
- X copy(uname);
- X }
- X }
- X at_nwl= Yes;
- X}
- X
- XVisible bool testing= No;
- X
- XVisible Procedure bye(ex) int ex; {
- X#ifdef GFX
- X if (gfx_mode != TEXT_MODE)
- X exit_gfx();
- X#endif
- X at_nwl= Yes;
- X/* putperm(); */ /* shall be called via endall() */
- X endall();
- X immexit(ex);
- X}
- X
- Xextern bool in_vtrm;
- X
- XVisible Procedure immexit(status) int status; {
- X if (in_vtrm)
- X endterm();
- X exit(status);
- X}
- X
- XVisible Procedure initerr() {
- X still_ok= Yes; interrupted= No; curline= Vnil; curlino= zero;
- X#ifdef TTY_ERRFILE
- X /* The idea of the following is, that we cannot use stderr
- X * for "abc cmd.file >out 2>err", since errors for READ
- X * commands must be visible for the user (who is entering
- X * them interactively, as reported in rd_interactive).
- X * The current solution is unix dependent; but stderr redirection
- X * seems impossible on non-unix anyway.
- X * When the first such system shows up it might be necessary
- X * to change all fprintf(errfile,...)'s to prerr's that print
- X * to the proper device (console or stderr file).
- X */
- X if (rd_interactive && (errfile= fopen("/dev/tty", "w")) == NULL)
- X errfile= stderr;
- X#endif
- X}
- X
- END_OF_FILE
- if test 8453 -ne `wc -c <'abc/bint3/i3err.c'`; then
- echo shar: \"'abc/bint3/i3err.c'\" unpacked with wrong size!
- fi
- # end of 'abc/bint3/i3err.c'
- fi
- if test -f 'abc/doc/abcintro.doc' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/doc/abcintro.doc'\"
- else
- echo shar: Extracting \"'abc/doc/abcintro.doc'\" \(8974 characters\)
- sed "s/^X//" >'abc/doc/abcintro.doc' <<'END_OF_FILE'
- XA SHORT INTRODUCTION TO THE ABC LANGUAGE
- X
- XThis article gives a quick overview of the programming language ABC
- Xand its implementations, and gives a few examples of ABC programs.
- XFull documentation about ABC is in the ABC Programmer's Handbook
- X(details below).
- X
- XTHE LANGUAGE
- XABC is an imperative language originally designed as a replacement for
- XBASIC: interactive, very easy to learn, but structured, high-level,
- Xand easy to use. ABC has been designed iteratively, and the present
- Xversion is the 4th iteration. The previous versions were called B (not
- Xto be confused with the predecessor of C).
- X
- XIt is suitable for general everyday programming, the sort of
- Xprogramming that you would use BASIC, Pascal, or AWK for. It is not a
- Xsystems-programming language. It is an excellent teaching language,
- Xand because it is interactive, excellent for prototyping. It is much
- Xfaster than Unix 'bc' for doing quick calculations.
- X
- XABC programs are typically very compact, around a quarter to a fifth
- Xthe size of the equivalent Pascal or C program. However, this is not
- Xat the cost of readability, on the contrary in fact (see the examples
- Xbelow).
- X
- XABC is simple to learn due to the small number of types in the
- Xlanguage (five). If you already know Pascal or something similar you
- Xcan learn the whole language in an hour or so. It is easy to use
- Xbecause the data-types are very high-level.
- X
- XThe five types are:
- X numbers: unbounded length, with exact arithmetic the rule
- X texts (strings): also unbounded length
- X compounds: records without field names
- X lists: sorted collections of any one type of items (bags or multi-sets)
- X tables: generalised arrays with any one type of keys, any one type
- X of items (finite mappings).
- X
- XTHE ENVIRONMENT
- XThe implementation includes a programming environment that makes
- Xproducing programs very much easier, since it knows a lot about the
- Xlanguage, and can therefore do much of the work for you. For instance,
- Xif you type a W, the system suggests a command completion for you:
- X W?RITE ?
- X
- XIf that is what you want, you press [tab], and carry on typing the
- Xexpression; if you wanted WHILE, you type an H, and the system changes
- Xthe suggestion to match:
- X WH?ILE ?:
- X
- XThis mechanism works for commands you define yourself too. Similarly,
- Xif you type an open bracket or quote, you get the closing bracket or
- Xquote for free. You can ignore the suggestions if you want, and just
- Xtype the commands full out.
- X
- XThere is support for workspaces for developing different programs.
- XWithin each workspace variables are persistent, so that if you stop
- Xusing ABC and come back later, your variables are still there as you
- Xleft them. This obviates the need for file-handling facilities: there
- Xis no conceptual difference between a variable and a file in ABC.
- X
- XThe language is strongly-typed, but without declarations. Types are
- Xdetermined from context.
- X
- XEXAMPLES
- XThe (second) best way to appreciate the power of ABC is to see some
- Xexamples (the first is to use it). In what follows, >>> is the
- Xprompt from ABC:
- X
- XNUMBERS
- X >>> WRITE 2**1000
- X 107150860718626732094842504906000181056140481170553360744375038837
- X 035105112493612249319837881569585812759467291755314682518714528569
- X 231404359845775746985748039345677748242309854210746050623711418779
- X 541821530464749835819412673987675591655439460770629145711964776865
- X 42167660429831652624386837205668069376
- X
- X >>> PUT 1/(2**1000) IN x
- X >>> WRITE 1 + 1/x
- X 107150860718626732094842504906000181056140481170553360744375038837
- X 035105112493612249319837881569585812759467291755314682518714528569
- X 231404359845775746985748039345677748242309854210746050623711418779
- X 541821530464749835819412673987675591655439460770629145711964776865
- X 42167660429831652624386837205668069377
- X
- XTEXTS
- X >>> PUT ("ha " ^^ 3) ^ ("ho " ^^ 3) IN laugh
- X >>> WRITE laugh
- X ha ha ha ho ho ho
- X
- X >>> WRITE #laugh
- X 18
- X
- X >>> PUT "Hello! "^^1000 IN greeting
- X >>> WRITE #greeting
- X 7000
- X
- XLISTS
- X >>> WRITE {1..10}
- X {1; 2; 3; 4; 5; 6; 7; 8; 9; 10}
- X >>> PUT {1..10} IN l
- X >>> REMOVE 5 FROM l
- X >>> INSERT 4 IN l
- X >>> INSERT pi IN l
- X >>> WRITE l
- X {1; 2; 3; 3.141592653589793; 4; 4; 6; 7; 8; 9; 10}
- X
- X >>> PUT {} IN ll
- X >>> FOR i IN {1..3}:
- X INSERT {1..i} IN ll
- X >>> WRITE ll
- X {{1}; {1; 2}; {1; 2; 3}}
- X >>> FOR l IN ll:
- X WRITE l /
- X {1}
- X {1; 2}
- X {1; 2; 3}
- X >>> WRITE #ll
- X 3
- X
- XCOMPOUNDS
- X >>> PUT ("Square root of 2", root 2) IN c
- X >>> WRITE c
- X ("Square root of 2", 1.414213562373095)
- X >>> PUT c IN name, value
- X >>> WRITE name
- X Square root of 2
- X >>> WRITE value
- X 1.414213562373095
- X
- XA TELEPHONE LIST
- XThis uses the table data-type. In use, tables resemble arrays:
- X
- X >>> PUT {} IN tel
- X >>> PUT 4054 IN tel["Jennifer"]
- X >>> PUT 4098 IN tel["Timo"]
- X >>> PUT 4134 IN tel["Guido"]
- X
- X >>> WRITE tel["Jennifer"]
- X 4054
- X
- XYou can write all ABC values out. Tables are kept sorted on the keys:
- X >>> WRITE tel
- X {["Guido"]: 4134; ["Jennifer"]: 4054; ["Timo"]: 4098}
- X
- XThe keys function returns a list:
- X >>> WRITE keys tel
- X {"Guido"; "Jennifer"; "Timo"}
- X
- X >>> FOR name IN keys tel:
- X WRITE name, ":", tel[name] /
- X Guido: 4134
- X Jennifer: 4054
- X Timo: 4098
- X
- XYou can define your own commands:
- X
- X HOW TO DISPLAY t:
- X FOR name IN keys t:
- X WRITE name<<10, t[name] /
- X
- X >>> DISPLAY tel
- X Guido 4134
- X Jennifer 4054
- X Timo 4098
- X
- XTo find the user of a given number, you can use a quantifier:
- X >>> IF SOME name IN keys tel HAS tel[name] = 4054:
- X WRITE name
- X Jennifer
- X
- XOr create the inverse table:
- X >>> PUT {} IN subscriber
- X >>> FOR name IN keys tel:
- X PUT name IN subscriber[tel[name]]
- X
- X >>> WRITE subscriber[4054]
- X Jennifer
- X
- X >>> WRITE subscriber
- X {[4054]: "Jennifer"; [4098]: "Timo"; [4134]: "Guido"}
- X
- XCommands and functions are polymorphic:
- X >>> DISPLAY subscriber
- X 4054 Jennifer
- X 4098 Timo
- X 4134 Guido
- X
- XFunctions may return any type. Note that indentation is significant -
- Xthere are no BEGIN-END's or { }'s:
- X
- X HOW TO RETURN inverse t:
- X PUT {} IN inv
- X FOR k IN keys t:
- X PUT k IN inv[t[k]]
- X RETURN inv
- X
- X >>> WRITE inverse tel
- X {[4054]: "Jennifer"; [4098]: "Timo"; [4134]: "Guido"}
- X
- X >>> DISPLAY inverse inverse tel
- X Guido 4134
- X Jennifer 4054
- X Timo 4098
- X
- XA CROSS-REFERENCE INDEXER
- X
- X'Text files' are represented as tables of numbers to strings:
- X
- X >>> DISPLAY poem
- X 1 I've never seen a purple cow
- X 2 I hope I never see one
- X 3 But I can tell you anyhow
- X 4 I'd rather see than be one
- X
- XThe following function takes such a document, and returns the
- Xcross-reference index of the document: a table from words to lists of
- Xline-numbers:
- X
- X HOW TO RETURN index doc:
- X PUT {} IN where
- X FOR line.no IN keys doc:
- X TREAT LINE
- X RETURN where
- X TREAT LINE:
- X FOR word IN split doc[line.no]:
- X IF word not.in keys where:
- X PUT {} IN where[word]
- X INSERT line.no IN where[word]
- X
- XTREAT LINE here is a refinement, directly supporting
- Xstepwise-refinement. 'split' is a function that splits a string into
- Xits space-separated words:
- X
- X >>> WRITE split "Hello world"
- X {[1]: "Hello"; [2]: "world"}
- X
- X >>> DISPLAY index poem
- X But {3}
- X I {2; 2; 3}
- X I'd {4}
- X I've {1}
- X a {1}
- X anyhow {3}
- X be {4}
- X can {3}
- X cow {1}
- X hope {2}
- X never {1; 2}
- X one {2; 4}
- X purple {1}
- X rather {4}
- X see {2; 4}
- X seen {1}
- X tell {3}
- X than {4}
- X you {3}
- X
- XMORE INFORMATION
- XFull details of ABC and the implementations, along with many example
- Xprograms are in the book "The ABC Programmer's Handbook" by Leo Geurts,
- XLambert Meertens and Steven Pemberton, published by Prentice-Hall
- X(ISBN 0-13-000027-2).
- X
- XSee also Steven Pemberton, "An Alternative Simple Language and
- XEnvironment for PCs", IEEE Software, Vol. 4, No. 1, January 1987, pp.
- X56-64.
- X
- XThere is an irregular newsletter available from us (address below),
- Xand a mailing list for discussions; to join send your preferred email
- Xaddress to abc-list-request@cwi.nl .
- X
- XIMPLEMENTATIONS
- XThe sources for the Unix version have been posted to the
- Xcomp.sources.unix group on Usenet; the binaries to comp.binaries.{mac,
- Xibm.pc, atari.st}. They are also available from some servers, for
- Xinstance by anonymous ftp from hp4nl.nluug.nl [192.16.202.2],
- Xmcsun.eu.net [192.16.202.1], and uunet.uu.net [192.48.96.2], in the
- Xdirectory {pub}/{programming}/languages/abc, or send the mail message
- X request: programming/languages/abc
- X topic: index
- Xto info-server@hp4nl.nluug.nl, for a list of the available files, or use
- X topic: <filename>
- Xto get one of the files.
- X
- XAs of this writing, the available files are:
- X
- X index for a list of all files available
- X abc.intro for an overview of ABC
- X (also included with the implementations below)
- X abcst.arc for the Atari ST version
- X abcpc.arc for the IBM PC version
- X abc.mac.sit.hqx for the Mac version
- X abc.unix.tar.Z for the Unix version
- X README for an explanation of how to unpack the above files
- X
- XADDRESS
- X ABC Implementations
- X CWI/AA
- X Kruislaan 413
- X 1098 SJ AMSTERDAM
- X The Netherlands
- X
- X Email: abc@cwi.nl
- X
- END_OF_FILE
- if test 8974 -ne `wc -c <'abc/doc/abcintro.doc'`; then
- echo shar: \"'abc/doc/abcintro.doc'\" unpacked with wrong size!
- fi
- # end of 'abc/doc/abcintro.doc'
- fi
- if test -f 'abc/ihdrs/i2par.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/ihdrs/i2par.h'\"
- else
- echo shar: Extracting \"'abc/ihdrs/i2par.h'\" \(6116 characters\)
- sed "s/^X//" >'abc/ihdrs/i2par.h' <<'END_OF_FILE'
- X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
- X
- X/***********************************************************************/
- X
- X#ifdef macintosh
- X/* Avoid name conflict with standard header files: */
- X#define compound b_compound
- X#endif
- X
- X/* General parsing routines */
- X
- Xtypedef char *txptr;
- X
- X#define Eotc '\0'
- X
- X#define Char(tx) (*(tx))
- X#define Eol(tx) (Char(tx) == '\n')
- X#define Ceol(tx) (Char(tx) == C_COMMENT || Eol(tx))
- X#define Text(q) (tx < q)
- X
- X#define Space(c) ((c) == ' ' || (c) == '\t')
- X
- X#define Letter(c) (islower(c))
- X#define Cap(c) (isupper(c))
- X#define Dig(c) (isdigit(c))
- X
- X#define Tagmark(tx) \
- X (Tagletmark(Char(tx)) || (Char(tx) == C_POINT && \
- X Tagletmark(Char(tx-1)) && Tagletmark(Char(tx+1)) ))
- X#define Tagletmark(c) \
- X (Letter(c) || Dig(c) || (c) == C_APOSTROPHE || (c) == C_QUOTE)
- X
- X#define Keytagmark(tx) \
- X (keymark(tx) || Tagmark(tx))
- X
- X#define Isexpr(c) \
- X (Letter(c) || (c) == C_OPEN || Dig(c) || (c) == C_POINT || \
- X (c) == C_APOSTROPHE || (c) == C_QUOTE || (c) == C_CUROPEN || \
- X (c) == C_ABOUT || (c) == C_TIMES || (c) == C_OVER || \
- X (c) == C_PLUS || (c) == C_MINUS || (c) == C_NUMBER)
- X
- Xtxptr fcol();
- Xchar *keyword();
- X
- Xextern txptr tx, ceol, first_col;
- Xextern intlet cur_ilev;
- Xintlet ilev();
- X
- Xextern value res_cmdnames;
- X
- Xvalue cr_text();
- X
- X/* contexts: */
- X#define In_share 's'
- X#define In_ranger 'q'
- X#define In_formal 'f'
- X#define In_ref 'r'
- X
- X/* Expressions: */
- X
- Xparsetree expr();
- Xparsetree singexpr();
- X
- X/* Targets: */
- X
- Xparsetree targ();
- X
- X/* Tests: */
- X
- Xparsetree test();
- Xparsetree unp_test();
- X
- X/* Commands: */
- X
- Xparsetree cmd_suite();
- Xparsetree cmd_seq();
- Xparsetree ucmd_seq();
- Xvalue tail_line();
- X
- X/* B units */
- X
- Xparsetree unit();
- Xparsetree collateral();
- Xparsetree compound();
- Xparsetree idf();
- Xextern literal idf_cntxt;
- X
- X/* signs */
- X
- X#define C_COLON ':'
- X#define S_COLON ":"
- X#define C_SEMICOLON ';'
- X#define S_SEMICOLON ";"
- X#define C_OPEN '('
- X#define S_OPEN "("
- X#define C_CLOSE ')'
- X#define S_CLOSE ")"
- X#define C_COMMA ','
- X#define S_COMMA ","
- X#define C_POINT '.'
- X#define S_POINT "."
- X#define C_APOSTROPHE '\''
- X#define S_APOSTROPHE "'"
- X#define C_QUOTE '"'
- X#define S_QUOTE "\""
- X#define C_CONVERT '`'
- X#define S_CONVERT "`"
- X#define C_CUROPEN '{'
- X#define S_CUROPEN "{"
- X#define C_CURCLOSE '}'
- X#define S_CURCLOSE "}"
- X#define C_SUB '['
- X#define S_SUB "["
- X#define C_BUS ']'
- X#define S_BUS "]"
- X#define C_BEHEAD '@'
- X#define S_BEHEAD "@"
- X#define C_CURTAIL '|'
- X#define S_CURTAIL "|"
- X#define C_ABOUT '~'
- X#define S_ABOUT "~"
- X#define C_PLUS '+'
- X#define S_PLUS "+"
- X#define C_MINUS '-'
- X#define S_MINUS "-"
- X#define C_TIMES '*'
- X#define S_TIMES "*"
- X#define C_OVER '/'
- X#define S_OVER "/"
- X#define C_JOIN '^'
- X#define S_JOIN "^"
- X#define C_NUMBER '#'
- X#define S_NUMBER "#"
- X#define C_LESS '<'
- X#define S_LESS "<"
- X#define C_EQUAL '='
- X#define S_EQUAL "="
- X#define C_GREATER '>'
- X#define S_GREATER ">"
- X#define S_POWER "**"
- X#define S_NUMERATOR "*/"
- X#define S_DENOMINATOR "/\*"
- X /* \ is needed, else some C preprocessors see it as comment start! */
- X#define S_REPEAT "^^"
- X#define S_LEFT_ADJUST "<<"
- X#define S_CENTER "><"
- X#define S_RIGHT_ADJUST ">>"
- X#define S_AT_MOST "<="
- X#define S_UNEQUAL "<>"
- X#define S_AT_LEAST ">="
- X#define S_RANGE ".."
- X
- X#define C_COMMENT '\\'
- X#define S_COMMENT "\\"
- X#define C_NEWLINE '/'
- X#define S_NEWLINE "/"
- X
- X#define open_sign _sign_is(C_OPEN)
- X#define point_sign _sign_is(C_POINT)
- X#define apostrophe_sign _sign_is(C_APOSTROPHE)
- X#define quote_sign _sign_is(C_QUOTE)
- X#define conv_sign _sign_is(C_CONVERT)
- X#define curlyopen_sign _sign_is(C_CUROPEN)
- X#define curlyclose_sign _sign_is(C_CURCLOSE)
- X#define sub_sign _sign_is(C_SUB)
- X#define behead_sign _sign_is(C_BEHEAD)
- X#define curtl_sign _sign_is(C_CURTAIL)
- X#define about_sign _sign_is(C_ABOUT)
- X#define plus_sign _sign_is(C_PLUS)
- X#define minus_sign _sign_is(C_MINUS)
- X#define number_sign _sign_is(C_NUMBER)
- X#define equals_sign _sign_is(C_EQUAL)
- X#define greater_sign _sign_is(C_GREATER)
- X
- X#define comment_sign _sign_is(C_COMMENT)
- X
- X#define reptext_sign _sign2_is(S_REPEAT)
- X#define leftadj_sign _sign2_is(S_LEFT_ADJUST)
- X#define center_sign _sign2_is(S_CENTER)
- X#define rightadj_sign _sign2_is(S_RIGHT_ADJUST)
- X#define at_most_sign _sign2_is(S_AT_MOST)
- X#define unequal_sign _sign2_is(S_UNEQUAL)
- X#define at_least_sign _sign2_is(S_AT_LEAST)
- X
- X#define _sign_is(c) \
- X (Char(tx) == (c) ? (tx++, Yes) : No)
- X#define _sign2_is(s) \
- X (Char(tx) == (s[0]) && Char(tx+1) == (s[1]) ? (tx+= 2, Yes) : No)
- X
- X#define nwl_sign _nwl_sign()
- X#define times_sign _times_sign()
- X#define over_sign _over_sign()
- X#define power_sign _power_sign()
- X#define numtor_sign _numtor_sign()
- X#define denomtor_sign _denomtor_sign()
- X#define join_sign _join_sign()
- X#define less_than_sign _less_than_sign()
- X#define greater_than_sign _greater_than_sign()
- X
- X/* keywords */
- X
- X#define atkw(kw, s) (strcmp(kw, s) == 0)
- X
- X#define check_keyword(kw) (atkw(kw, K_CHECK))
- X#define delete_keyword(kw) (atkw(kw, K_DELETE))
- X#define insert_keyword(kw) (atkw(kw, K_INSERT))
- X#define pass_keyword(kw) (atkw(kw, K_PASS))
- X#define put_keyword(kw) (atkw(kw, K_PUT))
- X#define read_keyword(kw) (atkw(kw, K_READ))
- X#define remove_keyword(kw) (atkw(kw, K_REMOVE))
- X#define setrandom_keyword(kw) (atkw(kw, K_SETRANDOM))
- X#define write_keyword(kw) (atkw(kw, K_WRITE))
- X#define fail_keyword(kw) (atkw(kw, K_FAIL))
- X#define quit_keyword(kw) (atkw(kw, K_QUIT))
- X#define return_keyword(kw) (atkw(kw, K_RETURN))
- X#define report_keyword(kw) (atkw(kw, K_REPORT))
- X#define succeed_keyword(kw) (atkw(kw, K_SUCCEED))
- X#define if_keyword(kw) (atkw(kw, K_IF))
- X#define select_keyword(kw) (atkw(kw, K_SELECT))
- X#define while_keyword(kw) (atkw(kw, K_WHILE))
- X#define for_keyword(kw) (atkw(kw, K_FOR))
- X#define else_keyword(kw) (atkw(kw, K_ELSE))
- X#define not_keyword(kw) (atkw(kw, K_NOT))
- X#define some_keyword(kw) (atkw(kw, K_SOME))
- X#define each_keyword(kw) (atkw(kw, K_EACH))
- X#define no_keyword(kw) (atkw(kw, K_NO))
- X#define how_keyword(kw) (atkw(kw, K_HOW))
- X#define share_keyword(kw) (atkw(kw, K_SHARE))
- X
- X#ifdef GFX
- X
- X#define spacefrom_keyword(kw) (atkw(kw, K_SPACEFROM))
- X#define linefrom_keyword(kw) (atkw(kw, K_LINEFROM))
- X#define clearscreen_keyword(kw) (atkw(kw, K_CLEARSCREEN))
- X
- X#endif /* GFX */
- END_OF_FILE
- if test 6116 -ne `wc -c <'abc/ihdrs/i2par.h'`; then
- echo shar: \"'abc/ihdrs/i2par.h'\" unpacked with wrong size!
- fi
- # end of 'abc/ihdrs/i2par.h'
- fi
- if test -f 'abc/lin/i1lta.c' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'abc/lin/i1lta.c'\"
- else
- echo shar: Extracting \"'abc/lin/i1lta.c'\" \(8268 characters\)
- sed "s/^X//" >'abc/lin/i1lta.c' <<'END_OF_FILE'
- X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
- X
- X/* Access and update lists and tables */
- X
- X#include "b.h"
- X#include "bint.h"
- X#include "bobj.h"
- X#include "i1tlt.h"
- X
- X#define INSERT_LIS MESS(100, "inserting in non-list")
- X#define INSERT_RAN MESS(101, "cannot insert in large range")
- X
- X#define REMOVE_LIS MESS(102, "removing from non-list")
- X#define REMOVE_EMPTY MESS(103, "removing from empty list")
- X#define REMOVE_ENTRY MESS(104, "removing non-existent list entry")
- X#define REMOVE_RAN MESS(105, "cannot remove from large range")
- X
- X#define RANGE_BIG MESS(107, "exceedingly large range in display")
- X
- X#define REPLACE_TAB MESS(115, "replacing in non-table")
- X
- X#define KEYS_TAB MESS(116, "in keys t, t is not a table")
- X
- X#define SEL_TAB MESS(117, "in t[k], t is not a table")
- X#define SEL_EMPTY MESS(118, "in t[k], t is empty")
- X#define SEL_KEY MESS(119, "in t[k], k is not a key of t")
- X
- X/* B lists */
- X
- X/* Rangedisplays will be set up as rangelists, only holding lwb and upb
- X * iff they contain more than Minrange elements.
- X * Minrange might even be just 1.
- X */
- X#define Minrange (2)
- X
- XForward value spawn_range();
- X
- XVisible bool is_rangelist(v) value v; {
- X return (bool) Is_range(v);
- X}
- X
- XVisible value list_elem(l, i) value l; intlet i; {
- X return List_elem(l, i);
- X}
- X
- Xextern bool found_ok;
- X
- XVisible insert(v, ll) value v, *ll; {
- X intlet len; register value *lp, *lq;
- X intlet k; register intlet kk;
- X if (!Is_list(*ll)) {
- X interr(INSERT_LIS);
- X return;
- X }
- X if (Is_range(*ll)) {
- X value l = spawn_range(Lwb(*ll), Upb(*ll));
- X if (l == Vnil) {
- X interr(INSERT_RAN);
- X return;
- X }
- X release((value)(*ll));
- X *ll = l;
- X }
- X len= Length(*ll);
- X VOID found(list_elem, *ll, v, &k);
- X if (!found_ok) return;
- X if (Unique(*ll) && !Is_ELT(*ll)) {
- X xtndlt(ll, 1);
- X lq= Ats(*ll)+len; lp= lq-1;
- X for (kk= len; kk > k; kk--) *lq--= *lp--;
- X *lq= copy(v);
- X } else {
- X value w;
- X lp= Ats(*ll);
- X release(*ll);
- X *ll= grab(Lis, ++len);
- X lq= Ats(*ll);
- X for (kk= 0; kk < len; kk++) {
- X w= kk == k ? v : *lp++;
- X *lq++= copy (w);
- X }
- X }
- X}
- X
- XVisible remove(v, ll) value v; value *ll; {
- X register value *lp, *lq;
- X intlet k, len;
- X if (!Is_list(*ll)) {
- X interr(REMOVE_LIS);
- X return;
- X }
- X if (Length(*ll) == 0) {
- X interr(REMOVE_EMPTY);
- X return;
- X }
- X if (Is_range(*ll)) {
- X value l = spawn_range(Lwb(*ll), Upb(*ll));
- X if (l == Vnil) {
- X interr(REMOVE_RAN);
- X return;
- X }
- X release((value)(*ll));
- X *ll = l;
- X }
- X if (!found(list_elem, *ll, v, &k))
- X interr(REMOVE_ENTRY);
- X else {
- X len= Length(*ll);
- X lp= Ats(*ll); /* lp[k] = v */
- X if (Unique(*ll)) {
- X release(*(lp+=k));
- X for (k= k; k < len; k++) {*lp= *(lp+1); lp++;}
- X xtndlt(ll, -1);
- X } else {
- X intlet kk= k;
- X lq= Ats(*ll);
- X release(*ll);
- X *ll= grab(Lis, --len);
- X lp= Ats(*ll);
- X for (k= 0; k < len; k++) {
- X if (k == kk) lq++;
- X *lp++= copy (*lq); lq++;
- X }
- X }
- X }
- X}
- X
- XVisible value rangesize(lwb, upb) value lwb, upb; {
- X value d, r;
- X d = diff(upb, lwb);
- X r = sum(d, one);
- X release(d);
- X return r;
- X}
- X
- XHidden value spawn_range(lo, hi) value lo, hi; {
- X value s;
- X value l, *lp;
- X value v, w;
- X int i;
- X intlet k, len;
- X bool enough_space();
- X
- X if (large(s = rangesize(lo, hi))
- X ||
- X (i = intval(s)) > Maxintlet
- X ||
- X !enough_space(Lis, len = (intlet) i)
- X ) {
- X release(s);
- X return Vnil;
- X }
- X release(s);
- X l = grab(Lis, len);
- X lp = Ats(l);
- X v = copy(lo);
- X for (k= 0; k < len; k++) {
- X *lp++ = copy(v);
- X v = sum(w = v, one);
- X release(w);
- X }
- X release(v);
- X return l;
- X}
- X
- XHidden value mk_numrange(lo, hi) value lo, hi; {
- X value l, r;
- X
- X if (large(r= rangesize(lo, hi)) || intval(r) >= Minrange) {
- X l= grab(Ran, 2);
- X Lwb(l)= copy(lo);
- X Upb(l)= copy(hi);
- X }
- X else {
- X l= spawn_range(lo, hi);
- X if (l == Vnil)
- X interr(RANGE_BIG);
- X }
- X release(r);
- X return l;
- X}
- X
- XHidden value i_range(lo, hi) value lo, hi; {
- X value r, res= Vnil;
- X
- X if (compare(r= rangesize(lo, hi), one) < 0)
- X res= mk_elt();
- X else
- X res= mk_numrange(lo, hi);
- X release(r);
- X
- X return res;
- X}
- X
- XHidden value mk_charrange(a, z) char a, z; {
- X value l= grab(Lis, (intlet) (z-a+1)); register value *ep= Ats(l);
- X char m[2];
- X m[1]= '\0';
- X for (m[0]= a; m[0] <= z; m[0]++) {
- X *ep++= mk_text(m);
- X }
- X return l;
- X}
- X
- XHidden value c_range(lo, hi) value lo, hi; {
- X char a, z;
- X
- X a= charval(lo); z= charval(hi);
- X if (z <= a-1) return mk_elt();
- X else return mk_charrange(a, z);
- X}
- X
- XVisible value mk_range(v1, v2) value v1, v2; {
- X if (Is_text(v1)) return c_range(v1, v2);
- X else return i_range(v1, v2);
- X}
- X
- XVisible relation range_comp(v, w) value v, w; {
- X /* Type(v) == Ran || Type(w) == Ran, and other type Is_list */
- X relation ci, cs;
- X value s, vs, ws, i, vi, wi, k;
- X
- X if (Is_range(v) && Is_range(w)) {
- X ci = compare(Lwb(v), Lwb(w));
- X if (ci == 0)
- X ci = compare(Upb(v), Upb(w));
- X }
- X else {
- X i = copy(one);
- X vs = size(v); ws = size(w);
- X if ((cs = compare(vs, ws)) <= 0)
- X s = copy(vs);
- X else
- X s = copy(ws);
- X release(vs); release(ws);
- X ci = 0; /* for ELT */
- X while (numcomp(i, s) <= 0) {
- X vi = item(v, i); wi = item(w, i);
- X ci = compare(vi, wi);
- X release(vi); release(wi);
- X if (ci != 0)
- X break;
- X i = sum(k=i, one);
- X release(k);
- X }
- X release(i); release(s);
- X if (ci == 0)
- X ci = cs;
- X }
- X return ci;
- X}
- X/**********************************************************************/
- X
- X/* B tables */
- X
- XVisible value* key(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */
- X return Key(v, k);
- X}
- X
- XVisible value* assoc(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */
- X return Assoc(v, k);
- X}
- X
- XVisible value associate(v, k) value v; value k; {
- X value *p= adrassoc(v, k);
- X if (p != Pnil) return copy(*p);
- X interr(SEL_KEY);
- X return Vnil;
- X}
- X
- XVisible value keys(ta) value ta; {
- X
- X if(!Is_table(ta)) {
- X interr(KEYS_TAB);
- X return grab(Lis, 0);
- X } else {
- X value li= grab(Lis, Length(ta)), *le, *te= (value *)Ats(ta);
- X int k, len= Length(ta);
- X le= (value *)Ats(li);
- X for (k= 0; k < len; k++) { *le++= copy(Cts(*te)); te++; }
- X return li;
- X }
- X}
- X
- XVisible value key_elem(t, i) value t; intlet i; { /*The key of the i-th entry*/
- X return *Key(t, i);
- X}
- X
- X/* adrassoc returns a pointer to the associate, rather than
- X the associate itself, so that the caller can decide if a copy
- X should be taken or not. If the key is not found, Pnil is returned. */
- XVisible value* adrassoc(t, ke) value t, ke; {
- X intlet where;
- X if (Type(t) != Tab && Type(t) != ELT) {
- X interr(SEL_TAB);
- X return Pnil;
- X }
- X return found(key_elem, t, ke, &where) ? Assoc(t, where) : Pnil;
- X}
- X
- XVisible Procedure uniq_assoc(ta, ke) value ta, ke; {
- X intlet k;
- X if (found(key_elem, ta, ke, &k)) {
- X uniql(Ats(ta)+k);
- X uniql(Assoc(ta,k));
- X } else syserr(MESS(120, "uniq_assoc called for non-existent table entry"));
- X}
- X
- XVisible Procedure replace(v, ta, ke) value *ta, ke, v; {
- X intlet len; value *tp, *tq;
- X intlet k, kk;
- X uniql(ta);
- X if (Type(*ta) == ELT) (*ta)->type = Tab;
- X else if (Type(*ta) != Tab) {
- X interr(REPLACE_TAB);
- X return;
- X }
- X len= Length(*ta);
- X if (found(key_elem, *ta, ke, &k)) {
- X value *a;
- X uniql(Ats(*ta)+k);
- X a= Assoc(*ta, k);
- X /* uniql(a); */
- X release(*a);
- X *a= copy(v);
- X return;
- X } else if (found_ok) {
- X xtndlt(ta, 1);
- X tq= Ats(*ta)+len; tp= tq-1;
- X for (kk= len; kk > k; kk--) *tq--= *tp--;
- X *tq= grab(Com, 2);
- X Cts(*tq)= copy(ke);
- X Dts(*tq)= copy(v);
- X }
- X}
- X
- XVisible bool in_keys(ke, tl) value ke, tl; {
- X intlet dummy;
- X if (Type(tl) == ELT) return No;
- X if (Type(tl) != Tab) syserr(KEYS_TAB);
- X return found(key_elem, tl, ke, &dummy);
- X}
- X
- XVisible Procedure delete(tl, ke) value *tl, ke; {
- X intlet len, k; value *tp;
- X if (Type(*tl) == ELT)
- X syserr(MESS(121, "deleting table entry from empty table"));
- X if (Type(*tl) != Tab)
- X syserr(MESS(122, "deleting table entry from non-table"));
- X tp= Ats(*tl); len= Length(*tl);
- X if (!found(key_elem, *tl, ke, &k))
- X syserr(MESS(123, "deleting non-existent table entry"));
- X if (Unique(*tl)) {
- X release(*(tp+=k));
- X for (k= k; k < len; k++) {*tp= *(tp+1); tp++;}
- X xtndlt(tl, -1);
- X } else {
- X intlet kk; value *tq= Ats(*tl);
- X release(*tl);
- X *tl= grab(Tab, --len);
- X tp= Ats(*tl);
- X for (kk= 0; kk < len; kk++) {
- X *tp++= copy (*tq); tq++;
- X if (kk == k) tq++;
- X }
- X }
- X}
- X
- X#define Len(len) (len < 200 ? len : ((len-1)/8+1)*8)
- X
- XHidden Procedure
- Xxtndlt(a, d)
- X value *a; intlet d;
- X{
- X intlet len= Length(*a); intlet l1= Len(len), l2;
- X len+= d; l2= Len(len);
- X if (l1 != l2) {
- X regrab(a, l2);
- X }
- X (*a)->len= len;
- X}
- X
- END_OF_FILE
- if test 8268 -ne `wc -c <'abc/lin/i1lta.c'`; then
- echo shar: \"'abc/lin/i1lta.c'\" unpacked with wrong size!
- fi
- # end of 'abc/lin/i1lta.c'
- fi
- echo shar: End of archive 16 \(of 25\).
- cp /dev/null ark16isdone
- 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...
-