#include "CCG"›/* start of cc2 */››/*Get required array size› *› * invoked when declared variable is› * followed by "["› * this routine makes subscript the› * absolute› * size of the array.› */››needsub()›$(›int num[1];›if(match("]"))return 0;/* null size */›if (number(num)==0)/* go after a number */›$(error("must be constant");/* it isn't */›num[0]=1;/* so force one */›$)›if (num[0]<0)›$(error("negative size illegal");›num[0]=(-num[0]);›$)›needbrack("]");/* force single dimension */›return num[0];/* and return size */›$)››/* Begin a function› *› * Called from "parse" this routine› * tries to make a function› * out of what follows.› */››newfunc()$(›char n[namesize],*ptr;›int argtop,adr[1]; /* for usr(x) */›if (symname(n)==0)›$(error("illegal function or declaration");›kill();/* invalidate line */›return;›$)›if(ptr=findglb(n))/* already in symbol table ? */›$(if(ptr[ident]!=function)multidef(n);›/* already variable by that name */›else if(ptr[offset]==function)multidef(n);›/* already function by that name */›else ptr[offset]=function;›/* otherwise we have what was earlier*/›/*  assumed to be a function */›$)›/* if not in table, define as a function now */›else$(›addglb(n,function,cint,›function,global);›ptr=findglb(n);  /* get offset */›$)››/* report we're hacking a function */››putchar(28);›putchar(eol);›putchar(156);›ps(n);››/* we had better see open paren for args... */››if(match("(")==0)›error("missing open paren");›outldf(ptr); /* print fun name */›locptr=startloc;/* pl woods */›argstk=0;/* init arg count */›while(match(")")==0)$(/* then count args */›/* any legal name bumps arg count */›if(symname(n))$(›if(findloc(n))multidef(n);›else$(›addloc(n,0,0,argstk); /* remember name, rank */›argstk=argstk+2;›$)›$)›else$(error("illegal argument name");junk();$)›blanks();›/* if not closing paren, should be comma */›if(streq(line+lptr,")")==0)›$(if(match(",")==0)›error("expected comma");›$)›if(endst())break;›$)›argtop= (-argstk); /* remember arguement offset base */›oursp=0;/* preset stack ptr */›while(argstk)›/* now let user declare what types of things */›/*those arguments were */›$(if(amatch("char",4))$(getarg(cchar,argtop);ns();$)›else if(amatch("int",3))$(getarg(cint,argtop);ns();$)›else$(error("wrong number args");break;$)›$)›if(amatch("asm",3))$( /* usr(x) function */›if(number(adr)==0)$(›error("Needed address");›adr[0]=0;›$)›/* output a usr(x) byte-code */›usr(adr[0]);›ns();›$)››else if(statement()!=streturn) /* do a statement, but if */›/* it's a return, skip */›/* cleaning up the stack */›$(modstk(0);›ret();›$)›oursp=0;/* reset stack ptr again */›locptr=startloc;/* deallocate all locals */›$)›/*› *Declare argument types› *› * called from "newfunc" this routine› * adds an entry in the› * local symbol table for each named› * argument› * re-written as per pg. 32 of› * Feb. '81 Dr. Dobb's Journal› */››getarg(t,argtop)/* t = cchar or cint */›int t,argtop;›$(›int j,legalname,address;›char n[namesize],*argptr;››while(1)›$(if(argstk==0)return;/* no more args */›if(match("*"))j=pointer;›else j=variable;›if((legalname=symname(n)) == 0)illname();›if(match("["))/* pointer ? */›/* it is a pointer, so skip all */›/* stuff between "[]" */›$(while(inbyte()!=']')›if(endst())break;›j=pointer;››$)››if(legalname)$(›if(argptr=findloc(n))$( /* add in details */›argptr[ident]=j;›argptr[type]=t;›address=argtop+((argptr[offset]&255)+›((argptr[offset+1]&255)<<8));›argptr[offset]=address&255;›argptr[offset+1]=((address>>8)&255);›$)›else error("Expecting arguement name");›$)›argstk=argstk-2;/* cnt down */›if(endst())return;›if(match(",")==0)›error("expected comma");›$)›$)›/*› * Statement parser› * called whenever syntax requires› * a statement.› * this routine performs that› * statement› * and returns a number telling› * which one› */›statement()› $(›abtchk();›if ((ch()==0) & (eof)) return;›else if(amatch("char",4))$(›declloc(cchar);›ns();›$)›else if(amatch("int",3))$(›declloc(cint);›ns();›$)›else if(match("$("))compound();›else if(amatch("if",2))$(›doif();›lastst=stif;›$)›else if(amatch("while",5))$(›dowhile('w');›lastst=stwhile;›$)›else if(amatch("do",2))$(›dowhile('d');›lastst=stwhile;›$)›else if(amatch("switch",6))$(›doswitch();›lastst=stswitch;›$)›else if(amatch("return",6))$(›doreturn();›ns();›lastst=streturn;›$)›else if(amatch("break",5))$(›dobreak();›ns();›lastst=stbreak;›$)›else if(amatch("continue",8))$(›docont();›ns();›lastst=stcont;›$)›else if(amatch("for",3))$(›dofor();›lastst=stfor;›$)›else if(match(";"));›else$(›expression();›ns();›lastst=stexp;›$)›return lastst;›$)››/* Semicolon enforcer› * called whenever syntax requires› * a semicolon› */›ns()$(if(match(";")==0)error("missing semicolon");$)››/*Compound statement› * allow any number of statements to› * fall between "$($)"› */››compound()›$(›++ncmp;/* new level open */›while (match("$)")==0) ›    if (eof)›$(›error("missing final end");›break;›$)›    else statement(); /* do one */›--ncmp;/* close current level */›$)››/*"if" statement› */››doif()›$(›int flev,fsp,flab1,flab2;›/* save current local level, sp */›flev=locptr;›fsp=oursp;›/* get label for false branch */›flab1=getlabel();›/* get expression & branch false */›test(flab1);›/* if true, do a statement */›statement();›/* then clean up the stack */›oursp=modstk(fsp);›/* and deallocate any locals */›locptr=flev;›if (amatch("else",4)==0)/* if...else ? */›/* simple "if"...print false label */›$(outcdf(flab1);›return;/* and exit */›$)›/* an "if...else" statement. */›jump(flab2=getlabel());/* jump around false code */›outcdf(flab1);›statement();/* and do "else" clause */›oursp=modstk(fsp);/* then clean up stk ptr */›locptr=flev;/* and deallocate locals */›outcdf(flab2);/* print true label */›$)››/*"while" statement› */››dowhile(wtype)›char wtype;›$(›int lwq[wqsiz];›/* record local level */›lwq[wqsym]=locptr;›/* and stk ptr */›lwq[wqsp]=oursp;›/* and looping label */›lwq[wqloop]=getlabel();›/* and exit label */›lwq[wqlab]=getlabel();›/* and no inc label */›lwq[wqinc]=0;›/* add entry to queue */›/* (for "break" statement) */›addwhile(lwq);›/* loop label */›outcdf(lwq[wqloop]);›if(wtype=='w')$(›/* while ...› * see if true; if so, do› * statement.› */›test(lwq[wqlab]);›statement();›$)›else$(›/* do ... while› * do statement first, then test.› */›statement();›if(amatch("while",5)==0)›error("do with no while");›test(lwq[wqlab]);›ns();›$)›jump(lwq[wqloop]);›/* exit label */›outcdf(lwq[wqlab]);›/* deallocate locals */›locptr=lwq[wqsym];›/* clean up stk ptr */›oursp=modstk(lwq[wqsp]);›/* delete queue entry */›delwhile();›$)››/*"return" statement› */››doreturn()›$(›/* if not end of statement, get an expression */›if(endst()==0)expression();›modstk(0);/* clean up stk */›ret();/* and exit function */›$)››/*"break" statement› */››dobreak()›$(›int *ptr;›/* see if any "whiles" are open */›if ((ptr=readwhile())==0)›return;/* no */›/* else clean up stk ptr› * jump to exit label› */›modstk((ptr[wqsp]));›jump(ptr[wqlab]);›$)››/*"continue" statement› */››docont()›$(›int *ptr;›/* see if any "whiles" are open */›if (wq==wqptr)$(›error("No active whiles");›return;/* no */›$)›ptr=wqptr-wqsiz;/* point to tos */›/* find non-switch */›while(ptr >= wq)$(›if(ptr[wqloop])break;›ptr = ptr - wqsiz;›$)›if(ptr < wq)$(›error("No active whiles");›return;›$)›/* else clean up stk ptr› * & jump to loop lable› */›modstk((ptr[wqsp]));›if(ptr[wqinc])jump(ptr[wqinc]);›else jump(ptr[wqloop]);›$)››/* end of cc2 */›