#include "CCG"›/*>>>>> start of cc3 <<<<<<<<<*/››/* Perform a function call› * called from hie11, this routine› * will either call› * the named function, or if the› * supplied ptr is› * zero, will call the contents of HL› */››callfunction(ptr)›char *ptr;/* symbol table entry (or 0) */›$(int nargs;›nargs=0;›blanks();/* already saw open paren */›if(ptr==0)push();/* calling HL */›while(streq(line+lptr,")")==0)›$(if(endst())break;›fexpress();/* get an argument */›if(ptr==0)swapstk(); /* don't push addr */›push();/* push argument */›nargs=nargs+2;/* count args*2 */›if (match(",")==0) break;›$)›needbrack(")");›if(ptr)call(ptr,nargs);›else callstk(nargs);›$)››junk()›$(if(an(inbyte()))›while(an(ch()))gch();›else while(an(ch())==0)›$(if(ch()==0)break;›gch();›$)›blanks();›$)›endst()›$(blanks();›return ((streq(line+lptr,";")|(ch()==0)));›$)›illname()›$(error("illegal symbol name");junk();$)›multidef(sname)›char *sname;›$(error("already defined");›pl(sname);putchar(eol);›$)›needbrack(str)›char *str;›$(if (match(str)==0)›$(error("missing bracket");›pl(str);putchar(eol);›$)›$)›needlval()›$(error("must be lvalue");›$)›findglb(sname)›char *sname;›$(char *ptr;›ptr=startglb;›while(ptr!=glbptr)›$(if(astreq(sname,ptr,namemax))return ptr;›ptr=ptr+symsiz;›$)›return 0;›$)›findloc(sname)›char *sname;›$(char *ptr;›ptr=startloc;›while(ptr!=locptr)›$(if(astreq(sname,ptr,namemax))return ptr;›ptr=ptr+symsiz;›$)›return 0;›$)›addglb(sname,id,typ,value,sclass)›char *sname,id,typ;›int value,sclass;›$(char *ptr;›if(cptr=findglb(sname))return cptr;›if(glbptr>=endglb)›$(error("global symbol table overflow");›return 0;›$)›cptr=ptr=glbptr;›while(an(*ptr++ = *sname++));/* copy name */›cptr[ident]=id;›cptr[type]=typ;›cptr[storage]=sclass;›cptr[offset]=value;›cptr[offset+1]=value>>8;›glbptr=glbptr+symsiz;›return cptr;›$)›addloc(sname,id,typ,value)›char *sname,id,typ;›int value;›$(char *ptr;›if(cptr=findloc(sname))return cptr;›if(locptr>=endloc)›$(error("local symbol table overflow");›return 0;›$)›cptr=ptr=locptr;›while(an(*ptr++ = *sname++));/* copy name */›cptr[ident]=id;›cptr[type]=typ;›cptr[storage]=stkloc;›cptr[offset]=value;›cptr[offset+1]=value>>8;›locptr=locptr+symsiz;›return cptr;›$)›/* Test if next input string is legal symbol name */›symname(sname)›char *sname;›$(int k;›blanks();›if(alpha(ch())==0)return 0;›k=0;›while(an(ch()))sname[k++]=gch();›sname[k]=0;›return 1;›$)›/* Return next avail internal label number */›getlabel()›$(return(++nxtlab);›$)››/* Test if given character is alpha */›alpha(c)›char c;›$(›return(((c>='a')&(c<='z'))|›((c>='A')&(c<='Z'))|›(c=='_'));›$)›/* Test if given character is numeric */›numeric(c)›char c;›$(›return((c>='0')&(c<='9'));›$)›/* Test if given character is alphanumeric */›an(c)›char c;›$(return((alpha(c))|(numeric(c)));›$)›/* Print a carriage return and a string only to console */›pl(str)›char *str;›$(int k;›k=0;›putchar(eol);›while(str[k])putchar(str[k++]);›$)›addwhile(ptr)›int ptr[];› $(›int k;›if (wqptr==wqmax)›$(error("too many active whiles");return;$)›k=0;›while (k<wqsiz)›$(*wqptr++ = ptr[k++];$)›$)›delwhile()›$(if(readwhile()) wqptr=wqptr-wqsiz;›$)›readwhile()› $(›if (wqptr==wq)$(error("no active whiles");return 0;$)›else return (wqptr-wqsiz);› $)››ch()›$(return(line[lptr]);›$)›nch()›$(if(ch()==0)return 0;›else return(line[lptr+1]);›$)›gch()›$(if(ch()==0)return 0;›else return(line[lptr++]);›$)›kill()›$(lptr=0;›line[lptr]=0;›$)›inbyte()›$(›while(ch()==0)›$(›if (eof) return 0;›inline();›preprocess();›$)›return gch();›$)›inchar()›$(›if(ch()==0)inline();›if(eof)return 0;›return(gch());›$)›inline()› $(›int k,unit;›while(1)$(if(inp==0)eof=1; /* dat's all */›if(eof)return;›if((unit=inp2)==0)unit=inp;›kill();›while((k=cgetc(unit))>0)›$(if((k==eol)|(lptr>=linemax))break;›line[lptr++]=k;›$)›line[lptr]=0;/* append null */›if(k<=0)›$(cclose(unit);›if(inp2)inp2=0;›else inp=0;›$)›if(lptr)›$(›lptr=0;›return;›$)›$)›$)›