Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume11/inline/part03

Internet Message Format | 1987-09-14 | 55.9 KB

Subject:  v11i041:  Inline code expander for C, Part03/04
Newsgroups: comp.sources.unix
Sender: sources
Approved: [e-mail]

Submitted-by: omepd!mcg
Posting-number: Volume 11, Issue 41
Archive-name: inline/Part03

# This is a shell archive.  Remove anything before this line
# then unpack it by saving it in a file and typing "sh file"
# (Files unpacked will be owned by you and have original permissions).
# This archive contains the following files:
#    ./expand.c
#    ./rewrite.c
#    ./yylex.c
#    ./tokens.c
#    ./utils.c
#    ./mem.c
#
if `test ! -s ./expand.c`
then
echo "writing ./expand.c"
sed 's/^X//' > ./expand.c << '\Rogue\Monster\'
X/*
X * inline code expander
X *
X * (c) 1986 - copyright 1986, s. mcgeady, all rights reserved
X */
X
X/* $Header: expand.c,v 1.13 87/06/24 13:11:24 mcg Rel $ */
X
X/*
X * find an expansion opportunity, get its parameters, and expand the node
X */
X
X#include "inline.h"
X#include "tokens.h"
X
Xextern struct expand_node *mkenode(); /* forward declaration */
Xextern struct expand_node *doactuals();
Xextern struct token *dostmt();
Xextern struct token *doexpr();
X
Xdoinline(mem,prog)
Xregister int mem;
Xregister struct toklist *prog;
X{
X    register struct token *tt, *tl, *tx;
X    register struct token *begin = NILTOK;
X    register struct token *end;
X    register struct expand_node *e;
X    register struct inline_node *node;
X    register int i;
X    register int emem;
X    int expanded = 0;
X
X    /*
X     * look through list to find first expansion possibility,
X     * keeping track of statement breaks.  a statement break occurs
X     * at the last semicolon, closing brace, or opening brace.  expansions
X     * inside control statements complicate matters
X     */
X
X    emem = openpool();
X    tt = NILTOK;
X    for (tl = prog->tl_head; tl != NILTOK; tt = tl, tl = tl->t_next) {
X        switch(tl->t_tok) {
X        case T_IDENT:
X            if (iscall(tl) && (node = isinline(tl->t_id))) {
X                node->i_nseen++;
X
X                /* don't expand if this expression has ||, && */
X                /* or  ?: --- should not expand if there's a */
X                /* comma operator, but can't identify those */
X                /* easily            */
X
X                for (tx = begin; tx && tx != tl; tx = tx->t_next) {
X                    if (tx->t_tok == T_CAND ||
X                        tx->t_tok == T_COR ||
X                        tx->t_tok == T_QUEST) {
X                        if (node->i_flags&I_EXPR) {
X                            tl->t_flags |= TNEEDEXPR;
X                        } else {
X                            tl->t_flags |= TNOEXPAND;
X                            warn(tl->t_line,"inline %s is not expandable in this context", tl->t_id);
X                        }
X                    }
X                }
X                if (tl->t_flags&TNOEXPAND) {
X                    break;
X                }
X
X                if ((e = doactuals(emem,tt,node)) == NILP(struct expand_node *)) {
X                    /* don't expand again */
X                    tl->t_flags |= TNOEXPAND;
X                    warn(tl->t_line,"inline %s is not expandable in this context", tl->t_id);
X                } else {
X
X                    end = dostmt(begin->t_next,0);
X                    if (doexpand(mem,begin,end,tt->t_next,tl->t_flags&TNEEDEXPR,e)) {
X                        node->i_nexpand++;
X                        tl = begin;
X                        expanded++;
X                    }
X                }
X            }
X            break;
X
X        case T_IF:
X        case T_SWITCH:
X            begin = tt;    /* point to node before */
X            break;
X
X        case T_WHILE:
X        case T_FOR:
X            /* skip over control part */
X            end = dostmt(tl,1);
X            i = 0;
X            for (tx = tl->t_next; tx != end; tx = tx->t_next) {
X                if (iscall(tx) && (node = isinline(tx->t_id))) {
X                    node->i_nseen++;
X                    if (node->i_flags&I_EXPR) {
X                        tx->t_flags |= TNEEDEXPR;
X                        i = 1;
X                    } else {
X                        warn(tx->t_line,"inline %s is not expandable in this context", tx->t_id);
X                        tx->t_flags |= TNOEXPAND;
X                    }
X                }
X            }
X            /* no expansion possibility inside for, while */
X            if (i) {
X                begin = tt;
X            } else {
X                begin = tl = end;
X            }
X            break;
X
X        case T_COLON:
X            /* distinguish between label and ? : op */
X            for (tx = begin; tx != tl; tx = tx->t_next) {
X                if (tx->t_tok == T_QUEST) {
X                    break;
X                }
X            }
X            if (tx->t_tok == T_QUEST) {
X                break;
X            }
X            /*FALLTHROUGH*/
X
X        case T_SEMIC:
X        case T_LBRACE:
X        case T_RBRACE:
X            begin = tl;
X            break;
X
X        default:
X            if (istype(tl) || isstoreclass(tl)) {
X                end = dostmt(tl->t_next,0);
X                for (tx = tl->t_next; tx != end; tx = tx->t_next) {
X                    if (iscall(tx) && (node = isinline(tx->t_id))) {
X                        node->i_nseen++;
X                        tx->t_flags |= TNOEXPAND;
X                        warn(tx->t_line,"inline %s is not expandable in this context", tx->t_id);
X                    }
X                }
X                /* no expansion in initializations */
X                begin = tl = end;
X            }
X            break;
X        }
X    }
X    (void) closepool(emem);
X    return(expanded);
X}
X
Xstruct token *
Xdostmt(begin,ctrl)
Xregister struct token *begin;
Xregister int ctrl;
X{
X    register struct token *tx;
X    register int seenquest = 0;
X
X    begin = skipws(begin);
X    while (begin) {
X        switch(begin->t_tok) {
X        case T_SWITCH:
X        case T_WHILE:
X        case T_FOR:
X        case T_IF:
X            /* find end of control part */
X            tx = doexpr(begin->t_next,1);
X            if (ctrl) {
X                return(tx);
X            }
X            /* find end of body */
X            tx = dostmt(tx->t_next,0);
X
X            if (begin->t_tok == T_IF) {
X                /* look for 'else' */
X                begin = skipws(tx->t_next);
X                if (begin->t_tok == T_ELSE) {
X                    return(dostmt(begin,0));
X                }
X            }
X            return(tx);
X
X        case T_ELSE:
X            return(dostmt(begin->t_next,0));
X
X        case T_LBRACE:
X            for (tx = begin; tx != NILTOK; tx = tx->t_next) {
X                if ((tx->t_tok == T_RBRACE) &&
X                     (tx->t_level == begin->t_level)) {
X                    return(tx);
X                }
X            }
X            error(begin->t_line,"unmatched {");
X            break;
X
X        case T_SEMIC:
X            return(begin);
X
X        case T_COLON:
X            if (seenquest--) {
X                begin = begin->t_next;
X                continue;
X            }
X            return(begin);
X
X        case T_QUEST:
X            seenquest++;
X        default:
X            begin = begin->t_next;
X            continue;
X        }
X        /* if we get here, it's an error */
X        break;
X    }
X    error(begin->t_line, "statement termination error");
X    return(NILTOK);
X}
X
Xstruct token *
Xdoexpr(begin,ctrl)
Xregister struct token *begin;
Xregister int ctrl;
X{
X    register int seenquest = 0;
X    register struct token *tx;
X
X    begin = skipws(begin);
X    while (begin) {
X        switch(begin->t_tok) {
X        case T_LPAREN:
X            for(tx = begin; tx != NILTOK; tx = tx->t_next) {
X                if ((tx->t_tok == T_RPAREN) &&
X                    (tx->t_paren == begin->t_paren)) {
X                    if (ctrl) {
X                        return(tx);
X                    } else {
X                        begin = begin->t_next;
X                        continue;
X                    }
X                }
X            }
X            error(begin->t_line, "unmatched parenthesis");
X            break;
X
X        case T_WHILE:
X        case T_FOR:
X        case T_SWITCH:
X        case T_IF:
X            break;
X
X
X        case T_RBRACE:
X        case T_LBRACE:
X        case T_SEMIC:
X            return(begin);
X
X        case T_QUEST:
X            seenquest++;
X            begin = begin->t_next;
X            continue;
X
X        case T_COLON:
X            if (seenquest--) {
X                return(begin);
X            }
X        default:
X            begin = begin->t_next;
X            continue;
X        }
X        /* if we get here, it's an error */
X        break;
X    }
X    error(begin->t_line, "expression error");
X    return(NILTOK);
X}
X
Xdoexpand(mem,begin,end,here,expr,enode)
Xregister int mem;
Xregister int expr;
Xregister struct token *begin, *end, *here;
Xregister struct expand_node *enode;
X{
X    struct toklist insert;
X    register struct token *tl, *tx, *th, *tp;
X    register struct inline_node *node;
X    register int formal;
X    register int i;
X    static int ident = 0;
X
X    if ((here->t_tok != T_ARGLIST) || !(node = isinline(here->t_id))) {
X        error(here->t_line, "bad call to doexpand '%s' not inline",
X            here->t_id);
X        return(0);
X    }
X    if (expr && !node->i_flags&I_EXPR) {
X        error(here->t_line, "bad call to doexpand '%s' not inline",
X            here->t_id);
X        return(0);
X    }
X
X    insert.tl_head = insert.tl_tail = NILTOK;
X
X    addtok(&insert, newtok(mem,T_WS, "\n"));
X    addtok(&insert, newtok(mem,T_LBRACE, NIL));
X    addtok(&insert, newtok(mem,T_WS, "\n"));
X
X    /* output declaration sections for each inline */
X    /* declare formal parameters */
X
X    cpytoklist(mem,&insert,&node->i_tl[SDECLBODY]);
X    if (expr) {
X        cpytoklist(mem,&insert,&node->i_tl[SEXPRDECL]);
X    }
X
X    for(tx = insert.tl_head; tx != NILTOK; tx = tx->t_next) {
X        if (tx->t_tok == T_FORMAL) {
X            tx->t_flags |= TNOEXPAND;
X        }
X    }
X
X    /* declare return value holders */
X
X    if (node->i_flags&NEEDRETVAL) {
X        addtok(&insert, newtok(mem,T_AUTO,NIL));
X        addtok(&insert, newtok(mem,T_WS, " "));
X
X        /* cpytoklist(mem, &insert, &node->i_tl[SDECL]); */
X
X        /*
X         * this is a hack to rewrite function pointers found in
X         * declaration form, e.g:
X         *    int (*(*fp())())() {}        [1]
X         *    int (*fp())() {}        [2]
X         * into pointer declaration form:
X         *    int (*(*fp)())();        [1]
X         *    int (*fp)();            [2]
X         *
X         * we do this by putting an RPAREN immediately after the
X         * identifier, and then deleting the next RPAREN of the
X         * appropriate nesting level.
X         *
X         * thanks to the bizarre syntax of C for this one
X         */
X
X        {
X        int plev = -1;
X        for(tp = node->i_tl[SDECL].tl_head;tp != NILTOK; tp = tp->t_next) {
X            if (tp->t_tok == T_RPAREN && tp->t_paren == plev) {
X                plev = -1;
X                continue;
X            }
X            if ((tp->t_tok == T_LPAREN) && (tp->t_paren > 0) &&
X                (tp->t_next->t_tok == T_RPAREN)) {
X                addtok(&insert,newtok(mem,T_RPAREN,NIL));
X                plev = tp->t_paren - 1;
X            }
X            addtok(&insert,duptok(mem,tp));
X        }
X        }
X
X        /* end of hack */
X
X        addtok(&insert, newtok(mem,T_SEMIC,NIL));
X        addtok(&insert, newtok(mem,T_WS, "\n"));
X    }
X
X    /* determine which actuals can be substituted directly, and    */
X    /* which need to be copied in  --  if the formal is never used    */
X    /* as an lvalue in the expanded routine, and if the actual    */
X    /* doesn't have any side-effects of referencing it, then it is    */
X    /* ok to replace instances of the formal with the actual string    */
X
X    /* output initialization */
X    /* ... but only for those not sub'd directly */
X
X    /* cpytoklist(mem,&insert,&node->i_tl[SINITBODY]); */
X
X    for (i = 0; i < node->i_nformals; i++) {
X        node->i_formalinfo[i] &= ~I_SUB_OK;
X        if ((node->i_formalinfo[i]&I_LVALUE) ||
X            (sideeffect(&enode->e_actuals[i]))) {
X            addtok(&insert,newtok(mem,T_FORMAL,node->i_formals[i]));
X            /* addtok(&insert,newtok(mem,T_EQ,NIL)); */
X            addtok(&insert,newtok(mem,T_ACTUAL,node->i_formals[i]));
X            addtok(&insert,newtok(mem,T_SEMIC,NIL));
X            addtok(&insert,newtok(mem,T_WS," "));
X        } else {
X            /* this actual can be sub'd directly */
X            node->i_formalinfo[i] |= I_SUB_OK;
X        }
X    }
X
X    /* output body */
X
X
X    here->t_tok = T_WS;
X    here->t_id = "";
X
X    if (expr) {
X        (void) instok(begin, insert.tl_head);
X        insert.tl_head = insert.tl_tail = NILTOK;
X        cpytoklist(mem,&insert,&node->i_tl[SEXPRBODY]);
X        (void) instok(here, insert.tl_head);
X    } else {
X        cpytoklist(mem,&insert,&node->i_tl[SBODY]);
X        if (node->i_flags&NEEDRETVAL) {
X            here->t_tok = T_IDENT;
X            here->t_id = mkstr(mem,"_",node->i_id,"_ret_",itoa(ident),"_",0);
X        }
X        (void) instok(begin, insert.tl_head);
X    }
X
X    tl = instok(end, newtok(mem,T_RBRACE, NIL));
X    end = instok(tl, newtok(mem,T_WS, "\n"));
X
X    /* go back and fix up all the special stuff */
X
X    for(tp = NILTOK,tx = begin; tx && tx != end; tp = tx,tx = tx->t_next) {
X        switch(tx->t_tok) {
X        case T_RETLAB:
X            tx->t_tok = T_IDENT;
X            tx->t_id = mkstr(mem,"_",node->i_id,"_end_",itoa(ident),"_",0);
X            break;
X
X        case T_RETVAL:
X            tx->t_tok = T_IDENT;
X            tx->t_id = mkstr(mem,"_",node->i_id,"_ret_",itoa(ident),"_",0);
X            break;
X
X        case T_FORMAL:
X            if ((formal = isformal(node,tx)) < 0) {
X                error(tx->t_line,"bogus formal");
X                break;
X            }
X            if ((node->i_formalinfo[formal]&I_SUB_OK) && !(tx->t_flags&TNOEXPAND)) {
X                insert.tl_head = insert.tl_tail = NILTOK;
X                addtok(&insert,newtok(mem,T_LPAREN,NIL));
X                cpytoklist(mem,&insert,&enode->e_actuals[formal]);
X                addtok(&insert,newtok(mem,T_RPAREN,NIL));
X                tp->t_next = tx->t_next;    /* drop formal node */
X                (void) instok(tp, insert.tl_head);
X
X            } else {
X                tx->t_tok = T_IDENT;
X                tx->t_id = mkstr(mem,"_",node->i_id,"_",tx->t_id,"_",itoa(ident),0);
X                tx->t_flags &= ~TNOEXPAND;
X            }
X            break;
X
X        case T_ACTUAL:
X            if ((formal = isformal(node,tx)) < 0) {
X                error(tx->t_line,"actual-formal mismatch");
X                break;
X            }
X            insert.tl_head = insert.tl_tail = NILTOK;
X            addtok(&insert, newtok(mem,T_WS, " "));
X            addtok(&insert, newtok(mem,T_EQ, NIL));
X            addtok(&insert, newtok(mem,T_WS, " "));
X            cpytoklist(mem,&insert,&enode->e_actuals[formal]);
X            tp->t_next = tx->t_next;    /* drop formal node */
X            (void) instok(tp, insert.tl_head);
X
X            break;
X
X        case T_LABEL:
X            tx->t_id = mkstr(mem,"_",node->i_id,"_",tx->t_id,"_",itoa(ident),0);
X            break;
X        }
X    }
X
X    /* update expansion identifier digit */
X    ident++;
X
X    return(1);
X}
X
X/*
X * begin an inline expansion by gathering actual arguments
X */
X
Xstruct expand_node *
Xdoactuals(mem,prog,node)
Xregister int mem;
Xstruct token *prog;
Xstruct inline_node *node;
X{
X    register struct token *tl;
X    int paramnest = 0;
X    register struct toklist *subparam;
X    struct expand_node *e;
X    int sawtok = 0;
X
X    for (tl = prog->t_next; tl != NILTOK; tl = tl->t_next) {
X        if (tl->t_tok == T_LPAREN)
X            break;
X    }
X
X    if (!tl) {    /* error */
X        error(prog->t_line, "gack!! lost '(' in doactuals()");
X        return(NILP(struct expand_node *));
X    }
X
X    /* setup an expansion node for this expansion */
X
X    e = mkenode(mem);
X    e->e_node = node;
X    subparam = e->e_actuals;
X
X    /* store the actuals away in the expansion node */
X
X    for (  ; tl != NILTOK; tl = tl->t_next) {
X        /* gather the actual parameter list */
X        switch(tl->t_tok) {
X        case T_LPAREN:
X            if (paramnest++ == 0) {
X                /* don't add the paren */
X                continue;
X            }
X            break;
X
X        case T_RPAREN:
X            if (paramnest == 0) {
X                error(tl->t_line, "bad parameter list - too many ')'s");
X                return(NILP(struct expand_node *));
X            }
X            if (--paramnest == 0) {    /* end of parameter list */
X                if (sawtok) {
X                    e->e_nactuals++;
X                }
X                if (e->e_nactuals != node->i_nformals) {
X                    error(tl->t_line, "wrong number of actuals to inline func %s", node->i_id);
X                    return(NILP(struct expand_node *));
X                }
X                /* replace to argument list with the ARGLIST token */
X                prog->t_next = newtok(mem,T_ARGLIST,e->e_node->i_id);
X                prog->t_next->t_next = tl->t_next;
X
X                return(e);
X            }
X            break;
X
X        case T_COMMA:
X            if (paramnest == 1) {
X                subparam++;
X                e->e_nactuals++;
X                sawtok = 0;
X                /* don't include the comma */
X                continue;
X            }
X            break;
X        }
X        if (paramnest) {
X            sawtok = 1;
X            addtok(subparam,duptok(mem,tl));
X        }
X    }
X    /* hmm, got an EOF */
X    error(prog->t_line, "improper call - EOF during arg gathering");
X    return(NILP(struct expand_node *));
X}
X
Xstruct expand_node *
Xmkenode(mem) {
X    register struct expand_node *e;
X    register int i;
X
X    e = (struct expand_node *) getmem(mem,1,sizeof(struct expand_node));
X
X    e->e_node = NILP(struct inline_node *);
X    e->e_multiple = 0; /* more than one call to this inline */
X    for (i = 0; i < NFORMALS; i++) {
X        e->e_actuals[i].tl_head = NILTOK;
X        e->e_actuals[i].tl_tail = NILTOK;
X    }
X    e->e_nactuals = 0;
X    return(e);
X}
X
Xsideeffect(tl)
Xregister struct toklist *tl;
X{
X    register struct token *t,*tp;
X
X    tp = NILTOK;
X    for (t = tl->tl_head; t != NILTOK; t = t->t_next) {
X        switch(t->t_tok) {
X        case T_EQ:    case T_RS_EQ:    case T_LS_EQ:
X        case T_ADD_EQ:    case T_SUB_EQ:    case T_MUL_EQ:
X        case T_DIV_EQ:    case T_MOD_EQ:    case T_AND_EQ:
X        case T_XOR_EQ:    case T_OR_EQ:
X        case T_INC:    case T_DEC:
X            return(1);
X
X        case T_LPAREN:
X            /* function call */
X            /* catches "fp(x)", "(*fp)(x)", "fp[foo](x)" */
X            if (tp && (
X                (tp->t_tok == T_IDENT) ||
X                (tp->t_tok == T_RPAREN) ||
X                (tp->t_tok == T_RSQ)
X               )) {
X                return(1);
X            }
X            break;
X
X        case T_LBRACE: case T_RBRACE:
X            error(tp->t_line, "brace in actual argument", 0);
X            return(1);
X
X        case T_WS: case T_COMMENT:
X            break;
X
X        default:
X            if (istype(t)) {    /* must be a cast */
X                return(1);    /* ???? */
X            }
X            tp = t;        /* save previous non-ws token */
X            break;
X        }
X        if (t == tl->tl_tail) {
X            break;
X        }
X    }
X    return(0);
X}
X
\Rogue\Monster\
else
  echo "will not over write ./expand.c"
fi
chmod 444 ./expand.c
if [ `wc -c ./expand.c | awk '{printf $1}'` -ne 14621 ]
then
echo `wc -c ./expand.c | awk '{print "Got " $1 ", Expected " 14621}'`
fi
if `test ! -s ./rewrite.c`
then
echo "writing ./rewrite.c"
sed 's/^X//' > ./rewrite.c << '\Rogue\Monster\'
X/*
X * inline code expander - rewrite a procedure into an expression if possible
X *
X * (c) 1986 - copyright 1986, s. mcgeady, all rights reserved
X */
X
X/* $Header: rewrite.c,v 1.3 87/05/12 10:53:05 mcg Rel $ */
X
X#include "inline.h"
X#include "tokens.h"
X
Xextern struct token *dostmt();        /* see expand.c */
Xextern struct token *doexpr();        /* see expand.c */
X
X
X/*
X * This module takes arbitrary sequences of C statements (assumed to be
X * the output of the inline declaration process), and rewrites them, if
X * possible, in an expression form, depositing the result in the
X * appropriate place (i_tl[SEXPRBODY]) in the inline node structure.
X *
X * This is done, fundamentally, by replacing semicolons with commas,
X * and deleting if's, following if conditional expressions with '?', and
X * replacing else's with ':'.  Clearly, it is somewhat more complex than
X * that, but most of the difficulty merely comes in keeping one's
X * parentheses matched.
X *
X * One subtlety is that local declarations need to be factored out,
X * except that if they contain initializations, the initializations need
X * to be separated from the declarations and prepended to the expression
X * list.  This is handled by the routine coalesce().  Coalesce() also
X * needs to handle name conflicts caused by local variables declared in
X * inner scopes when it is moving these to outer scopes.
X *
X * If rewrite() finds a statement that it can't rewrite into an expression
X * (this class consists entirely of loops (while(), for()), goto's, and
X * switch statements, and the break's and continue's that go along with
X * these), then it returns -1, and the calling routine (declare.c:dodecl())
X * frees the memory pool associated with it.
X */
X
X
Xstatic int saw_innerret = 0;
X
X
X/* turn a basic block into an expression */
X
Xrewrite(node,tl,toplevel)
Xregister struct inline_node *node;
Xregister struct toklist *tl;
Xregister int toplevel;
X{
X    register struct token *tx, *tt;
X    register struct token *estart;    /* start of current expression */
X    register struct token *bstart;    /* start of this block */
X    register struct token *last = NILTOK;
X    struct toklist *expr = &node->i_tl[SEXPRBODY];
X    register int mem = node->i_exprmem;
X    struct toklist block;
X    register int inblock = 0;
X    register int ntok = 0;
X    int saw_topret = 0;
X    int nonempty = 0;
X
X
X    /* skip over leading whitespace */
X
X    tx = skipws(tl->tl_head);
X    if (tx->t_tok == T_LBRACE) {
X        inblock++;
X    }
X    if (toplevel) {
X        addtok(expr,last = bstart = estart = newtok(mem,T_WS,""));
X        saw_innerret = 0;
X    } else {
X        bstart = estart = expr->tl_tail;
X    }
X
X    for(  ; tx && tx != tl->tl_tail; last = tx, tx = tx->t_next) {
X        if (istype(tx) || isstoreclass(tx)) {
X            /* local definition block */
X            block.tl_head = tx;
X            tx = block.tl_tail = dostmt(tx,0);
X
X            if (tx->t_tok != T_SEMIC) {
X                /* weird */
X                return(-1);
X            }
X
X            if (ntok = coalesce(node,&block)) {
X                nonempty++;
X            }
X        }
X
X
X        switch(tx->t_tok) {
X        case T_CONTINUE:
X        case T_BREAK:
X            /*FALLTHROUGH*/
X        case T_WHILE:
X        case T_FOR:
X        case T_SWITCH:
X            return(-1);
X
X        case T_RBRACE:
X            if (inblock && tx->t_level == tl->tl_head->t_level) {
X                goto end;
X            }
X            /*FALLTHROUGH*/
X
X        case T_LBRACE:
X            break;
X
X        case T_GOTO:
X            /* if it's not a rewritten return(), it's an error */
X            if (tx->t_next->t_next->t_tok == T_RETLAB) {
X                tx = dostmt(tx,0);
X                break;
X            }
X            return(-1);
X
X        case T_IF:
X            block.tl_head = skipws(tx->t_next);
X            block.tl_tail = doexpr(block.tl_head,1);
X
X            /* copy control part */
X            cpytoklist(mem,expr,&block);
X
X            addtok(expr,newtok(mem,T_QUEST,NIL));
X            addtok(expr,newtok(mem,T_WS," "));
X
X            block.tl_head = skipws(block.tl_tail->t_next);
X            block.tl_tail = dostmt(block.tl_head,0);
X
X            if ((ntok = rewrite(node,&block,0)) < 0) {
X                return(-1);
X            }
X            /* if no tokens added - i.e. empty block */
X            if (ntok == 0) {
X                addtok(expr,newtok(mem,T_NUM,"0"));
X            }
X
X            addtok(expr,newtok(mem,T_COLON,NIL));
X            addtok(expr,newtok(mem,T_WS," "));
X
X            tx = skipws(block.tl_tail->t_next);
X            if (tx && tx != tl->tl_tail) {
X                if (tx->t_tok != T_ELSE) {
X                    /* no else - treat rest of block like else */
X                    block.tl_head = tx;
X                    tx = block.tl_tail = tl->tl_tail;
X                    if ((ntok = rewrite(node,&block,0)) < 0) {
X                        return(-1);
X                    }
X                } else {
X                    block.tl_head = skipws(tx->t_next);
X                    tx = block.tl_tail = dostmt(block.tl_head,0);
X                    if ((ntok = rewrite(node,&block,0)) < 0) {
X                        return(-1);
X                    }
X                }
X            } else {
X                ntok = 0;
X            }
X            /* if no tokens added - i.e. empty block */
X            if (ntok == 0) {
X                addtok(expr,newtok(mem,T_NUM,"0"));
X            }
X            ntok = 1;
X            nonempty++;
X            /*FALLTHROUGH*/
X
X        case T_SEMIC:
X            if (ntok == 0) {
X                break;
X            }
X            /* if there was a preceding expression, insert a comma */
X            if (estart && estart->t_tok == T_RPAREN) {
X                instok(estart,tt = newtok(mem,T_COMMA,NIL));
X                estart = tt;
X            }
X
X            /* wrap some parens around the expression itself */
X            instok(estart,newtok(mem,T_LPAREN,NIL));
X            addtok(expr,newtok(mem,T_RPAREN,NIL));
X
X            /* ... and around the whole expression so far */
X            if (bstart && bstart != expr->tl_head) {
X                instok(bstart,newtok(mem,T_LPAREN,NIL));
X                addtok(expr,newtok(mem,T_RPAREN,NIL));
X            }
X            estart = expr->tl_tail;
X            bstart = bstart->t_next;
X            ntok = 0;
X            nonempty++;
X            if (debug >= 9) {
X                fprintf(stderr,"> ");
X                prtoklist(expr,0,stderr);
X                fprintf(stderr,"\n");
X            }
X            break;
X
X        case T_WS:
X            if (last && last->t_tok != T_WS &&
X                last->t_tok != T_RPAREN &&
X                last->t_tok != T_LPAREN) {
X                addtok(expr,newtok(mem,T_WS," "));
X            }
X            break;
X
X        case T_RETVAL:
X            if (toplevel) {
X                saw_topret++;
X                for ( ; tx && tx != tl->tl_tail; tx = tx->t_next) {
X                    if (tx->t_tok == T_EQ) {
X                        break;
X                    }
X                }
X                break;
X            } else {
X                saw_innerret++;
X            }
X            /*FALLTHROUGH*/
X        default:
X            addtok(expr,duptok(mem,tx));
X            ntok++;
X            nonempty++;
X            break;
X        }
X    }
X    end:
X    if (toplevel) {
X        if (saw_innerret == 0 && saw_topret == 0) {
X            /* no returns, must be void */
X            return(-1);
X        }
X        if (saw_innerret) {
X            if (expr->tl_head != expr->tl_tail) {
X                addtok(expr,newtok(mem,T_COMMA,NIL));
X            }
X            addtok(expr,newtok(mem,T_RETVAL,NIL));
X        }
X        instok(expr->tl_head,newtok(mem,T_LPAREN,NIL));
X        addtok(expr,newtok(mem,T_RPAREN,NIL));
X        fixparens(expr,0,0);
X    }
X    if (debug >= 9) {
X        fprintf(stderr,"% ");
X        prtoklist(expr,0,stderr);
X        fprintf(stderr,"\n");
X    }
X    return(nonempty);
X}
X
X
Xcoalesce(node,tl)
Xregister struct inline_node *node;
Xregister struct toklist *tl;
X{
X    register struct token *tx, *ts, *estart, *bstart;
X    struct toklist *expr = &node->i_tl[SEXPRBODY];
X    struct toklist *exprdecl = &node->i_tl[SEXPRDECL];
X    register int mem = node->i_exprmem;
X    int initializer = 0;
X    int ntok = 0;
X
X    bstart = expr->tl_tail;
X
X    /* copy up to an '=' or ';' */
X    for(tx = tl->tl_head; tx && tx != tl->tl_tail->t_next; tx = tx->t_next) {
X        if (!initializer) {
X            if (tx->t_tok == T_IDENT) {
X                ts = tx;    /* save for future reference */
X            }
X            if (tx->t_tok != T_EQ) {
X                addtok(exprdecl,duptok(mem,tx));
X                if (tx->t_tok == T_SEMIC) {
X                    return(ntok);
X                }
X                continue;
X            }
X            estart = expr->tl_tail;
X            /* an '=' */
X            addtok(expr,duptok(mem,ts));
X            addtok(expr,newtok(mem,T_WS," "));
X            ntok++;
X            initializer = 1;
X        }
X        /* in initializer */
X
X        /* look for ',' or ';' terminating initialization */
X        if ((tx->t_tok == T_COMMA && tx->t_paren <= ts->t_paren)
X             || tx->t_tok == T_SEMIC) {
X
X            addtok(exprdecl,duptok(mem,tx));
X
X            /* if there was a preceeding expr, prepend a comma */
X            if (estart && estart->t_tok == T_RPAREN) {
X                instok(estart,ts = newtok(mem,T_COMMA,NIL));
X                 estart = ts;
X            }
X
X            /* wrap some parens around this expr */
X            instok(estart,newtok(mem,T_LPAREN,NIL));
X            addtok(expr,newtok(mem,T_RPAREN,NIL));
X
X            /* ... and around the whole expression so far */
X            if (bstart && bstart != estart) {
X                instok(bstart,newtok(mem,T_LPAREN,NIL));
X                addtok(expr,newtok(mem,T_RPAREN,NIL));
X            }
X            estart = expr->tl_tail;
X            bstart = bstart->t_next;
X            initializer = 0;
X            if (debug >= 9) {
X                fprintf(stderr,">> ");
X                prtoklist(expr,0,stderr);
X                fprintf(stderr,"\n");
X            }
X        } else {
X            addtok(expr,duptok(mem,tx));
X        }
X    }
X    if (debug >= 9) {
X        fprintf(stderr,">> ");
X        prtoklist(expr,0,stderr);
X        fprintf(stderr,"\n");
X    }
X    return(ntok);
X}
\Rogue\Monster\
else
  echo "will not over write ./rewrite.c"
fi
chmod 444 ./rewrite.c
if [ `wc -c ./rewrite.c | awk '{printf $1}'` -ne 8260 ]
then
echo `wc -c ./rewrite.c | awk '{print "Got " $1 ", Expected " 8260}'`
fi
if `test ! -s ./yylex.c`
then
echo "writing ./yylex.c"
sed 's/^X//' > ./yylex.c << '\Rogue\Monster\'
X/*
X * inline code expander
X *
X * (c) 1986,1987 - copyright 1986,1987, s. mcgeady, all rights reserved
X */
X
X/*
X * fast lexer for C
X */
X
X/* $Header: yylex.c,v 1.9 87/06/24 13:05:47 mcg Rel $ */
X
X#include "inline.h"
X#include <ctype.h>
X#include "tokens.h"
X
X#define    MAXLEXBUF    1024
X
X/* you can use these macros on any machine with stdio guts like a VAX */
X#if defined(vax) || defined(sun) || defined(gould) || defined(pyr)
X
X#ifndef lint
X#define    peekc(p)   ((p)->_cnt > 0 ? (int)(*(unsigned char *)(p)->_ptr) \
X            :((_filbuf(p) == EOF) ? EOF :            \
X                ((p)->_cnt++),(int)(*(unsigned char *)(--(p)->_ptr))))
X
X
X#define ungetc(c, p)    ((c) == EOF) ? EOF : ((p)->_cnt++ == 0 ?    \
X        (((p)->_ptr == (p)->_base) ?                 \
X        *(p)->_ptr = (c) : (*--((p)->_ptr) = (c)))        \
X        : (((p)->_ptr == (p)->_base) ? (p)->_cnt--,EOF :     \
X        (*--((p)->_ptr) = (c))))
X
X#endif
X#else
Xstatic int _pc;        /* 'peek'ed character holder */
X
X#define    peekc(p)    ((_pc = getc(p),ungetc(_pc,p)),_pc)
X#endif
X
Xextern char *gather();
X
X#ifndef NIL
X#define NIL (char *) 0
X#endif
X
X/* 33 keywords */
Xstruct keys {
X    char    *k_str;
X    int    k_val;
X} kw[8][10] = {
X{
X    { NIL,        0,        /* */ },
X},
X{
X    { "do",        T_DO,        /* do */ },
X    { "if",        T_IF,        /* if */ },
X    { NIL,        0,        /* */ },
X},
X{
X    { "for",    T_FOR,        /* for */ },
X    { "int",    T_INT,        /* int */ },
X    { NIL,        0,        /* */ },
X},
X{
X    { "auto",    T_AUTO,        /* auto */ },
X    { "case",    T_CASE,        /* case */ },
X    { "char",    T_CHAR,        /* char */ },
X    { "else",    T_ELSE,        /* else */ },
X    { "enum",    T_ENUM,        /* enum */ },
X    { "goto",    T_GOTO,        /* goto */ },
X    { "long",    T_LONG,        /* long */ },
X    { "void",    T_VOID,        /* void */ },
X    { NIL,        0,        /* */ },
X},
X{
X    { "break",    T_BREAK,    /* break */ },
X    { "const",    T_CONST,    /* const */ },
X    { "float",    T_FLOAT,    /* float */ },
X    { "short",    T_SHORT,    /* short */ },
X    { "union",    T_UNION,    /* union */ },
X    { "while",    T_WHILE,    /* while */ },
X    { NIL,        0,        /* */ },
X},
X{
X    { "double",    T_DOUBLE,    /* double */ },
X    { "extern",    T_EXTERN,    /* extern */ },
X    { "inline",    T_INLINE,    /* inline */ },
X    { "return",    T_RETURN,    /* return */ },
X    { "signed",    T_SIGNED,    /* signed */ },
X    { "sizeof",    T_SIZEOF,    /* sizeof */ },
X    { "static",    T_STATIC,    /* static */ },
X    { "struct",    T_STRUCT,    /* struct */ },
X    { "switch",    T_SWITCH,    /* switch */ },
X    { NIL,        0,        /* */ },
X},
X{
X    { "default",    T_DEFAULT,    /* default */ },
X    { "typedef",    T_TYPEDEF,    /* typedef */ },
X    { NIL,        0,         /* */ },
X},
X{
X    { "continue",    T_CONTINUE,    /* continue */ },
X    { "register",    T_REGISTER,    /* register */ },
X    { "unsigned",    T_UNSIGNED,    /* unsigned */ },
X    { "volatile",    T_VOLATILE,    /* volatile */ },
X    { NIL,        0,        /* */ },
X}
X};
X
Xiskeyword(s,n)
Xregister char *s;
Xregister int n;
X{
X    register struct keys *kwp;
X
X    kwp = &kw[n-1][0];
X
X    if (n < 2 || n > 8) return(0);
X    do {
X        if (s[0] != kwp->k_str[0] || s[1] != kwp->k_str[1])
X            continue;
X        if (strncmp(s,kwp->k_str,n) == 0)
X            return(kwp->k_val);
X    } while ((++kwp)->k_str);    /* fix thanks to ucbcad!thomas */
X    return(0);
X}
X
Xstatic char yytext[MAXLEXBUF];
Xstatic char *yylval;
Xint line = 1;
X
Xyylex(mem)
Xregister int mem;
X{
X    register int c, cc, pc;
X    register int len;
X    register char *p;
X    int base, i;
X
X    base = 10;
X    yylval = NIL;
X
X    if ((c = getc(stdin)) == EOF) {
X        return(0);
X    }
X    pc = peekc(stdin);
X    if (pc == '=') {
X        cc = getc(stdin);
X        switch(c) {
X            case '+': { return(T_ADD_EQ); }
X            case '-': { return(T_SUB_EQ); }
X            case '*': { return(T_MUL_EQ); }
X            case '/': { return(T_DIV_EQ); }
X            case '%': { return(T_MOD_EQ); }
X            case '&': { return(T_AND_EQ); }
X            case '^': { return(T_XOR_EQ); }
X            case '|': { return(T_OR_EQ); }
X            case '=': { return(T_CEQ); }
X            case '!': { return(T_NE); }
X            default:
X                ungetc(cc,stdin);
X                /* pc is correct */
X                break;
X        }
X    } else if (pc == c) {
X        cc = getc(stdin);
X        pc = peekc(stdin);
X        switch(c) {
X        case '+': { return(T_INC); }
X        case '-': { return(T_DEC); }
X        case '&': { return(T_CAND); }
X        case '|': { return(T_COR); }
X        case '>':        /* also >>, >>= */
X            if (pc == '=') {
X                getc(stdin);
X                return(T_RS_EQ);
X            }
X            return(T_RS);
X
X        case '<':        /* also <<, <<= */
X            if (pc == '=') {
X                getc(stdin);
X                return(T_LS_EQ);
X            }
X            return(T_LS);
X
X        default:
X            ungetc(cc,stdin);
X            pc = cc;
X            break;
X        }
X    }
X    switch(c) {
X    case '#':        /* CPP line */
X        yylval = gather(mem,T_CPP,"#");
X        return(T_CPP);
X
X
X    case '-':        /* also --, -=, -> */
X        if (pc == '>') { getc(stdin); return(T_PTR); }
X        return(T_MINUS);
X
X
X    case '/':        /* also /=, comment */
X        if (pc == '*') {    /* comment */
X            getc(stdin);
X            yylval = gather(mem,T_COMMENT,"/*");
X            return(T_COMMENT);
X        }
X        return(T_DIV);
X
X    case '<': return(T_LT);        /* also <<, <<= */
X    case '>': return(T_GT);        /* also >>, >>= */
X    case '+': return(T_PLUS);    /* also ++, += */
X    case '*': return(T_STAR);    /* also *= */
X    case '%': return(T_MOD);    /* also %= */
X    case '&': return(T_AMPER);    /* also &&, &= */
X    case '^': return(T_XOR);    /* also ^= */
X    case '|': return(T_OR);        /* also ||, |= */
X    case '=': return(T_EQ);        /* also == */
X    case '!': return(T_NOT);    /* also != */
X    case '.':            /* also ... */
X        if (pc == '.') {
X            cc = getc(stdin);
X            if (peekc(stdin) == '.') {
X                getc(stdin);
X                return(T_ELLIPSES);
X            }
X            ungetc(cc,stdin);
X        }
X        return(T_DOT);
X
X    case ';': return(T_SEMIC);
X    case '{': return(T_LBRACE);
X    case '}': return(T_RBRACE);
X    case ',': return(T_COMMA);
X    case ':': return(T_COLON);
X    case '(': return(T_LPAREN);
X    case ')': return(T_RPAREN);
X    case '[': return(T_LSQ);
X    case ']': return(T_RSQ);
X    case '~': return(T_TILDE);
X    case '?': return(T_QUEST);
X
X    case '\'':
X        yylval = gather(mem,T_CHARCONST,"'");
X        return(T_CHARCONST);
X
X    case '"':
X        yylval = gather(mem,T_STR,"\"");
X        return(T_STR);
X
X    case ' ': case '\t': case '\v': case '\n': case '\f':
X        p = yytext;
X        do {
X            *p++ = c;
X            if (c == '\n') line++;
X            c = peekc(stdin);
X        } while ((c == ' ' || c == '\t' || c == '\v' || c == '\n' ||
X              c == '\f') && (p < &yytext[MAXLEXBUF]) &&
X              ((c = getc(stdin)) != EOF));
X        *p = '\0';
X        yylval = yytext;
X        return(T_WS);
X
X    case '0':
X        p = yytext;
X        *p++ = c;
X        if (tolower(pc) == 'x') {
X            base = 16;
X            *p++ = getc(stdin);
X            c = getc(stdin);
X        } else if (tolower(pc) == 'f') {
X#ifdef notdef
X            /* 0finf or 0fnan(xxx) */
X            *p++ = getc(stdin);
X            base = -1;    /* FLOAT */
X            c = getc(stdin);
X#endif
X        } else if (isdigit(pc)) {
X            base = 8;
X            c = getc(stdin);
X        } else {
X            p = yytext;
X        }
X        /*FALLTHROUGH*/
X
X    case '1': case '2': case '3': case '4': case '5':
X    case '6': case '7': case '8': case '9':
X
X        if (base == 10) {
X            p = yytext;
X        }
X        do {
X            if (!isdigit(c) &&
X                !((c == '.') || (tolower(c) == 'e') ||
X                  (c == '+') || (c == '-'))) {
X                ungetc(c,stdin);
X                break;
X            }
X            *p++ = c;
X        } while((c = getc(stdin)) != EOF);
X        *p = '\0';
X        yylval = yytext;
X        return(T_NUM);
X
X    case EOF:
X        return(0);
X
X    default:    /* an identifier or keyword */
X        if ((c < ' ') || (c > '~') || !isalpha(c)) {
X            error(line,"illegal character");
X            yytext[0] = c; yytext[1] = '\0';
X            yylval = yytext;
X            return(T_WS);
X        }
X        /*FALLTHROUGH*/
X    case '_':
X        yytext[0] = c;
X        p = &yytext[1];
X        len = 1;
X        while((c = getc(stdin)) != EOF) {
X            if (!isalpha(c) && !isdigit(c) && c != '$' && c != '_') {
X                ungetc(c,stdin);
X                break;
X            }
X            *p++ = c;
X            len++;
X        }
X        *p = '\0';
X        if (i = iskeyword(yytext,len)) {
X            return(i);
X        } else {
X            yylval = yytext;
X            return(T_IDENT);
X        }
X    }
X    /*NOTREACHED*/
X}
X
X/*
X */
X
Xchar *
Xgather(mem,type,init)
Xregister int mem;
Xint type;
Xchar *init;
X{
X    char buf[MAXLEXBUF];
X    register int c;
X    register char *tbuf;
X    register int tbufsize = 0;
X    register char *bb = buf;
X    register char *p = bb;
X    register char *ebuf = &buf[MAXLEXBUF-1];
X
X
X    strcpy(buf,init);
X    p = buf + strlen(init);
X    while ((c = getc(stdin)) != EOF) {
X        *p = c;
X        if (*p == 0)
X            break;
X
X        if (*p == '\n') line++;
X
X        switch (type) {
X        case T_COMMENT:
X            if (*p == '*' && peekc(stdin) == '/') {
X                *++p = getc(stdin);
X                goto end;
X            }
X            break;
X        case T_CPP:
X            if (*p == '\\') {
X                *++p = getc(stdin);
X            } else if (*p == '\n') {
X                /* ungetc(*p,stdin); */
X                goto end;
X            }
X            break;
X        case T_STR:
X            if (*p == '\\') {
X                *++p = getc(stdin);
X            } else if (*p == '\n') {
X                /* error */
X            } else if (*p == '"') {
X                goto end;
X            }
X            break;
X
X        case T_CHARCONST:
X            if (*p == '\\') {
X                *++p = getc(stdin);
X            } else if (*p == '\n') {
X                /* error */
X            } else if (*p == '\'') {
X                goto end;
X            }
X            break;
X        }
X        /* leave two slots open at end */
X        if (++p >= ebuf-1) {
X            *p = '\0';
X            if (tbufsize == 0) {
X                tbufsize = 1024;
X            }
X            if (mem < 0) {
X                tbuf = (char *) malloc((unsigned) (tbufsize *= 2));
X            } else {
X                tbuf = getmem(mem, 0, (unsigned) (tbufsize *= 2));
X            }
X            strcpy(tbuf, bb);
X            p = tbuf + (p - bb);
X            if (bb != buf) {
X                free(bb);
X            }
X            bb = tbuf;
X            ebuf = bb + tbufsize;
X        }
X    }
X    end:
X    *++p = '\0';
X    p++;
X    if (tbufsize == 0) {
X        if (mem < 0) {
X            tbuf = (char *) malloc((unsigned) (p-bb));
X        } else {
X            tbuf = getmem(mem, 0, (unsigned) (p-bb));
X        }
X        strcpy(tbuf, bb);
X        bb = tbuf;
X    }
X    return(bb);
X}
X
X
X#ifndef TEST
X
Xcheck_type(tok)
Xregister struct token *tok;
X{
X    register int i;
X    register char **p;
X
X    for (i = 0; (i < NSCOPE) && (typeid[i] != NILP(struct typelist *));i++) {
X        for (p = typeid[i]->type_id; *p != NIL; p++) {
X            if (strcmp(tok->t_id,*p) == 0) {
X                tok->t_tok = T_TYPE_ID;
X                return;
X            }
X        }
X    }
X}
X
Xstruct token *
Xgettok(mem)
Xregister int mem;
X{
X    register int t;
X    struct token *tok;
X    static int bracelev = 0;
X    static int parenlev = 0;
X
X    if ((t = yylex(mem)) == 0)
X        return((struct token *) 0);
X    tok = newtok(mem, t, yylval);
X    tok->t_line = line;
X    switch(t) {
X    case T_COMMENT:
X    case T_CPP:
X        tok->t_tok = T_WS;
X        /*FALLTHROUGH*/
X    case T_STR:
X        /* free(yylval); */
X        break;
X
X    case T_LBRACE:
X        tok->t_level = bracelev++;
X        tok->t_paren = parenlev;
X        pushscope(bracelev);
X        break;
X    case T_LPAREN:
X        tok->t_paren = parenlev++;
X        tok->t_level = bracelev;
X        break;
X    case T_RPAREN:
X        tok->t_level = bracelev;
X        tok->t_paren = --parenlev;
X        break;
X    case T_RBRACE:
X        popscope(bracelev);
X        tok->t_level = --bracelev;
X        tok->t_paren = parenlev;
X        break;
X
X    default:
X        tok->t_level = bracelev;
X        tok->t_paren = parenlev;
X        break;
X    }
X    if (t == T_IDENT) {
X        check_type(tok);
X    }
X    return(tok);
X}
X#endif
X
X#ifdef TEST
Xmain() {
X    int tok;
X    extern char *tokens[];
X
X    while(tok = yylex(-1)) {
X        switch (tok) {
X        case T_COMMENT:
X        case T_STR:
X        case T_CPP:
X            free(yylval);
X
X        case T_IDENT:
X        case T_WS:
X        case T_NUM:
X        case T_CHARCONST:
X        case T_TYPE_ID:
X            fputs(yylval,stdout);
X            break;
X        case T_ACTUAL:
X            fputs("<ACTUAL>",stdout);
X            break;
X        case T_RETVAL:
X            fputs("<RETVAL>",stdout);
X            break;
X        case T_ARGLIST:
X            fprintf(stdout,"%s(ARGLIST)", yylval);
X            break;
X        case T_RETLAB:
X            fputs("<RETLAB>",stdout);
X            break;
X        case T_FORMAL:
X            fprintf(stdout,"<FORMAL '%s'>",yylval);
X            break;
X        default:
X            if (tok <= T_INLINE)
X                fputs(tokens[tok],stdout);
X            else
X                fputs("???",stdout);
X
X            break;
X        }
X    }
X}
X#endif
\Rogue\Monster\
else
  echo "will not over write ./yylex.c"
fi
chmod 444 ./yylex.c
if [ `wc -c ./yylex.c | awk '{printf $1}'` -ne 10795 ]
then
echo `wc -c ./yylex.c | awk '{print "Got " $1 ", Expected " 10795}'`
fi
if `test ! -s ./tokens.c`
then
echo "writing ./tokens.c"
sed 's/^X//' > ./tokens.c << '\Rogue\Monster\'
X/*
X * inline code expander
X *
X * (c) 1986 - copyright 1986, s. mcgeady, all rights reserved
X */
X
X/* $Header: tokens.c,v 1.3 87/04/27 18:16:52 mcg Rel $ */
X
X
Xchar *tokens[] =  {
X    "",
X    "auto",
X    "break",
X    "case",
X    "char",
X    "const",
X    "continue",
X    "default",
X    "do",
X    "double",
X    "else",
X    "enum",
X    "extern",
X    "float",
X    "for",
X    "goto",
X    "if",
X    "int",
X    "long",
X    "register",
X    "return",
X    "short",
X    "signed",
X    "sizeof",
X    "static",
X    "struct",
X    "switch",
X    "typedef",
X    "union",
X    "unsigned",
X    "void",
X    "volatile",
X    "while",
X    "...",
X    "=",
X    ",",
X    "{",
X    "}",
X    ";",
X    ">>=",
X    "<<=",
X    "+=",
X    "-=",
X    "*=",
X    "/=",
X    "%=",
X    "&=",
X    "^=",
X    "|=",
X    ">>",
X    "<<",
X    "++",
X    "--",
X    "->",
X    "&&",
X    "||",
X    "<=",
X    ">=",
X    "==",
X    "!=",
X    ":",
X    "",
X    "(",
X    ")",
X    "[",
X    "]",
X    ".",
X    "&",
X    "!",
X    "~",
X    "-",
X    "+",
X    "*",
X    "/",
X    "%",
X    "<",
X    ">",
X    "^",
X    "|",
X    "?",
X    "inline",
X};
\Rogue\Monster\
else
  echo "will not over write ./tokens.c"
fi
chmod 444 ./tokens.c
if [ `wc -c ./tokens.c | awk '{printf $1}'` -ne 828 ]
then
echo `wc -c ./tokens.c | awk '{print "Got " $1 ", Expected " 828}'`
fi
if `test ! -s ./utils.c`
then
echo "writing ./utils.c"
sed 's/^X//' > ./utils.c << '\Rogue\Monster\'
X/*
X * C inline code substituter - 11/24/86 - mcg
X *
X * utility routines
X *
X * (c) 1986 - copyright 1986, s. mcgeady, all rights reserved
X */
X
X/* $Header: utils.c,v 1.13 87/06/24 13:11:40 mcg Rel $ */
X
X
X#include <stdio.h>
X#include "tokens.h"
X#include "inline.h"
X
Xstruct token *
Xskipws(t)
Xregister struct token *t;
X{
X    while (t && t->t_next && (t->t_tok == T_WS)) {
X        t = t->t_next;
X    }
X    return(t);
X}
X
X/*
X * add a token to a list
X */
X
Xaddtok(list, tok)
Xregister struct toklist *list;
Xregister struct token *tok;
X{
X    if (list->tl_head == NILTOK) {
X        list->tl_head = tok;
X    }
X    if (list->tl_tail != NILTOK) {
X        list->tl_tail->t_next = tok;
X    }
X    list->tl_tail = tok;
X}
X
Xstruct token *
Xinstok(tok,ntok)
Xregister struct token *tok;
Xregister struct token *ntok;
X{
X    register struct token *tl;
X
X    if (ntok == NILTOK) {
X        return(tok);
X    }
X    /* find end of new token list */
X    for(tl = ntok; tl->t_next != NILTOK; tl = tl->t_next)
X        ;
X
X    if (tok->t_next == NILTOK) {
X        tok->t_next = ntok;
X    } else {
X        tl->t_next = tok->t_next;
X        tok->t_next = ntok;
X    }
X    return(tl);    /* return end of new list */
X}
X
X/*
X * get a new token
X */
X
Xstruct token *
Xnewtok(mem,val, id)
Xint val;
Xchar *id;
X{
X    register struct token *t;
X    register unsigned int len,l;
X
X    len = sizeof(struct token);
X    if (id) {
X        len += (l = strlen(id) + 1);
X    }
X
X    t = (struct token *) getmem(mem,1,len);
X
X    if (id) {
X        t->t_id = ((char *) t) + sizeof(struct token);
X        (void) strncpy(t->t_id,id,l);
X    } else {
X        t->t_id = NIL;
X    }
X
X    t->t_tok = val;
X    t->t_flags = 0;
X    t->t_num = 0;
X    t->t_level = 0;
X    t->t_paren = 0;
X    t->t_line = 0;
X    t->t_next = NILTOK;
X    return(t);
X}
X
Xstruct token *
Xduptok(mem,tok)
Xregister struct token *tok;
X{
X    register struct token *t;
X
X    t = newtok(mem,tok->t_tok, tok->t_id);
X    t->t_flags = tok->t_flags;
X    t->t_num = tok->t_num;
X    t->t_level = tok->t_level;
X    t->t_paren = tok->t_paren;
X    t->t_line = 0;
X    t->t_next = NILTOK;    /* next token in this list */
X    return(t);
X}
X
Xcpytoklist(mem, olist, ilist)
Xint mem;
Xregister struct toklist *olist;
Xregister struct toklist *ilist;
X{
X    register struct token *tl;
X
X    for(tl = ilist->tl_head; tl != NILTOK; tl = tl->t_next) {
X        addtok(olist,duptok(mem,tl));
X        if (tl == ilist->tl_tail)
X            break;
X    }
X}
X
Xfixparens(tl,plev,blev)
Xregister struct toklist *tl;
Xregister int plev, blev;
X{
X    register struct token *tp;
X    register int paren = plev;
X    register int brace = blev;
X
X    for (tp = tl->tl_head; tp && tp != tl->tl_tail->t_next; tp = tp->t_next) {
X        tp->t_paren = paren;
X        tp->t_level = brace;
X        switch(tp->t_tok) {
X        case T_LPAREN:
X            paren++;
X            break;
X        case T_LBRACE:
X            brace++;
X            break;
X        case T_RBRACE:
X            tp->t_level = --brace;
X            break;
X        case T_RPAREN:
X            tp->t_paren = --paren;
X            break;
X        default:
X            break;
X        }
X    }
X}
X
X#include "varargs.h"
X
X/*VARARGS1*/
Xchar *
Xmkstr(mem,va_alist)
Xint mem;
Xva_dcl
X{
X    va_list s;
X    register int i;
X    register char *rs,*ts;
X
X    va_start(s);
X    i = 0;
X    while(1) {
X        rs = va_arg(s, char *);
X        if (rs == NIL) {
X            break;
X        }
X        i += strlen(rs);
X    }
X    va_end(s);
X    rs = (char *) getmem(mem,0,(unsigned) i+1);
X    *rs = '\0';
X    va_start(s);
X    while(1) {
X        ts = va_arg(s, char *);
X        if (ts == NIL) {
X            break;
X        }
X        (void) strcat(rs,ts);
X    }
X    va_end(s);
X    return(rs);
X}
X
X
X#ifdef vax
X/*VARARGS*/
Xerror(lin,fmt,args)
Xint lin;
Xchar *fmt;
Xchar *args;
X{
X    if (infile) {
X        fprintf(stderr,"\"%s\", line %d: ",infile,lin);
X    } else {
X        fprintf(stderr,"%s: line %d: ",myname,lin);
X    }
X    _doprnt(fmt,&args,stderr);
X    fputs("\n",stderr);
X    errs++;
X}
X
X
X/*VARARGS*/
Xwarn(lin,fmt,args)
Xint lin;
Xchar *fmt;
Xchar *args;
X{
X    if (nowarn) return;
X
X    if (infile) {
X        fprintf(stderr,"\"%s\", line %d: warning: ",infile,lin);
X    } else {
X        fprintf(stderr,"%s: line %d: warning: ",myname,lin);
X    }
X    _doprnt(fmt,&args,stderr);
X    fputs("\n",stderr);
X}
X#else
X/*VARARGS*/
Xerror(line,fmt,va_alist)
Xint line;
Xchar *fmt;
Xva_dcl
X{
X    va_list s;
X    va_list *p;
X    register int i;
X    register char *rs,*ts;
X
X    va_start(s);
X    p = &s;
X    if (infile) {
X        fprintf(stderr,"\"%s\", line %d: ",infile,line);
X    } else {
X        fprintf(stderr,"%s: line %d: ",myname,line);
X    }
X    _doprnt(fmt,p,stderr);
X    fputs("\n",stderr);
X    va_end(s);
X    errs++;
X}
X
X/*VARARGS*/
Xwarn(line,fmt,va_alist)
Xint line;
Xchar *fmt;
Xva_dcl
X{
X    va_list s;
X    va_list *p;
X    register int i;
X    register char *rs,*ts;
X
X    if (nowarn) return;
X
X    va_start(s);
X    p = &s;
X    if (infile) {
X        fprintf(stderr,"%s: \"%s\", line %d: ",infile,line);
X    } else {
X        fprintf(stderr,"%s: line %d: ",myname,line);
X    }
X    _doprnt(fmt,p,stderr);
X    fputs("\n",stderr);
X}
X
X#endif
X
X
X/* extremely limited - positive numbers only */
X/* useful only for appending positive digits to strings */
X
Xchar *
Xitoa(n)
X{
X    static char buf[20];
X    register char *p = &buf[18];
X
X    buf[19] = '\0';
X    do {
X        *p-- = '0' + (n%10);
X        n /= 10;
X    } while(n && (p >= buf));
X    return(++p);
X}
X
X/*
X * create a (non-filled-in) inline expansion node
X */
X
Xstruct inline_node *
Xmknode(mem)
Xint mem;
X{
X    register struct inline_node *node;
X    register int i;
X
X    node = (struct inline_node *) getmem(mem,1,sizeof (struct inline_node));
X    node->i_id = NIL;
X    for (i=0; i < NSTATES; i++) {
X        node->i_tl[i].tl_head = NILTOK;
X        node->i_tl[i].tl_tail = NILTOK;
X    }
X
X    node->i_text.tl_head = NILTOK;
X    node->i_text.tl_tail = NILTOK;
X
X    for(i=0; i < NFORMALS; i++) {
X        node->i_formals[i] = NIL;
X        node->i_formalinfo[i] = 0;
X    }
X    node->i_nformals = 0;
X
X    node->i_mem = mem;
X    node->i_line = 0;
X    node->i_flags = 0;
X    node->i_storclass = 0;
X    node->i_nseen = 0;
X    node->i_nexpand = 0;
X
X    node->i_exprmem = -1;
X
X    return(node);
X}
X
Xprtoklist(tl,doauto,s)
Xregister struct toklist *tl;
Xint doauto;
XFILE *s;
X{
X    register struct token *th = tl->tl_head;
X
X    while (th != NILTOK) {
X        prtok(th,doauto,s);
X        th = th->t_next;
X    }
X}
X
Xprtok(tok,doauto,s)
Xstruct token *tok;
Xint doauto;
XFILE *s;
X{
X    extern char *tokens[];
X
X    switch (tok->t_tok) {
X    case T_IDENT:
X        if (doauto && tok->t_flags&TAUTO) {
X            if (tok->t_flags&TINLINE) {
X                if (tok->t_num > 1) {
X                    fprintf(s,"_loc_%s_%d",tok->t_id,tok->t_num);
X                    break;
X                }
X            } else {
X                fprintf(s,"_auto_%s",tok->t_id);
X                break;
X            }
X        }
X        /*FALLTHROUGH*/
X    case T_LABEL:
X    case T_WS:
X    case T_NUM:
X    case T_CHARCONST:
X    case T_CPP:
X    case T_STR:
X    case T_TYPE_ID:
X    case T_STRTAG:
X        fputs(tok->t_id,s);
X        break;
X    case T_ACTUAL:
X        fputs("<ACTUAL>",s);
X        break;
X    case T_RETVAL:
X        fputs("<RETVAL>",s);
X        break;
X    case T_ARGLIST:
X        fprintf(s,"%s(ARGLIST)", tok->t_id);
X        break;
X    case T_RETLAB:
X        fputs("<RETLAB>",s);
X        break;
X    case T_FORMAL:
X        fprintf(s,"<FORMAL '%s'>",tok->t_id);
X        break;
X    default:
X        if (tok->t_tok <= T_INLINE)
X            fputs(tokens[tok->t_tok],s);
X        else
X            fputs("???",s);
X
X        break;
X    }
X}
X
X
Xdebugnode(node)
Xregister struct inline_node *node;
X{
X    register int i;
X
X    fprintf(stderr,"> inline '%s' @ line %d\n",node->i_id,node->i_line);
X    fprintf(stderr,"> formals (%d):\n", node->i_nformals);
X    for (i = 0; i < node->i_nformals; i++) {
X        fprintf(stderr,">    '%s'\n", node->i_formals[i]);
X    }
X    fprintf(stderr,"> function type:\n");
X    prtoklist(&node->i_tl[SDECL],0,stderr);
X    fprintf(stderr,"\n");
X    fprintf(stderr,"> declarations:\n");
X    prtoklist(&node->i_tl[SDECLBODY],0,stderr);
X    fprintf(stderr,"> body:\n");
X    prtoklist(&node->i_tl[SBODY],1,stderr);
X    fprintf(stderr,"\n");
X    if (node->i_flags&I_EXPR) {
X        fprintf(stderr,"> as expression:\n");
X        fprintf(stderr,">  declarations:\n");
X        prtoklist(&node->i_tl[SEXPRDECL],1,stderr);
X        fprintf(stderr,"\n>  body:\n");
X        prtoklist(&node->i_tl[SEXPRBODY],1,stderr);
X        fprintf(stderr,"\n");
X    } else {
X        fprintf(stderr, "(not an expression)\n");
X    }
X}
X
X
X
Xistype(tok)
Xstruct token *tok;
X{
X    switch(tok->t_tok) {
X    case T_CHAR:
X    case T_INT:
X    case T_SHORT:
X    case T_LONG:
X    case T_FLOAT:
X    case T_DOUBLE:
X    case T_UNSIGNED:
X    case T_SIGNED:
X    case T_VOID:
X    case T_ENUM:
X    case T_STRUCT:
X    case T_UNION:
X    case T_TYPE_ID:
X        return(1);
X
X    default:
X        return(0);
X    }
X}
X
Xisstoreclass(tok)
Xstruct token *tok;
X{
X    switch(tok->t_tok) {
X    case T_REGISTER:
X    case T_EXTERN:
X    case T_STATIC:
X    case T_AUTO:
X    case T_CONST:
X    case T_VOLATILE:
X        return(1);
X    default:
X        return(0);
X    }
X}
X
Xiscontrol(tok)
Xstruct token *tok;
X{
X    switch(tok->t_tok) {
X    case T_IF:
X    case T_WHILE:
X    case T_FOR:
X    case T_SWITCH:
X        return(1);
X    default:
X        return(0);
X    }
X}
X
X/*
X * returns true if the tokens following the argument conform to
X * the pattern of a simple call:
X *    identifier, optional whitespace, leftparen
X * e.g.:
X *    foo /* comment  ();
X *
X * thus
X *    (foo)();  (*foo)();  etc
X * are not calls
X */
X
Xiscall(tok)
Xregister struct token *tok;
X{
X    if (tok == NILTOK) {
X        return(0);
X    }
X    if ((tok->t_tok != T_IDENT) || (tok->t_flags&TNOEXPAND)) {
X        return(0);
X    }
X    /* skip over any leading whitespace */
X    for(tok = tok->t_next; tok != NILTOK; tok = tok->t_next) {
X        if (tok->t_tok != T_WS) {
X            break;
X        }
X    }
X    if (tok && (tok->t_tok == T_LPAREN)) {
X        return(1);
X    }
X    return(0);
X}
X
\Rogue\Monster\
else
  echo "will not over write ./utils.c"
fi
chmod 444 ./utils.c
if [ `wc -c ./utils.c | awk '{printf $1}'` -ne 8665 ]
then
echo `wc -c ./utils.c | awk '{print "Got " $1 ", Expected " 8665}'`
fi
if `test ! -s ./mem.c`
then
echo "writing ./mem.c"
sed 's/^X//' > ./mem.c << '\Rogue\Monster\'
X/*
X * pool-based memory allocation scheme
X *
X * (c) 1986 - copyright 1986, s. mcgeady, all rights reserved
X *
X * this is good for low-overhead memory allocation of many small units,
X * where all the memory is freed at once at the end
X */
X
X/* $Header: mem.c,v 1.6 87/04/27 18:16:43 mcg Rel $ */
X
X
X#define    STATS    1
X#define    FREELIST 1    /* maintain freelist of hunks and bufs, cutting down */
X            /* on calls to malloc() and free() */
X#define    NFREEBUFS 10    /* number of free buffers to maintain */
X
X/* #define    TEST    1 */
X/* #define    ZEROMEM(p,n,a)    bzero(p,n) /* define to zero memory on allocation */
X#define    ZEROMEM(p,n,a)
X
Xextern char *malloc();
Xextern char *sbrk();
Xextern char *getmem();
X
X#define    NIL    0
X#define    POOLSIZE    4096
X
Xstruct memhunk {
X    char        *m_base;    /* pointer to memory buffer */
X    char        *m_free;    /* pointer to free mem */
X    unsigned    m_size;        /* size of this buffer */
X    unsigned    m_nleft;    /* number of bytes left */
X    struct memhunk    *m_next;    /* next pool in this cache */
X};
X
X/*
X * each pool consists of a series of 'hunks' of memory, organized
X * as a linked list.  the pool 'handle' is really a pointer to the
X * poolhead for the list
X */
X
Xstruct poolhead {
X    struct    memhunk    *pl_pool;
X    struct    poolhead *pl_next;
X};
X
Xstatic struct poolhead head = {0};
X
X#ifdef STATS
Xstatic int nrequest    = 0;
Xstatic int nloops    = 0;
Xstatic int maxloops    = 0;
Xstatic int minloops    = 0;
Xstatic int nfree    = 0;
Xstatic int nmalloc    = 0;
Xstatic int maxsize    = 0;
Xstatic int npools    = 0;
Xstatic int maxpools    = 0;
Xstatic int nhunks    = 0;
Xstatic int maxhunks    = 0;
Xstatic int firsttime    = 0;
Xstatic unsigned totsize = 0;
Xstatic char *lowwater    = 0;
Xstatic char *hiwater    = 0;
Xstatic int nphdr    = 0;
X
Xstatic
Xchar *
XMALLOC(n)
Xunsigned int n;
X{
X    register char *p;
X
X    nmalloc++;
X    p = malloc(n);
X    if (p > hiwater) {
X        hiwater = p;
X    }
X    return(p);
X}
X
X#define    FREE(x)        (nfree++,free((unsigned)x))
X
X#else
X
X#define    MALLOC    malloc
X#define    FREE    free
X
X#endif
X
X#ifndef FREELIST
X
X#define    getpool() ((struct poolhead *) MALLOC(sizeof(struct poolhead)))
X#define gethunk() ((struct memhunk *) MALLOC(sizeof(struct memhunk)))
X#define    getbuf(s)  ((char *) MALLOC(*(s)))
X#define freebuf(p,s) (FREE(p))
X#define    freehunk(p) (FREE(p))
X
X#else
X#define    getpool() ((struct poolhead *) MALLOC(sizeof(struct poolhead)))
X
Xstruct freebufs {
X    int    fb_size;
X    char    *fb_buf;
X};
X
Xstatic struct memhunk *hunks = {0};
Xstatic struct freebufs bufs[NFREEBUFS] = {0};
X
X
Xstruct memhunk *
Xgethunk() {
X    register struct memhunk *p = hunks;
X
X    if (p != NIL) {
X        hunks = p->m_next;
X        return(p);
X    }
X    return((struct memhunk *) MALLOC(sizeof(struct memhunk)));
X}
X
X#define freehunk(p)    ((p)->m_next = hunks, hunks = (p))
X
Xchar *
Xgetbuf(size)
Xunsigned int *size;
X{
X    register int i;
X    register struct freebufs *p;
X
X    if (*size == 0) return(NIL);
X
X    for (i = 0, p = bufs; i < NFREEBUFS; i++, p++) {
X        if (p->fb_size >= *size) {
X            *size = p->fb_size;
X            p->fb_size = 0;
X            return(p->fb_buf);
X        }
X    }
X    return((char *) MALLOC(*size));
X}
X
Xvoid
Xfreebuf(p,size)
Xchar *p;
Xunsigned size;
X{
X    register int i;
X    register struct freebufs *q;
X
X    for (i = 0, q = bufs; i < NFREEBUFS; i++, q++) {
X        if (q->fb_size == 0) {
X            q->fb_size = size;
X            q->fb_buf = p;
X            return;
X        }
X    }
X    FREE(p);
X}
X
X#endif
X
X
X/*
X * open a new memory pool, returning a handle to it
X */
X
Xopenpool() {
X    register struct poolhead *pl, *lastpl;
X    register int pool = 0;
X
X#ifdef STATS
X    if (firsttime == 0) {
X        firsttime++;
X        lowwater = sbrk(0);
X    }
X    npools++;
X    if (npools > maxpools) {
X        maxpools = npools;
X    }
X#endif
X    /* this finds the last pool header */
X    for (pl = &head;
X        ((pl != NIL) && (pl->pl_pool != NIL));
X          lastpl = pl, pl = pl->pl_next)
X    {
X        pool++;
X    }
X    if (pl == NIL) {
X        /* add a new pool header on the end */
X        pl = lastpl->pl_next = getpool();
X        pl->pl_pool = gethunk();
X        pl->pl_next = NIL;
X        pl->pl_pool->m_base = NIL;
X        pl->pl_pool->m_free = NIL;
X        pl->pl_pool->m_size = 0;
X        pl->pl_pool->m_nleft = 0;
X        pl->pl_pool->m_next = NIL;
X#ifdef STATS
X        nhunks++;
X        nphdr++;
X#endif
X    }
X    return(pool);
X}
X
X
X
X/*
X * close a memory pool, freeing all memory associated with it
X */
X
Xclosepool(pool)
Xregister int pool;
X{
X    register struct poolhead *pl;
X    register struct memhunk *p, *q;
X
X    if (pool < 0) {
X        return(NIL);
X    }
X    for(pl = &head; pl != NIL; pl = pl->pl_next) {
X        if (pool == 0) {
X            break;
X        }
X        pool--;
X    }
X    if (pool != 0) {        /*  invalid pool */
X        return(0);
X    }
X
X    for(p = pl->pl_pool; p != NIL; p = q) {
X        q = p->m_next;
X        if (p->m_base) {
X            freebuf(p->m_base,p->m_size);
X        }
X        freehunk(p);
X#ifdef STATS
X        nhunks--;
X#endif
X    }
X    pl->pl_pool = NIL;
X#ifdef STATS
X    npools--;
X#endif
X    return(1);
X}
X
X
X/*
X * get 'size' bytes, from 'pool'
X * if 'align' is 1, align the result on a (sizeof long) boundary
X */
X
Xchar *
Xgetmem(pool,align,size)
Xint pool;
Xunsigned align;
Xunsigned size;
X{
X    register struct poolhead *pl;
X    register struct memhunk *p,*lastp;
X    register char *r;
X    register int psize;
X    register int lnloops;
X
X#ifdef STATS
X    nrequest++;
X    totsize += size;
X    if (size > maxsize) {
X        maxsize = size;
X    }
X    lnloops = 0;
X#endif
X
X    if (pool < 0) {
X        return(NIL);
X    }
X    for(pl = &head; pl != NIL; pl = pl->pl_next) {
X        if (pool == 0) {
X            break;
X        }
X        pool--;
X    }
X    if (pool != 0) {        /*  invalid pool */
X        return(NIL);
X    }
X
X    for(p = pl->pl_pool,lastp = NIL; p != NIL; lastp = p, p = p->m_next) {
X#ifdef STATS
X        nloops++;
X        lnloops++;
X#endif
X        if (!p->m_nleft)
X            continue;
X        if (align && (psize = (((int) p->m_free) % sizeof(long)))) {
X            psize = sizeof(long) - psize;
X            if (p->m_nleft >= size+psize) {
X                p->m_nleft -= psize;
X                p->m_free += psize;
X            } else {
X                continue;
X            }
X        }
X        if (p->m_nleft && (p->m_nleft >= size)) {
X            r = p->m_free;
X            p->m_nleft -= size;
X            p->m_free += size;
X            ZEROMEM(r,size,align);
X            return(r);
X        }
X    }
X    if (size < POOLSIZE) {
X        psize = POOLSIZE;
X    } else {
X        psize = size;
X    }
X
X#ifdef STATS
X    nhunks++;
X    if (nhunks > maxhunks) {
X        maxhunks = nhunks;
X    }
X    if (lnloops > maxloops) {
X        maxloops = lnloops;
X    }
X    if ((minloops == 0) || (lnloops < minloops)) {
X        minloops = lnloops;
X    }
X#endif
X
X    /* don't need to worry about alignment here, malloc always aligned */
X    p = gethunk();
X
X    /* if lastp == NIL, then this is first allocation for this pool */
X    if (lastp != NIL) {
X        lastp->m_next = p;
X    } else {
X        pl->pl_pool = p;
X    }
X    p->m_nleft = p->m_size = psize;
X    p->m_free = p->m_base = getbuf(&p->m_nleft);
X    p->m_next = NIL;
X
X    r = p->m_free;
X    p->m_nleft -= size;
X    p->m_free += size;
X    ZEROMEM(r,size,align);
X    return(r);
X}
X
X#ifdef notdef
X/* should improve this */
X
Xbzero(p,s,a)
Xregister char *p;
Xregister int s;
Xregister int a;
X{
X    while(s--) {
X        *p++ = 0;
X    }
X}
X#endif
X
X#ifdef STATS
X#include <stdio.h>
X
Xmemstats() {
X    fprintf(stderr,"%d hunks (max %d) in %d pools (max %d), (%d hdrs), largest is %d\n",
X        nhunks,maxhunks,npools,maxpools,nphdr,maxsize);
X    fprintf(stderr,"%d loops in getmem (avg), %d min, %d max\n",
X            nloops/nrequest, minloops, maxloops);
X    fprintf(stderr, "pools between 0x%x and 0x%x, heap max %d.%d Kb\n",
X        lowwater, hiwater, (hiwater-lowwater)/1024, (hiwater-lowwater)%1024);
X    fprintf(stderr, "%d requests, %d mallocs, %d frees\n", nrequest,nmalloc,nfree);
X    fprintf(stderr, "%d total bytes, average request %d.%d\n", totsize,
X        totsize/nrequest, totsize%nrequest);
X}
X#endif
X
X#ifdef TEST
X/*
X * testing code
X */
X
X#include <stdio.h>
X
X#define skipws(p)    while((*p == ' ') || (*p == '\t')) p++
X#define skiptows(p)    while((*p != ' ') && (*p != '\t') && (*p != '\0')) p++
X
Xmain() {
X    register int i,n,x;
X    char buf[20];
X    char c;
X    register char *p,*q;
X
X    printf("memory allocator test routine\n");
X    while(printf("> "),gets(buf) != NIL) {
X        p = buf;
X        skipws(p);
X        c = *p++;
X        skipws(p);
X        switch(c) {
X        case 'd':
X            dump();
X            break;
X        case 's':
X#ifdef STATS
X            memstats();
X#else
X            printf("no statistics available\n");
X#endif
X            break;
X        case 'g':    /* get mem (nbytes) (align) (poolnum) */
X            n = atoi(p);
X            skiptows(p); skipws(p);
X            i = atoi(p);
X            skiptows(p); skipws(p);
X            x = atoi(p);
X            q = getmem(x, i, n);
X            printf("got %d bytes @ 0x%x %sfrom pool %d\n", n, q,
X                 i ? "(aligned) ": "", x);
X            break;
X        case 'o':    /* open a new pool */
X            n = openpool();
X            printf("pool %d opened\n", n);
X            break;
X        case 'c':    /* close pool */
X            printf("closing pool %d\n", n = atoi(p));
X            x = closepool(n);
X            if (!x) {
X                printf("error closing pool %d\n", x);
X            }
X            break;
X        case 'q':
X            printf("exiting ...\n");
X            return;
X        default:
X            printf("unrecognized command '%c'\n", c);
X            break;
X
X        }
X    }
X}
X
Xdump() {
X    register struct poolhead *pl;
X    register struct memhunk *p;
X    register int i,j;
X
X    for (i=0, pl = &head; pl != NIL; i++,pl = pl->pl_next) {
X        printf("\tpool %d (@ 0x%x):\n", i, pl);
X        for(j=0, p = pl->pl_pool; p != NIL; j++,p = p->m_next) {
X            printf("\t\tmemhunk %d (@ 0x%x)", j, p);
X            printf("buf %d bytes @ 0x%x (%d left @ 0x%x)\n",
X                p->m_size, p->m_base, p->m_nleft, p->m_free);
X        }
X    }
X}
X
Xstatic
Xatoi(p)
Xregister char *p;
X{
X    register int n = 0;
X
X    while ((*p >= '0') && (*p <= '9')) {
X        n = (n*10) + (*p - '0');
X        p++;
X    }
X    return(n);
X}
X
X#endif /* TEST */
\Rogue\Monster\
else
  echo "will not over write ./mem.c"
fi
chmod 444 ./mem.c
if [ `wc -c ./mem.c | awk '{printf $1}'` -ne 8948 ]
then
echo `wc -c ./mem.c | awk '{print "Got " $1 ", Expected " 8948}'`
fi
echo "Finished archive 2 of 3"
# if you want to concatenate archives, remove anything after this line
exit