rs@uunet.UU.NET (Rich Salz) (09/16/87)
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