Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume23/abc/part18

Internet Message Format | 1991-01-08 | 54.3 KB

Subject:  v23i097:  ABC interactive programming environment, Part18/25
Newsgroups: comp.sources.unix
Approved: [e-mail]
X-Checksum-Snefru: 6b39f011 f6c290da 79edface 2b74f748

Submitted-by: Steven Pemberton <[e-mail]>
Posting-number: Volume 23, Issue 97
Archive-name: abc/part18

#! /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 [e-mail] if you want that tool.
# Contents:  abc/bed/e1cell.c abc/bed/e1gram.c abc/bed/e1ins2.c
#   abc/bint1/i1nug.c abc/bint3/i3fpr.c abc/ihdrs/i2nod.h
#   abc/stc/i2tcp.c
# Wrapped by [e-mail] on Mon Dec 17 13:28:14 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 18 (of 25)."'
if test -f 'abc/bed/e1cell.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1cell.c'\"
else
  echo shar: Extracting \"'abc/bed/e1cell.c'\" \(7336 characters\)
  sed "s/^X//" >'abc/bed/e1cell.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Screen management package, cell list manipulation routines.
X */
X
X#include "b.h"
X#include "b0lan.h"
X#include "bedi.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "node.h"
X#include "cell.h"
X#include "args.h"
X
Xextern bool noscroll;
X
X/*
X * Definitions for internals of cell manipulations.
X */
X
XHidden cell *freelist;
X
X#define CELLSIZE (sizeof(cell))
X
X#ifndef PAGESIZE /* 4.2 BSD freaks compile with -DPAGESIZE='getpagesize()' */
X#define PAGESIZE 1024
X#endif
X
X#ifndef MALLOCLOSS
X#define MALLOCLOSS (sizeof(char*))
X    /* number of bytes taken by malloc administration per block */
X#endif
X
X
X/*
X * Replace `oldlcnt' cells from `tops', starting at the one numbered `oldlno',
X * by the list `rep'.
X * Returns a pointer to the deleted chain (with a Nil end pointer).
X */
X
XVisible cell *
Xreplist(tops, rep, oldlno, oldlcnt)
X    cell *tops;
X    cell *rep;
X    int oldlno;
X    register int oldlcnt;
X{
X    cell head;
X    register cell *p;
X    register cell *q;
X    register cell *old;
X    register cell *end;
X    register int diff;
X    int i;
X    int replcnt;
X
X    if (!tops) /* Start with empty list */
X        return rep;
X    head.c_link = tops;
X    p = &head;
X    for (diff = oldlno; diff > 0; --diff) {
X        p = p->c_link;
X        Assert(p);
X    }
X    q = p;
X    for (i = oldlcnt; i > 0 && p; --i)
X        p = p->c_link;
X    if (i > 0) {
X#ifndef NDEBUG
X    if (dflag)
X        debug("[replist jackpot]");
X#endif /* NDEBUG */
X        oldlcnt -= i;
X    }
X    old = q->c_link;
X    q->c_link = rep;
X    if (p) {
X        end = p->c_link;
X        p->c_link = Cnil;
X    }
X    for (replcnt = 0; q->c_link; ++replcnt, q = q->c_link)
X        ;
X    dupmatch(old, rep, oldlcnt, replcnt);
X    discard(old);
X    if (p)
X        q->c_link = end;
X    return head.c_link;
X}
X
X
X/*
X * Allocate a new cell.
X */
X
XHidden cell *
Xnewcell()
X{
X    register cell *p;
X
X    if (!freelist)
X        feedfreelist();
X    p = freelist;
X    freelist = p->c_link;
X    p->c_link = Cnil;
X    return p;
X}
X
X
X/*
X * Feed the free list with a block of new entries.
X * We try to keep them together on a page
X * to keep consecutive accesses fast.
X */
X
XHidden Procedure
Xfeedfreelist()
X{
X    register int n = (PAGESIZE-MALLOCLOSS) / CELLSIZE;
X    register cell *p = (cell*) getmem((unsigned)(n*CELLSIZE));
X#ifdef MEMTRACE
X    fixmem((ptr) p);
X#endif
X    Assert(n > 0);
X    freelist = p;
X    for (; n > 1; --n, ++p)
X        p->c_link = p+1;
X    p->c_link = Cnil;
X}
X
X
X/*
X * Discard all entries of a list of cells.
X */
X
XVisible Procedure
Xdiscard(p)
X    register cell *p;
X{
X    register cell *savefreelist;
X
X    if (!p)
X        return;
X    savefreelist = p;
X    for (;;) {
X        noderelease(p->c_data);
X        p->c_data = Nnil;
X        if (!p->c_link)
X            break;
X        p = p->c_link;
X    }
X    p->c_link = freelist;
X    freelist = savefreelist;
X}
X
X
X/*
X * Replace the `onscreen' fields in the replacement chain by those
X * in the old chain, if they match.
X */
X
XHidden Procedure
Xdupmatch(old, rep, oldcnt, repcnt)
X    register cell *old;
X    register cell *rep;
X    int oldcnt;
X    int repcnt;
X{
X    register int diff = repcnt - oldcnt;
X
X#ifndef NDEBUG
X    if (dflag)
X        debug("[dupmatch(oldcnt=%d, newcnt=%d)]", oldcnt, repcnt);
X#endif /* NDEBUG */
X    while (rep && old) {
X        if (old->c_length == rep->c_length
X            && eqlines(old->c_data, rep->c_data)) {
X            if (old->c_onscreen != Nowhere) {
X                rep->c_onscreen = old->c_onscreen;
X                rep->c_oldindent = old->c_oldindent;
X                rep->c_oldvhole = old->c_oldvhole;
X                rep->c_oldfocus = old->c_oldfocus;
X            }
X            rep = rep->c_link;
X            old = old->c_link;
X        }
X        else {
X            if (diff >= 0) {
X                --diff;
X                rep = rep->c_link;
X            }
X            if (diff < 0) {
X                ++diff;
X                old = old->c_link;
X            }
X        }
X    }
X}
X
X
X/*
X * Build a list of cells consisting of the first `lcnt' lines of the tree.
X */
X
XVisible cell *
Xbuild(p, lcnt)
X    /*auto*/ path p;
X    register int lcnt;
X{
X    cell head;
X    register cell *q = &head;
X
X    p = pathcopy(p);
X    for (;;) {
X        q = q->c_link = newcell();
X        q->c_onscreen = Nowhere;
X        q->c_data = nodecopy(tree(p));
X        q->c_length = linelen(q->c_data);
X        q->c_newindent = Level(p) * INDENTSIZE;
X        q->c_oldindent = 0;
X        q->c_oldvhole = q->c_newvhole = q->c_oldfocus = q->c_newfocus = No;
X        --lcnt;
X        if (lcnt <= 0)
X            break;
X        if (!nextline(&p)) Abort();
X    }
X    q->c_link = Cnil;
X    pathrelease(p);
X    return head.c_link;
X}
X
X
X/*
X * Decide which line is to be on top of the screen.
X * We slide a window through the list of lines, recognizing
X * lines of the focus and lines already on the screen,
X * and stop as soon as we find a reasonable focus position.
X *
X * - The focus must always be on the screen completely;
X *   if it is larger than the screen, its first line must be
X *   on top of the screen.
X * - When old lines can be retained, at least one line above
X *   and below the focus must be shown; the retained lines
X *   should be moved as little as possible.
X * - As little as possible blank space should be shown at the
X *   bottom, even if the focus is at the end of the unit.
X * - If no rule applies, try to center the focus on the screen.
X * - If noscroll is Yes (the terminal can't scroll), and the top
X *   line can't be retained, also try to center the focus on the
X *   screen.
X */
X
XVisible cell *
Xgettop(tops)
X    cell *tops;
X{
X    register cell *pfwa = tops; /* First line of sliding window */
X    register cell *plwa = tops; /* Last+1 line of sliding window */
X    register cell *pffocus = Cnil; /* First line of focus */
X    cell *pscreen = Cnil; /* First line still on screen */
X    register int nfwa = 0; /* Corresponding line numbers in parse tree */
X    register int nlwa = 0;
X    register int nffocus;
X    int nlfocus;
X    int nscreen;
X    int size;
X
X    for (;;) { /* plwa is the current candidate for top line. */
X        if (!pfwa) {
X#ifndef NDEBUG
X            debug("[Lost the focus!]");
X#endif /* NDEBUG */
X            return tops; /* To show *something*... */
X        }
X        while (plwa && nlwa < nfwa+winheight) {
X            /* Find first line *not* in window */
X            size = Space(plwa);
X            if (plwa->c_newfocus) { /* Hit a focus line */
X                if (!pffocus) { /* Note first focus line */
X                    pffocus = plwa;
X                    nffocus = nlwa;
X                }
X                nlfocus = nlwa + size;
X            }
X            if (plwa->c_onscreen != Nowhere) { /* Hello old chap */
X                if (!pscreen) { /* Note first line on screen */
X                    pscreen = plwa;
X                    nscreen = nlwa;
X                }
X            }
X            nlwa += size;
X            plwa = plwa->c_link;
X        }
X        if (pffocus) {
X            /* Focus in sight; stop at first reasonable opportunity */
X            if (pffocus == pfwa)
X                break; /* Grab last chance! */
X            if (!noscroll && nlwa - nfwa <= winheight - winheight/3)
X                break; /* Don't show too much white space at bottom */
X            if (pffocus == pfwa->c_link && nlfocus < nfwa+winheight)
X                break; /* Near top line */
X            if (pscreen && (!noscroll || nffocus > nscreen)) {
X                /* Conservatism may succeed */
X                if (pscreen->c_onscreen >= nscreen - nfwa
X                    && (nlfocus < nfwa+winheight
X                        || !plwa && nlfocus == nfwa+winheight))
X                    break; /* focus entirely on screen */
X            }
X            else { /* No comrades seen */
X                if (nffocus - nfwa <= nfwa+winheight - nlfocus
X                    || !plwa && nlwa <= nfwa+winheight)
X                    break; /* Nicely centered focus or end of unit */
X            }
X        }
X        if (pfwa == pscreen) { /* Say farewell to oldest comrade */
X            pscreen->c_onscreen = Nowhere;
X            do { /* Find next in age */
X                nscreen += Space(pscreen);
X                pscreen = pscreen->c_link;
X                if (pscreen == plwa) {
X                    pscreen = Cnil;
X                    break;
X                }
X            } while (pscreen->c_onscreen == Nowhere);
X        }
X        nfwa += Space(pfwa);
X        pfwa = pfwa->c_link; /* Pass the buck */
X    }
X    return pfwa; /* This is what all those breaks aim at */
X}
END_OF_FILE
  if test 7336 -ne `wc -c <'abc/bed/e1cell.c'`; then
    echo shar: \"'abc/bed/e1cell.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1cell.c'
fi
if test -f 'abc/bed/e1gram.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1gram.c'\"
else
  echo shar: Extracting \"'abc/bed/e1gram.c'\" \(7451 characters\)
  sed "s/^X//" >'abc/bed/e1gram.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- All routines referencing the grammar table are in this file.
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "etex.h"
X#include "bmem.h"
X#include "feat.h"
X#include "bobj.h"
X#include "node.h"
X#include "gram.h"
X#include "supr.h"
X#include "tabl.h"
X#include "code.h"    /* not strictly necessary, only for initcodes() */
X#include "args.h"
X
X/*
X * Test whether sym is in the given class.
X */
X
XVisible bool
Xisinclass(sym, ci)
X    register int sym;
X    struct classinfo *ci;
X{
X    register classptr cp;
X
X    Assert(ci && ci->c_class);
X    if (sym == Hole)
X        return !isinclass(Optional, ci);
X    for (cp = ci->c_class; *cp; ++cp)
X        if (sym == *cp)
X            return Yes;
X    return No;
X}
X
X
X/*
X * Deliver the representation array for the given node.
X * If the node is actually just a "text" value, construct
X * one in static storage -- which is overwritten at each call.
X * In this case there are two deficiencies: the next call to
X * noderepr which uses the same feature overwrites the reply
X * value of the previous call, AND if the text value itself
X * is changed, the representation may change, too.
X * In practical use this is no problem at all, however.
X */
X
XVisible string *
Xnoderepr(n)
X    register node n;
X{
X    register int sym;
X
X    if (n && Is_etext(n)) {
X        static string buf[2];
X        if (buf[0]) e_fstrval(buf[0]);
X        buf[0] = e_sstrval((value)n);
X        return buf;
X    }
X    sym = symbol(n);
X    return table[sym].r_repr;
X}
X
X#ifdef MEMTRACE
XVisible Procedure endnoderepr() { /* hack to free noderepr static store */
X    value v= mk_etext("dummy");
X    string *s= noderepr((node)v);
X    freemem((ptr) s[0]);
X    release(v);
X}
X#endif
X
X/*
X * Deliver the prototype node for the given symbol.
X */
X
XVisible node
Xgram(sym)
X    register int sym;
X{
X    Assert(0 <= sym && sym < TABLEN);
X    return table[sym].r_node;
X}
X
X#ifdef SAVEBUF
X
X/*
X * Deliver the name of a symbol.
X */
X
XVisible string
Xsymname(sym)
X    int sym;
X{
X    static char buf[20];
X
X    if (sym >= 0 && sym < TABLEN && table[sym].r_name)
X        return table[sym].r_name;
X    sprintf(buf, "%d", sym);
X    return buf;
X}
X
X
X/*
X * Find the symbol corresponding to a given name.
X * Return -1 if not found.
X */
X
XVisible int
Xnametosym(str)
X    register string str;
X{
X    register int sym;
X    register string name;
X
X    for (sym = 0; sym < TABLEN; ++sym) {
X        name = table[sym].r_name;
X        if (name && !strcmp(name, str))
X            return sym;
X    }
X    return -1;
X}
X
X#endif /* SAVEBUF */
X
X/*
X * Test whether `sym' may replace the node in the path `p'.
X */
X
XVisible bool
Xallowed(p, sym)
X    register path p;
X    register int sym;
X{
X    register path pa = parent(p);
X    register int ich = ichild(p);
X    register int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
X
X    Assert(sympa >= 0 && sympa < TABLEN && ich > 0 && ich <= MAXCHILD);
X    return isinclass(sym, table[sympa].r_class[ich-1]);
X}
X
X
X/*
X * Initialize (and verify) the grammar table.
X * (sets refcnt to infinity)
X */
X
XVisible Procedure
Xinitgram()
X{
X    register int sym;
X    register int nch;
X    register struct classinfo **cp;
X    register struct classinfo *sp;
X    node ch[MAXCHILD];
X
X#ifndef NDEBUG
X    if (dflag)
X        putstr(DEBUGFILE, "*** initgram();\n");
X#endif /* NDEBUG */
X    /* Set the node pointers in the table and check the representations.
X       The code assumes Optional and Hole are the last
X       symbols in the table, i.e. the first processed by the loop. */
X
X    for (sym = TABLEN-1; sym >= 0; --sym) {
X        cp = table[sym].r_class;
X        for (nch = 0; nch < MAXCHILD && (sp = cp[nch]); ++nch)
X            ch[nch] =
X                table[sp->c_class[0] == Optional ?
X                    Optional : Hole].r_node;
X        table[sym].r_node = newnode(nch, sym, ch);
X        fix_refcnt(table[sym].r_node);
X    }
X    initcodes();
X}
X
X/*
X * Set a node's refcnt to infinity, so it will never be released.
X */
X
XHidden Procedure
Xfix_refcnt(n)
X    register node n;
X{
X    Assert(n->refcnt > 0);
X    n->refcnt = Maxrefcnt;
X#ifdef MEMTRACE
X    fixmem((ptr) n);
X#endif
X}
X
X/*
X * Add built-in commands to the suggestion tables.
X */
X
XVisible Procedure
Xinitclasses()
X{
X#ifdef USERSUGG
X    register struct table *tp;
X
X    tp= &table[Rootsymbol];
X    Assert(isinclass(Suggestion, tp->r_class[0]));
X    makesugg(tp->r_class[0]->c_class);
X#endif /* USERSUGG */
X}
X
X#ifdef USERSUGG
X
X/*
X * Extract suggestions from class list.
X */
X
XHidden Procedure
Xmakesugg(cp)
X    classptr cp;
X{
X    struct table *tp;
X    string *rp;
X    char buffer[1000];
X    string bp;
X    string sp;
X    int i;
X    int nch;
X
X    for (; *cp; ++cp) {
X        if (*cp >= TABLEN)
X            continue;
X        Assert(*cp > 0);
X        tp = &table[*cp];
X        rp = tp->r_repr;
X        if (rp[0] && isupper(rp[0][0])) {
X            bp = buffer;
X            nch = nchildren(tp->r_node);
X            for (i = 0; i <= nch; ++i) {
X                if (rp[i]) {
X                    for (sp = rp[i]; *sp >= ' '; ++sp)
X                        *bp++ = *sp;
X                }
X                if (i < nch && !isinclass(Optional, tp->r_class[i]))
X                    *bp++ = '?';
X            }
X            if (bp > buffer) {
X                *bp = 0;
X                addsugg(buffer, (int) *cp);
X            }
X        }
X    }
X}
X
X#endif /* USERSUGG */
X
X/*
X * Set the root of the grammar to the given symbol.  It must exist.
X */
X
XVisible Procedure
Xsetroot(isym) int isym; {    /* symbols defined in tabl.h */
X    register int ich;
X
X    table[Rootsymbol].r_name = table[isym].r_name;
X    for (ich = 0; ich < MAXCHILD; ++ich) {
X        table[Rootsymbol].r_repr[ich] = table[isym].r_repr[ich];
X        table[Rootsymbol].r_class[ich] = table[isym].r_class[ich];
X    }
X    table[Rootsymbol].r_repr[ich] = table[isym].r_repr[ich];
X    table[Rootsymbol].r_node = table[isym].r_node;
X}
X
X/*
X * The remainder of this file is specific for the currently used grammar.
X */
X
X/*
X * Table indicating which symbols are used to form lists of items.
X * Consulted via predicate 'issublist'.
X */
X
XHidden classelem Asublists[] = {
X    Exp_plus, Formal_naming_plus,
X    And, And_kw, Or, Or_kw,
X    0
X};
X
XHidden struct classinfo sublists[] = {Asublists};
X
X
X/*
X * Predicate telling whether two symbols can form lists together.
X * This is important for list whose elements must alternate in some
X * way, as is the case for [KEYWORD [expression] ]*.
X *
X * This code must be in this file, otherwise the names and values
X * of the symbols would have to be made public.
X */
X
XVisible bool
Xsamelevel(sym, sym1)
X    register int sym;
X    register int sym1;
X{
X    register int zzz;
X
X    if (sym1 == sym)
X        return Yes;
X    if (sym1 < sym)
X        zzz = sym, sym = sym1, sym1 = zzz; /* Ensure sym <= sym1 */
X    /* Now always sym < sym1 */
X    return sym == Kw_plus && sym1 == Exp_plus
X        || sym == Formal_kw_plus && sym1 == Formal_naming_plus
X        || sym == And && sym1 == And_kw
X        || sym == Or && sym1 == Or_kw;
X}
X
X
X/*
X * Predicate to tell whether a symbol can form chained lists.
X * By definition, all right-recursive symbols can do so;
X * in addition, those listed in the class 'sublists' can do
X * it, too (this is used for lists formed of alternating members
X * such as KW expr KW ...).
X */
X
XVisible bool
Xissublist(sym)
X    register int sym;
X{
X    register int i;
X    register string repr;
X
X    Assert(sym < TABLEN);
X    if (isinclass(sym, sublists))
X        return Yes;
X    repr = table[sym].r_repr[0];
X    if (Fw_positive(repr))
X        return No;
X    for (i = 0; i < MAXCHILD && table[sym].r_class[i]; ++i)
X        ;
X    if (i <= 0)
X        return No;
X    repr = table[sym].r_repr[i];
X    if (!Fw_zero(repr))
X        return No;
X    return isinclass(sym, table[sym].r_class[i-1]);
X}
X
X/* true iff parent allows a command with a colon (a control-command);
X * this is false for grammar constructs allowing simple-commands
X * following a colon.
X * sym == symbol(tree(parent(ep->focus)))
X */
XVisible bool allows_colon(sym) int sym; {
X    switch (sym) {
X    case Short_comp:
X    case Test_suite:
X    case Short_unit:
X    case Refinement:
X        return No;
X    default:
X        return Yes;
X    }
X    /*NOTREACHED*/
X}
END_OF_FILE
  if test 7451 -ne `wc -c <'abc/bed/e1gram.c'`; then
    echo shar: \"'abc/bed/e1gram.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1gram.c'
fi
if test -f 'abc/bed/e1ins2.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1ins2.c'\"
else
  echo shar: Extracting \"'abc/bed/e1ins2.c'\" \(7384 characters\)
  sed "s/^X//" >'abc/bed/e1ins2.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Insert characters from keyboard.
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "etex.h"
X#include "bobj.h"
X#include "node.h"
X#include "supr.h"
X#include "queu.h"
X#include "gram.h"
X#include "tabl.h"
X
X/*
X * Insert a character.
X */
X
Xextern bool justgoon;
X
XHidden bool quot_in_tag(c, ep) int c; environ *ep; {
X    /* hack to not surround part of name or keyword;
X     * fixes bug 890417
X     */
X    int sym= symbol(tree(ep->focus));
X
X    return (ep->s2 > 0 &&
X        ((char)c == '\'' || (char)c == '\"')
X        &&
X        (sym == Name || sym == Keyword));
X}
X
XVisible bool
Xins_char(ep, c, alt_c)
X    register environ *ep;
X    int c;
X    int alt_c;
X{
X    auto queue q = Qnil;
X    auto queue qf = Qnil;
X    value copyout();
X    auto string str;
X    char buf[2];
X    int where;
X    bool spwhere;
X
X    if (!justgoon) {
X        higher(ep);
X        shrink(ep);
X        if (strchr("({[`'\"", (char)c)
X            && !ishole(ep)
X            && !quot_in_tag(c, ep)) {
X            /* Surround something.  Wonder what will happen! */
X            qf = (queue) copyout(ep);
X            if (!delbody(ep)) {
X                qrelease(qf);
X                return No;
X            }
X        }
X        fixit(ep);
X    }
X    ep->changed = Yes;
X    buf[0] = c;
X    buf[1] = 0;
X    if (!ins_string(ep, buf, &q, alt_c))
X        return No;
X    if (!emptyqueue(q) || !emptyqueue(qf)) {
X        /* Slight variation on app_queue */
X        if (!emptyqueue(qf) && emptyqueue(q))
X            ritevhole(ep); /* Wizardry.  Why does this work? */
X        spwhere = ep->spflag;
X        ep->spflag = No;
X        where = focoffset(ep);
X        markpath(&ep->focus, 1);
X        ep->spflag = spwhere;
X        if (ep->mode == FHOLE && ep->s2 > 0) {
X            /* If we just caused a suggestion, insert the remains
X               after the suggested text, not after its first character. */
X            str = "";
X            if (!soften(ep, &str, 0)) {
X                ep->mode = ATEND;
X                leftvhole(ep);
X                if (symbol(tree(ep->focus)) == Hole) {
X                    ep->mode = ATBEGIN;
X                    leftvhole(ep);
X                }
X            }
X        }
X        if (!emptyqueue(q)) { /* Re-insert stuff queued by ins_string */
X            if (!ins_queue(ep, &q, &q))
X                return No;
X            where += spwhere;
X            spwhere = No;
X        }
X        if (!emptyqueue(qf)) { /* Re-insert deleted old focus */
X            if (!firstmarked(&ep->focus, 1)) Abort();
X            fixfocus(ep, where);
X            if (!ins_queue(ep, &qf, &qf))
X                return No;
X        }
X        if (!firstmarked(&ep->focus, 1)) Abort();
X        unmkpath(&ep->focus, 1);
X        ep->spflag = No;
X        fixfocus(ep, where + spwhere);
X    }
X    return Yes;
X}
X
X
X/*
X * Insert a newline.
X */
X
XVisible bool
Xins_newline(ep)
X    register environ *ep;
X{
X    register node n;
X    register int sym;
X    auto bool mayindent;
X
X    ep->changed = Yes;
X    if (!fiddle(ep, &mayindent))
X        return No;
X    for (;;) {
X        switch (ep->mode) {
X
X        case VHOLE:
X            ep->mode = ATEND;
X            continue;
X
X        case FHOLE:
X            ep->s2 = lenitem(ep);
X            if (!fix_move(ep))
X                return No;
X            continue;
X
X        case ATEND:
X            if (!joinstring(&ep->focus, "\n", No, 0, mayindent)) {
X                if (!move_on(ep))
X                    return No;
X                continue;
X            }
X            s_downi(ep, 2);
X            s_downi(ep, 1);
X            ep->mode = WHOLE;
X            Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
X            return Yes;
X
X        case ATBEGIN:
X            n = tree(ep->focus);
X            if (Is_etext(n)) {
X                ep->mode = ATEND;
X                continue;
X            }
X            sym = symbol(n);
X            if (sym == Hole || sym == Optional) {
X                ep->mode = WHOLE;
X                continue;
X            }
X            n = nodecopy(n);
X            if (!fitstring(&ep->focus, "\n", 0)) {
X                if (!down(&ep->focus))
X                    ep->mode = ATEND;
X                noderelease(n);
X                continue;
X            }
X            s_downrite(ep);
X            if (fitnode(&ep->focus, n)) {
X                noderelease(n);
X                s_up(ep);
X                s_down(ep);
X                ep->mode = WHOLE;
X                return Yes;
X            }
X            s_up(ep);
X            s_down(ep);
X            if (!fitnode(&ep->focus, n)) {
X                noderelease(n);
X#ifndef NDEBUG
X                debug("[Sorry, I don't see how to insert a newline here]");
X#endif /* NDEBUG */
X                return No;
X            }
X            noderelease(n);
X            ep->mode = ATBEGIN;
X            return Yes;
X
X        case WHOLE:
X            Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
X            if (!fitstring(&ep->focus, "\n", 0)) {
X                ep->mode = ATEND;
X                continue;
X            }
X            s_downi(ep, 1);
X            Assert((sym = symbol(tree(ep->focus))) == Hole || sym == Optional);
X            ep->mode = WHOLE;
X            return Yes;
X
X        default:
X            Abort();
X
X        }
X    }
X}
X
X
X/*
X * Refinement for ins_newline() to do the initial processing.
X */
X
XHidden bool
Xfiddle(ep, pmayindent)
X    register environ *ep;
X    bool *pmayindent;
X{
X    register int level;
X    auto string str = "";
X
X    higher(ep);
X    while (rnarrow(ep))
X        ;
X    fixit(ep);
X    VOID soften(ep, &str, 0);
X    higher(ep);
X    *pmayindent = Yes;
X    if (atdedent(ep)) {
X        *pmayindent = No;
X        s_up(ep);
X        level = Level(ep->focus);
X        delfocus(&ep->focus);
X        if (symbol(tree(ep->focus)) == Hole) {
X            if (hackhack(ep))
X                return Yes;
X        }
X        while (Level(ep->focus) >= level) {
X            if (!nexthole(ep)) {
X                ep->mode = ATEND;
X                break;
X            }
X        }
X        if (ep->mode == ATEND) {
X            leftvhole(ep);
X            ep->mode = ATEND;
X            while (Level(ep->focus) >= level) {
X                if (!up(&ep->focus))
X                    return No;
X            }
X        }
X        return Yes;
X    }
X    else if (atrealhole(ep))
X        return No;
X    return Yes;
X}
X
X
X/*
X * "Hier komen de houthakkers."
X *
X * Incredibly ugly hack to delete a join whose second child begins with \n,
X * such as a suite after an IF, FOR or WHILE or  unit heading.
X * Inspects the parent node.
X * If this has rp[0] ands rp[1] both empty, replace it by its first child.
X * (caller assures this makes sense).
X * Return Yes if this happened AND rp[1] contained a \t.
X */
X
XHidden Procedure
Xhackhack(ep)
X    environ *ep;
X{
X    node n;
X    int ich = ichild(ep->focus);
X    string *rp;
X
X    if (!up(&ep->focus))
X        return No;
X    higher(ep);
X    rp = noderepr(tree(ep->focus));
X    if (!Fw_zero(rp[0]) || !Fw_zero(rp[1])) {
X        s_downi(ep, ich);
X        return No;
X    }
X    n = nodecopy(firstchild(tree(ep->focus)));
X    delfocus(&ep->focus);
X    treereplace(&ep->focus, n);
X    ep->mode = ATEND;
X    return rp[1] && rp[1][0] == '\t';
X}
X
X
X/*
X * Refinement for fiddle() to find out whether we are at a possible
X * decrease-indentation position.
X */
X
XHidden bool
Xatdedent(ep)
X    register environ *ep;
X{
X    register path pa;
X    register node npa;
X    register int i;
X    register int sym = symbol(tree(ep->focus));
X
X    if (sym != Hole && sym != Optional)
X        return No;
X    if (ichild(ep->focus) != 1)
X        return No;
X    switch (ep->mode) {
X    case FHOLE:
X        if (ep->s1 != 1 || ep->s2 != 0)
X            return No;
X        break;
X    case ATBEGIN:
X    case WHOLE:
X    case SUBSET:
X        break;
X    default:
X        return No;
X    }
X    pa = parent(ep->focus);
X    if (!pa)
X        return No;
X    npa = tree(pa);
X    if (fwidth(noderepr(npa)[0]) >= 0)
X        return No;
X    for (i = nchildren(npa); i > 1; --i) {
X        sym = symbol(child(npa, i));
X        if (sym != Hole && sym != Optional)
X            return No;
X    }
X    return Yes; /* Sigh! */
X}
X
X/*
X * Refinement for ins_node() and fiddle() to find the next hole,
X * skipping blank space only.
X */
X
XHidden bool
Xnexthole(ep)
X    register environ *ep;
X{
X    register node n;
X    register int ich;
X    register string repr;
X
X    do {
X        ich = ichild(ep->focus);
X        if (!up(&ep->focus))
X            return No;
X        higher(ep);
X        n = tree(ep->focus);
X        repr = noderepr(n)[ich];
X        if (!Fw_zero(repr) && !allspaces(repr))
X            return No;
X    } while (ich >= nchildren(n));
X    s_downi(ep, ich+1);
X    return Yes;
X}
X
XHidden int atrealhole(ep) environ *ep; {
X    node n;
X    int i;
X
X    n= tree(ep->focus);
X
X    if (symbol(n) == Hole)
X        return Yes;
X    if (ep->mode == FHOLE
X        && strlen(noderepr(n)[i= ep->s1/2]) <= ep->s2) {
X        if (i < nchildren(n)) {
X            n= child(n, i+1);
X            if (Is_etext(n))
X                return No;
X            if (symbol(n) == Hole
X                || symbol(n) == Exp_plus
X                   && symbol(child(n, 1)) == Hole
X               )
X                return Yes;
X        }
X    }
X    return No;
X}
END_OF_FILE
  if test 7384 -ne `wc -c <'abc/bed/e1ins2.c'`; then
    echo shar: \"'abc/bed/e1ins2.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1ins2.c'
fi
if test -f 'abc/bint1/i1nug.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint1/i1nug.c'\"
else
  echo shar: Extracting \"'abc/bint1/i1nug.c'\" \(4268 characters\)
  sed "s/^X//" >'abc/bint1/i1nug.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1988. */
X
X#include "b.h"
X#include "feat.h"     /* for EXT_RANGE */
X#include "bobj.h"
X#include "i1num.h"
X
X
X/*
X * Routines for greatest common divisor calculation
X * "Binary gcd algorithm"
X *
X * Assumptions about built-in arithmetic:
X * x>>1 == x/2  (if x >= 0)
X * 1<<k == 2**k (if it fits in a word)
X */
X
X/* Single-precision gcd for integers > 0 */
X
XHidden digit dig_gcd(u, v) register digit u, v; {
X    register digit temp;
X    register int k = 0;
X
X    if (u <= 0 || v <= 0) syserr(MESS(900, "dig_gcd of number(s) <= 0"));
X
X    while (Even(u) && Even(v)) ++k, u >>= 1, v >>= 1;
X
X    /* u or v is odd */
X
X    while (Even(u)) u >>= 1;
X
X    while (v) {
X        /* u is odd */
X
X        while (Even(v)) v >>= 1;
X
X        /* u and v odd */
X
X        if (u > v) { temp = v; v = u - v; u = temp; }
X        else v = v - u;
X
X        /* u is odd and v even */
X    }
X
X    return u * (1<<k);
X}
X
XVisible integer int_half(v) integer v; {
X    register int i;
X    register long carry;
X
X    if (IsSmallInt(v))
X        return (integer) MkSmallInt(SmallIntVal(v) / 2);
X
X    if (Msd(v) < 0) {
X        i = Length(v)-2;
X        if (i < 0) {
X            Release(v);
X            return int_0;
X        }
X        carry = BASE;
X    }
X    else {
X        carry = 0;
X        i = Length(v)-1;
X    }
X
X    if (Refcnt(v) > 1) uniql((value *) &v);
X
X    for (; i >= 0; --i) {
X        carry += Digit(v,i);
X        Digit(v,i) = carry/2;
X        carry = carry&1 ? BASE : 0;
X    }
X
X    return int_canon(v);
X}
X
X/*
X * u or v is a smallint
X * call int_mod() to make the other smallint too
X * call dig_gcd()
X * multiply with twopow
X */
X
XHidden integer gcd_small(u, v, twopow) integer u, v, twopow; {
X    integer g;
X
X    if (!IsSmallInt(u) && !IsSmallInt(v))
X        syserr(MESS(901, "gcd_small of numbers > smallint"));
X
X    if (!IsSmallInt(v))
X        { g = u; u = v; v = g; }
X    if (v == int_0)
X        g = (integer) Copy(u);
X    else if (v == int_1)
X        g = int_1;
X    else {
X        u= IsSmallInt(u) ? (integer) Copy(u) : int_mod(u, v);
X        if (u == int_0)
X            g = (integer) Copy(v);
X        else if (u == int_1)
X            g = int_1;
X        else  g= (integer) MkSmallInt(
X            dig_gcd(SmallIntVal(u), SmallIntVal(v)));
X        Release(u);
X    }
X
X    g = int_prod(u= g, twopow);
X    Release(u);
X
X    if (interrupted && g == int_0)
X        { Release(g); g = int_1; }
X    return g;
X}
X
XHidden int lwb_lendiff = (3 / tenlogBASE) + 1;
X
X#define Modgcd(u, v) (Length(u) - Length(v) > lwb_lendiff)
X
X/* Multi-precision gcd of integers > 0 */
X
XVisible integer int_gcd(u1, v1) integer u1, v1; {
X    integer t, u, v;
X    integer twopow= int_1;
X    long k = 0;
X
X    if (Msd(u1) <= 0 || Msd(v1) <= 0)
X        syserr(MESS(902, "gcd of number(s) <= 0"));
X
X    if (IsSmallInt(u1) || IsSmallInt(v1))
X        return gcd_small(u1, v1, int_1);
X
X    u = (integer) Copy(u1);
X    v = (integer) Copy(v1);
X
X    if (int_comp(u, v) < 0)
X        { t = u; u = v; v = t; }
X
X    while (Modgcd(u, v)) {
X        t = int_mod(u, v); /* u > v > t >= 0 */
X        Release(u);
X        u = v;
X        v = t;
X        if (IsSmallInt(v))
X            goto smallint;
X    }
X
X
X    while (Even(Lsd(u)) && Even(Lsd(v))) {
X        u = int_half(u);
X        v = int_half(v);
X        if (++k < 0) {
X            /*It's a number we can't cope with,
X              with too many common factors 2.
X              Though the user can't help it,
X              the least we can do is to allow
X              continuation of the session.
X            */
X            interr(MESS(903, "exceptionally large rational number"));
X            k = 0;
X        }
X    }
X
X    t= mk_int((double) k);
X    twopow= (integer) power((value) int_2, (value) t);
X    Release(t);
X
X    if (IsSmallInt(v))
X        goto smallint;
X
X    while (Even(Lsd(u)))
X        u = int_half(u);
X
X    if (IsSmallInt(u))
X        goto smallint;
X
X    /* u is odd */
X
X    while (v != int_0) {
X
X        while (Even(Lsd(v)))
X            v = int_half(v);
X
X        if (IsSmallInt(v))
X            goto smallint;
X
X        /* u and v are odd */
X
X        if (int_comp(u, v) > 0) {
X            if (Modgcd(u, v))
X                t = int_mod(u, v); /* u>v>t>=0 */
X                /* t can be odd */
X            else
X                t = int_diff(u, v);
X                /* t is even */
X            Release(u);
X            u = v;
X            v = t;
X        }
X        else {
X            if (Modgcd(v, u))
X                t = int_mod(v, u); /* v>u>t>=0 */
X                /* t can be odd */
X            else
X                t = int_diff(v, u);
X                /* t is even */
X            Release(v);
X            v = t;
X        }
X        /* u is odd
X         * v can be odd too, but in that case is the new value
X         * smaller than the old one
X         */
X    }
X
X    Release(v);
X
X    u = int_prod(v = u, twopow);
X    Release(v); Release(twopow);
X
X    if (interrupted && u == int_0)
X        { Release(u); u = int_1; }
X    return u;
X
Xsmallint:
X    t = gcd_small(u, v, twopow);
X    Release(u); Release(v); Release(twopow);
X
X    return t;
X}
END_OF_FILE
  if test 4268 -ne `wc -c <'abc/bint1/i1nug.c'`; then
    echo shar: \"'abc/bint1/i1nug.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint1/i1nug.c'
fi
if test -f 'abc/bint3/i3fpr.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint3/i3fpr.c'\"
else
  echo shar: Extracting \"'abc/bint3/i3fpr.c'\" \(7591 characters\)
  sed "s/^X//" >'abc/bint3/i3fpr.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* B formula/predicate invocation */
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "b0lan.h"
X#include "i1num.h"
X#include "i2par.h"
X#include "i3sou.h"
X
X#define Other 0
X#define Nume 1        /* e.g. number1 + number2 */
X#define Adjust 5    /* e.g. v >< number2 */
X#define Numpair 2    /* e.g. angle(x,y) has numeric pair */
X#define Nonzero 3    /* e.g. 0 sin x undefined */
X#define Textual 4    /* e.g. stripped t */
X
X#define Xact 0
X#define In 1
X#define Not_in 2
X
X/*
X * Table defining all predefined functions (but not propositions).
X */
X
Xstruct funtab {
X    string f_name; literal f_adic, f_kind;
X    value    (*f_fun)();
X    char /* bool */ f_extended;
X} funtab[] = {
X    {S_ABOUT,    Mfd, Nume, approximate},
X    {S_PLUS,    Mfd, Nume, copy},
X    {S_PLUS,    Dfd, Nume, sum},
X    {S_MINUS,    Mfd, Nume, negated},
X    {S_MINUS,    Dfd, Nume, diff},
X    {S_NUMERATOR,    Mfd, Nume, numerator},
X    {S_DENOMINATOR,    Mfd, Nume, denominator},
X
X    {S_TIMES,    Dfd, Nume, prod},
X    {S_OVER,    Dfd, Nume, quot},
X    {S_POWER,    Dfd, Nume, power},
X
X    {S_BEHEAD,    Dfd, Other, behead},
X    {S_CURTAIL,    Dfd, Other, curtail},
X    {S_JOIN,    Dfd, Other, concat},
X    {S_REPEAT,    Dfd, Other, repeat},
X    {S_LEFT_ADJUST,    Dfd, Adjust, adjleft},
X    {S_CENTER,    Dfd, Adjust, centre},
X    {S_RIGHT_ADJUST, Dfd, Adjust, adjright},
X
X    {S_NUMBER,    Mfd, Other, size},
X    {S_NUMBER,    Dfd, Other, size2},
X
X    {F_pi,        Zfd, Other, pi},
X    {F_e,        Zfd, Other, e},
X    {F_now,        Zfd, Other, nowisthetime},
X
X    {F_abs,        Mfd, Nume, absval},
X    {F_sign,       Mfd, Nume, signum},
X    {F_floor,      Mfd, Nume, floorf},
X    {F_ceiling,    Mfd, Nume, ceilf},
X    {F_round,      Mfd, Nume, round1},
X    {F_round,      Dfd, Nume, round2},
X    {F_mod,        Dfd, Nume, mod},
X    {F_root,       Mfd, Nume, root1},
X    {F_root,       Dfd, Nume, root2},
X    {F_random,     Zfd, Nume, random},
X
X    {F_exactly,    Mfd, Nume, exactly},
X
X    {F_sin,        Mfd, Nume, sin1},
X    {F_cos,     Mfd, Nume, cos1},
X    {F_tan,        Mfd, Nume, tan1},
X    {F_arctan,    Mfd, Nume, arctan1},
X    {F_angle,    Mfd, Numpair, angle1},
X    {F_radius,    Mfd, Numpair, radius},
X
X    {F_sin,        Dfd, Nonzero, sin2},
X    {F_cos,     Dfd, Nonzero, cos2},
X    {F_tan,     Dfd, Nonzero, tan2},
X    {F_arctan,    Dfd, Nume, arctan2},
X    {F_angle,    Dfd, Numpair, angle2},
X
X    {F_exp,        Mfd, Nume, exp1},
X    {F_log,        Mfd, Nume, log1},
X    {F_log,        Dfd, Nume, log2},
X
X    {F_stripped,    Mfd, Textual, stripped},
X    {F_split,    Mfd, Textual, split},
X    {F_upper,    Mfd, Textual, upper},
X    {F_lower,    Mfd, Textual, lower},
X
X    {F_keys,    Mfd, Other, keys},
X#ifdef B_COMPAT
X    {F_thof,     Dfd, Other, th_of},
X#endif
X    {F_item,     Dfd, Other, item},
X    {F_min,      Mfd, Other, min1},
X    {F_min,      Dfd, Other, min2},
X    {F_max,      Mfd, Other, max1},
X    {F_max,      Dfd, Other, max2},
X    {F_choice,     Mfd, Other, choice},
X    {"",         Dfd, Other, NULL} /*sentinel*/
X};
X
XVisible Procedure initfpr() {
X    struct funtab *fp; value r, f, pname;
X
X    for (fp= funtab; *(fp->f_name) != '\0'; ++fp) {
X        /* Define function */
X        r= mk_text(fp->f_name);
X        f= mk_fun(fp->f_adic, (intlet) (fp-funtab), NilTree, Yes);
X        pname= permkey(r, fp->f_adic);
X        def_unit(pname, f);
X        release(f); release(r); release(pname);
X    }
X
X    defprd(P_exact, Mpd, Xact);
X    defprd(P_in, Dpd, In);
X    defprd(P_notin, Dpd, Not_in);
X}
X
XHidden Procedure defprd(repr, adic, pre) string repr; literal adic; intlet pre; {
X    value r= mk_text(repr), p= mk_prd(adic, pre, NilTree, Yes), pname;
X    pname= permkey(r, adic);
X    def_unit(pname, p);
X    release(p); release(r); release(pname);
X}
X
X/* returns if a given test/yield exists *without faults* */
XHidden bool is_funprd(t, f, adicity, func) value t, *f; literal adicity; bool func; {
X    value *aa;
X    *f= Vnil;
X    if (!Valid(t) || !Is_text(t))
X        return No;
X    if (!is_unit(t, adicity, &aa)) return No;
X    if (still_ok) {
X        if (func) {
X            if (!Is_function(*aa)) return No;
X        } else {
X            if (!Is_predicate(*aa)) return No;
X        }
X        *f= *aa; return Yes;
X    } else return No;
X}
X
XVisible bool is_zerfun(t, f) value t, *f; {
X    return is_funprd(t, f, Zfd, Yes);
X}
X
XVisible bool is_monfun(t, f) value t, *f; {
X    return is_funprd(t, f, Mfd, Yes);
X}
X
XVisible bool is_dyafun(t, f) value t, *f; {
X    return is_funprd(t, f, Dfd, Yes);
X}
X
XVisible bool is_zerprd(t, p) value t, *p; {
X    return is_funprd(t, p, Zpd, No);
X}
X
XVisible bool is_monprd(t, p) value t, *p; {
X    return is_funprd(t, p, Mpd, No);
X}
X
XVisible bool is_dyaprd(t, p) value t, *p; {
X    return is_funprd(t, p, Dpd, No);
X}
X
X/* the following is a boolean function or predicate for the static type check,
X * telling whether a certain name was overwritten by a how-to
X * definition of the user.
X * unlike the above one's this one doesn't load the definition if it
X * is not in memory.
X */
X
XVisible bool is_udfpr(name, type) value name; literal type; {
X    value pname;
X    bool res;
X    value *aa;
X
X    pname= permkey(name, type);
X    res= p_exists(pname, &aa);
X    release(pname);
X    return res;
X}
X
X#define Is_numpair(v) (Is_compound(v) && Nfields(v) == 2 && \
X            Is_number(*Field(v, 0)) && Is_number(*Field(v, 1)))
X
XVisible value pre_fun(nd1, pre, nd2) value nd1, nd2; intlet pre; {
X    struct funtab *fp= &funtab[pre];
X    literal adic= fp->f_adic, kind= fp->f_kind;
X    value name= mk_text(fp->f_name);
X    switch (adic) {
X    case Dfd:
X        if ((kind==Nume||kind==Numpair||kind==Nonzero) && !Is_number(nd1)) {
X    interrV(MESS(3200, "in x %s y, x is not a number"), name);
X            release(name);
X            return Vnil;
X        }
X        else if ((kind==Nume||kind==Nonzero||kind==Adjust)
X             && !Is_number(nd2)) {
X    interrV(MESS(3201, "in x %s y, y is not a number"), name);
X            release(name);
X            return Vnil;
X        }
X        else if (kind==Numpair && !Is_numpair(nd2)) {
X    interrV(MESS(3202, "in x %s y, y is not a compound of two numbers"), name);
X            release(name);
X            return Vnil;
X        } else if (kind==Nonzero && numcomp(nd1, zero)==0) {
X    interrV(MESS(3203,"in c %s x, c is zero"), name);
X            release(name);
X            return Vnil;
X        }
X        break;
X    case Mfd:
X        switch (kind) {
X        case Nume:
X            if (!Is_number(nd2)) {
X    interrV(MESS(3204, "in %s x, x is not a number"), name);
X                release(name);
X                return Vnil;
X            }
X            break;
X        case Numpair:
X            if (!Is_numpair(nd2)) {
X    interrV(MESS(3205, "in %s y, y is not a compound of two numbers"), name);
X                release(name);
X                return Vnil;
X            }
X            break;
X        case Textual:
X            if (!Is_text(nd2)) {
X    interrV(MESS(3206, "in %s t, t is not a text"), name);
X                release(name);
X                return Vnil;
X            }
X            break;
X        }
X        break;
X    }
X    release(name);
X
X    switch (adic) {
X    case Zfd: return((*fp->f_fun)());
X    case Mfd:
X        if (fp->f_kind == Numpair)
X            return((*fp->f_fun)(*Field(nd2,0), *Field(nd2,1)));
X        else
X            return((*fp->f_fun)(nd2));
X    case Dfd:
X        if (fp->f_kind == Numpair)
X            return((*fp->f_fun)(nd1, *Field(nd2,0), *Field(nd2,1)));
X        else
X            return((*fp->f_fun)(nd1, nd2));
X    default: syserr(MESS(3207, "pre-defined fpr wrong"));
X         /*NOTREACHED*/
X    }
X}
X
XVisible bool pre_prop(nd1, pre, nd2) value nd1, nd2; intlet pre; {
X    switch (pre) {
X    case Xact:
X        if (!Is_number(nd2)) {
X        interr(MESS(3208, "in the test exact x, x is not a number"));
X            return No;
X        }
X        return exact(nd2);
X    case In:
X        if (!Is_tlt(nd2)) {
Xinterr(MESS(3209, "in the test e in t, t is not a text list or table"));
X            return No;
X        }
X        if (Is_text(nd2) && (!character(nd1))) {
X            interr(
XMESS(3210, "in the test e in t, t is a text, but e is not a character")
X            );
X            return No;
X        }
X        return in(nd1, nd2);
X    case Not_in:
X        if (!Is_tlt(nd2)) {
X            interr(
XMESS(3211, "in the test e not.in t, t is not a text list or table"));
X            return No;
X        }
X        if (Is_text(nd2) && (!character(nd1))) {
X            interr(
XMESS(3212, "in the test e not.in t, t is a text, but e isn't a character")
X            );
X            return No;
X        }
X        return !in(nd1, nd2);
X    default:
X        syserr(MESS(3213, "predicate not covered by proposition"));
X        /*NOTREACHED*/
X    }
X}
END_OF_FILE
  if test 7591 -ne `wc -c <'abc/bint3/i3fpr.c'`; then
    echo shar: \"'abc/bint3/i3fpr.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint3/i3fpr.c'
fi
if test -f 'abc/ihdrs/i2nod.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/ihdrs/i2nod.h'\"
else
  echo shar: Extracting \"'abc/ihdrs/i2nod.h'\" \(7578 characters\)
  sed "s/^X//" >'abc/ihdrs/i2nod.h' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* Units */
X
Xtypedef intlet typenode;
X
X#define _Nodetype(len)     ((len) & 0377)
X#define _Nbranches(len)  ((len) >> 8)
X#define Nodetype(v)   _Nodetype((v)->len)
X#define Nbranches(v)  _Nbranches((v)->len)
X#define Branch(v, n)  ((Ats(v)+(n)))
X
X#define Unit(n)       (n>=HOW_TO && n<=REFINEMENT)
X#ifndef GFX
X#define Command(n)    (n>=SUITE && n<=EXTENDED_COMMAND)
X#else
X#define Command(n)    (n>=SUITE && n<=EXTENDED_COMMAND || \
X               n>=GFX_first && n<=GFX_last)
X#endif
X#define Expression(n) ((n>=TAG && n<=TAB_DIS)||(n>=TAGformal && n<=TAGzerprd))
X#define Comparison(n) (n>=LESS_THAN && n<=UNEQUAL)
X
X#define HOW_TO            0
X#define YIELD            1
X#define TEST            2
X#define REFINEMENT        3
X
X/* Commands */
X
X#define SUITE            4
X#define PUT            5
X#define INSERT            6
X#define REMOVE            7
X#define SET_RANDOM        8
X#define DELETE            9
X#define CHECK            10
X#define SHARE            11
X#define PASS            12
X
X#define WRITE            13 /* collateral expression */
X#define WRITE1            14 /* single expression */
X#define READ            15
X#define READ_RAW        16
X
X#define IF            17
X#define WHILE            18
X#define FOR            19
X
X#define SELECT            20
X#define TEST_SUITE        21
X#define ELSE            22
X
X#define QUIT            23
X#define RETURN            24
X#define REPORT            25
X#define SUCCEED         26
X#define FAIL            27
X
X#define USER_COMMAND        28
X#define EXTENDED_COMMAND    29
X
X/* Expressions, targets, tests */
X
X#define TAG            30
X#define COMPOUND        31
X
X/* Expressions, targets */
X
X#define COLLATERAL        32
X#define SELECTION        33
X#define BEHEAD            34
X#define CURTAIL         35
X
X/* Expressions, tests */
X
X#define UNPARSED        36
X
X/* Expressions */
X
X#define MONF            37
X#define DYAF            38
X#define NUMBER            39
X#define TEXT_DIS        40
X#define TEXT_LIT        41
X#define TEXT_CONV        42
X#define ELT_DIS         43
X#define LIST_DIS        44
X#define RANGE_BNDS        45
X#define TAB_DIS         46
X
X/* Tests */
X
X#define AND            47
X#define OR            48
X#define NOT            49
X#define SOME_IN         50
X#define EACH_IN         51
X#define NO_IN            52
X#define MONPRD            53
X#define DYAPRD            54
X#define LESS_THAN        55
X#define AT_MOST         56
X#define GREATER_THAN        57
X#define AT_LEAST        58
X#define EQUAL            59
X#define UNEQUAL         60
X#define Nonode            61
X
X#define TAGformal        62
X#define TAGlocal        63
X#define TAGglobal        64
X#define TAGrefinement        65
X#define TAGzerfun        66
X#define TAGzerprd        67
X
X#define ACTUAL            68
X#define FORMAL            69
X
X#ifndef GFX
X
X#define COLON_NODE        70
X    /* special node on top of suite inside WHILE or TEST_SUITE */
X#define NTYPES            71
X    /* number of nodetypes */
X
X#else    /* GFX */
X
X#define SPACE            70
X#define LINE            71
X#define CLEAR            72
X#define GFX_first        SPACE
X#define GFX_last        CLEAR
X
X#define COLON_NODE        73
X#define NTYPES            74
X
X#endif    /* GFX */
X
Xvalue node1();
Xvalue node2();
Xvalue node3();
Xvalue node4();
Xvalue node5();
Xvalue node6();
Xvalue node8();
Xvalue node9();
Xtypenode nodetype();
X/* Procedure display(); */
X/* Procedure fix_nodes(); */
X
X#define First_fieldnr    0
X
X#define UNIT_NAME    First_fieldnr
X#define HOW_FORMALS    First_fieldnr + 1    /* HOW'TO */
X#define HOW_COMMENT    First_fieldnr + 2
X#define HOW_SUITE    First_fieldnr + 3
X#define HOW_REFINEMENT    First_fieldnr + 4
X#define HOW_R_NAMES    First_fieldnr + 5
X#define HOW_NLOCALS    First_fieldnr + 6
X#define FPR_ADICITY    First_fieldnr + 1    /* YIELD, TEST */
X#define FPR_FORMALS    First_fieldnr + 2
X#define FPR_COMMENT    First_fieldnr + 3
X#define FPR_SUITE    First_fieldnr + 4
X#define FPR_REFINEMENT    First_fieldnr + 5
X#define FPR_R_NAMES    First_fieldnr + 6
X#define FPR_NLOCALS    First_fieldnr + 7
X
X#define FML_KEYW    First_fieldnr        /* FORMALS HOW'TO */
X#define FML_TAG     First_fieldnr + 1
X#define FML_NEXT    First_fieldnr + 2
X
X#define SUI_LINO    First_fieldnr        /* SUITE */
X#define SUI_CMD     First_fieldnr + 1
X#define SUI_COMMENT    First_fieldnr + 2
X#define SUI_NEXT    First_fieldnr + 3
X#define REF_NAME    First_fieldnr        /* REFINEMENT */
X#define REF_COMMENT    First_fieldnr + 1
X#define REF_SUITE    First_fieldnr + 2
X#define REF_NEXT    First_fieldnr + 3
X#define REF_START    First_fieldnr + 4
X
X#define PUT_EXPR    First_fieldnr        /* PUT */
X#define PUT_TARGET    First_fieldnr + 1
X#define INS_EXPR    First_fieldnr        /* INSERT */
X#define INS_TARGET    First_fieldnr + 1
X#define RMV_EXPR    First_fieldnr        /* REMOVE */
X#define RMV_TARGET    First_fieldnr + 1
X#define SET_EXPR    First_fieldnr        /* SET'RANDOM */
X#define DEL_TARGET    First_fieldnr        /* DELETE */
X#define CHK_TEST    First_fieldnr        /* CHECK */
X#define SHR_TARGET    First_fieldnr        /* SHARE */
X
X#define WRT_L_LINES    First_fieldnr        /* WRITE */
X#define WRT_EXPR    First_fieldnr + 1
X#define WRT_R_LINES    First_fieldnr + 2
X#define RD_TARGET    First_fieldnr        /* READ */
X#define RD_EXPR     First_fieldnr + 1
X#define RDW_TARGET    First_fieldnr        /* READ'RAW */
X
X#define IF_TEST     First_fieldnr        /* IF */
X#define IF_COMMENT    First_fieldnr + 1
X#define IF_SUITE    First_fieldnr + 2
X#define WHL_LINO    First_fieldnr        /* WHILE */
X#define WHL_TEST    First_fieldnr + 1
X#define WHL_COMMENT    First_fieldnr + 2
X#define WHL_SUITE    First_fieldnr + 3
X#define FOR_TARGET    First_fieldnr        /* FOR */
X#define FOR_EXPR    First_fieldnr + 1
X#define FOR_COMMENT    First_fieldnr + 2
X#define FOR_SUITE    First_fieldnr + 3
X
X#define SLT_COMMENT    First_fieldnr        /* SELECT */
X#define SLT_TSUITE    First_fieldnr + 1
X#define TSUI_LINO    First_fieldnr        /* TEST SUITE */
X#define TSUI_TEST    First_fieldnr + 1
X#define TSUI_COMMENT    First_fieldnr + 2
X#define TSUI_SUITE    First_fieldnr + 3
X#define TSUI_NEXT    First_fieldnr + 4
X#define ELSE_LINO    First_fieldnr        /* ELSE */
X#define ELSE_COMMENT    First_fieldnr + 1
X#define ELSE_SUITE    First_fieldnr + 2
X
X#define RTN_EXPR    First_fieldnr        /* RETURN */
X#define RPT_TEST    First_fieldnr        /* REPORT */
X
X#define UCMD_NAME    First_fieldnr        /* USER COMMAND */
X#define UCMD_ACTUALS    First_fieldnr + 1
X#define UCMD_DEF    First_fieldnr + 2
X#define ACT_KEYW    First_fieldnr        /* ACTUALS USER COMMAND */
X#define ACT_EXPR    First_fieldnr + 1
X#define ACT_NEXT    First_fieldnr + 2
X
X#define ECMD_NAME    First_fieldnr        /* EXTENDED COMMAND */
X#define ECMD_ACTUALS    First_fieldnr + 1
X
X#define COMP_FIELD    First_fieldnr        /* COMPOUND */
X#define COLL_SEQ    First_fieldnr        /* COLLATERAL */
X#define MON_NAME    First_fieldnr        /* MONADIC FUNCTION */
X#define MON_RIGHT    First_fieldnr + 1
X#define MON_FCT     First_fieldnr + 2
X#define DYA_NAME    First_fieldnr + 1    /* DYADIC FUNCTION */
X#define DYA_LEFT    First_fieldnr
X#define DYA_RIGHT    First_fieldnr + 2
X#define DYA_FCT     First_fieldnr + 3
X#define TAG_NAME    First_fieldnr        /* TAG */
X#define TAG_ID        First_fieldnr + 1
X#define NUM_VALUE    First_fieldnr        /* NUMBER */
X#define NUM_TEXT    First_fieldnr + 1
X#define XDIS_QUOTE    First_fieldnr        /* TEXT DIS */
X#define XDIS_NEXT    First_fieldnr + 1
X#define XLIT_TEXT    First_fieldnr        /* TEXT LIT */
X#define XLIT_NEXT    First_fieldnr + 1
X#define XCON_EXPR    First_fieldnr        /* TEXT CONV */
X#define XCON_NEXT    First_fieldnr + 1
X#define LDIS_SEQ    First_fieldnr        /* LIST DIS */
X#define TDIS_SEQ    First_fieldnr        /* TAB_DIS */
X#define SEL_TABLE    First_fieldnr        /* SELECTION */
X#define SEL_KEY     First_fieldnr + 1
X#define TRIM_LEFT    First_fieldnr        /* BEHEAD, CURTAIL */
X#define TRIM_RIGHT    First_fieldnr + 1
X#define UNP_SEQ     First_fieldnr        /* UNPARSED */
X#define UNP_TEXT    First_fieldnr + 1
X
X#define AND_LEFT    First_fieldnr        /* AND */
X#define AND_RIGHT    First_fieldnr + 1
X#define OR_LEFT     First_fieldnr        /* OR */
X#define OR_RIGHT    First_fieldnr + 1
X#define NOT_RIGHT    First_fieldnr        /* NOT */
X#define QUA_TARGET    First_fieldnr        /* QUANTIFICATION */
X#define QUA_EXPR    First_fieldnr + 1
X#define QUA_TEST    First_fieldnr + 2
X#define REL_LEFT    First_fieldnr        /* ORDER TEST */
X#define REL_RIGHT    First_fieldnr + 1
X
X#ifdef GFX
X#define SPACE_FROM    First_fieldnr
X#define SPACE_TO    First_fieldnr + 1
X#define LINE_FROM    First_fieldnr
X#define LINE_TO     First_fieldnr + 1
X#endif
X
X#define COLON_SUITE    First_fieldnr        /* COLON_NODE */
X
END_OF_FILE
  if test 7578 -ne `wc -c <'abc/ihdrs/i2nod.h'`; then
    echo shar: \"'abc/ihdrs/i2nod.h'\" unpacked with wrong size!
  fi
  # end of 'abc/ihdrs/i2nod.h'
fi
if test -f 'abc/stc/i2tcp.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/stc/i2tcp.c'\"
else
  echo shar: Extracting \"'abc/stc/i2tcp.c'\" \(7399 characters\)
  sed "s/^X//" >'abc/stc/i2tcp.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* polytype representation */
X
X#include "b.h"
X#include "bobj.h"
X#include "i2stc.h"
X
X/* A polytype is a compound with two fields.
X * The first field is a B text, and holds the typekind.
X * If the typekind is 'Variable', the second field is
X *   a B text, holding the identifier of the variable;
X * otherwise, the second field is a compound of sub(poly)types,
X *   indexed from 0 to one less then the number of subtypes.
X */
X
X#define Kin    0
X#define Sub    1
X#define Id    Sub
X#define Asc    0
X#define Key    1
X
X#define Kind(u)        ((typekind) *Field((value) (u), Kin))
X#define Psubtypes(u)    (Field((value) (u), Sub))
X#define Ident(u)    (*Field((value) (u), Id))
X
Xtypekind var_kind;
Xtypekind num_kind;
Xtypekind tex_kind;
Xtypekind lis_kind;
Xtypekind tab_kind;
Xtypekind com_kind;
Xtypekind t_n_kind;
Xtypekind l_t_kind;
Xtypekind tlt_kind;
Xtypekind err_kind;
Xtypekind ext_kind;
X
Xpolytype num_type;
Xpolytype tex_type;
Xpolytype err_type;
Xpolytype t_n_type;
X
X/* Making, setting and accessing (the fields of) polytypes */
X
XVisible polytype mkt_polytype(k, nsub) typekind k; intlet nsub; {
X    value u;
X
X    u = mk_compound(2);
X    *Field(u, Kin)= copy((value) k);
X    *Field(u, Sub)= mk_compound(nsub);
X    return (polytype) u;
X}
X
XProcedure putsubtype(sub, u, isub) polytype sub, u; intlet isub; {
X    *Field(*Psubtypes(u), isub)= (value) sub;
X}
X
Xtypekind kind(u) polytype u; {
X    return Kind(u);
X}
X
Xintlet nsubtypes(u) polytype u; {
X    return Nfields(*Psubtypes(u));
X}
X
Xpolytype subtype(u, i) polytype u; intlet i; {
X    return (polytype) *Field(*Psubtypes(u), i);
X}
X
Xpolytype asctype(u) polytype u; {
X    return subtype(u, Asc);
X}
X
Xpolytype keytype(u) polytype u; {
X    return subtype(u, Key);
X}
X
Xvalue ident(u) polytype u; {
X    return Ident(u);
X}
X
X/* making new polytypes */
X
Xpolytype mkt_number() {
X    return p_copy(num_type);
X}
X
Xpolytype mkt_text() {
X    return p_copy(tex_type);
X}
X
Xpolytype mkt_tn() {
X    return p_copy(t_n_type);
X}
X
Xpolytype mkt_error() {
X    return p_copy(err_type);
X}
X
Xpolytype mkt_list(s) polytype s; {
X    polytype u;
X
X    u = mkt_polytype(lis_kind, 1);
X    putsubtype(s, u, Asc);
X    return u;
X}
X
Xpolytype mkt_table(k, a) polytype k, a; {
X    polytype u;
X
X    u = mkt_polytype(tab_kind, 2);
X    putsubtype(a, u, Asc);
X    putsubtype(k, u, Key);
X    return u;
X}
X
Xpolytype mkt_lt(s) polytype s; {
X    polytype u;
X
X    u = mkt_polytype(l_t_kind, 1);
X    putsubtype(s, u, Asc);
X    return u;
X}
X
Xpolytype mkt_tlt(s) polytype s; {
X    polytype u;
X
X    u = mkt_polytype(tlt_kind, 1);
X    putsubtype(s, u, Asc);
X    return u;
X}
X
Xpolytype mkt_compound(nsub) intlet nsub; {
X    return mkt_polytype(com_kind, nsub);
X}
X
Xpolytype mkt_var(id) value id; {
X    polytype u;
X
X    u = mk_compound(2);
X    *Field(u, Kin)= copy((value) var_kind);
X    *Field(u, Id)= id;
X    return u;
X}
X
XHidden value nnewvar;
X
Xpolytype mkt_newvar() {
X    value v;
X    v = sum(nnewvar, one);
X    release(nnewvar);
X    nnewvar = v;
X    return mkt_var(convert(nnewvar, No, No));
X}
X
XHidden value n_external;  /* external variable types used by how-to's */
X
XVisible Procedure new_externals() {
X    n_external= zero;
X}
X
XVisible polytype mkt_ext() {
X    polytype u;
X    value v;
X
X    v = sum(n_external, one);
X    release(n_external);
X    n_external = v;
X
X    u= mk_compound(2);
X    *Field(u, Kin)= copy((value) ext_kind);
X    *Field(u, Id)= convert(n_external, No, No);
X
X    return u;
X}
X
Xpolytype p_copy(u) polytype u; {
X    return (polytype) copy((polytype) u);
X}
X
XProcedure p_release(u) polytype u; {
X    release((polytype) u);
X}
X
X/* predicates */
X
Xbool are_same_types(u, v) polytype u, v; {
X    if (compare((value) Kind(u), (value) Kind(v)) != 0)
X        return No;
X    else if (t_is_var(Kind(u)))
X        return (compare(Ident(u), Ident(v)) == 0);
X    else
X        return (
X            (nsubtypes(u) == nsubtypes(v))
X            &&
X            (compare(*Psubtypes(u), *Psubtypes(v)) == 0)
X        );
X}
X
Xbool have_same_structure(u, v) polytype u, v; {
X    return(
X        (compare((value) Kind(u), (value) Kind(v)) == 0)
X        &&
X        nsubtypes(u) == nsubtypes(v)
X    );
X}
X
Xbool t_is_number(kind) typekind kind; {
X    return (compare((value) kind, (value) num_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_text(kind) typekind kind; {
X    return (compare((value) kind, (value) tex_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_tn(kind) typekind kind; {
X    return (compare((value) kind, (value) t_n_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_error(kind) typekind kind; {
X    return (compare((value) kind, (value) err_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_list(kind) typekind kind; {
X    return (compare((value) kind, (value) lis_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_table(kind) typekind kind; {
X    return (compare((value) kind, (value) tab_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_lt(kind) typekind kind; {
X    return (compare((value) kind, (value) l_t_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_tlt(kind) typekind kind; {
X    return (compare((value) kind, (value) tlt_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_compound(kind) typekind kind; {
X    return (compare((value) kind, (value) com_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_var(kind) typekind kind; {
X    return (compare((value) kind, (value) var_kind) == 0 ? Yes : No);
X}
X
Xbool t_is_ext(kind) typekind kind; {
X    return (compare((value) kind, (value) ext_kind) == 0 ? Yes : No);
X}
X
Xbool has_number(kind) typekind kind; {
X    if (compare(kind, num_kind) == 0 || compare(kind, t_n_kind) == 0)
X        return Yes;
X    else
X        return No;
X}
X
Xbool has_text(kind) typekind kind; {
X    if (compare(kind, tex_kind) == 0 || compare(kind, t_n_kind) == 0)
X        return Yes;
X    else
X        return No;
X}
X
Xbool has_lt(kind) typekind kind; {
X    if (compare(kind, l_t_kind) == 0 || compare(kind, tlt_kind) == 0)
X        return Yes;
X    else
X        return No;
X}
X
X/* The table "ptype_of" maps the identifiers of the variables (B texts)
X * to polytypes.
X */
X
Xvalue ptype_of;
X
XProcedure repl_type_of(u, p) polytype u, p; {
X    replace((value) p, &ptype_of, Ident(u));
X}
X
Xbool table_has_type_of(u) polytype u; {
X    return in_keys(Ident(u), ptype_of);
X}
X
X#define    Table_type_of(u) ((polytype) *adrassoc(ptype_of, Ident(u)))
X
XVisible polytype bottomtype(u) polytype u; {
X    while (t_is_var(Kind(u)) && table_has_type_of(u)) {
X        u = Table_type_of(u);
X    }
X    return u;
X}
X
Xpolytype bottomvar(u) polytype u; {
X    polytype b;
X
X    if (!t_is_var(Kind(u)))
X        return u;
X    /* Kind(u) == Variable */
X    while (table_has_type_of(u)) {
X        b = Table_type_of(u);
X        if (t_is_var(Kind(b)))
X            u = b;
X        else
X            break;
X    }
X    /* Kind(u) == Variable &&
X       !(table_has_type_of(u) && Kind(Table_type_of(u)) == Variable) */
X    return u;
X}
X
XVisible Procedure usetypetable(t) value t; {
X    ptype_of = t;
X}
X
XVisible Procedure deltypetable() {
X    release(ptype_of);
X}
X
X/* init */
X
XVisible Procedure initpol() {
X    num_kind = mk_text("Number");
X    num_type = mkt_polytype(num_kind, 0);
X    tex_kind = mk_text("Text");
X    tex_type = mkt_polytype(tex_kind, 0);
X    t_n_kind = mk_text("TN");
X    t_n_type = mkt_polytype(t_n_kind, 0);
X    err_kind = mk_text("Error");
X    err_type = mkt_polytype(err_kind, 0);
X
X    lis_kind = mk_text("List");
X    tab_kind = mk_text("Table");
X    com_kind = mk_text("Compound");
X    l_t_kind = mk_text("LT");
X    tlt_kind = mk_text("TLT");
X    var_kind = mk_text("Variable");
X    ext_kind = mk_text("External");
X
X    nnewvar = zero;
X}
X
XVisible Procedure endpol() {
X    release((value) num_kind);
X    release((value) num_type);
X    release((value) tex_kind);
X    release((value) tex_type);
X    release((value) t_n_kind);
X    release((value) t_n_type);
X    release((value) err_kind);
X    release((value) err_type);
X    release((value) lis_kind);
X    release((value) tab_kind);
X    release((value) com_kind);
X    release((value) l_t_kind);
X    release((value) tlt_kind);
X    release((value) var_kind);
X}
END_OF_FILE
  if test 7399 -ne `wc -c <'abc/stc/i2tcp.c'`; then
    echo shar: \"'abc/stc/i2tcp.c'\" unpacked with wrong size!
  fi
  # end of 'abc/stc/i2tcp.c'
fi
echo shar: End of archive 18 \(of 25\).
cp /dev/null ark18isdone
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...