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

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

Subject:  v23i096:  ABC interactive programming environment, Part17/25
Newsgroups: comp.sources.unix
Approved: [e-mail]
X-Checksum-Snefru: 1625473c 9c90c416 e7088d59 34948ff1

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

#! /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/e1inse.c abc/bed/e1move.c abc/bed/e1outp.c
#   abc/bint1/i1nui.c abc/bint3/i3gfx.c abc/lin/i1tlt.h
#   abc/stc/i2tce.c
# Wrapped by [e-mail] on Mon Dec 17 13:28:12 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 17 (of 25)."'
if test -f 'abc/bed/e1inse.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1inse.c'\"
else
  echo shar: Extracting \"'abc/bed/e1inse.c'\" \(7653 characters\)
  sed "s/^X//" >'abc/bed/e1inse.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * Subroutines (refinements) for ins_string() (see que2.c).
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "etex.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"
X
X
X/*
X * Try to insert the character c in the focus *pp.
X */
X
XVisible bool
Xinsguess(pp, c, ep)
X    path *pp;
X    char c;
X    environ *ep;
X{
X    path pa = parent(*pp);
X    node n;
X    int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
X    int ich = ichild(*pp);
X    struct classinfo *ci = table[sympa].r_class[ich-1];
X    classptr cp;
X    string *rp;
X    int code = Code(c);
X    int sym;
X    char buf[2];
X
X#ifdef USERSUGG
X    if (isascii(c) && isinclass(Suggestion, ci)
X        && (isalpha(c) || (c == ':' && sympa == Rootsymbol)))
X    {
X        if (setsugg(pp, c, ep, allows_colon(sympa)))
X            return Yes;
X    }
X#endif /* USERSUGG */
X    for (cp = ci->c_insert; *cp; cp += 2) {
X        if (cp[0] == code)
X            break;
X    }
X    if (!*cp)
X        return No;
X    sym = cp[1];
X    if (sym >= LEXICAL) {
X        buf[0] = c;
X        buf[1] = 0;
X        treereplace(pp, (node) mk_etext(buf));
X        ep->mode = VHOLE;
X        ep->s1 = 2*ich;
X        ep->s2 = 1;
X        return Yes;
X    }
X    Assert(sym < TABLEN);
X    rp = table[sym].r_repr;
X    n = table[sym].r_node;
X    if (Fw_zero(rp[0])) {
X        buf[0] = c;
X        buf[1] = 0;
X        setchild(&n, 1, (node) mk_etext(buf));
X        treereplace(pp, n);
X        ep->mode = VHOLE;
X        ep->s1 = 2;
X        ep->s2 = 1;
X        return Yes;
X    }
X    treereplace(pp, n);
X    if (c == '\n' || c == '\r') {
X        ep->mode = SUBSET;
X        ep->s1 = ep->s2 = 2;
X    }
X    else {
X        ep->mode = FHOLE;
X        ep->s1 = 1;
X        ep->s2 = 1;
X    }
X    return Yes;
X}
X
X
X/*
X * Test whether character `c' may be inserted in position `s2' in
X * child `ich' of node `n'; that child must be a Text.
X */
X
XVisible bool
Xmayinsert(n, ich, s2, c)
X    node n;
X    int ich;
X    int s2;
X    register char c;
X{
X    int sympa = symbol(n);
X    struct classinfo *ci;
X    register classptr cp;
X    register value v = (value) child(n, ich);
X    register char c1;
X    bool maycontinue();
X    bool maystart();
X    register bool (*fun1)() = s2 > 0 ? /*&*/maystart : /*&*/maycontinue;
X    register bool (*fun2)() = s2 > 0 ? /*&*/maycontinue : /*&*/maystart;
X
X    Assert(v && v->type == Etex);
X    Assert(sympa > 0 && sympa < TABLEN);
X    ci = table[sympa].r_class[ich-1];
X    Assert(ci && ci->c_class);
X    /* c1 = strval(v)[0]; */
X    c1= e_ncharval(1, v);
X    for (cp = ci->c_class; *cp; ++cp) {
X        if (*cp >= LEXICAL && (*fun1)(c1, *cp)) {
X            if ((*fun2)(c, *cp))
X                return Yes;
X        }
X    }
X    return No;
X}
X
X
X/*
X * Change a Fixed into a Variable node, given a string pointer variable
X * which contains the next characters to be inserted.
X * If the change is not appropriate, No is returned.
X * Otherwise, as many (though maybe zero) characters from the string
X * as possible will have been incorporated in the string node.
X */
X
XVisible bool
Xsoften(ep, pstr, alt_c)
X    environ *ep;
X    string *pstr;
X    int alt_c;
X{
X    path pa = parent(ep->focus);
X    node n;
X    int sympa = pa ? symbol(tree(pa)) : Rootsymbol;
X    struct classinfo *ci;
X    register classptr cp;
X    register int code;
X    string repr;
X    register struct table *tp;
X    char buf[1024];
X
X    if (ep->mode == VHOLE && (ep->s1&1))
X        ep->mode = FHOLE;
X    if (ep->mode != FHOLE || ep->s1 != 1 || ep->s2 <= 0 || !issuggestion(ep))
X        return No;
X    n = tree(ep->focus);
X    repr = noderepr(n)[0];
X    if (!repr || !isupper(repr[0]))
X        return No;
X    if (symbol(n) == Select && repr[ep->s2-1] == ':')
X        return No;
X    if (symbol(n) == Head)
X        return No;
X    code = Code(repr[0]);
X    ci = table[sympa].r_class[ichild(ep->focus) - 1];
X    n = Nnil;
X    for (cp = ci->c_insert; *cp; cp += 2) {
X        if (cp[0] != code)
X            continue;
X        if (cp[1] >= TABLEN)
X            continue;
X        tp = &table[cp[1]];
X        if (Fw_zero(tp->r_repr[0])) {
X            Assert(tp->r_class[0]->c_class[0] >= LEXICAL);
X            n = tp->r_node;
X            break;
X        }
X    }
X    if (!n)
X        return No;
X    strncpy(buf, repr, ep->s2);
X    buf[ep->s2] = 0;
X    setchild(&n, 1, (node) mk_etext(buf));
X    if (!mayinsert(n, 1, ep->s2, repr[ep->s2])) {
X        if (!**pstr || !mayinsert(n, 1, ep->s2, **pstr)
X            && (!alt_c || !mayinsert(n, 1, ep->s2, alt_c))) {
X            noderelease(n); /* Don't forget! */
X            return No;
X        }
X    }
X    if (!ep->spflag && **pstr && mayinsert(n, 1, ep->s2, **pstr)) {
X        do {
X            buf[ep->s2] = **pstr;
X            ++*pstr;
X            ++ep->s2;
X        } while (ep->s2 < sizeof buf - 1 && **pstr
X                && mayinsert(n, 1, ep->s2, **pstr));
X        buf[ep->s2] = 0;
X        setchild(&n, 1, (node) mk_etext(buf));
X    }
X    treereplace(&ep->focus, n);
X    ep->mode = VHOLE;
X    ep->s1 = 2;
X    return Yes;
X}
X
X
X/*
X * Renew suggestion, or advance in old suggestion.
X * Return Yes if *pstr has been advanced.
X */
X
XVisible bool
Xresuggest(ep, pstr, alt_c)
X    environ *ep;
X    string *pstr;
X    int alt_c;
X{
X    struct table *tp;
X    struct classinfo *ci;
X    classptr cp;
X    path pa;
X    node nn;
X    node n = tree(ep->focus);
X    register string *oldrp = noderepr(n);
X    register int ich = ep->s1/2;
X    register string str = oldrp[ich];
X    int oldsym = symbol(n);
X    int childsym[MAXCHILD];
X    string *newrp;
X    int sympa;
X    register int sym;
X    int symfound = -1;
X    register int i;
X    int code;
X    char buf[15]; /* Should be sufficient for all fixed texts */
X    bool ok;
X    bool anyok = No;
X
X    if (!str || !**pstr || !issuggestion(ep))
X        return No;
X    /***** Change this if commands can be prefixes of others! *****/
X    /***** Well, they can!
X    if (!c)
X        return No;
X        *****/
X
X    if (ich > 0 && ifmatch(ep, pstr, str, alt_c))
X        /* Shortcut: sec. keyword, exact match will do just fine */
X        return Yes;
X    if (ep->s2 <= 0 || Fw_zero(oldrp[0]))
X        return No;
X    if (**pstr != ' ' && !isupper(**pstr)
X        && !alt_c && **pstr != '"' && **pstr != '\'' && **pstr != '.')
X        /* Shortcut: not a keyword, must match exactly */
X        return ifmatch(ep, pstr, str, alt_c);
X    for (i = 0; i < ich; ++i) { /* Preset some stuff for main loop */
X        if (!oldrp[i])
X            oldrp[i] = "";
X        childsym[i] = symbol(child(n, i+1));
X    }
X    Assert(ep->s2 + 1 < sizeof buf);
X    strcpy(buf, oldrp[ich]);
X    buf[ep->s2] = alt_c ? alt_c : **pstr;
X    buf[ep->s2 + 1] = 0;
X    pa = parent(ep->focus);
X    sympa = pa ? symbol(tree(pa)) : Rootsymbol;
X    ci = table[sympa].r_class[ichild(ep->focus) - 1];
X    code = Code(oldrp[0][0]);
X
X    for (cp = ci->c_insert; *cp; cp += 2) {
X        if (cp[0] != code)
X            continue;
X        sym = cp[1];
X        if (sym >= TABLEN)
X            continue;
X        if (sym == oldsym) {
X            anyok = Yes;
X            continue;
X        }
X        tp = &table[sym];
X        newrp = tp->r_repr;
X        ok = Yes;
X        for (i = 0; i < ich; ++i) {
X            str = newrp[i];
X            if (!str)
X                str = "";
X            if (strcmp(str, oldrp[i])
X                || childsym[i] != Optional && childsym[i] != Hole
X                    && !isinclass(childsym[i], tp->r_class[i])) {
X                ok = No;
X                break;
X            }
X        }
X        if (!ok)
X            continue;
X        str = newrp[i];
X        if (!str || strncmp(str, buf, ep->s2+1))
X            continue;
X        if (anyok) {
X            if (!strcmp(str, oldrp[ich]))
X                continue; /* Same as it was: no new suggestion */
X            symfound = sym;
X            break;
X        }
X        else if (symfound < 0 && strcmp(str, oldrp[ich]))
X            symfound = sym;
X    }
X
X    if (symfound < 0) {
X        return ifmatch(ep, pstr, oldrp[ich], alt_c);
X    }
X    nn = table[symfound].r_node;
X    for (i = 1; i <= ich; ++i) { /* Copy children to the left of the focus */
X        sym = symbol(child(n, i));
X        if (sym == Optional || sym == Hole)
X            continue;
X        setchild(&nn, i, nodecopy(child(n, i)));
X    }
X    treereplace(&ep->focus, nn);
X    str = newrp[ich];
X    do { /* Find easy continuation */
X        ++ep->s2;
X        ++*pstr;
X    } while (**pstr && **pstr == str[ep->s2]);
X
X    return Yes;
X}
X
X
X/*
X * Refinement for resuggest(): see if there is a match, and if so, find
X * longest match.
X */
X
XHidden bool
Xifmatch(ep, pstr, str, alt_c)
X    register environ *ep;
X    register string *pstr;
X    register string str;
X    register int alt_c;
X{
X    register int c = str[ep->s2];
X
X    if (c != **pstr && (!alt_c || c != alt_c))
X        return No;
X    do {
X        ++ep->s2;
X        ++*pstr;
X    } while (**pstr && **pstr == str[ep->s2]);
X
X    return Yes;
X}
END_OF_FILE
  if test 7653 -ne `wc -c <'abc/bed/e1inse.c'`; then
    echo shar: \"'abc/bed/e1inse.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1inse.c'
fi
if test -f 'abc/bed/e1move.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1move.c'\"
else
  echo shar: Extracting \"'abc/bed/e1move.c'\" \(7754 characters\)
  sed "s/^X//" >'abc/bed/e1move.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Process arrow keys in four directions, plus TAB.
X */
X
X#include "b.h"
X#include "feat.h"
X#include "bedi.h"
X#include "etex.h"
X#include "bobj.h"
X#include "node.h"
X#include "supr.h"
X#include "gram.h"
X#include "tabl.h"
X
X#define Left (-1)
X#define Rite 1
X
X
X/*
X * Common code for PREVIOUS and NEXT commands.
X */
X
XHidden bool
Xprevnext(ep, direction)
X    environ *ep;
X{
X    node n;
X    node n1;
X    int nch;
X    int i;
X    int len;
X    int sym;
X    string *rp;
X
X    higher(ep);
X    switch (ep->mode) {
X    case VHOLE:
X    case FHOLE:
X    case ATBEGIN:
X    case ATEND:
X        if (direction == Left)
X            leftvhole(ep);
X        else
X            ritevhole(ep);
X    }
X
X    for (;;) {
X        n = tree(ep->focus);
X        nch = nchildren(n);
X        rp = noderepr(n);
X
X        switch (ep->mode) {
X
X        case ATBEGIN:
X        case ATEND:
X            ep->mode = WHOLE;
X            continue;
X
X        case VHOLE:
X        case FHOLE:
X            if (direction == Rite) {
X                if (ep->s1&1)
X                    len = Fwidth(rp[ep->s1/2]);
X                else {
X                    n1 = child(n, ep->s1/2);
X                    len = nodewidth(n1);
X                }
X            }
X            if (direction == Rite ? ep->s2 >= len : ep->s2 <= 0) {
X                ep->mode = SUBSET;
X                ep->s2 = ep->s1;
X                return nextchar(ep, direction);
X            }
X            ep->s2 += direction;
X            return Yes;
X
X        case SUBRANGE:
X            if (direction == Rite) {
X                if (ep->s1&1)
X                    len = Fwidth(rp[ep->s1/2]);
X                else {
X                    n1 = child(n, ep->s1/2);
X                    len = nodewidth(n1);
X                }
X            }
X            if (direction == Left ? ep->s2 <= 0 : ep->s3 >= len-1) {
X                ep->mode = SUBSET;
X                ep->s2 = ep->s1;
X                return nextchar(ep, direction);
X            }
X            if (direction == Rite)
X                ep->s2 = ++ep->s3;
X            else
X                ep->s3 = --ep->s2;
X            return Yes;
X
X        case SUBSET:
X            if (direction == Rite ? ep->s2 > 2*nch : ep->s1 <= 1) {
X                ep->mode = WHOLE;
X                continue;
X            }
X            if (direction == Rite)
X                ep->s1 = ++ep->s2;
X            else
X                ep->s2 = --ep->s1;
X            if (ep->s1&1) {
X                if (!Fw_positive(rp[ep->s1/2]) || allspaces(rp[ep->s1/2]))
X                    continue;
X            }
X            else {
X                sym = symbol(n);
X                if (downi(&ep->focus, ep->s1/2)) {
X                    n = tree(ep->focus);
X                    if (((value)n)->type == Etex)
X                        s_up(ep);
X                    else {
X                        if (ep->s1 == 2*nch && direction == Rite
X                            && issublist(sym) && samelevel(sym, symbol(n))) {
X                            ep->mode = SUBLIST;
X                            ep->s3 = 1;
X                            return Yes;
X                        }
X                        ep->mode = WHOLE;
X                        if (nodewidth(n) == 0)
X                            continue;
X                    }
X                }
X            }
X            return Yes;
X
X        case SUBLIST:
X            sym = symbol(n);
X            if (direction == Left) {
X                i = ichild(ep->focus);
X                if (!up(&ep->focus))
X                    return No;
X                higher(ep);
X                n = tree(ep->focus);
X                if (i == nchildren(n) && samelevel(sym, symbol(n))) {
X                    ep->s3 = 1;
X                    return Yes;
X                }
X                ep->mode = SUBSET;
X                ep->s1 = ep->s2 = 2*i;
X                continue;
X            }
X            for (i = ep->s3; i > 0; --i)
X                if (!downrite(&ep->focus))
X                    return No; /* Sorry... */
X            if (samelevel(sym, symbol(tree(ep->focus))))
X                ep->s3 = 1;
X            else
X                ep->mode = WHOLE;
X            return Yes;
X
X        case WHOLE:
X            i = ichild(ep->focus);
X            if (!up(&ep->focus))
X                return No;
X            higher(ep);
X            ep->mode = SUBSET;
X            ep->s1 = ep->s2 = 2*i;
X            continue;
X
X        default:
X            Abort();
X        }
X    }
X    /* Not reached */
X}
X
X
XVisible bool
Xprevious(ep)
X    environ *ep;
X{
X    if (!prevnext(ep, Left))
X        return No;
X    return Yes;
X}
X
X
XVisible bool
Xnextarrow(ep)
X    environ *ep;
X{
X    if (!prevnext(ep, Rite))
X        return No;
X    return Yes;
X}
X
XVisible bool
Xleftarrow(ep)
X    environ *ep;
X{
X    int w;
X    bool hole;
X
X    if (narrow(ep)) {
X        while (narrow(ep))
X            ;
X        return Yes;
X    }
X    hole= ep->mode == WHOLE;
X    if (!previous(ep))
X        return No;
X    if (hole) {
X        for (;;) {
X            w= focwidth(ep);
X            if (w >= 0 && w <= 1)
X                break;
X            if (!rnarrow(ep))
X                return No;
X        }
X        VOID narrow(ep);
X    }
X    else {
X        while (rnarrow(ep))
X            ;
X    }
X    return Yes;
X}
X
XVisible bool
Xritearrow(ep)
X    environ *ep;
X{
X    while (narrow(ep))
X        ;
X    if (!nextarrow(ep))
X        return No;
X    while (narrow(ep))
X        ;
X    return Yes;
X}
X
X/*
X * Position focus at next or previous char relative to current position.
X * Assume current position given as SUBSET.
X */
X
XHidden bool
Xnextchar(ep, direction)
X    register environ *ep;
X    register int direction;
X{
X    register int ich;
X    register int nch;
X    register node n;
X    node n1;
X    register int len;
X    string *rp;
X
X    Assert(ep->mode == SUBSET);
X    for (;;) {
X        n = tree(ep->focus);
X        rp = noderepr(n);
X        nch = nchildren(n);
X        if (direction == Left)
X            ep->s2 = --ep->s1;
X        else
X            ep->s1 = ++ep->s2;
X        if (direction == Left ? ep->s1 < 1 : ep->s2 > 2*nch+1) {
X            ich = ichild(ep->focus);
X            if (!up(&ep->focus))
X                return No; /* *ep is garbage now! */
X            higher(ep);
X            ep->s1 = ep->s2 = 2*ich;
X            continue;
X        }
X        if (ep->s1&1) {
X            len = Fwidth(rp[ep->s1/2]);
X            if (len > 0) {
X                ep->mode = SUBRANGE;
X                ep->s2 = ep->s3 = direction == Left ? len-1 : 0;
X                return Yes;
X            }
X            continue;
X        }
X        n1 = child(n, ep->s1/2);
X        len = nodewidth(n1);
X        if (len == 0)
X            continue;
X        if (!downi(&ep->focus, ep->s1/2))
X            return No; /* Sorry... */
X        n = tree(ep->focus);
X        if (((value)n)->type == Etex) {
X            s_up(ep);
X            ep->mode = SUBRANGE;
X            ep->s2 = ep->s3 = direction == Left ? len-1 : 0;
X            return Yes;
X        }
X        if (direction == Left) {
X            nch = nchildren(n);
X            ep->s1 = ep->s2 = 2*(nch+1);
X        }
X        else
X            ep->s1 = ep->s2 = 0;
X    }
X    /* Not reached */
X}
X
X
X/*
X * Up and down arrows.
X */
X
XHidden bool
Xupdownarrow(ep, yincr)
X    environ *ep;
X    int yincr;
X{
X    int y, x;
X
X    while (narrow(ep))
X        ;
X    y= lineno(ep) + yincr;
X    x= colno(ep);
X    if (!gotoyx(ep, y, x))
X        return No;
X    gotofix(ep, y, x);
X    while (narrow(ep))
X        ;
X    return Yes;
X}
X
XVisible bool
Xuparrow(ep)
X    environ *ep;
X{
X    return updownarrow(ep, -1);
X}
X
XVisible bool
Xdownarrow(ep)
X    environ *ep;
X{
X    return updownarrow(ep, 1);
X}
X
XVisible bool
Xupline(ep)
X    register environ *ep;
X{
X    register int y;
X
X    y = lineno(ep);
X    if (y <= 0)
X        return No;
X    if (!gotoyx(ep, y-1, 0))
X        return No;
X    oneline(ep);
X    return Yes;
X}
X
XVisible bool
Xdownline(ep)
X    register environ *ep;
X{
X    register int w;
X
X    if (!parent(ep->focus) && ep->mode == ATEND)
X        return No; /* Superfluous? */
X    w = -focwidth(ep);
X    if (w <= 0)
X        w = 1;
X    if (!gotoyx(ep, lineno(ep) + w, 0))
X        return No;
X    oneline(ep);
X    return Yes;
X}
X
X
X/*
X * ACCEPT command
X * move to next Hole hole or to end of suggestion or to end of line.
X */
X
X
XVisible bool
Xaccept(ep)
X    environ *ep;
X{
X    int i;
X    string repr;
X
X    shrink(ep);
X    switch (ep->mode) {
X    case ATBEGIN:
X    case ATEND:
X    case FHOLE:
X    case VHOLE:
X        ritevhole(ep);
X    }
X#ifdef USERSUGG
X    if (symbol(tree(ep->focus)) == Sugghowname)
X        ackhowsugg(ep);
X#endif
X    if (symbol(tree(ep->focus)) == Hole) {
X        ep->mode = WHOLE;
X        return No;
X    }
X    switch (ep->mode) {
X    case ATBEGIN:
X    case SUBLIST:
X    case WHOLE:
X        i = 1;
X        break;
X    case ATEND:
X        i = 2*nchildren(tree(ep->focus)) + 2;
X        break;
X    case SUBRANGE:
X    case VHOLE:
X    case FHOLE:
X        i = ep->s1;
X        if (ep->s2 > 0 && i > 2*nchildren(tree(ep->focus)))
X            ++i; /* Kludge so after E?LSE: the focus moves to ELSE: ? */
X        break;
X    case SUBSET:
X        i = ep->s1 - 1;
X        break;
X    default:
X        Abort();
X    }
X    ep->mode = WHOLE;
X    for (;;) {
X        if (i/2 == nchildren(tree(ep->focus))) {
X            repr = noderepr(tree(ep->focus))[i/2];
X            if (Fw_positive(repr))
X                break;
X        }
X        if (tabstop(ep, i + 1))
X            return Yes;
X        i = 2*ichild(ep->focus) + 1;
X        if (!up(&ep->focus))
X            break;
X        higher(ep);
X    }
X    ep->mode = ATEND;
X    return Yes;
X}
X
X
X/*
X * Find suitable tab stops for accept.
X */
X
XHidden bool
Xtabstop(ep, i)
X    environ *ep;
X    int i;
X{
X    node n = tree(ep->focus);
X    int nch;
X    string repr;
X
X    if (Is_etext(n))
X        return No;
X    nch = nchildren(n);
X    if (i/2 > nch)
X        return No;
X    if (symbol(n) == Hole) {
X        ep->mode = WHOLE;
X        return Yes;
X    }
X    if (i < 2) {
X        i = 2;
X        if (nodewidth(n) < 0) {
X            repr = noderepr(n)[0];
X            if (Fw_negative(repr)) {
X                ep->mode = ATBEGIN;
X                leftvhole(ep);
X                return Yes;
X            }
X        }
X    }
X    for (i /= 2; i <= nch; ++i) {
X        s_downi(ep, i);
X        if (tabstop(ep, 1))
X            return Yes;
X        s_up(ep);
X    }
X    return No;
X}
END_OF_FILE
  if test 7754 -ne `wc -c <'abc/bed/e1move.c'`; then
    echo shar: \"'abc/bed/e1move.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1move.c'
fi
if test -f 'abc/bed/e1outp.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1outp.c'\"
else
  echo shar: Extracting \"'abc/bed/e1outp.c'\" \(7976 characters\)
  sed "s/^X//" >'abc/bed/e1outp.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Screen management package, lower level output part.
X */
X
X#include "b.h"
X#include "bedi.h"
X#include "etex.h"
X#include "bobj.h"
X#include "bmem.h"
X#include "node.h"
X#include "supr.h"
X#include "gram.h"
X#include "cell.h"
X#include "tabl.h"
X
X#define SOBIT 0200
X#define CHAR 0177
X
X/*
X * Variables used for communication with outfocus.
X */
X
XHidden node thefocus;
XHidden environ wherebuf;
XHidden environ *where = &wherebuf;
XHidden bool realvhole;
XHidden int multiline; /* Height of focus */
XHidden int yfocus;
X
XVisible int focy; /* Where the cursor must go */
XVisible int focx;
X
X
X/*
X * Save position of the focus for use by outnode/outfocus.
X */
X
XVisible Procedure
Xsavefocus(ep)
X    register environ *ep;
X{
X    register int sym;
X    register int w;
X
X    realvhole = No;
X    thefocus = Nnil;
X    multiline = 0;
X    yfocus = Ycoord(ep->focus);
X    w = focoffset(ep);
X    if (w < 0)
X        yfocus += -w;
X    w = focwidth(ep);
X    if (w < 0) {
X        multiline = -w;
X        if (focchar(ep) == '\n')
X            ++yfocus;
X        else
X            ++multiline;
X        return;
X    }
X    if (ep->mode == WHOLE) {
X        sym = symbol(tree(ep->focus));
X        if (sym == Optional)
X            ep->mode = ATBEGIN;
X    }
X    switch(ep->mode) {
X    case VHOLE:
X        if (ep->s1&1)
X            ep->mode = FHOLE;
X    case ATBEGIN:
X    case ATEND:
X    case FHOLE:
X        ritevhole(ep);
X        switch (ep->mode) {
X        case ATBEGIN:
X        case FHOLE:
X            sym = symbol(tree(ep->focus));
X            if (sym == Hole && (ep->mode == ATBEGIN || ep->s2 == 0)) {
X                ep->mode = WHOLE;
X                break;
X            }
X            /* Fall through */
X        case VHOLE:
X        case ATEND:
X            leftvhole(ep);
X            realvhole = 1 + ep->spflag;
X        }
X    }
X    touchpath(&ep->focus); /* Make sure it is a unique pointer */
X    thefocus = tree(ep->focus); /* No copy; used for comparison only! */
X    where->mode = ep->mode;
X    where->s1 = ep->s1;
X    where->s2 = ep->s2;
X    where->s3 = ep->s3;
X    where->spflag = ep->spflag;
X}
X
X
X/*
X * Incorporate the information saved about the focus.
X */
X
XVisible Procedure
Xsetfocus(tops)
X    register cell *tops;
X{
X    register cell *p;
X    register int i;
X
X    for (p = tops, i = 0; i < yfocus; ++i, p = p->c_link) {
X        if (!p) {
X#ifndef NDEBUG
X            debug("[Focus lost (setfocus)]");
X#endif /* NDEBUG */
X            return;
X        }
X    }
X    p->c_newvhole = realvhole;
X    i = multiline;
X    do {
X        p->c_newfocus = Yes;
X        p = p->c_link;
X    } while (--i > 0);
X}
X
X
X/*
X * Signal that actual updata is started.
X */
X
XVisible Procedure
Xstartactupdate(nofocus)
X    bool nofocus;
X{
X    if (nofocus) {
X        multiline = 0;
X        thefocus = Nnil;
X    }
X}
X
X
X/*
X * Signal the end of the actual update.
X */
X
XVisible Procedure
Xendactupdate()
X{
X}
X
X
X/*
X * Output a line of text.
X */
X
XVisible Procedure
Xoutline(p, lineno)
X    register cell *p;
X    register int lineno;
X{
X    register node n = p->c_data;
X    register int w = nodewidth(n);
X    register int len=  p->c_newindent + 4 + (w < 0 ? linelen(n) : w);
X            /* some 4 extra for spflag and vhole */
X    register string buf;
X    auto string bp;
X    register int i;
X    register int endarea = lineno+Space(p)-1;
X
X    buf= (string) getmem((unsigned) len);
X    bp= buf;
X    if (endarea >= winheight)
X        endarea = winheight-1;
X    for (i = p->c_newindent; i-- > 0; )
X        *bp++ = ' ';
X    if (!p->c_newfocus) {
X        smash(&bp, n, 0);
X        *bp = 0;
X        Assert(bp-buf < len);
X    }
X    else {
X        if (multiline)
X            smash(&bp, n, SOBIT);
X        else if (n == thefocus)
X            focsmash(&bp, n);
X        else
X            smash(&bp, n, 0);
X        *bp = 0;
X        Assert(bp-buf < len);
X        for (bp = buf; *bp && !(*bp&SOBIT); ++bp)
X            ;
X        if (*bp&SOBIT) {
X            if (focy == Nowhere) {
X                focx = indent + bp-buf;
X                focy = lineno + focx/llength;
X                focx %= llength;
X            }
X            if (multiline <= 1 && !(bp[1]&SOBIT))
X                *bp &= ~SOBIT; /* Clear mask if just one char in focus */
X        }
X    }
X    trmputdata(lineno, endarea, indent, buf);
X    freemem((ptr) buf);
X}
X
X
X/*
X * Smash -- produce a linear version of a node in a buffer (which had
X * better be long enough!).  The buffer pointer is moved to the end of
X * the resulting string.
X * Care is taken to represent the focus.
X * Characters in the focus have their upper bit set.
X */
X
X#define Outvhole() \
X    (where->spflag && strsmash(pbuf, " ", 0), strsmash(pbuf, "?", SOBIT))
X
XHidden Procedure
Xfocsmash(pbuf, n)
X    string *pbuf;
X    node n;
X{
X    value v;
X    string str;
X    register string *rp;
X    register int maxs2;
X    register int i;
X    register bool ok;
X    register int j;
X    register int mask;
X
X    switch (where->mode) {
X
X    case WHOLE:
X        smash(pbuf, n, SOBIT);
X        break;
X
X    case ATBEGIN:
X        Outvhole();
X        smash(pbuf, n, 0);
X        break;
X
X    case ATEND:
X        smash(pbuf, n, 0);
X        Outvhole();
X        break;
X
X    case VHOLE:
X        if (!(where->s1&1)) {
X            v = (value) child(n, where->s1/2);
X            Assert(Is_etext(v));
X            str= e_sstrval(v);
X            subsmash(pbuf, str, where->s2, 0);
X            Outvhole();
X            j= symbol(n);
X            i= str[where->s2] == '?' &&
X             (j == Suggestion || j == Sugghowname);
X            strsmash(pbuf, str + where->s2 + i, 0);
X            e_fstrval(str);
X            break;
X        }
X        /* Else, fall through */
X    case FHOLE:
X        rp = noderepr(n);
X        maxs2 = 2*nchildren(n) + 1;
X        for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
X            if (i&1) {
X                if (i == where->s1) {
X                    subsmash(pbuf, rp[i/2], where->s2, 0);
X                    Outvhole();
X                    if (rp[i/2])
X                        strsmash(pbuf, rp[i/2] + where->s2, 0);
X                }
X                else
X                    strsmash(pbuf, rp[i/2], 0);
X            }
X            else
X                ok = chismash(pbuf, n, i/2, 0);
X        }
X        break;
X
X    case SUBRANGE:
X        rp = noderepr(n);
X        maxs2 = 2*nchildren(n) + 1;
X        for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
X            if (i&1) {
X                if (i == where->s1) {
X                    subsmash(pbuf, rp[i/2], where->s2,0);
X                    if (rp[i/2])
X                        subsmash(pbuf, rp[i/2] + where->s2,
X                            where->s3 - where->s2 + 1, SOBIT);
X                    if (rp[i/2])
X                        strsmash(pbuf, rp[i/2] + where->s3 + 1, 0);
X                }
X                else
X                    strsmash(pbuf, rp[i/2], 0);
X            }
X            else if (i == where->s1) {
X                v = (value)child(n, i/2);
X                Assert(Is_etext(v));
X                str = e_sstrval(v);
X                subsmash(pbuf, str, where->s2, 0);
X                subsmash(pbuf, str + where->s2, where->s3 - where->s2 + 1,
X                    SOBIT);
X                strsmash(pbuf, str + where->s3 + 1, 0);
X                e_fstrval(str);
X            }
X            else
X                ok = chismash(pbuf, n, i/2, 0);
X        }
X        break;
X
X    case SUBLIST:
X        for (ok = Yes, j = where->s3; j > 0; --j) {
X            rp = noderepr(n);
X            maxs2 = 2*nchildren(n) - 1;
X            for (i = 1; ok && i <= maxs2; ++i) {
X                if (i&1)
X                    strsmash(pbuf, rp[i/2], SOBIT);
X                else
X                    ok = chismash(pbuf, n, i/2, SOBIT);
X            }
X            if (ok)
X                n = lastchild(n);
X        }
X        if (ok)
X            smash(pbuf, n, 0);
X        break;
X
X    case SUBSET:
X        rp = noderepr(n);
X        maxs2 = 2*nchildren(n) + 1;
X        mask = 0;
X        for (ok = Yes, i = 1; ok && i <= maxs2; ++i) {
X            if (i == where->s1)
X                mask = SOBIT;
X            if (i&1)
X                strsmash(pbuf, rp[i/2], mask);
X            else
X                ok = chismash(pbuf, n, i/2, mask);
X            if (i == where->s2)
X                mask = 0;
X        }
X        break;
X
X    default:
X        Abort();
X    }
X}
X
XHidden Procedure
Xsmash(pbuf, n, mask)
X    register string *pbuf;
X    register node n;
X    register int mask;
X{
X    register string *rp;
X    register int i;
X    register int nch;
X
X    rp = noderepr(n);
X    strsmash(pbuf, rp[0], mask);
X    nch = nchildren(n);
X    for (i = 1; i <= nch; ++i) {
X        if (!chismash(pbuf, n, i, mask))
X            break;
X        strsmash(pbuf, rp[i], mask);
X    }
X}
X
XHidden Procedure
Xstrsmash(pbuf, str, mask)
X    register string *pbuf;
X    register string str;
X    register int mask;
X{
X    if (!str)
X        return;
X    for (; *str; ++str) {
X        if (isprint(*str) || *str == ' ')
X            **pbuf = *str|mask, ++*pbuf;
X    }
X}
X
XHidden Procedure
Xsubsmash(pbuf, str, len, mask)
X    register string *pbuf;
X    register string str;
X    register int len;
X    register int mask;
X{
X    if (!str)
X        return;
X    for (; len > 0 && *str; --len, ++str) {
X        if (isprint(*str) || *str == ' ')
X            **pbuf = *str|mask, ++*pbuf;
X    }
X}
X
X
X/*
X * Smash a node's child.
X * Return No if it contained a newline (to stop the parent).
X */
X
XHidden bool
Xchismash(pbuf, n, i, mask)
X    register string *pbuf;
X    register node n;
X    register int i;
X{
X    register node nn = child(n, i);
X    register int w;
X
X    if (Is_etext(nn)) {
X        strsmash(pbuf, e_strval((value)nn), mask);
X        return Yes;
X    }
X    w = nodewidth(nn);
X    if (w < 0 && Fw_negative(noderepr(nn)[0]))
X        return No;
X    if (nn == thefocus)
X        focsmash(pbuf, nn);
X    else
X        smash(pbuf, nn, mask);
X    return w >= 0;
X}
END_OF_FILE
  if test 7976 -ne `wc -c <'abc/bed/e1outp.c'`; then
    echo shar: \"'abc/bed/e1outp.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1outp.c'
fi
if test -f 'abc/bint1/i1nui.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint1/i1nui.c'\"
else
  echo shar: Extracting \"'abc/bint1/i1nui.c'\" \(8077 characters\)
  sed "s/^X//" >'abc/bint1/i1nui.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* Multi-precision integer arithmetic */
X
X#include "b.h"
X#include "feat.h"     /* for EXT_RANGE */
X#include "bobj.h"
X#include "i1num.h"
X
X/*
X * Number representation:
X * ======================
X *
X * (Think of BASE = 10 for ordinary decimal notation.)
X * A number is a sequence of N "digits" b1, b2, ..., bN
X * where each bi is in {0..BASE-1}, except for negative numbers,
X * where bN = -1.
X * The number represented by b1, ..., bN is
X *      b1*BASE**(N-1) + b2*BASE**(N-2) + ... + bN .
X * The base BASE is chosen so that multiplication of two positive
X * integers up to BASE-1 can be multiplied exactly using double
X * precision floating point arithmetic.
X * Also it must be possible to add two long integers between
X * -BASE and +BASE (exclusive), giving a result between -2BASE and
X * +2BASE.
X * BASE must be even (so we can easily decide whether the whole
X * number is even), and positive (to avoid all kinds of other trouble).
X * Presently, it is restricted to a power of 10 by the I/O-conversion
X * routines (file "i1nuc.c").
X *
X * Canonical representation:
X * bN is never zero (for the number zero itself, N is zero).
X * If bN is -1, b[N-1] is never BASE-1 .
X * All operands are assumed to be in canonical representation.
X * Routine "int_canon" brings a number in canonical representation.
X *
X * Mapping to C objects:
X * A "digit" is an integer of type "digit", probably an "int".
X * A number is represented as a "B-integer", i.e. something
X * of type "integer" (which is actually a pointer to some struct).
X * The number of digits N is extracted through the macro Length(v).
X * The i-th digit is extracted through the macro Digit(v,N-i).
X * (So in C, we count in a backwards direction from 0 ... n-1 !)
X * A number is created through a call to grab_num(N), which sets
X * N zero digits (thus not in canonical form!).
X */
X
X
X/*
X * Bring an integer into canonical form.
X * Make a SmallInt if at all possible.
X */
X
XVisible integer int_canon(v) integer v; {
X    register int i;
X
X    if (IsSmallInt(v)) return v;
X
X    for (i = Length(v) - 1; i >= 0 && Digit(v,i) == 0; --i)
X        ;
X
X    if (i < 0) {
X        Release(v);
X        return int_0;
X    }
X
X    if (i == 0) {
X        digit dig = Digit(v,0);
X        Release(v);
X        return (integer) MkSmallInt(dig);
X    }
X
X    /* i > 0 */
X    if (Digit(v,i) == -1) {
X        while (i > 0 && Digit(v, i-1) == BASE-1) --i;
X        if (i == 0) {
X            Release(v);
X            return int_min1;
X        }
X        if (i == 1) {
X            digit dig = Digit(v,0) - BASE;
X            Release(v);
X            return (integer) MkSmallInt(dig);
X        }
X        Digit(v,i) = -1;
X    }
X    else if (Digit(v, i) < -1) {
X        /* e.g. after -100 * 10**7, with BASE == 10**4 */
X        ++i;
X        if (i+1 != Length(v))
X            v = (integer) regrab_num((value) v, i+1);
X        Digit(v, i) = -1;
X        Digit(v, i-1) += BASE;
X        /* note: i>=2 && Digit(v, i-1) != BASE-1 */
X    }
X
X    if (i+1 < Length(v)) return (integer) regrab_num((value) v, i+1);
X
X    return v;
X}
X
X
X/* General add/subtract subroutine */
X
XHidden twodigit fmodulo(x) twodigit x; {
X    /* RETURN x - (BASE * floor(x/BASE)) */
X    twodigit d= x/BASE;
X    /* next one remedies if negative x/BASE rounds towards 0 */
X    if (x < 0 && d*BASE > x) --d;
X    return x - BASE*d;
X}
X
XHidden Procedure dig_gadd(to, nto, from, nfrom, ffactor)
X    digit *to, *from; intlet nto, nfrom; digit ffactor; {
X    twodigit carry= 0;
X    twodigit factor= ffactor;
X    digit save;
X
X    nto -= nfrom;
X    if (nto < 0)
X        syserr(MESS(1000, "dig_gadd: nto < nfrom"));
X    for (; nfrom > 0; ++to, ++from, --nfrom) {
X        carry += *to + *from * factor;
X        *to= save= fmodulo(carry);
X        carry= (carry-save) / BASE;
X    }
X    for (; nto > 0; ++to, --nto) {
X        if (carry == 0)
X            return;
X        carry += *to;
X        *to= save= fmodulo(carry);
X        carry= (carry-save) / BASE;
X    }
X    if (carry != 0)
X        to[-1] += carry*BASE;
X        /* Mostly -1, but it can be <-1,
X         * e.g. after -100*10**7 with BASE == 10**4
X         */
X}
X
X
X/* Sum or difference of two integers */
X/* Should have its own version of dig-gadd without double precision */
X
XVisible integer int_gadd(v, w, factor) integer v, w; intlet factor; {
X    struct integer vv, ww;
X    integer s;
X    int len, lenv, i;
X
X    FreezeSmallInt(v, vv);
X    FreezeSmallInt(w, ww);
X    lenv= len= Length(v);
X    if (Length(w) > len)
X        len= Length(w);
X    ++len;
X    s= (integer) grab_num(len);
X    for (i= 0; i < lenv; ++i)
X        Digit(s, i)= Digit(v, i);
X    for (; i < len; ++i)
X        Digit(s, i)= 0;
X    dig_gadd(&Digit(s, 0), len, &Digit(w, 0), Length(w), (digit)factor);
X    return int_canon(s);
X}
X
X/* Sum of two integers */
X
XVisible integer int_sum(v, w) integer v, w; {
X    if (IsSmallInt(v) && IsSmallInt(w))
X        return mk_int((double)SmallIntVal(v) + (double)SmallIntVal(w));
X    return int_gadd(v, w, 1);
X}
X
X/* Difference of two integers */
X
XVisible integer int_diff(v, w) integer v, w; {
X    if (IsSmallInt(v) && IsSmallInt(w))
X        return mk_int((double)SmallIntVal(v) - (double)SmallIntVal(w));
X    return int_gadd(v, w, -1);
X}
X
X/* Product of two integers */
X
XVisible integer int_prod(v, w) integer v, w; {
X    int i;
X    integer a;
X    struct integer vv, ww;
X
X    if (v == int_0 || w == int_0) return int_0;
X    if (v == int_1) return (integer) Copy(w);
X    if (w == int_1) return (integer) Copy(v);
X
X    if (IsSmallInt(v) && IsSmallInt(w))
X        return mk_int((double)SmallIntVal(v) * (double)SmallIntVal(w));
X    FreezeSmallInt(v, vv);
X    FreezeSmallInt(w, ww);
X
X    a = (integer) grab_num(Length(v) + Length(w));
X
X    for (i= Length(a)-1; i >= 0; --i)
X        Digit(a, i)= 0;
X    for (i = 0; i < Length(v) && !Interrupted(); ++i)
X        dig_gadd(&Digit(a, i), Length(w)+1, &Digit(w, 0), Length(w),
X            Digit(v, i));
X    return int_canon(a);
X}
X
XVisible integer int_neg(u) integer u; {
X    if (IsSmallInt(u))
X        return mk_int((double) (-SmallIntVal(u)));
X    return int_gadd(int_0, u, -1);
X}
X
X/* Compare two integers */
X
XVisible relation int_comp(v, w) integer v, w; {
X    int sv, sw;
X    register int i;
X    struct integer vv, ww;
X
X    /* 1. Compare pointers and equal SmallInts */
X    if (v == w) return 0;
X
X    /* 1a. Handle SmallInts */
X    if (IsSmallInt(v) && IsSmallInt(w))
X        return SmallIntVal(v) - SmallIntVal(w);
X    FreezeSmallInt(v, vv);
X    FreezeSmallInt(w, ww);
X
X    /* 2. Extract signs */
X    sv = Length(v)==0 ? 0 : Digit(v,Length(v)-1)<0 ? -1 : 1;
X    sw = Length(w)==0 ? 0 : Digit(w,Length(w)-1)<0 ? -1 : 1;
X
X    /* 3. Compare signs */
X    if (sv != sw) return (sv>sw) - (sv<sw);
X
X    /* 4. Compare sizes */
X    if (Length(v) != Length(w))
X        return sv * ( (Length(v)>Length(w)) - (Length(v)<Length(w)) );
X
X    /* 5. Compare individual digits */
X    for (i = Length(v)-1; i >= 0 && Digit(v,i) == Digit(w,i); --i)
X        ;
X
X    /* 6. All digits equal? */
X    if (i < 0) return 0;  /* Yes */
X
X    /* 7. Compare leftmost different digits */
X    if (Digit(v,i) < Digit(w,i)) return -1;
X
X    return 1;
X}
X
X
X/* Construct an integer out of a floating point number */
X
X#define GRAN 8    /* Granularity used when requesting more storage */
X        /* MOVE TO MEM! */
XVisible integer mk_int(x) double x; {
X    register integer a;
X    integer b;
X    register int i, j;
X    int negate;
X
X    if (MinSmallInt <= x && x <= MaxSmallInt)
X        return (integer) MkSmallInt((int)x);
X
X    a = (integer) grab_num(1);
X    negate = x < 0 ? 1 : 0;
X    if (negate) x = -x;
X
X    for (i = 0; x != 0; ++i) {
X        double z = floor(x/BASE);
X        double y = z*BASE;
X        digit save = Modulo((int)(x-y), BASE);
X        if (i >= Length(a)) {
X            a = (integer) regrab_num((value) a, Length(a)+GRAN);
X            for (j = Length(a)-1; j > i; --j)
X                Digit(a,j) = 0;    /* clear higher digits */
X        }
X        Digit(a,i) = save;
X        x = floor((x-save)/BASE);
X    }
X
X    if (negate) {
X        b = int_neg(a);
X        Release(a);
X        return b;
X    }
X
X    return int_canon(a);
X}
X
X/* Construct an integer out of a C int.  Like mk_int, but optimized. */
X
XVisible value mk_integer(x) int x; {
X    if (MinSmallInt <= x && x <= MaxSmallInt) return MkSmallInt(x);
X    return (value) mk_int((double)x);
X}
X
X
X/* Efficiently compute 10**n as a B integer, where n is a C int >= 0 */
X
XVisible integer int_tento(n) int n; {
X    integer i;
X    digit msd = 1;
X    if (n < 0) syserr(MESS(1001, "int_tento(-n)"));
X    if (n < tenlogBASE) {
X        while (n != 0) msd *= 10, --n;
X        return (integer) MkSmallInt(msd);
X    }
X    i = (integer) grab_num(1 + (int)(n/tenlogBASE));
X    if (i) {
X        n %= tenlogBASE;
X        while (n != 0) msd *= 10, --n;
X        Digit(i, Length(i)-1) = msd;
X    }
X    /* else caveat invocator */
X    return i;
X}
END_OF_FILE
  if test 8077 -ne `wc -c <'abc/bint1/i1nui.c'`; then
    echo shar: \"'abc/bint1/i1nui.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint1/i1nui.c'
fi
if test -f 'abc/bint3/i3gfx.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint3/i3gfx.c'\"
else
  echo shar: Extracting \"'abc/bint3/i3gfx.c'\" \(8005 characters\)
  sed "s/^X//" >'abc/bint3/i3gfx.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * Graphics extension to B.
X *
X * Three commands have been added:
X *
X * SPACE'FROM a, b TO c, d
X *    Enters graphics mode; (a, b) is the lower left corner, (c, d) the
X *    upper right corner of screen.  Clears the screen in any case.
X *    A few lines at the bottom of the screen are still used for
X *    normal scrolling text.    If a=c or b=d, the corresponding
X *    scale is taken from the device precision with the origin
X *    in the middle of the screen.
X *
X * LINE'FROM a, b TO c, d
X *    Draws a line (with clipping) from (a, b) to (c, d).
X *    If not already in graphics mode, enter it (with unchanged
X *    coordinate space).
X *
X * CLEAR'SCREEN
X *    If in graphics mode, turns it off.  Clears the screen in any case.
X *
X *
X * Changes have also been made to the editor, parser and interpreter;
X * these are only compiled if '#ifdef GFX' is true.
X */
X
X#include "b.h"
X#include "bobj.h"
X#include "bgfx.h"
X
X#ifdef GFX
X
X/* Interface for interpreter ----------------------------------------------- */
X
Xbool enter_gfx();
Xdo_space();
Xdo_line();
X
X
X/*
X * Enter graphics mode.  Clear the screen.  Set spacing to given values.
X */
X
XVisible Procedure space_to(v, w) value v, w; {
X    do_gfx(v, w, /*&*/do_space);
X}
X
X
X/*
X * Draw a line between given points.
X * If not already in graphics mode, enter it first.
X * (Default spacing is the same as used last time, or (0, 0) TO (100, 100)
X * if no SPACE command was ever issued.)
X */
X
XVisible Procedure line_to(v, w) value v, w; {
X    do_gfx(v, w, /*&*/do_line);
X}
X
X
X/*
X * Exit graphics mode.
X * Clear the screen.
X */
X
XVisible Procedure clear_screen() {
X    exit_gfx();
X}
X
X
X/* Device-independent code ------------------------------------------------- */
X
X/*
X * Graphics mode.
X */
X
XVisible int gfx_mode= TEXT_MODE;
X
X
X/*
X * Representation of a vector.
X */
X
Xtypedef struct vector {
X    double x;
X    double y;
X} vector;
X
X
X/*
X * Variables describing the user coordinate space.
X * (Can be changed by calls to space_to).
X */
X
Xstatic vector origin= {0.0, 0.0};
Xstatic vector corner= {0.0, 0.0};
X
X
X/*
X * Scale factor for coordinate transformation.
X * (Computed from above variables plus device information by space_to.)
X */
X
Xstatic vector scale;
X
X
X/*
X * Macros to do the transformation from user to device coordinates.
X */
X
X#define XSCALE(a) (((a) - origin.x) * scale.x)
X#define YSCALE(a) (((a) - origin.y) * scale.y)
X
X
X/*
X * Check to see if a B value is a valid vector (= pair of numbers).
X * If so, extract the value into the vector whose address is passed.
X */
X
XHidden bool get_point(v, pv) value v; vector *pv; {
X    value x, y;
X
X    if (!Is_compound(v) || Nfields(v) != 2)
X        return No;
X    x= *Field(v, 0);
X    y= *Field(v, 1);
X    if (!Is_number(x) || !Is_number(y))
X        return No;
X    pv->x= numval(x);
X    pv->y= numval(y);
X    return Yes;
X}
X
X
X/*
X * Generic code for graphics routines that have two vector parameters.
X * Check that the arguments are indeed vectors and call the processing code.
X */
X
XHidden Procedure do_gfx(v, w, proc) value v; value w; int (*proc)(); {
X    vector v1, v2;
X
X    if (!get_point(v, &v1) || !get_point(w, &v2)) {
X        interr(MESS(8000, "argument to graphics command not a vector"));
X        return;
X    }
X    (*proc)(&v1, &v2);
X}
X
X
X/*
X * Routine to enter graphics mode and set the spacing as desired.
X */
X
XHidden Procedure do_space(pv1, pv2) vector *pv1, *pv2; {
X    double tmp;
X
X    if (gfx_mode != GFX_MODE) {
X        if (!enter_gfx()) {
X            interr(MESS(8001, "no graphics hardware available"));
X            return;
X        }
X    }
X    clipinit(dev_origin.x, dev_origin.y, dev_corner.x, dev_corner.y);
X    origin.x= pv1->x;
X    origin.y= pv1->y;
X    corner.x= pv2->x;
X    corner.y= pv2->y;
X    if (origin.x > corner.x) {
X        tmp= origin.x;
X        origin.x= corner.x;
X        corner.x= tmp;
X    }
X    else if (origin.x == corner.x) {
X        origin.x= dev_origin.x - (dev_corner.x - dev_origin.x) / 2;
X        corner.x= origin.x + (dev_corner.x - dev_origin.x);
X    }
X    if (origin.y > corner.y) {
X        tmp= origin.y;
X        origin.y= corner.y;
X        corner.y= tmp;
X    }
X    else if (origin.y == corner.y) {
X        origin.y= dev_origin.y - (dev_corner.y - dev_origin.y) / 2;
X        corner.y= origin.y + (dev_corner.y - dev_origin.y);
X    }
X    scale.x= (double) (dev_corner.x - dev_origin.x) /
X            (corner.x - origin.x);
X    scale.y= (double) (dev_corner.y - dev_origin.y) /
X            (corner.y - origin.y);
X}
X
X
X/*
X * Routine to draw a line.
X */
X
XHidden Procedure do_line(pv1, pv2) vector *pv1, *pv2; {
X    int x1, y1, x2, y2;
X
X    if (gfx_mode != GFX_MODE) {
X        do_space(&origin, &corner);
X        if (gfx_mode != GFX_MODE)
X            return;
X    }
X    x1= XSCALE(pv1->x);
X    x2= XSCALE(pv2->x);
X    y1= YSCALE(pv1->y);
X    y2= YSCALE(pv2->y);
X    if (inview2d(x1, y1, x2, y2) || clip2d(&x1, &y1, &x2, &y2))
X        draw_line(x1, y1, x2, y2);
X}
X
X/* Clipping ---------------------------------------------------------------- */
X
X/* @(#)clip.c    1.2 - 85/10/07 */
X/*
X * Fast, 2d, integer clipping plot(3) operations.
X * Clipping algorithm taken from "A New Concept and Method for Line Clipping,"
X * Barsky & Liang, ACM Tran. on Graphics Vol 3, #1, Jan 84.
X * In contrast to the algoritm presented in TOG, this one works
X * on integers only.  The idea is to only do that which is useful
X * for my plot(3) based graphics programs.
X */
X
X/* AUTHOR:
XRob Adams <ima!rob>
XInteractive Systems, 7th floor, 441 Stuart st, Boston, MA 02116; 617-247-1155
X*/
X
X/*
X * Interface:
X *
X *  clipinit(int xleft, int ybottom, int xright, int ytop)
X *   Send this guy the same things you would send to space().
X *   Don't worry if xleft > xright.
X *
X *  clip2d(int *x0p, int *y0p, int *x1p, int *y1p)
X *   By the time this returns, the points referenced will have
X *   been clipped.  Call this right before line(), with pointers
X *   to the same arguments.  Returns TRUE is the resulting line
X *   can be displayed.
X *
X *  inview2d(int x0,int y0,int x1,int y1)
X *   Does a fast check for simple acceptance.  Returns TRUE if
X *   the segment is intirely in view.  If your program runs too
X *   slowly, consider making this a macro.
X *
X *  Usage of clip2d and inview2d would be something like --
X *    (inview2d(x0,y0, x1,y1) || clip2d(&x0,&y0, &x1,&y1))
X *        && line(x0,y0,x1,y1);
X *  If inview2d says the segment is safe or clip2d says the clipped
X *  segment is safe, then go ahead and print the line.
X */
Xstatic int Xleft, Xright, Ytop, Ybot;
X
X#define TRUE    1
X#define FALSE    0
X#define bool    int
X
X/*------------------------------- clipinit ----------------------------------*/
Xclipinit(x0,y0,x1,y1) {
X    if ( x0 > x1 ) {
X        Xleft  = x1;
X        Xright = x0;
X    } else {
X        Xleft  = x0;
X        Xright = x1;
X    }
X    if ( y0 > y1 ) {
X        Ytop = y0;
X        Ybot = y1;
X    } else {
X        Ytop = y1;
X        Ybot = y0;
X    }
X}
X
X/*------------------------------- inview2d ----------------------------------*/
Xbool inview2d(x0,y0, x1,y1) register x0,y0, x1,y1; {
X    return    x0 >= Xleft && x0 <= Xright && x1 >= Xleft && x1 <= Xright &&
X        y0 >= Ybot  && y0 <= Ytop   && y1 >= Ybot  && y1 <= Ytop;
X}
X
X/*-------------------------------- clip2d -----------------------------------*/
Xbool clip2d(x0p, y0p, x1p, y1p) int *x0p, *y0p, *x1p, *y1p; {
X    register int    x0 = *x0p,
X            y0 = *y0p,
X            x1 = *x1p,
X            y1 = *y1p;
X
X    register int    dx, dy;
X         double t0, t1;
X
X    t0 = 0.0, t1 = 1.0;             /* init parametic equations */
X    dx = x1 - x0;
X    if ( clipt( -dx, x0 - Xleft, &t0, &t1) &&
X         clipt( dx, Xright - x0, &t0, &t1)) {
X        dy = y1 - y0;
X        if ( clipt( -dy, y0 - Ybot, &t0, &t1) &&
X         clipt( dy, Ytop - y0, &t0, &t1)) {
X        if ( t1 < 1 ) {
X            *x1p = x0 + t1 * dx;
X            *y1p = y0 + t1 * dy;
X        }
X        if ( t0 > 0.0 ) {
X            *x0p = x0 + t0 * dx;
X            *y0p = y0 + t0 * dy;
X        }
X        return TRUE;
X        }
X    }
X    return FALSE;
X}
X
X/*-------------------------------- clipt ------------------------------------*/
Xstatic bool clipt(p, q, t0p, t1p) register int p, q;
X        register double *t0p, *t1p; {
X    register double r;
X
X    if ( p < 0 ) {
X        r = (double)q / p;
X        if ( r > *t1p )
X        return FALSE;
X        if ( r > *t0p )
X        *t0p = r;
X    } else if (p > 0) {
X        r = (double)q / p;
X        if ( r < *t0p )
X        return FALSE;
X        if ( r < *t1p )
X        *t1p = r;
X    } else if (q < 0)
X        return FALSE;
X    return TRUE;
X}
X
X#endif /* GFX */
END_OF_FILE
  if test 8005 -ne `wc -c <'abc/bint3/i3gfx.c'`; then
    echo shar: \"'abc/bint3/i3gfx.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint3/i3gfx.c'
fi
if test -f 'abc/lin/i1tlt.h' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/lin/i1tlt.h'\"
else
  echo shar: Extracting \"'abc/lin/i1tlt.h'\" \(1494 characters\)
  sed "s/^X//" >'abc/lin/i1tlt.h' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/************************************************************************/
X/* Private definitions for small texts, lists and tables module         */
X/* A text is modelled as a sequence of len characters.                  */
X/*                                                                      */
X/* A list is modelled as a sequence of len values,                      */
X/*         each of which corresponds to a list entry.                   */
X/*  or, for a numeric range display with more than Minrange entries,    */
X/*         it is modelled as a sequence of two values, corresponding    */
X/*         to the lower and upper bounds, respectively.                 */
X/*                                                                      */
X/* A table is modelled as a sequence of len values,                     */
X/*         each of which corresponds to a table entry;                  */
X/*     table entries are modelled as a compound with two fields.        */
X/************************************************************************/
X
X#define Cts(v) (*Ats(v))
X#define Dts(v) (*(Ats(v)+1))
X
X#define List_elem(l, i) (*(Ats(l)+i)) /*counts from 0; takes no copy*/
X#define Key(t, i) (Ats(*(Ats(t)+i))) /*Ditto*/
X#define Assoc(t, i) (Ats(*(Ats(t)+i))+1) /*Ditto*/
X
X#define Lwb(l)    (*Ats(l))
X#define Upb(l)    (*(Ats(l)+1))
X
Xvalue rangesize();
Xrelation range_comp();
Xbool found();
Xvalue list_elem();
Xvalue key_elem();
END_OF_FILE
  if test 1494 -ne `wc -c <'abc/lin/i1tlt.h'`; then
    echo shar: \"'abc/lin/i1tlt.h'\" unpacked with wrong size!
  fi
  # end of 'abc/lin/i1tlt.h'
fi
if test -f 'abc/stc/i2tce.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/stc/i2tce.c'\"
else
  echo shar: Extracting \"'abc/stc/i2tce.c'\" \(7902 characters\)
  sed "s/^X//" >'abc/stc/i2tce.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* process type unification errors */
X
X#include "b.h"
X#include "bobj.h"
X#include "i2stc.h"
X
X#define I_FOUND_TYPE    GMESS(2600, "I found type ")
X#define EG        GMESS(2601, "EG ")
X#define WHERE_EXPECTED    GMESS(2602, " where I expected ")
X
X#define I_THOUGHT    GMESS(2603, "I thought ")
X#define WAS_OF_TYPE    GMESS(2604, " was of type ")
X
X#define LT_OF        GMESS(2605, "list or table of ")
X#define LT        GMESS(2606, "list or table")
X#define T_OR_LT_OF_T    GMESS(2607, """, or list or table of """)
X#define TLT        GMESS(2608, "text or list or table")
X
X#define INCOMPATIBLE    GMESS(2609, "incompatible type for ")
X#define INCOMPATIBLES    GMESS(2610, "incompatible types for ")
X#define _AND_        GMESS(2611, " and ")
X
X/*
X * The variables from the users line are inserted in var_list.
X * This is used to produce the right variable names
X * in the error message.
X * Call start_vars() when a new error context is established
X * with the setting of curline.
X */
X
XHidden value var_list;
X
XVisible Procedure start_vars() {
X    var_list = mk_elt();
X}
X
XVisible Procedure add_var(tvar) polytype tvar; {
X    insert(tvar, &var_list);
X}
X
XHidden bool in_vars(t) polytype t; {
X    return in(t, var_list);
X}
X
XVisible Procedure end_vars() {
X    release(var_list);
X}
X
X/* t_repr(u) is used to print polytypes when an error
X * has occurred.
X * Because the errors are printed AFTER unification, the variable
X * polytypes in question have changed to the error-type.
X * To print the real types in error, the table has to be
X * saved in reprtable.
X * The routines are called in unify().
X */
X
XHidden value reprtable;
Xextern value ptype_of;         /* defined in i2tp.c */
X
XVisible Procedure setreprtable() {
X    reprtable = copy(ptype_of);
X}
X
XVisible Procedure delreprtable() {
X    release(reprtable);
X}
X
X/* variables whose type is in error are gathered in errvarlist */
X
XHidden value errvarlist;
X
XVisible Procedure starterrvars() {
X    errvarlist= mk_elt();
X}
X
XVisible Procedure adderrvar(t) polytype t; {
X    if (in_vars(t) && !in(t, errvarlist))
X        insert(t, &errvarlist);
X}
X
XVisible Procedure enderrvars() {
X    release(errvarlist);
X}
X
X/* miscellaneous procs */
X
XVisible value conc(v, w) value v, w; {
X    value c;
X    c = concat(v, w);
X    release(v); release(w);
X    return c;
X}
X
XHidden bool newvar(u) polytype u; {
X    value u1;
X    char ch;
X    u1 = curtail(ident(u), one);
X    ch = charval(u1);
X    release(u1);
X    return (bool) ('0' <= ch && ch <= '9');
X}
X
X#define Known(tu) (!t_is_var(kind(tu)) && !t_is_error(kind(tu)))
X
XHidden polytype oldbottomtype(u) polytype u; {
X    polytype tu= u;
X    while (t_is_var(kind(tu)) && in_keys(ident(tu), reprtable))
X        tu= *adrassoc(reprtable, ident(tu));
X    return tu; /* not a copy, just a pointer! */
X}
X
XHidden value t_repr(u) polytype u; {
X    typekind u_kind;
X    polytype tau;
X    value c;
X
X    u_kind = kind(u);
X    if (t_is_number(u_kind)) {
X        return mk_text("0");
X    }
X    else if (t_is_text(u_kind)) {
X        return mk_text("\"\"");
X    }
X    else if (t_is_tn(u_kind)) {
X        return mk_text("\"\" or 0");
X    }
X    else if (t_is_compound(u_kind)) {
X        intlet k, len = nsubtypes(u);
X        c = mk_text("(");
X        for (k = 0; k < len - 1; k++) {
X            c = conc(c, t_repr(subtype(u, k)));
X            c = conc(c, mk_text(", "));
X        }
X        c = conc(c, t_repr(subtype(u, k)));
X        return conc(c, mk_text(")"));
X    }
X    else if (t_is_error(u_kind)) {
X        return mk_text("?");
X    }
X    else if (t_is_var(u_kind)) {
X        value tu;
X        tu = oldbottomtype(u);
X        if (Known(tu))
X            return t_repr(tu);
X        else if (newvar(u))
X            return mk_text("?");
X        else
X            return copy(ident(u));
X    }
X    else if (t_is_table(u_kind)) {
X        c = conc(mk_text("{["),
X            t_repr(keytype(u)));
X        c = conc(c, mk_text("]: "));
X        c = conc(c, t_repr(asctype(u)));
X        return conc(c, mk_text("}"));
X    }
X    else if (t_is_list(u_kind)) {
X        c = conc(mk_text("{"), t_repr(asctype(u)));
X        return conc(c, mk_text("}"));
X    }
X    else if (t_is_lt(u_kind)) {
X        tau = oldbottomtype(asctype(u));
X        if (Known(tau))
X            return conc(mk_text(LT_OF),
X                    t_repr(tau));
X        else
X            return mk_text(LT);
X    }
X    else if (t_is_tlt(u_kind)) {
X        tau= oldbottomtype(asctype(u));
X        if (Known(tau)) {
X            if (t_is_text(kind(tau)))
X                return mk_text(T_OR_LT_OF_T);
X            else
X                return conc(mk_text(LT_OF), t_repr(tau));
X        }
X        else
X            return mk_text(TLT);
X    }
X    else {
X        return mk_text("***"); /* cannot happen */
X    }
X}
X
X/* now, the real error messages */
X
XVisible Procedure badtyperr(a, b) polytype a, b; {
X    value t;
X    value nerrs, n, ne_min, m, sep;
X    polytype te, bte;
X
X    nerrs= size(errvarlist);
X
X    if (compare(nerrs, one) < 0) {
X        t= mk_text(I_FOUND_TYPE);
X        if (!has_lt(kind(a)))
X            t= conc(t, mk_text(EG));
X        t= conc(t, t_repr(a));
X        t= conc(t, mk_text(WHERE_EXPECTED));
X        t= conc(t, t_repr(b));
X    }
X    else if (compare(nerrs, one) == 0) {
X        te= (polytype) item(errvarlist, one);
X        bte= oldbottomtype(te);
X        if (Known(bte)) {
X            t= conc(mk_text(I_THOUGHT),
X                copy(ident(te)));
X            t= conc(t, mk_text(WAS_OF_TYPE));
X            if (!has_lt(kind(bte)))
X                t= conc(t, mk_text(EG));
X            t= conc(t, t_repr(bte));
X        }
X        else {
X            t= conc(mk_text(INCOMPATIBLE),
X                copy(ident(te)));
X        }
X    }
X    else {
X        n= copy(one);
X        ne_min= diff(nerrs, one);
X        t= mk_text(INCOMPATIBLES);
X        for (;;) {
X            te= item(errvarlist, n);
X            t= conc(t, copy(ident(te)));
X            if (compare(n, nerrs) == 0)
X                break;
X            if (compare(n, ne_min) < 0)
X                sep= mk_text(", ");
X            else
X                sep= mk_text(_AND_);
X            t= conc(t, sep);
X            n= sum(m=n, one);
X            release(m); release(te);
X        }
X        release(te); release(ne_min); release(n);
X    }
X    release(nerrs);
X
X    typerrV(MESS(2612, "%s"), t);
X    release(t);
X}
X
X#ifdef TYPETRACE
X#include "i2nod.h"
Xchar *treename[NTYPES] = { /* legible names for debugging */
X    "HOW TO",
X    "HOW TO RETURN",
X    "HOW TO REPORT",
X    "REFINEMENT",
X
X/* Commands */
X
X    "SUITE",
X    "PUT",
X    "INSERT",
X    "REMOVE",
X    "SET RANDOM",
X    "DELETE",
X    "CHECK",
X    "SHARE",
X    "PASS",
X
X    "WRITE",
X    "WRITE1",
X    "READ",
X    "READ_RAW",
X
X    "IF",
X    "WHILE",
X    "FOR",
X
X    "SELECT",
X    "TEST_SUITE",
X    "ELSE",
X
X    "QUIT",
X    "RETURN",
X    "REPORT",
X    "SUCCEED",
X    "FAIL",
X
X    "USER_COMMAND",
X    "EXTENDED_COMMAND",
X
X/* Expressions, targets, tests */
X
X    "TAG",
X    "COMPOUND",
X
X/* Expressions, targets */
X
X    "COLLATERAL",
X    "SELECTION",
X    "BEHEAD",
X    "CURTAIL",
X
X/* Expressions, tests */
X
X    "UNPARSED",
X
X/* Expressions */
X
X    "MONF",
X    "DYAF",
X    "NUMBER",
X    "TEXT_DIS",
X    "TEXT_LIT",
X    "TEXT_CONV",
X    "ELT_DIS",
X    "LIST_DIS",
X    "RANGE_BNDS",
X    "TAB_DIS",
X
X/* Tests */
X
X    "AND",
X    "OR",
X    "NOT",
X    "SOME_IN",
X    "EACH_IN",
X    "NO_IN",
X    "MONPRD",
X    "DYAPRD",
X    "LESS_THAN",
X    "AT_MOST",
X    "GREATER_THAN",
X    "AT_LEAST",
X    "EQUAL",
X    "UNEQUAL",
X    "Nonode",
X
X    "TAGformal",
X    "TAGlocal",
X    "TAGglobal",
X    "TAGrefinement",
X    "TAGzerfun",
X    "TAGzerprd",
X
X    "ACTUAL",
X    "FORMAL",
X
X#ifdef GFX
X    "SPACE",
X    "LINE",
X    "CLEAR",
X#endif
X
X    "COLON_NODE",
X
X};
X
Xextern FILE *stc_fp;
X
XVisible Procedure t_typecheck(nt, t) int nt; string t; {
X    if (stc_fp == NULL)
X        return;
X    fprintf(stc_fp, "TC NODE %s, CODE %s\n", treename[nt], t);
X    fflush(stc_fp);
X}
X
XVisible Procedure s_unify(a, b) polytype a, b; {
X    value t;
X
X    if (stc_fp == NULL)
X        return;
X    t= mk_text("START UNIFY ");
X    if (t_is_var(kind(a))) {
X        t= conc(t, copy(ident(a)));
X        t= conc(t, mk_text("="));
X    }
X    t= conc(t, convert((value)oldbottomtype(a), No, No));
X    t= conc(t, mk_text(" WITH "));
X    if (t_is_var(kind(b))) {
X        t= conc(t, copy(ident(b)));
X        t= conc(t, mk_text("="));
X    }
X    t= conc(t, convert((value)oldbottomtype(b), No, No));
X    fprintf(stc_fp, "%s\n", strval(t));
X    release(t);
X    t= mk_text("USING ");
X    t= conc(t, convert(ptype_of, No, No));
X    fprintf(stc_fp, "%s\n", strval(t));
X    release(t);
X    fflush(stc_fp);
X}
X
XVisible Procedure e_unify(a, b, c) polytype a, b, c; {
X    value t;
X
X    if (stc_fp == NULL)
X        return;
X    t= mk_text("GIVING ");
X    if (t_is_var(kind(c))) {
X        t= conc(t, copy(ident(c)));
X        t= conc(t, mk_text("="));
X    }
X    t= conc(t, convert((value)oldbottomtype(c), No, No));
X    fprintf(stc_fp, "%s\n", strval(t));
X    release(t);
X    t= mk_text("PRODUCING ");
X    t= conc(t, convert(ptype_of));
X    fprintf(stc_fp, "%s\n", strval(t));
X    release(t);
X    fflush(stc_fp);
X}
X#endif /* TYPETRACE */
END_OF_FILE
  if test 7902 -ne `wc -c <'abc/stc/i2tce.c'`; then
    echo shar: \"'abc/stc/i2tce.c'\" unpacked with wrong size!
  fi
  # end of 'abc/stc/i2tce.c'
fi
echo shar: End of archive 17 \(of 25\).
cp /dev/null ark17isdone
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...