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

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

Subject:  v23i092:  ABC interactive programming environment, Part13/25
Newsgroups: comp.sources.unix
Approved: [e-mail]
X-Checksum-Snefru: e42a6455 d4dc5881 00faf5b0 64a38b31

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

#! /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/e1que1.c abc/bint1/DEP abc/bint3/i3loc.c
#   abc/bint3/i3scr.c abc/mkconfig.c
# Wrapped by [e-mail] on Mon Dec 17 13:28:05 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 13 (of 25)."'
if test -f 'abc/bed/e1que1.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bed/e1que1.c'\"
else
  echo shar: Extracting \"'abc/bed/e1que1.c'\" \(11620 characters\)
  sed "s/^X//" >'abc/bed/e1que1.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/*
X * B editor -- Manipulate queues of nodes, lower levels.
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 "supr.h"
X#include "queu.h"
X#include "gram.h"
X#include "tabl.h"
X
X#ifdef lint
XVisible queue
Xqcopy(q)
X    queue q;
X{
X    return (queue) copy((value) q);
X}
X
XVisible Procedure
Xqrelease(q)
X    queue q;
X{
X    release((value) q);
X}
X#endif
X
X/*
X * Append queue 2 to the end of queue 1.
X */
X
XVisible Procedure
Xjoinqueues(pq, q)
X    register queue *pq;
X    register queue q;
X{
X    if (emptyqueue(q))
X        return;
X    while (*pq) {
X        if (Refcnt(*pq) > 1)
X            uniql((value*)pq);
X        pq = &(*pq)->q_link;
X    }
X    *pq = q;
X}
X
X
X/*
X * Prepend a node to a queue ("push").
X * Empty strings and Optional holes are silently discarded.
X */
X
XVisible Procedure
Xpreptoqueue(n, pq)
X    node n;
X    register queue *pq;
X{
X    register queue q;
X
X    if (Is_etext(n)) {
X        if (e_length((value) n) == 0)
X            return;
X        n = nodecopy(n);
X    }
X    else { /* Avoid Optional holes */
X        if (symbol(n) == Optional)
X            return;
X        n = nodecopy(n);
X    }
X    q = (queue) mk_compound(2);
X    q->q_data = n;
X    q->q_link = *pq;
X    *pq = q;
X}
X
X
X/*
X * Append a node to the end of a queue (same extras as preptoqueue).
X */
X
XVisible Procedure
Xaddtoqueue(pq, n)
X    register queue *pq;
X    register node n;
X{
X    auto queue q = Qnil;
X
X    preptoqueue(n, &q);
X    joinqueues(pq, q);
X}
X
X
X/*
X * Push a string onto a queue.
X */
X
XVisible Procedure
Xstringtoqueue(str, pq)
X    register string str;
X    register queue *pq;
X{
X    register value  v;
X
X    if (str == NULL)
X        return;
X    v = mk_etext(str);
X    preptoqueue((node) v, pq);
X    release(v);
X}
X
X/*
X * Append a string to a queue.
X */
X
X#ifdef NOT_USED
X
XVisible Procedure
Xaddstringtoqueue(pq, str)
X    register queue *pq;
X    register string str;
X{
X    register value v = mk_etext(str);
X
X    addtoqueue(pq, (node) v);
X    release(v);
X}
X
X#endif /* NOT_USED */
X
X/*
X * Get the first node of a queue and delink it ("pop").
X */
X
XVisible node
Xqueuebehead(pq)
X    register queue *pq;
X{
X    register node n;
X    register queue q = *pq;
X
X    Assert(q);
X
X    n = nodecopy(q->q_data);
X    *pq = qcopy(q->q_link);
X    qrelease(q);
X    return n;
X}
X
X
X/*
X * Split a node in successive queue elements which are pushed
X * on the queue using preptoqueue.
X * 'Atomic' nodes (texts and holes) are pushed unadorned.
X */
X
XVisible Procedure
Xsplitnode(n, pq)
X    register node n;
X    register queue *pq;
X{
X    register node nn;
X    register string *rp;
X    register int i;
X    register int sym;
X
X    if (Is_etext(n)) {
X        preptoqueue(n, pq);
X        return;
X    }
X    sym = symbol(n);
X    if (sym == Optional)
X        return;
X    if (sym == Hole) {
X        preptoqueue(n, pq);
X        return;
X    }
X
X    rp = noderepr(n);
X    for (i = nchildren(n); i >= 0; --i) {
X        if (rp[i] && rp[i][0])
X            stringtoqueue(rp[i], pq);
X        if (i) {
X            nn = child(n, i);
X            if (Is_etext(nn) || symbol(nn) != Optional)
X                preptoqueue(nn, pq);
X        }
X    }
X}
X
X
X/*
X * Substitute the focus for its parent, appending the remainder of
X * the parent to the queue.
X * The focus must be the first child and not preceded by fixed text.
X * The focus must be allowed in the place of its parent.
X * If any of these conditions is not met, No is returned and nothing
X * is changed.
X *
X * Do not queue a "hollow" rest, since it seems to be substituted anyway.
X * (timo)
X */
X
XVisible bool
Xresttoqueue(pp, pq)
X    register path *pp;
X    register queue *pq;
X{
X    auto queue q = Qnil;
X    register path pa = parent(*pp);
X    register node n = tree(*pp);
X    register int sym = symbol(n);
X    /* register markbits x; */
X    bool rest_is_hollow();
X
X    if (!pa || ichild(*pp) != 1
X        || fwidth(noderepr(tree(pa))[0]) != 0 || !allowed(pa, sym))
X        return No;
X
X    n = nodecopy(n);
X    /* x = marks(n); */
X    if (!up(pp)) Abort();
X    if (!rest_is_hollow(tree(*pp))) {
X        splitnode(tree(*pp), &q);
X        noderelease(queuebehead(&q));
X        joinqueues(pq, q);
X    }
X    treereplace(pp, n);
X    /* if (x) { */
X        /* markpath(pp, x); */ /* Actually, should restore all n's marks? */
X    /* } */
X    return Yes;
X}
X
XHidden bool rest_is_hollow(n) node n; {
X    register node nn;
X    register string *rp;
X    register int i;
X    register int sym;
X
X    Assert(!Is_etext(n));
X
X    rp = noderepr(n);
X    for (i = nchildren(n); i >= 0; --i) {
X        if (Fwidth(rp[i]) > 0)
X            return No;
X        if (i > 1) {
X            nn = child(n, i);
X            if (Is_etext(nn)
X                ||
X                ((sym=symbol(nn)) != Optional
X                 &&
X                 sym != Hole
X                )
X               )
X                return No;
X        }
X    }
X    return Yes;
X}
X
X/*
X * Like resttoqueue, but exactly from current position in fixed text.
X * Also, it cannot fail.
X */
X
XVisible Procedure
Xnosuggtoqueue(ep, pq)
X    register environ *ep;
X    queue *pq;
X{
X    auto queue q = Qnil;
X    register int i;
X    register string *rp;
X    register node n;
X    register node nn;
X    register int sym;
X    string str;
X
X    if (issuggestion(ep))
X        return;
X    Assert((ep->mode == FHOLE || ep->mode == VHOLE) && (ep->s1&1));
X
X    n = tree(ep->focus);
X    rp = noderepr(n);
X    for (i = nchildren(n); i > ep->s1/2; --i) {
X        if (!Fw_zero(rp[i]))
X            stringtoqueue(rp[i], &q);
X        nn = child(n, i);
X        sym = symbol(nn);
X        if (sym != Optional) {
X            preptoqueue(nn, &q);
X            if (sym != Hole) {
X                s_downi(ep, i);
X                delfocus(&ep->focus);
X                s_up(ep);
X            }
X        }
X    }
X    str = rp[i];
X    if (str && str[ep->s2]) /* Push partial first text */
X        stringtoqueue(str + ep->s2, &q);
X    joinqueues(pq, q);
X}
X
X
X/*
X * Check whether the remainder of the current node is all suggestion.
X */
X
XVisible bool
Xissuggestion(ep)
X    register environ *ep;
X{
X    register node n;
X    register int nch;
X    register int sym;
X    register int i;
X
X    if (ep->mode != VHOLE && ep->mode != FHOLE || !(ep->s1&1))
X        return No; /* Actually wrong call? */
X
X    n = tree(ep->focus);
X    nch = nchildren(n);
X    for (i = ep->s1/2 + 1; i <= nch; ++i) {
X        sym = symbol(child(n, i));
X        if (sym != Hole && sym != Optional)
X            return No;
X    }
X    return Yes;
X}
X
X
X/*
X * See if a node fits in a hole.
X */
X
XVisible bool
Xfitnode(pp, n)
X    register path *pp;
X    register node n;
X{
X    if (!allowed(*pp, symbol(n)))
X        return No;
X    treereplace(pp, nodecopy(n));
X    return Yes;
X}
X
X
X/*
X * Fit a string in a hole.
X * Returns the number of characters consumed.
X * (This does not have to be the maximum possible, but a reasonable attempt
X * is made.  If the internal buffer is exhausted, it leaves the rest for
X * another call.)
X */
X
XVisible int
Xfitstring(pp, str, alt_c)
X    register path *pp;
X    register string str;
X    int alt_c;
X{
X    environ dummyenv;
X    register node n;
X    register int ich;
X    register int len;
X    register string cp;
X    char buf[1024];
X
X    Assert(str);
X    if (!str[0])
X        return 0;
X    if (!insguess(pp, str[0], &dummyenv)) {
X        if (!alt_c)
X            return 0;
X        if (!insguess(pp, alt_c, &dummyenv))
X            return 0;
X    }
X    if (Is_etext(tree(*pp)))
X        if (!up(pp)) Abort();
X    if (dummyenv.mode == FHOLE) {
X        cp = noderepr(tree(*pp))[0];
X        len = 1;
X        if (cp) {
X            ++str;
X            ++cp;
X            while (*str >= ' ' && *str == *cp) {
X                ++len;
X                ++str;
X                ++cp;
X            }
X        }
X        return len;
X    }
X    if (dummyenv.mode == VHOLE) {
X        buf[0] = str[0];
X        ++str;
X        len = 1;
X        n = tree(*pp);
X        ich = dummyenv.s1/2;
X        while (*str && mayinsert(n, ich, len, *str) && len < sizeof buf - 1) {
X            buf[len] = *str;
X            ++str;
X            ++len;
X        }
X        if (len > 1) {
X            buf[len] = 0;
X            if (!downi(pp, ich)) Abort();
X            treereplace(pp, (node) mk_etext(buf));
X            if (!up(pp)) Abort();
X        }
X        return len;
X    }
X    return 1;
X}
X
X
X/*
X * Set the focus position (some VHOLE/FHOLE setting, probably)
X * at the 'len'th character from the beginning of the current node.
X * This may involve going to a child or moving beyond the current subtree.
X * Negative 'len' values may be given to indicate negative widths;
X * this is implemented incomplete.
X */
X
XVisible Procedure
Xfixfocus(ep, len)
X    register environ *ep;
X    register int len;
X{
X    node nn;
X    register node n = tree(ep->focus);
X    register string *rp;
X    register int i = 0;
X    register int nch;
X    register int w;
X
X    if (Is_etext(n)) {
X        w = e_length((value)n);
X        Assert(w >= len && len >= 0);
X        if (w > len)
X            ep->spflag = No;
X        ep->mode = VHOLE;
X        ep->s1 = ichild(ep->focus) * 2;
X        ep->s2 = len;
X        s_up(ep);
X        return;
X    }
X    nch = nchildren(n);
X    w = nodewidth(n);
X    if (len > w && w >= 0) {
X        i = ichild(ep->focus); /* Change initial condition for for-loop */
X        if (!up(&ep->focus)) {
X            ep->mode = ATEND;
X            return;
X        }
X        higher(ep);
X        n = tree(ep->focus);
X    }
X
X    rp = noderepr(n);
X    for (; i <= nch; ++i) {
X        if (i) {
X            nn = child(n, i);
X            w = nodewidth(nn);
X            if (w < 0 || w >= len && len >= 0) {
X                s_downi(ep, i);
X                fixfocus(ep, len);
X                return;
X            }
X            if (len >= 0)
X                len -= w;
X        }
X        w = Fwidth(rp[i]);
X        if (w >= len && len >= 0) {
X            if (w > len)
X                ep->spflag = No;
X            ep->mode = FHOLE;
X            ep->s1 = 2*i + 1;
X            ep->s2 = len;
X            return;
X        }
X        else if (w < 0)
X            len = 0;
X        else
X            len -= w;
X    }
X    ep->mode = ATEND;
X}
X
X
X/*
X * Apply, if possible, a special fix relating to spaces:
X * when a space has been interpreted as joining character
X * and we end up in the following hole, but we don't succeed
X * in filling the hole; it is then tried to delete the hole
X * and the space.
X * Usually this doesn't occur, but it may occur when inserting
X * after a space that was already fixed on the screen but now
X * deserves re-interpretation.
X */
X
XVisible bool
Xspacefix(ep)
X    environ *ep;
X{
X    path pa;
X    node n;
X    string *rp;
X
X    if (ichild(ep->focus) != 2 || symbol(tree(ep->focus)) != Hole)
X        return No;
X    pa = parent(ep->focus);
X    n = tree(pa);
X    rp = noderepr(n);
X    if (!Fw_zero(rp[0]) || Fwidth(rp[1]) != 1 || rp[1][0] != ' ')
X        return No;
X    n = firstchild(n);
X    if (!allowed(pa, symbol(n)))
X        return No;
X    s_up(ep);
X    treereplace(&ep->focus, nodecopy(n));
X    ep->mode = ATEND;
X    ep->spflag = Yes;
X    return Yes;
X}
X
X
X/*
X * Prepend a subset of a node to a queue.
X */
X
XVisible Procedure
Xsubsettoqueue(n, s1, s2, pq)
X    register node n;
X    register int s1;
X    register int s2;
X    register queue *pq;
X{
X    register string *rp = noderepr(n);
X
X    for (; s2 >= s1; --s2) {
X        if (s2&1)
X            stringtoqueue(rp[s2/2], pq);
X        else
X            preptoqueue(child(n, s2/2), pq);
X    }
X}
X
X#ifdef SHOWBUF
X
X/*
X * Produce flat text out of a queue's first line, to show it on screen.
X */
X
XVisible string
Xquerepr(qv)
X    value qv;
X{
X    queue q = (queue)qv;
X    node n;
X    static char buf[1000]; /***** Cannot overflow? *****/
X    string cp;
X    string sp;
X    string *rp;
X    int nch;
X    int i;
X    int len;
X    value chld;
X
X    cp = buf;
X    for (; q; q = q->q_link) {
X        n = q->q_data;
X        if (Is_etext(n)) {
X            for (sp = e_strval((value) n); cp < buf+80 && *sp; ++sp) {
X                if (!isprint(*sp) && *sp != ' ')
X                    break;
X                *cp++ = *sp;
X            }
X            if (*sp == '\n') {
X                if (!emptyqueue(q->q_link)) {
X                    strcpy(cp, " ...");
X                    cp += 4;
X                }
X                break;
X            }
X        }
X        else {
X            rp = noderepr(n);
X            nch = nchildren(n);
X            for (i = 0; i <= nch; ++i) {
X                if (i > 0) {
X                    if (Is_etext(child(n, i))) {
X                        chld= (value) child(n, i);
X                        len = e_length(chld);
X                        if (len > 80)
X                            len = 80;
X                        strncpy(cp, e_strval(chld), len);
X                        cp += len;
X                    }
X                    else {
X                        strcpy(cp, "...");
X                        cp += 3;
X                    }
X                }
X                if (Fw_negative(rp[i])) {
X                    strcpy(cp, " ...");
X                    cp += 4;
X                    break;
X                }
X                if (Fw_positive(rp[i])) {
X                    strcpy(cp, rp[i]);
X                    while (*cp)
X                        ++cp;
X                    if (cp[-1] == '\t' || cp[-1] == '\b')
X                        --cp;
X                }
X            }
X        }
X        if (cp >= buf+80) {
X            strcpy(buf+76, "...");
X            break;
X        }
X    }
X    *cp = 0;
X    return buf;
X}
X
X#endif /* SHOWBUF */
X
X#ifdef UNUSED
XVisible Procedure dumpqueue(pq, m) queue *pq; string m; {
X    char stuff[80];
X    register string str = stuff;
X    FILE *fp;
X    static int qdump;
X    queue q= *pq;
X    node n;
X
X    fp= fopen("/userfs4/abc/timo/mark2/ABCENV", "a");
X    Assert(fp != NULL);
X
X    qdump++;
X    fprintf(fp, "+++ QUEUE %d: %s +++\n", qdump, m);
X
X    for (; q; q=q->q_link) {
X        fprintf(fp, "NEXTNODE: ");
X        n= q->q_data;
X        writenode(n, fp);
X        fprintf(fp, "\n");
X    }
X    fprintf(fp, "NILQ\n");
X    fclose(fp);
X}
X#endif
END_OF_FILE
  if test 11620 -ne `wc -c <'abc/bed/e1que1.c'`; then
    echo shar: \"'abc/bed/e1que1.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bed/e1que1.c'
fi
if test -f 'abc/bint1/DEP' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint1/DEP'\"
else
  echo shar: Extracting \"'abc/bint1/DEP'\" \(2543 characters\)
  sed "s/^X//" >'abc/bint1/DEP' <<'END_OF_FILE'
Xi1com.o: i1com.c
Xi1com.o: ../bhdrs/b.h
Xi1com.o: ../uhdrs/osconf.h
Xi1com.o: ../uhdrs/os.h
Xi1com.o: ../uhdrs/conf.h
Xi1com.o: ../uhdrs/config.h
Xi1com.o: ../bhdrs/bint.h
Xi1com.o: ../bhdrs/bobj.h
Xi1com.o: ../ihdrs/i2nod.h
Xi1com.o: ../ihdrs/i2gen.h
Xi1com.o: ../ihdrs/i3env.h
Xi1fun.o: i1fun.c
Xi1fun.o: ../bhdrs/b.h
Xi1fun.o: ../uhdrs/osconf.h
Xi1fun.o: ../uhdrs/os.h
Xi1fun.o: ../uhdrs/conf.h
Xi1fun.o: ../uhdrs/config.h
Xi1fun.o: ../uhdrs/feat.h
Xi1fun.o: ../bhdrs/bobj.h
Xi1fun.o: ../ihdrs/i0err.h
Xi1fun.o: ../ihdrs/i1num.h
Xi1nua.o: i1nua.c
Xi1nua.o: ../bhdrs/b.h
Xi1nua.o: ../uhdrs/osconf.h
Xi1nua.o: ../uhdrs/os.h
Xi1nua.o: ../uhdrs/conf.h
Xi1nua.o: ../uhdrs/config.h
Xi1nua.o: ../uhdrs/feat.h
Xi1nua.o: ../bhdrs/bobj.h
Xi1nua.o: ../ihdrs/i0err.h
Xi1nua.o: ../ihdrs/i1num.h
Xi1nuc.o: i1nuc.c
Xi1nuc.o: ../bhdrs/b.h
Xi1nuc.o: ../uhdrs/osconf.h
Xi1nuc.o: ../uhdrs/os.h
Xi1nuc.o: ../uhdrs/conf.h
Xi1nuc.o: ../uhdrs/config.h
Xi1nuc.o: ../uhdrs/feat.h
Xi1nuc.o: ../bhdrs/bmem.h
Xi1nuc.o: ../bhdrs/bobj.h
Xi1nuc.o: ../ihdrs/i1num.h
Xi1nug.o: i1nug.c
Xi1nug.o: ../bhdrs/b.h
Xi1nug.o: ../uhdrs/osconf.h
Xi1nug.o: ../uhdrs/os.h
Xi1nug.o: ../uhdrs/conf.h
Xi1nug.o: ../uhdrs/config.h
Xi1nug.o: ../uhdrs/feat.h
Xi1nug.o: ../bhdrs/bobj.h
Xi1nug.o: ../ihdrs/i1num.h
Xi1nui.o: i1nui.c
Xi1nui.o: ../bhdrs/b.h
Xi1nui.o: ../uhdrs/osconf.h
Xi1nui.o: ../uhdrs/os.h
Xi1nui.o: ../uhdrs/conf.h
Xi1nui.o: ../uhdrs/config.h
Xi1nui.o: ../uhdrs/feat.h
Xi1nui.o: ../bhdrs/bobj.h
Xi1nui.o: ../ihdrs/i1num.h
Xi1num.o: i1num.c
Xi1num.o: ../bhdrs/b.h
Xi1num.o: ../uhdrs/osconf.h
Xi1num.o: ../uhdrs/os.h
Xi1num.o: ../uhdrs/conf.h
Xi1num.o: ../uhdrs/config.h
Xi1num.o: ../uhdrs/feat.h
Xi1num.o: ../bhdrs/bobj.h
Xi1num.o: ../ihdrs/i1num.h
Xi1nuq.o: i1nuq.c
Xi1nuq.o: ../bhdrs/b.h
Xi1nuq.o: ../uhdrs/osconf.h
Xi1nuq.o: ../uhdrs/os.h
Xi1nuq.o: ../uhdrs/conf.h
Xi1nuq.o: ../uhdrs/config.h
Xi1nuq.o: ../uhdrs/feat.h
Xi1nuq.o: ../bhdrs/bobj.h
Xi1nuq.o: ../ihdrs/i1num.h
Xi1nur.o: i1nur.c
Xi1nur.o: ../bhdrs/b.h
Xi1nur.o: ../uhdrs/osconf.h
Xi1nur.o: ../uhdrs/os.h
Xi1nur.o: ../uhdrs/conf.h
Xi1nur.o: ../uhdrs/config.h
Xi1nur.o: ../uhdrs/feat.h
Xi1nur.o: ../bhdrs/bobj.h
Xi1nur.o: ../ihdrs/i0err.h
Xi1nur.o: ../ihdrs/i1num.h
Xi1nut.o: i1nut.c
Xi1nut.o: ../bhdrs/b.h
Xi1nut.o: ../uhdrs/osconf.h
Xi1nut.o: ../uhdrs/os.h
Xi1nut.o: ../uhdrs/conf.h
Xi1nut.o: ../uhdrs/config.h
Xi1nut.o: ../bhdrs/bobj.h
Xi1nut.o: ../ihdrs/i1num.h
Xi1tra.o: i1tra.c
Xi1tra.o: ../bhdrs/b.h
Xi1tra.o: ../uhdrs/osconf.h
Xi1tra.o: ../uhdrs/os.h
Xi1tra.o: ../uhdrs/conf.h
Xi1tra.o: ../uhdrs/config.h
Xi1tra.o: ../uhdrs/feat.h
Xi1tra.o: ../bhdrs/bobj.h
Xi1tra.o: ../ihdrs/i0err.h
Xi1tra.o: ../ihdrs/i1num.h
END_OF_FILE
  if test 2543 -ne `wc -c <'abc/bint1/DEP'`; then
    echo shar: \"'abc/bint1/DEP'\" unpacked with wrong size!
  fi
  # end of 'abc/bint1/DEP'
fi
if test -f 'abc/bint3/i3loc.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint3/i3loc.c'\"
else
  echo shar: Extracting \"'abc/bint3/i3loc.c'\" \(11448 characters\)
  sed "s/^X//" >'abc/bint3/i3loc.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* B locations and environments */
X#include "b.h"
X#include "bint.h"
X#include "bobj.h"
X#include "i0err.h"
X#include "i3env.h" /* for bndtgs */
X#include "i3in2.h"
X
X#define TAR_NO_INIT    MESS(3600, "location not initialised")
X#define TARNAME_NO_INIT    MESS(3601, "%s hasn't been initialised")
X#define NO_KEY_OF_TABLE    MESS(3602, "key not in table")
X#define INS_NO_LIST    MESS(3603, "inserting in non-list")
X#define REM_NO_LIST    MESS(3604, "removing from non-list")
X#define REM_EMPTY_LIST    MESS(3605, "removing from empty list")
X#define SEL_EMPTY    MESS(3606, "selection on empty table")
X
X#define Is_local(t)    (Is_compound(t))
X#define Is_global(t)    (Is_table(t))
X
X#define Loc_indirect(ll) ((ll) != Pnil && *(ll) != Vnil && Is_indirect(*(ll)))
X
XHidden value* location(l, err) loc l; bool err; {
X    value *ll= Pnil, lv;
X
X    if (Is_locloc(l)) {
X        if (!in_locenv(curnv->tab, l, &ll) && err)
X            interr(TAR_NO_INIT);
X        return ll;
X    }
X    else if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X        value ta= sl->e->tab, ke= sl->i;
X
X        if (!in_locenv(ta, ke, &ll)) {
X            if (Loc_indirect(ll) && Is_global(ta))
X                load_global(*ll, ke, err);
X            else if (err) {
X                if (Is_locloc(ke))
X                    interr(TAR_NO_INIT);
X                else
X                    interrV(TARNAME_NO_INIT, ke);
X            }
X        }
X        return ll;
X    }
X    else if (Is_tbseloc(l)) {
X        tbseloc *tl= Tbseloc(l);
X
X        lv= locvalue(tl->R, &ll, err);
X        if (lv != Vnil) {
X            if (!Is_table(lv)) {
X                if (err) interr(SEL_NO_TABLE);
X                ll= Pnil;
X            }
X            else {
X                ll= adrassoc(lv, tl->K);
X                if (ll == Pnil && err)
X                    interr(NO_KEY_OF_TABLE);
X            }
X        }
X        return ll;
X    }
X    else {
X        syserr(MESS(3607, "call of location with improper type"));
X        return (value *) Dummy;
X    }
X}
X
XVisible value locvalue(l, ll, err) loc l; value **ll; bool err; {
X    *ll= location(l, err);
X    if (*ll == Pnil || **ll == Vnil)
X        return Vnil;
X    else if (Is_indirect(**ll))
X        return Indirect(**ll)->val;
X    else return **ll;
X}
X
XHidden bool in_locenv(t, k, ll) value t, k, **ll; {
X    *ll= envassoc(t, k);
X    if (*ll == Pnil || **ll == Vnil)
X        return No;
X    else if (Is_indirect(**ll) && Indirect(**ll)->val == Vnil)
X        return No;
X    else return Yes;
X}
X
XVisible Procedure uniquify(l) loc l; {
X    if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X        value *ta= &(sl->e->tab), ke= sl->i;
X        value *aa;
X
X        check_location(l);
X        uniql(ta);
X        if (still_ok) {
X            if (Is_local(*ta))
X                uniql(aa= Field(*ta, SmallIntVal(ke)));
X            else {
X                VOID uniq_assoc(*ta, ke);
X                aa= adrassoc(*ta, ke);
X            }
X            if (*aa != Vnil && Is_indirect(*aa))
X                uniql(&(Indirect(*aa)->val));
X        }
X    }
X    else if (Is_tbseloc(l)) {
X        tbseloc *tl= Tbseloc(l);
X        value ta, ke, *ll;
X
X        uniquify(tl->R);
X        if (still_ok) {
X            ta= locvalue(tl->R, &ll, Yes);
X            ke= tl->K;
X            if (!Is_table(ta)) interr(SEL_NO_TABLE);
X            else if (empty(ta)) interr(SEL_EMPTY);
X            else if (!in_keys(ke, ta)) interr(NO_KEY_OF_TABLE);
X            else VOID uniq_assoc(ta, ke);
X        }
X    }
X    else if (Is_trimloc(l)) {
X        syserr(MESS(3608, "uniquifying text-selection location"));
X    }
X    else if (Is_compound(l)) {
X        syserr(MESS(3609, "uniquifying comploc"));
X    }
X    else syserr(MESS(3610, "uniquifying non-location"));
X}
X
XVisible Procedure check_location(l) loc l; {
X    VOID location(l, Yes);
X    /* location may produce an error message */
X}
X
XHidden value content(l) loc l; {
X    value *ll;
X    value lv= locvalue(l, &ll, Yes);
X    return still_ok ? copy(lv) : Vnil;
X}
X
X#define TRIM_TARG_TYPE MESS(3611, "text-selection (@ or |) on non-text")
X#define TRIM_TARG_TEXT MESS(3612, "in the location t@p or t|p, t does not contain a text")
X#define TRIM_TARG_BND  MESS(3613, "in the location t@p or t|p, p is out of bounds")
X
XVisible loc trim_loc(l, N, sign) loc l; value N; char sign; {
X    loc root, res= Lnil;
X    value text, B, C;
X
X    if (Is_simploc(l) || Is_tbseloc(l)) {
X        root= l;
X        B= zero; C= zero;
X    }
X    else if (Is_trimloc(l)) {
X        trimloc *rr= Trimloc(l);
X        root= rr->R;
X        B= rr->B; C= rr->C;
X    }
X    else {
X        interr(TRIM_TARG_TYPE);
X        return Lnil;
X    }
X    text= content(root);
X    if (!still_ok);
X    else if (!Is_text(text))
X        interr(TRIM_TARG_TEXT);
X    else {
X        value n= size(text), w;
X        value Bnew= Vnil, Cnew= Vnil;
X        bool changed= No;
X
X        if (sign == '@') {     /* behead: B= max{N-1+B, B} */
X            Bnew= sum(B, w= diff(N, one));
X            if (changed= (compare(Bnew, B) > 0))
X                B= Bnew;
X        }
X        else {            /* curtail: C= max{n-N-B, C} */
X            Cnew= diff(w= diff(n, N), B);
X            if (changed= (compare(Cnew, C) > 0))
X                C= Cnew;
X        }
X        if (changed) {
X            value b_plus_c= sum(B, C);
X             if (still_ok && compare(b_plus_c, n) > 0)
X                interr(TRIM_TARG_BND);
X            release(b_plus_c);
X        }
X        if (still_ok) res= mk_trimloc(root, B, C);
X        release(Bnew);
X        release(Cnew);
X        release(w);
X        release(n);
X    }
X    release(text);
X    return res;
X}
X
XVisible loc tbsel_loc(R, K) loc R; value K; {
X    if (Is_simploc(R) || Is_tbseloc(R)) return mk_tbseloc(R, K);
X    else interr(MESS(3614, "selection on location of improper type"));
X    return Lnil;
X}
X
XVisible loc local_loc(i) basidf i; { return mk_simploc(i, curnv); }
X
XVisible loc global_loc(i) basidf i; { return mk_simploc(i, prmnv); }
X
XHidden Procedure put_trim(v, tl) value v; trimloc *tl; {
X    value rr, nn, head, tail, part, *ll;
X    value B= tl->B, C= tl->C, len, b_plus_c, tail_start;
X
X    rr= locvalue(tl->R, &ll, Yes);
X    len= size(rr);
X    b_plus_c= sum(B, C);
X     if (compare(b_plus_c, len) > 0)
X        interr(MESS(3615, "text-selection (@ or |) out of bounds"));
X    else {
X        if (compare(B, zero) < 0) B= zero;
X        tail_start= sum(len, one);
X        if (compare(C, zero) > 0) {
X            tail_start= diff(nn= tail_start, C);
X            release(nn);
X        }
X        head= curtail(rr, B); /* rr|B */
X        tail= behead(rr, tail_start); /* rr@(#rr-C+1) */
X        release(tail_start);
X        part= concat(head, v); release(head);
X        nn= concat(part, tail); release(part); release(tail);
X        put(nn, tl->R); release(nn);
X    }
X    release(len); release(b_plus_c);
X}
X
XHidden Procedure rm_indirection(l) loc l; {
X    for (; Is_tbseloc(l); l= Tbseloc(l)->R)
X        ;
X    if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X        value *ll= envassoc(sl->e->tab, sl->i);
X
X        if (Loc_indirect(ll)) {
X            value v= copy(Indirect(*ll)->val);
X            release(*ll);
X            *ll= v;
X        }
X    }
X}
X
XVisible Procedure put(v, l) value v; loc l; {
X    if (Is_locloc(l)) {
X        e_replace(v, &curnv->tab, l);
X    }
X    else if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X         e_replace(v, &(sl->e->tab), sl->i);
X    }
X    else if (Is_trimloc(l)) {
X        if (!Is_text(v)) interr(MESS(3616, "putting non-text in text-selection (@ or |)"));
X        else put_trim(v, Trimloc(l));
X    }
X    else if (Is_compound(l)) {
X        intlet k, len= Nfields(l);
X        if (!Is_compound(v))
X            interr(MESS(3617, "putting non-compound in compound location"));
X        else if (Nfields(v) != Nfields(l))
X            interr(MESS(3618, "putting compound in compound location of different length"));
X        else k_Overfields { put(*Field(v, k), *Field(l, k)); }
X    }
X    else if (Is_tbseloc(l)) {
X        tbseloc *tl= Tbseloc(l);
X        uniquify(tl->R);
X        if (still_ok) {
X            value *ll, lv;
X            lv= locvalue(tl->R, &ll, Yes);
X            if (!Is_table(lv))
X                interr(SEL_NO_TABLE);
X            else {
X                rm_indirection(tl->R);
X                replace(v, ll, tl->K);
X            }
X        }
X    }
X    else interr(MESS(3619, "putting in non-location"));
X}
X
X/* Check for correct effect of multiple put-command: catches PUT 1, 2 IN x, x.
X   The assignment cannot be undone, but this is not considered a problem.
X   For trimmed-texts, no checks are made because the language definition
X   itself causes problem (try PUT "abc", "" IN x@2|1, x@3|1). */
X
XHidden bool putck(v, l) value v; loc l; {
X    intlet k, len;
X    value *ll, lv;
X    if (!still_ok) return No;
X    if (Is_compound(l)) {
X        if (!Is_compound(v) || Nfields(v) != (len= Nfields(l)))
X            return No; /* Severe type error */
X        k_Overfields
X            { if (!putck(*Field(v, k), *Field(l, k))) return No; }
X        return Yes;
X    }
X    if (Is_trimloc(l)) return Yes; /* Don't check trim locations */
X    lv= locvalue(l, &ll, No);
X    return lv != Vnil && compare(v, lv) == 0;
X}
X
X/* The check can't be called from within put because put is recursive,
X   and so is the check: then, for the inner levels the check would be done
X   twice.  Moreover, we don't want to clutter up put, which is called
X   internally in, many places. */
X
XVisible Procedure put_with_check(v, l) value v; loc l; {
X    intlet i, k, len; bool ok;
X    put(v, l);
X    if (!still_ok || !Is_compound(l))
X        return; /* Single target can't be wrong */
X    len= Nfields(l); ok= Yes;
X    /* Quick check for putting in all different local targets: */
X    k_Overfields {
X        if (!IsSmallInt(*Field(l, k))) { ok= No; break; }
X        for (i= k-1; i >= 0; --i) {
X            if (*Field(l, i) == *Field(l, k)) { ok= No; break; }
X        }
X        if (!ok) break;
X    }
X    if (ok) return; /* All different local basic-targets */
X    if (!putck(v, l))
X        interr(MESS(3620, "putting different values in same location"));
X}
X
X
X#define DEL_NO_TARGET    MESS(3621, "deleting non-location")
X#define DEL_TRIM_TARGET    MESS(3622, "deleting text-selection (@ or |) location")
X
XHidden bool l_exists(l) loc l; {
X    if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X        value ta= sl->e->tab, *ll;
X        return in_locenv(ta, sl->i, &ll) ||
X            Loc_indirect(ll) && Is_global(ta);
X    }
X    else if (Is_trimloc(l)) {
X        interr(DEL_TRIM_TARGET);
X        return No;
X    }
X    else if (Is_compound(l)) {
X        intlet k, len= Nfields(l);
X        k_Overfields { if (!l_exists(*Field(l, k))) return No; }
X        return Yes;
X    }
X    else if (Is_tbseloc(l)) {
X        tbseloc *tl= Tbseloc(l);
X        value *ll;
X        value lv= locvalue(tl->R, &ll, Yes);
X        if (still_ok) {
X            if (!Is_table(lv))
X                interr(SEL_NO_TABLE);
X            else
X                return in_keys(tl->K, lv);
X        }
X        return No;
X    }
X    else {
X        interr(DEL_NO_TARGET);
X        return No;
X    }
X}
X
X/* Delete a location if it exists */
X
XVisible Procedure l_del(l) loc l; {
X    if (Is_simploc(l)) {
X        simploc *sl= Simploc(l);
X        e_delete(&(sl->e->tab), sl->i);
X        if (sl->e == prmnv)
X            del_target(sl->i);
X    }
X    else if (Is_trimloc(l)) {
X        interr(DEL_TRIM_TARGET);
X    }
X    else if (Is_compound(l)) {
X        intlet k, len= Nfields(l);
X        k_Overfields { l_del(*Field(l, k)); }
X    }
X    else if (Is_tbseloc(l)) {
X        tbseloc *tl= Tbseloc(l);
X        value *ll, lv;
X        uniquify(tl->R);
X        if (still_ok) {
X            lv= locvalue(tl->R, &ll, Yes);
X            if (in_keys(tl->K, lv)) {
X                rm_indirection(tl->R);
X                delete(ll, tl->K);
X            }
X        }
X    }
X    else interr(DEL_NO_TARGET);
X}
X
XVisible Procedure l_delete(l) loc l; {
X    if (l_exists(l)) l_del(l);
X    else interr(MESS(3623, "deleting non-existent location"));
X}
X
XVisible Procedure l_insert(v, l) value v; loc l; {
X    value *ll, lv;
X    uniquify(l);
X    if (still_ok) {
X        lv= locvalue(l, &ll, Yes);
X        if (!Is_list(lv))
X            interr(INS_NO_LIST);
X        else {
X            rm_indirection(l);
X            insert(v, ll);
X        }
X    }
X}
X
XVisible Procedure l_remove(v, l) value v; loc l; {
X    value *ll, lv;
X    uniquify(l);
X    if (still_ok) {
X        lv= locvalue(l, &ll, Yes);
X        if (!Is_list(lv))
X            interr(REM_NO_LIST);
X        else if (empty(lv))
X            interr(REM_EMPTY_LIST);
X        else {
X            rm_indirection(l);
X            remove(v, ll);
X        }
X    }
X}
X
XVisible Procedure bind(l) loc l; {
X    if (*bndtgs != Vnil) {
X        if (Is_simploc(l)) {
X            simploc *ll= Simploc(l);
X            if (!in(ll->i, *bndtgs)) /* kludge */ /* what for? */
X                insert(ll->i, bndtgs);
X        }
X        else if (Is_compound(l)) {
X            intlet k, len= Nfields(l);
X            k_Overfields { bind(*Field(l, k)); }
X        }
X        else interr(MESS(3624, "binding non-location"));
X    }
X    l_del(l);
X}
X
XVisible Procedure unbind(l) loc l; {
X    if (*bndtgs != Vnil) {
X        if (Is_simploc(l)) {
X            simploc *ll= Simploc(l);
X            if (in(ll->i, *bndtgs))
X                remove(ll->i, bndtgs);
X        }
X        else if (Is_compound(l)) {
X            intlet k, len= Nfields(l);
X            k_Overfields { unbind(*Field(l, k)); }
X        }
X        else interr(MESS(3625, "unbinding non-location"));
X    }
X    l_del(l);
X}
END_OF_FILE
  if test 11448 -ne `wc -c <'abc/bint3/i3loc.c'`; then
    echo shar: \"'abc/bint3/i3loc.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint3/i3loc.c'
fi
if test -f 'abc/bint3/i3scr.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/bint3/i3scr.c'\"
else
  echo shar: Extracting \"'abc/bint3/i3scr.c'\" \(12005 characters\)
  sed "s/^X//" >'abc/bint3/i3scr.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
X
X/* B input/output handling */
X
X#include "b.h"
X#include "bint.h"
X#include "feat.h"
X#include "bmem.h"
X#include "bobj.h"
X#include "bcom.h"
X#include "i2nod.h"
X#include "i2par.h"
X#include "i3typ.h"
X#include "i3env.h"
X#include "i3in2.h"
X#include "i3scr.h"
X
X#ifdef SETJMP
X#include <setjmp.h>
X#endif
X
XVisible bool interactive;
XVisible bool rd_interactive;
XVisible value iname= Vnil;    /* input name */
XVisible bool outeractive;
XVisible bool at_nwl= Yes;    /*Yes if currently at the start of an output line*/
XHidden bool last_was_text= No;    /*Yes if last value written was a text*/
X
XVisible bool Eof;
XHidden FILE *ofile= stdout;
XVisible FILE *ifile;         /* input file */
XVisible FILE *sv_ifile;        /* copy of ifile for restoring after reading unit */
X
XVisible bool readIcontext= No;
X#ifdef SETJMP
XVisible jmp_buf readIinterrupt;
X#endif
X
X/******************************* Output *******************************/
X
XHidden int ocol;    /* Current output column */
X
XHidden Procedure putch(c) char c; {
X    if (still_ok) {
X        putchr(ofile, c);
X        if (c == '\n') { at_nwl= Yes; ocol= 0; }
X        else {
X            if (at_nwl) { ocol= 0; at_nwl= No;}
X            ++ocol;
X        }
X    }
X}
X
XVisible Procedure newline() {
X    putch('\n');
X    fflush(ofile);
X}
X
XVisible Procedure oline() {
X    if (!at_nwl) newline();
X}
X
XVisible Procedure wri_space() {
X    putch(' ');
X}
X
XVisible Procedure writ(v) value v; {
X    wri(v, No, Yes, No);
X    fflush(ofile);
X}
X
X#define Putch_sp() {if (!perm) putch(' ');}
X
XHidden int intsize(v) value v; {
X    value s= size(v); int len=0;
X    if (large(s)) interr(MESS(3800, "value too big to output"));
X    else len= intval(s);
X    release(s);
X    return len;
X}
X
XHidden bool lwt;
X
X#ifdef RANGEPRINT
XHidden Procedure wri_vals(l, u) value l, u; {
X    if (compare(l, u) == 0)
X        wri(l, No, No, No);
X    else if (is_increment(u, l)) {
X        wri(l, No, No, No);
X        putch(';'); putch(' ');
X        wri(u, No, No, No);
X    }
X    else {
X        wri(l, No, No, No);
X        putch('.'); putch('.');
X        wri(u, No, No, No);
X    }
X}
X#endif /* RANGEPRINT */
X
XVisible Procedure wri(v, coll, outer, perm) value v; bool coll, outer, perm; {
X    if (outer && !at_nwl && (!Is_text(v) || !last_was_text)
X            && (!Is_compound(v) || !coll)) putch(' ');
X    lwt= No;
X    if (Is_number(v)) {
X        if (perm) printnum(ofile, v);
X        else {
X            string cp= convnum(v);
X            while(*cp && still_ok) putch(*cp++);
X        }
X    } else if (Is_text(v)) {
X        wrtext(putch, v, outer ? '\0' : '"');
X        lwt= outer;
X    } else if (Is_compound(v)) {
X        intlet k, len= Nfields(v);
X        if (!coll) putch('(');
X        for (k=0; k<len && still_ok; k++) {
X            wri(*Field(v, k), No, No, perm);
X            if (!Lastfield(k)) {
X                putch(',');
X                Putch_sp();
X            }
X        }
X        if (!coll) putch(')');
X    } else if (Is_list(v) || Is_ELT(v)) {
X        putch('{');
X#ifndef RANGEPRINT
X        if (perm && is_rangelist(v)) {
X            value vm;
X            wri(vm=min1(v), No, No, perm);
X            release(vm);
X            putch('.'); putch('.');
X            wri(vm=max1(v), No, No, perm);
X            release(vm);
X        }
X        else {
X            value i, s, vi;
X            relation c;
X
X            i= copy(one); s= size(v);
X            while((c= numcomp(i, s)) <= 0 && !Interrupted()) {
X                vi= item(v, i);
X                wri(vi, No, No, perm);
X                if (c < 0) {
X                    putch(';'); putch(' ');
X                }
X                release(vi);
X                i= sum(vi=i, one);
X                release(vi);
X            }
X            release(i); release(s);
X        }
X#else /* RANGEPRINT */
X        if (is_rangelist(v)) {
X            value vm;
X            wri(vm=min1(v), No, No, perm);
X            release(vm);
X            putch('.'); putch('.');
X            wri(vm=max1(v), No, No, perm);
X            release(vm);
X        }
X        else if (!perm) {
X            value i, s, vi, lwb, upb;
X            bool first= Yes;
X            i= copy(one); s= size(v);
X            while (numcomp(i, s) <= 0 && !Interrupted()) {
X                vi= item(v, i);
X                if (first) {
X                    lwb= copy(vi);
X                    upb= copy(vi);
X                    first= No;
X                }
X                else if (is_increment(vi, upb)) {
X                    release(upb);
X                    upb= copy(vi);
X                }
X                else {
X                    wri_vals(lwb, upb) ;
X                    putch(';'); putch(' ');
X                    release(lwb); release(upb);
X                    lwb= copy(vi); upb= copy(vi);
X                }
X                release(vi);
X                i= sum(vi=i, one);
X                release(vi);
X            }
X            if (!first) {
X                wri_vals(lwb, upb);
X                release(lwb); release(upb);
X            }
X            release(i); release(s);
X        }
X        else {
X            value ve; int k, len= intsize(v);
X            for (k=0; k<len && still_ok; k++) {
X                wri(ve= thof(k+1, v), No, No, perm);
X                release(ve);
X                if (k < len - 1) {
X                    putch(';');
X                    Putch_sp();
X                }
X            }
X        }
X#endif
X        putch('}');
X    } else if (Is_table(v)) {
X        int k, len= intsize(v);
X        putch('{');
X        for (k=0; k<len && still_ok; k++) {
X            putch('['); wri(*key(v, k), Yes, No, perm);
X            putch(']'); putch(':'); Putch_sp();
X            wri(*assoc(v, k), No, No, perm);
X            if (k < len - 1) {
X                putch(';');
X                Putch_sp();
X            }
X        }
X        putch('}');
X    } else {
X        if (testing) { putch('?'); putch(Type(v)); putch('?'); }
X        else syserr(MESS(3801, "writing value of unknown type"));
X    }
X    last_was_text= lwt;
X    if (interrupted) clearerr(ofile); /* needed for MSDOS
X                       * harmless for unix ???
X                       */
X}
X
X/***************************** Input ****************************************/
X
X/* Read a line; EOF only allowed if not interactive, in which case eof set */
X/* Returns the line input                                                  */
X/* This is the only place where a long jump is necessary                   */
X/* In other places, interrupts are just like procedure calls, and checks   */
X/* of still_ok and interrupted suffice: eventually the stack unwinds to the*/
X/* main loop in imm_command(). Here though, an interrupt must actually     */
X/* terminate the read. Hence the bool readIcontext indicating if the     */
X/* long jump is necessary or not                                           */
X
X#define Mixed_stdin_file (!rd_interactive && sv_ifile == stdin)
X
XHidden bufadm i_buf, o_buf;
Xextern bool i_looked_ahead;
X
XHidden char *read_line(kind, should_prompt, eof)
X    literal kind;
X    bool should_prompt, *eof;
X{
X    bufadm *bp= (kind == R_cmd && ifile == sv_ifile) ? &i_buf : &o_buf;
X    FILE *fp= (kind == R_cmd || kind == R_ioraw) ? ifile : stdin;
X
X    bufreinit(bp);
X    *eof= No;
X
X#ifdef SETJMP
X    if (setjmp(readIinterrupt) != 0) {
X        readIcontext= No;
X        return bp->buf;
X    }
X#endif
X    if ((kind == R_expr || kind == R_raw)
X        && Mixed_stdin_file && i_looked_ahead)
X    {
X        /* e.g. "abc <mixed_commands_and_input_for_READs_on_file" */
X        /* ilev looked_ahead for command following suite */
X        /* and ate a line meant for a READ command */
X        bufcpy(bp, i_buf.buf);
X        i_looked_ahead= No;
X    }
X    else if (!should_prompt) {
X        if (!fileline(fp, bp))
X            *eof= Yes;
X    }
X    else if (cmdline(kind, bp, (at_nwl ? 0 : ocol))) {
X        if (outeractive) at_nwl= Yes;
X    }
X    return bp->buf;
X}
X
X#define LINESIZE 200
X
XHidden bool fileline(fp, bp) FILE *fp; bufadm *bp; {
X    char line[LINESIZE];
X    char *pline;
X
X    for (;;) {
X        readIcontext= Yes;
X        pline= fgets(line, LINESIZE, fp);
X        readIcontext= No;
X        if (pline == NULL) {
X            bufcpy(bp, "\n");
X            if (*(bp->buf) == '\n')
X                return No;
X            clearerr(fp);
X            return Yes;
X        }
X        bufcpy(bp, line);
X        if (strchr(line, '\n') != NULL)
X            return Yes;
X    }
X}
X
XHidden Procedure init_read() {
X    bufinit(&i_buf);
X    bufinit(&o_buf);
X    bufcpy(&o_buf, "\n");
X    tx= (txptr) o_buf.buf;
X}
X
XHidden Procedure end_read() {
X    buffree(&i_buf);
X    buffree(&o_buf);
X}
X
X/****************************************************************************/
X
X#define ANSWER        MESS(3802, "*** Please answer with '%c' or '%c'\n")
X#define JUST_YES_OR_NO    MESS(3803, "*** Just '%c' or '%c', please\n")
X#define LAST_CHANCE    MESS(3804, "*** This is your last chance. Take it. I really don't know what you want.\n    So answer the question\n")
X#define NO_THEN        MESS(3805, "*** Well, I shall assume that your refusal to answer the question means '%c'!\n")
X
X/* Rather over-fancy routine to ask the user a question */
X/* Will anybody discover that you're only given 4 chances? */
X
XVisible char q_answer(m, c1, c2, c3) int m; char c1, c2, c3; {
X    char answer; intlet try; txptr tp; bool eof;
X
X    if (!interactive)
X        return c1;
X    if (outeractive)
X        oline();
X    for (try= 1; try<=4; try++){
X        if (try == 1 || try == 3)
X            q_mess(m, c1, c2);
X        tp= (txptr) read_line(R_answer, Yes, &eof);
X        if (interrupted) {
X            interrupted= No;
X            if (c3 == '\0') {
X                still_ok= Yes;
X                q_mess(NO_THEN, c2, c1);
X                break;
X            }
X            else {
X                return c3;
X            }
X        }
X        skipsp(&tp);
X        answer= Char(tp);
X        if (answer == c1)
X            return c1;
X        if (answer == c2)
X            return c2;
X        if (outeractive)
X            oline();
X        if (try == 1)
X            q_mess(ANSWER, c1, c2);
X        else if (try == 2)
X            q_mess(JUST_YES_OR_NO, c1, c2);
X        else if (try == 3)
X            q_mess(LAST_CHANCE, c1, c2);
X        else
X            q_mess(NO_THEN, c2, c1);
X    } /* end for */
X    return c2;
X}
X
XHidden Procedure q_mess(m, c1, c2) int m; char c1, c2; {
X    put2Cmess(errfile, m, c1, c2);
X    fflush(errfile);
X}
X
XVisible bool is_intended(m) int m; {
X    char c1, c2;
X
X#ifdef FRENCH
X    c1= 'o'; c2= 'n';
X#else /* ENGLISH */
X    c1= 'y'; c2= 'n';
X#endif
X    return q_answer(m, c1, c2, (char)'\0') == c1 ? Yes : No;
X}
X
X#define EG_EOF        MESS(3806, "End of input encountered during READ command")
X#define RAW_EOF        MESS(3807, "End of input encountered during READ t RAW")
X#define EG_INCOMP    MESS(3808, "type of expression does not agree with that of EG sample")
X#define TRY_AGAIN    MESS(3809, "*** Please try again\n")
X
X/* Read_eg uses evaluation but it shouldn't.
X   Wait for a more general mechanism. */
X
XVisible Procedure read_eg(l, t) loc l; btype t; {
X    context c; parsetree code;
X    parsetree r= NilTree; value rv= Vnil; btype rt= Vnil;
X    envtab svprmnvtab= Vnil;
X    txptr fcol_save= first_col, tx_save= tx;
X    do {
X        still_ok= Yes;
X        sv_context(&c);
X        if (cntxt != In_read) {
X            release(read_context.uname);
X            sv_context(&read_context);
X        }
X        svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
X        /* save scratch-pad copy because of following setprmnv() */
X        setprmnv();
X        cntxt= In_read;
X        first_col= tx= (txptr) read_line(R_expr, rd_interactive, &Eof);
X        if (still_ok && Eof) interr(EG_EOF);
X        if (!rd_interactive) {
X            if (sv_ifile == stdin)
X                f_lino++;
X            else
X                i_lino++;
X        }
X        rt= Vnil;
X        if (still_ok) {
X            findceol();
X            r= expr(ceol);
X            if (still_ok) fix_nodes(&r, &code);
X            rv= evalthread(code); release(r);
X            if (still_ok) rt= valtype(rv);
X        }
X        if (svprmnvtab != Vnil) {
X            prmnvtab= prmnv->tab;
X            prmnv->tab= svprmnvtab;
X        }
X        if (still_ok) must_agree(t, rt, EG_INCOMP);
X        set_context(&c);
X        release(rt);
X        if (!still_ok && rd_interactive && !interrupted)
X            putmess(errfile, TRY_AGAIN);
X    } while (!interrupted && !still_ok && rd_interactive);
X    if (still_ok) put(rv, l);
X    first_col= fcol_save;
X    tx= tx_save;
X    release(rv);
X}
X
XVisible Procedure read_raw(l) loc l; {
X    value r; bool eof;
X    txptr text= (txptr) read_line(R_raw, rd_interactive, &eof);
X    if (still_ok && eof)
X        interr(RAW_EOF);
X    if (!rd_interactive) {
X        if (sv_ifile == stdin)
X            f_lino++;
X        else
X            i_lino++;
X    }
X    if (still_ok) {
X        txptr rp= text;
X        while (*rp != '\n') rp++;
X        *rp= '\0';
X        r= mk_text(text);
X        put(r, l);
X        release(r);
X    }
X}
X
XVisible bool io_exit;
X
XVisible bool read_ioraw(v) value *v; { /* returns Yes if end of input */
X    txptr text, rp;
X    bool eof;
X
X    *v= Vnil;
X    io_exit= No;
X    text= (txptr) read_line(R_ioraw, rd_interactive, &eof);
X    if (eof || interrupted || !still_ok)
X        return Yes;
X    rp= text;
X    while (*rp != '\n')
X        rp++;
X    *rp= '\0';
X    if (strlen(text) > 0 || !io_exit)
X        *v= mk_text(text);
X    return io_exit;
X}
X
XVisible char *getline() {
X    bool should_prompt=
X        interactive && ifile == sv_ifile;
X    return read_line(R_cmd, should_prompt, &Eof);
X}
X
X/******************************* Files ******************************/
X
XVisible Procedure redirect(of) FILE *of; {
X    static bool woa= No, wnwl= No;    /*was outeractive, was at_nwl */
X    ofile= of;
X    if (of == stdout) {
X        outeractive= woa;
X        at_nwl= wnwl;
X    } else {
X        woa= outeractive; outeractive= No;
X        wnwl= at_nwl; at_nwl= Yes;
X    }
X}
X
XVisible Procedure vs_ifile() {
X    ifile= sv_ifile;
X}
X
XVisible Procedure re_screen() {
X    sv_ifile= ifile;
X    interactive= f_interactive(ifile);
X    Eof= No;
X}
X
X/* initscr is a reserved name of CURSES */
XVisible Procedure init_scr() {
X    outeractive= f_interactive(stdout);
X    rd_interactive= f_interactive(stdin);
X    init_read();
X}
X
XVisible Procedure end_scr() {
X    end_read();
X}
END_OF_FILE
  if test 12005 -ne `wc -c <'abc/bint3/i3scr.c'`; then
    echo shar: \"'abc/bint3/i3scr.c'\" unpacked with wrong size!
  fi
  # end of 'abc/bint3/i3scr.c'
fi
if test -f 'abc/mkconfig.c' -a "${1}" != "-c" ; then
  echo shar: Will not clobber existing file \"'abc/mkconfig.c'\"
else
  echo shar: Extracting \"'abc/mkconfig.c'\" \(12184 characters\)
  sed "s/^X//" >'abc/mkconfig.c' <<'END_OF_FILE'
X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
X
X/* Generate constants for configuration file            */
X
X#include "osconf.h"
X
X/* If your C system is not unix but does have signal/setjmp,    */
X/*    add a #define unix                    */
X/* You may also need to add some calls to signal().        */
X
X#ifdef unix
X
X#define SIGNAL
X
X#include <signal.h>
X#include <setjmp.h>
X
X    jmp_buf lab;
X    overflow(sig) int sig; { /* what to do on overflow/underflow */
X        signal(sig, overflow);
X        longjmp(lab, 1);
X    }
X
X#else
X    /* Dummy routines instead */
X    int lab=1;
X    int setjmp(lab) int lab; { return(0); }
X
X#endif
X
X#define absval(x) (((x)<0.0)?(-x):(x))
X#define min(x,y) (((x)<(y))?(x):(y))
X
X/* These routines are intended to defeat any attempt at optimisation */
XDstore(a, b) double a, *b; { *b=a; }
Xdouble Dsum(a, b) double a, b; { double r; Dstore(a+b, &r); return (r); }
Xdouble Ddiff(a, b) double a, b; { double r; Dstore(a-b, &r); return (r); }
Xdouble Dmul(a, b) double a, b; { double r; Dstore(a*b, &r); return (r); }
Xdouble Ddiv(a, b) double a, b; { double r; Dstore(a/b, &r); return (r); }
X
Xdouble power(x, n) int x, n; {
X    double r=1.0;
X    for (;n>0; n--) r*=x;
X    return r;
X}
X
Xint floor_log(base, x) int base; double x; { /* return floor(log base(x)) */
X    int r=0;
X    while (x>=base) { r++; x/=base; }
X    return r;
X}
X
Xint ceil_log(base, x) int base; double x; {
X    int r=0;
X    while (x>1.0) { r++; x/=base; }
X    return r;
X}
X
X/*     The following is ABC specific.                */
X/*     It tries to prevent different alignments for the field    */
X/*    following common HEADER fields in various structures    */
X/*    used by the ABC system for different types of values.    */
X
X/* literal and reftype are in ?hdrs/osconf.h */
Xtypedef short intlet;
X#define HEADER literal type; reftype refcnt; intlet len
Xtypedef struct header { HEADER; } header;
Xtypedef struct value { HEADER; char **cts;} value;
X
X
Xmain(argc, argv) int argc; char *argv[]; {
X    char c;
X    short newshort, maxshort, maxershort;
X    int newint, maxint, maxdigit, shortbits, bits, mantbits,
X        *p, shortpower, intpower, longpower;
X    long newlong, maxlong;
X#ifdef MEMSIZE
X    long count;
X#endif
X    unsigned long nfiller;
X    int i, ibase, iexp, irnd, imant, iz, k, machep, maxexp, minexp,
X        mx, negeps, tendigs;
X    double a, b, base, basein, basem1, eps, epsneg, xmax, newxmax,
X           xmin, xminner, y, y1, z, z1, z2;
X
X    double BIG, Maxreal;
X    int BASE, MAXNUMDIG, tenlogBASE, Maxexpo, Minexpo, DBLBITS, LONGBITS;
X
X#ifdef SIGNAL
X    signal(SIGFPE, overflow);
X    if (setjmp(lab)!=0) { printf("Unexpected over/underflow\n"); exit(1); }
X#endif
X
X/****** Calculate max short *********************************************/
X/*      Calculate 2**n-1 until overflow - then use the previous value    */
X
X    newshort=1; maxshort=0;
X
X    if (setjmp(lab)==0)
X        for(shortpower=0; newshort>maxshort; shortpower++) {
X            maxshort=newshort;
X            newshort=newshort*2+1;
X        }
X
X    /* Now for those daft Cybers: */
X
X    maxershort=0; newshort=maxshort;
X
X    if (setjmp(lab)==0)
X        for(shortbits=shortpower; newshort>maxershort; shortbits++) {
X            maxershort=newshort;
X            newshort=newshort+newshort+1;
X        }
X
X    bits= (shortbits+1)/sizeof(short);
X    c= (char)(-1);
X    printf("/\* char=%d bits, %ssigned *\/\n", sizeof(c)*bits,
X            ((int)c)<0?"":"un");
X    printf("/\* maxshort=%d (=2**%d-1) *\/\n", maxshort, shortpower);
X
X    if (maxershort>maxshort) {
X        printf("/\* There is a larger maxshort, %d (=2**%d-1), %s *\/\n",
X            maxershort, shortbits,
X            "but only for addition, not multiplication");
X    }
X
X/****** Calculate max int by the same method ***************************/
X
X    newint=1; maxint=0;
X
X    if (setjmp(lab)==0)
X        for(intpower=0; newint>maxint; intpower++) {
X            maxint=newint;
X            newint=newint*2+1;
X        }
X
X    printf("/\* maxint=%d (=2**%d-1) *\/\n", maxint, intpower);
X
X/****** Calculate max long by the same method ***************************/
X
X    newlong=1; maxlong=0;
X
X    if (setjmp(lab)==0)
X        for(longpower=0; newlong>maxlong; longpower++) {
X            maxlong=newlong;
X            newlong=newlong*2+1;
X        }
X
X    if (setjmp(lab)!=0) { printf("\nUnexpected under/overflow\n"); exit(1); }
X
X    printf("/\* maxlong=%ld (=2**%d-1) *\/\n", maxlong, longpower);
X
X/****** Pointers ********************************************************/
X    printf("/\* pointers=%d bits%s *\/\n", sizeof(p)*bits,
X        sizeof(p)>sizeof(int)?" BEWARE! larger than int!":"");
X
X/****** Base and size of mantissa ***************************************/
X    a=1.0;
X    do { a=Dsum(a, a); } while (Ddiff(Ddiff(Dsum(a, 1.0), a), 1.0) == 0.0);
X    b=1.0;
X    do { b=Dsum(b, b); } while ((base=Ddiff(Dsum(a, b), a)) == 0.0);
X    ibase=base;
X    printf("/\* base=%d *\/\n", ibase);
X
X    imant=0; b=1.0;
X    do { imant++; b=Dmul(b, base); }
X    while (Ddiff(Ddiff(Dsum(b,1.0),b),1.0) == 0.0);
X    printf("/\* Significant base digits=%d *\/\n", imant);
X    tendigs= ceil_log(10, b); /* the number of digits */
X
X/****** Various flavours of epsilon *************************************/
X    basem1=Ddiff(base,1.0);
X    if (Ddiff(Dsum(a, basem1), a) != 0.0) irnd=1;
X    else irnd=0;
X
X    negeps=imant+imant;
X    basein=1.0/base;
X    a=1.0;
X    for(i=1; i<=negeps; i++) a*=basein;
X
X    b=a;
X    while (Ddiff(Ddiff(1.0, a), 1.0) == 0.0) {
X        a*=base;
X        negeps--;
X    }
X    negeps= -negeps;
X    printf("/\* Smallest x such that 1.0-base**x != 1.0=%d *\/\n", negeps);
X
X    epsneg=a;
X    if ((ibase!=2) && (irnd==1)) {
X    /*    a=(a*(1.0+a))/(1.0+1.0); => */
X        a=Ddiv(Dmul(a, Dsum(1.0, a)), Dsum(1.0, 1.0));
X    /*    if ((1.0-a)-1.0 != 0.0) epsneg=a; => */
X        if (Ddiff(Ddiff(1.0, a), 1.0) != 0.0) epsneg=a;
X    }
X    printf("/\* Small x such that 1.0-x != 1.0=%g *\/\n", epsneg);
X    /* it may not be the smallest */
X
X    machep= -imant-imant;
X    a=b;
X    while (Ddiff(Dsum(1.0, a), 1.0) == 0.0) { a*=base; machep++; }
X    printf("/\* Smallest x such that 1.0+base**x != 1.0=%d *\/\n", machep);
X
X    eps=a;
X    if ((ibase!=2) && (irnd==1)) {
X    /*    a=(a*(1.0+a))/(1.0+1.0); => */
X        a=Ddiv(Dmul(a, Dsum(1.0, a)), Dsum(1.0, 1.0));
X    /*    if ((1.0+a)-1.0 != 0.0) eps=a; => */
X        if (Ddiff(Dsum(1.0, a), 1.0) != 0.0) eps=a;
X    }
X    printf("/\* Smallest x such that 1.0+x != 1.0=%g *\/\n", eps);
X
X/****** Round or chop ***************************************************/
X    if (irnd == 1) { printf("/\* Arithmetic rounds *\/\n"); }
X    else {
X        printf("/\* Arithmetic chops");
X        if (Ddiff(Dmul(Dsum(1.0,eps),1.0),1.0) != 0.0) {
X            printf(" but uses guard digits");
X        }
X        printf(" *\/\n");
X    }
X
X/****** Size of and minimum normalised exponent ****************************/
X    y=0; i=0; k=1; z=basein; z1=(1.0+eps)/base;
X
X    /* Coarse search for the largest power of two */
X    if (setjmp(lab)==0) /* in case of underflow trap */
X        do {
X            y=z; y1=z1;
X            z=Dmul(y,y); z1=Dmul(z1, y);
X            a=Dmul(z,1.0);
X            z2=Ddiv(z1,y);
X            if (z2 != y1) break;
X            if ((Dsum(a,a) == 0.0) || (absval(z) >= y)) break;
X            i++;
X            k+=k;
X        } while(1);
X
X    if (ibase != 10) {
X        iexp=i+1; /* for the sign */
X        mx=k+k;
X    } else {
X        iexp=2;
X        iz=ibase;
X        while (k >= iz) { iz*=ibase; iexp++; }
X        mx=iz+iz-1;
X    }
X
X    /* Fine tune starting with y and y1 */
X    if (setjmp(lab)==0) /* in case of underflow trap */
X        do {
X            xmin=y; z1=y1;
X            y=Ddiv(y,base); y1=Ddiv(y1,base);
X            a=Dmul(y,1.0);
X            z2=Dmul(y1,base);
X            if (z2 != z1) break;
X            if ((Dsum(a,a) == 0.0) || (absval(y) >= xmin)) break;
X            k++;
X        } while (1);
X
X    if (setjmp(lab)!=0) { printf("Unexpected over/underflow\n"); exit(1); }
X
X    minexp= (-k)+1;
X
X    if ((mx <= k+k-3) && (ibase != 10)) { mx+=mx; iexp+=1; }
X    printf("/\* Number of bits used for exponent=%d *\/\n", iexp);
X    printf("/\* Minimum normalised exponent=%d *\/\n", minexp);
X    printf("/\* Minimum normalised positive number=%g *\/\n", xmin);
X
X/****** Minimum exponent ***************************************************/
X    if (setjmp(lab)==0) /* in case of underflow trap */
X        do {
X            xminner=y;
X            y=Ddiv(y,base);
X            a=Dmul(y,1.0);
X            if ((Dsum(a,a) == 0.0) || (absval(y) >= xminner)) break;
X        } while (1);
X
X    if (setjmp(lab)!=0) { printf("Unexpected over/underflow\n"); exit(1); }
X
X    if (xminner != 0.0 && xminner != xmin) {
X        printf("/\* The smallest numbers are not kept normalised *\/\n");
X        printf("/\* Smallest unnormalised positive number=%g *\/\n",
X            xminner);
X    }
X
X/****** Maximum exponent ***************************************************/
X    maxexp=2; xmax=1.0; newxmax=base+1.0;
X    if (setjmp(lab) == 0) {
X        while (xmax<newxmax) {
X            xmax=newxmax;
X            newxmax=Dmul(newxmax, base);
X            if (Ddiv(newxmax, base) != xmax) break; /* ieee infinity */
X            maxexp++;
X        }
X    }
X    if (setjmp(lab)!=0) { printf("Unexpected over/underflow\n"); exit(1); }
X
X    printf("/\* Maximum exponent=%d *\/\n", maxexp);
X
X/****** Largest and smallest numbers ************************************/
X    xmax=Ddiff(1.0, epsneg);
X    if (Dmul(xmax,1.0) != xmax) xmax=Ddiff(1.0, Dmul(base,epsneg));
X    for (i=1; i<=maxexp; i++) xmax=Dmul(xmax, base);
X    printf("/\* Maximum number=%g *\/\n", xmax);
X
X/****** Hidden bit + sanity check ***************************************/
X    if (ibase != 10) {
X        mantbits=floor_log(2, (double)ibase)*imant;
X        if (mantbits+iexp+1 == sizeof(double)*bits+1) {
X            printf("/\* Double arithmetic uses a hidden bit *\/\n");
X        } else if (mantbits+iexp+1 == sizeof(double)*bits) {
X            printf("/\* Double arithmetic doesn't use a hidden bit *\/\n");
X        } else {
X            printf("/\* Something fishy here! %s %s *\/\n",
X                "Exponent size + mantissa size doesn't match",
X                "with the size of a double.");
X        }
X    }
X
X/****** The point of it all: ********************************************/
X    printf("\n/\* Numeric package constants *\/\n");
X
X    tenlogBASE= floor_log(10, (double)maxlong)/2;
X    BASE=1; for(i=1; i<=tenlogBASE; i++) BASE*=10;
X
X    BIG= power(ibase, imant)-1.0;
X    MAXNUMDIG= tendigs;
X    Maxreal= xmax;
X    Maxexpo= floor_log(2, (double)ibase)*maxexp;
X    Minexpo= floor_log(2, (double)ibase)*minexp;
X    DBLBITS= floor_log(2, (double)ibase)*imant;
X    LONGBITS= longpower;
X
X    printf("#define Maxintlet %d /\* Maximum short *\/\n", maxshort);
X    printf("#define Maxint %d /\* Maximum int *\/\n", maxint);
X
X    if (2*intpower + 1 <= longpower) {
X        printf("typedef int digit;\n");
X        maxdigit= maxint;
X    }
X    else {
X        printf("typedef short digit;\n");
X        maxdigit= maxshort;
X    }
X    printf("typedef long twodigit;\n");
X
X    printf("\/* BASE must be a power of ten, BASE**2 must fit in a twodigit *\/\n");
X    printf("\/* and -2*BASE as well as BASE*2 must fit in a digit *\/\n");
X
X    printf("#define BASE %d\n", BASE);
X    if (((double)BASE)*BASE > maxlong || ((double)BASE)+BASE > maxdigit) {
X        printf("*** BASE value wrong\n");
X        exit(1);
X    }
X    printf("#define tenlogBASE %d /\*  = log10(BASE) *\/\n", tenlogBASE);
X
X    printf("#define BIG %1.1f /\* Maximum integral double *\/\n", BIG);
X    printf("#define MAXNUMDIG %d /\* The number of decimal digits in BIG *\/\n",
X        MAXNUMDIG);
X    printf("#define MINNUMDIG 6 /\* Don't change: this is here for consistency *\/\n");
X
X    printf("#define Maxreal %e /\* Maximum double *\/\n", Maxreal);
X    printf("#define Maxexpo %d /\* Maximum value such that 2**Maxexpo<=Maxreal *\/\n",
X        Maxexpo);
X    printf("#define Minexpo (%d) /\* Minimum value such that -2**Minexpo>=Minreal *\/\n",
X        Minexpo);
X    printf("#define DBLBITS %d /\* The number of bits in the fraction of a double *\/\n",
X        DBLBITS);
X
X    printf("#define LONGBITS %d /\* The number of bits in a long *\/\n",
X        LONGBITS);
X    printf("#define TWOTO_DBLBITSMIN1 %1.1f /\* 2**(DBLBITS-1) *\/\n",
X        power(2, DBLBITS-1));
X    printf("#define TWOTO_LONGBITS %1.1f /\* 2**LONGBITS *\/\n",
X        power(2, LONGBITS));
X    printf("#define RNDM_LIMIT %1.1f /\* save limit for choice *\/\n",
X        power(2, (DBLBITS < 66 ? DBLBITS-3 : 63)));
X
X#ifdef MEMSIZE
X/* An extra goody: the approximate amount of data-space */
X/* Put here because it is likely to be slower then the rest */
X
X    /*Allocate blocks of 1000 until no more available*/
X    /*Don't be tempted to change this to 1024: */
X    /*we don't know how much header information there is*/
X
X    for(count=0; (p=(int *)malloc(1000))!=0; count++) { }
X
X    printf("\n/\* Memory~= %d000 *\/\n", count);
X#endif /*MEMSIZE*/
X
X    /* Aligning ABC values */
X
X    printf("\n");
X    nfiller= (unsigned)
X        ((sizeof(value)) - ((sizeof(header)) + (sizeof(char **))));
X    printf("#define HEADER literal type; reftype refcnt; intlet len");
X    if (nfiller > 0)
X        printf("; char filler[%u]", nfiller);
X    printf("\n");
X    printf("#define FILLER");
X    if (nfiller > 0) {
X        printf(" {");
X        for (i= 1; i < nfiller; i++) {
X            printf("0, ");
X        }
X        printf("0},");
X    }
X    printf("\n");
X
X    exit(0);
X}
END_OF_FILE
  if test 12184 -ne `wc -c <'abc/mkconfig.c'`; then
    echo shar: \"'abc/mkconfig.c'\" unpacked with wrong size!
  fi
  # end of 'abc/mkconfig.c'
fi
echo shar: End of archive 13 \(of 25\).
cp /dev/null ark13isdone
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...