Mercurial > hg > CbC > old > device
view mc-parse.c @ 128:d497c39add36 args-works
arg.c works (?)
author | kono |
---|---|
date | Thu, 03 Apr 2003 03:04:16 +0900 |
parents | eb4d8975926c |
children | 07eb1249f07a |
line wrap: on
line source
/* Micro-C Parser Part */ /* $Id$ */ #define EXTERN /**/ #include "mc.h" #include "mc-codegen.h" static NMTBL *decl0(void),*decl1(void),*lsearch(char *name),*gsearch(void); static NMTBL *def(NMTBL *n); static NMTBL *free_nptr(); static NMTBL *msearch(char *name); static NMTBL *msearch0(char *name); static char * mappend(int lists); static int alpha(char c); static int append3(int p,int a1,int a2); static int binop(int op, int e1, int e2, int t1, int t2); static int cexpr(int e); static int decl_data(int t, NMTBL *n,int offset); static int digit(char c); static int expr(int); static int expr0(void); static int expr1(void); static int expr10(void); static int expr11(void); static int expr12(void); static int expr13(void); static int expr14(void); static int expr15(int e1); static int expr16(int e1); static int expr2(void); static int expr3(void); static int expr4(void); static int expr5(void); static int expr6(void); static int expr7(void); static int expr8(void); static int expr9(void); static int getch(void); static int getfree(int n); static int getsym(void); static int indop(int e); static int macro_args(char **pcheapp,char* max,char **pchptr); static int macro_eval(int macrop,char *body,int history); static int macro_function(int macrop,char **pchptr,NMTBL *nptr,int history); static int macroeq(char *s); static int ndecl0(void); static int ndecl1(void); static int neqname(char *p,char *name); static int postequ(int s1, int s2); static int rvalue(int e); static int sdecl(int s); static int skipspc(void); static int strop(int e); static int typeid(int s); static int typename(void); static int typespec(void); static int adecl(NMTBL *n); static void code_decl(NMTBL *n); static void compatible(int t1, int t2); static void copy(NMTBL *nptr, char *s); static void decl(void); static void docase(void); static void docomp(void); static void dodefault(void); static void dodo(void); static void dofor(void); static void dogoto(void); static void doif(void); static void dolabel(void); static void doreturn(void); static void doswitch(void); static void dowhile(void); static void errmsg(void); static void fcheck(NMTBL *n); static void fdecl(NMTBL *n); static void fdecl_struct(int type); static void getline(void); static void getstring(void); static void init(void); static void lcheck(int e); static void local_define(); static void local_undef(); static void macro_define(); static void macro_define0(); static void macro_processing(); static void newfile(void); static void replace_return_struct(int func,int left); static void reserve(char *s, int d); static void reverse(int t1); static void set_converter(char *s); static void statement(void); static int correct_type(int e,int t); static int struct_return = 0; static int sdecl_f = 1; static int stypedecl; static Converter *conv = &null_converter; /* Converter *conv = &c_converter; */ static char *ccout = 0; int main(int argc, char **argv) { NMTBL *nptr; int i; if(argc==1) exit(1); lsrc = chk = asmf = 0; ac=argc; av=argv; for (ac2=1; (ac2 < ac) && (*av[ac2] == '-'); ++ac2) { switch (*(av[ac2]+1)) { case 's': lsrc = 1; break; case 'o': ccout = av[ac2]+2; break; case 'c': chk = 1; break; case 'd': debug = 1; break; case 'C': if (av[ac2+1]) set_converter(av[ac2]+2); chk = 1; ccout=0; break; default: error(OPTION); exit(1); } } if (!chk && ccout) if ( (freopen(ccout,"w",stdout)) == NULL ) error(FILERR); init(); while(1) { for (nptr = &ntable[GSYMS],i=LSYMS; i--;) { (nptr++)->sc = 0; } emit_init(); init_free_lvar_list(); mode=TOP; lfree= HEAPSIZE; chptrsave = chsave = 0; while(getsym()==SM) conv->sm_(); mode=GDECL; stmode=0; args=0; decl(); } /*NOTREACHED*/ } void error(int n) { if(n == EOFERR) { if(filep!=filestack) { fclose(filep->fcb); lineno=filep->ln; --filep; return; } else if(ac2!=ac) { fclose(filep->fcb); newfile(); return; } else if(mode == TOP) { if (chk) { fprintf(stderr, "Total internal labels : %u.\n",labelno-1); fprintf(stderr, "Total global variables: %u bytes.\n",gpc); } closing(); exit(0); } } if (conv->error_(n)) return; fprintf(stderr,"%s:%d:%s\n",filep->name0,lineno, (n==FILERR) ? "Can't open specified file" : (n==DCERR) ? "Declaration syntax" : (n==STERR) ? "Statement syntax" : (n==EXERR) ? "Expression syntax" : (n==CNERR) ? "Constant required" : (n==CHERR) ? "Illegal character" : (n==GSERR) ? "Too many global symbols" : (n==LSERR) ? "Too many local symbols" : (n==MSERR) ? "Too many macro symbols" : (n==STRERR) ? "Too many strings or macros" : (n==LNERR) ? "Line too long" : (n==EOFERR) ? "Unexpected end of file" : (n==MCERR) ? "Macro syntax" : (n==INCERR) ? "Include syntax" : (n==HPERR) ? "Too long expression" : (n==TYERR) ? "Type mismatch" : (n==LVERR) ? "Lvalue required" : (n==UDERR) ? "Undeclared identifier" : (n==OPTION) ? "Illegal option" : (n==REG_ERR) ? "illegal register var" : (n==CODE_ERR) ? "goto code is necessary" : "Bug of compiler"); errmsg(); exit(1); } static void errmsg(void) { char *p,*lim; if(lineno==0) return; fprintf(stderr,"%s",linebuf); lim=chptr; while (chptrsave) { lim = (char*)car(chptrsave); chptrsave = cadr(chptrsave); } for (p=linebuf; p < lim;) fprintf(stderr,(*p++ == '\t') ? "\t" : " "); fprintf (stderr,"^\n"); } static void checksym(int s) { char *p; if (sym != s) { p=(s==RPAR) ? "')'": (s==RBRA) ? "']'": (s==SM) ? "';'": (s==LPAR) ? "'('": (s==WHILE) ? "'while'": (s==COLON) ? "':'": "Identifier"; fprintf(stderr,"%d:%s expected.\n",lineno,p); errmsg(); } else getsym(); } static void init(void) { NMTBL *nptr; int i; cheapp=cheap; for(nptr = ntable,i = GSYMS; i--;) (nptr++)->sc = 0; for(nptr = mtable,i = MSYMS; i--;) (nptr++)->sc = 0; reserve("int",INT); reserve("void",VOID); reserve("char",CHAR); reserve("const",KONST); reserve("struct",STRUCT); reserve("union",UNION); reserve("unsigned",UNSIGNED); reserve("static",STATIC); reserve("goto",GOTO); reserve("return",RETURN); reserve("break",BREAK); reserve("continue",CONTINUE); reserve("if",IF); reserve("else",ELSE); reserve("for",FOR); reserve("do",DO); reserve("while",WHILE); reserve("switch",SWITCH); reserve("case",CASE); reserve("default",DEFAULT); reserve("typedef",TYPEDEF); reserve("sizeof",SIZEOF); reserve("long",LONG); reserve("short",SHORT); reserve("extern",EXTRN); reserve("defined",DEFINED); reserve("register",REGISTER); reserve("code",CODE); reserve("environment",ENVIRONMENT); reserve("float",FLOAT); reserve("double",DOUBLE); gpc=glineno=0; gfree=ilabel=1; labelno=2; lfree=HEAPSIZE; filep=filestack; codegen_init(); newfile(); macro_define("__micro_c__ 1\n"); #ifdef __APPLE__ macro_define("__APPLE__ 1\n"); #endif #ifdef bsd macro_define("bsd 1\n"); #endif getline(); getch(); } static void newfile(void) { char *s; lineno=0; if (chk) fprintf(stderr,"%s:\n",av[ac2]); if ( (filep->fcb = fopen(av[ac2++],"r")) == NULL ) error(FILERR); s = av[ac2-1]; filep->name0 = cheapp; while((*cheapp++ = *s++)); if(!ccout) { ccout=s=cheapp; s= filep->name0; while((*cheapp++ = *s++)) { if(s[0]=='.'&&s[1]=='c') { *cheapp++=*s++; *cheapp++=*s++; cheapp[-1]='s'; } } if ( (freopen(ccout,"w",stdout)) == NULL ) error(FILERR); cheapp=ccout; ccout=0; } opening(filep->name0); conv->open_(filep->name0); } static void set_converter(char *s) { chptr = s; #if 0 if (macroeq("c2cbc")) conv=&c2cbc_converter; else if (macroeq("cbc2c")) conv=&cbc2c_converter; else if (macroeq("c")) conv=&c_converter; #else if (macroeq("c")) conv=&c_converter; else conv=&null_converter; #endif } static void reserve(char *s, int d) { NMTBL *nptr; int i; hash=0; name=namebuf; i=0; while((name[i++] = *s)) { hash=(((7*hash)&0xfffffff) ^ *s++); } if (cheapp+i >= cheap+CHEAPSIZE) error(STRERR); name[i++] = 0; (nptr = gsearch())->sc = RESERVE; if (d==0) { nptr->sc = MACRO; nptr->dsp = (int)""; nptr->ty=0; } else { nptr->dsp = d; } } static void decl(void) { NMTBL *n; int t,sd; if (mode==GDECL) { typedefed=0; } if(sym==STATIC) { if(mode==LDECL) { getsym(); conv->static_(); mode=STADECL; stmode=LDECL; } else if(mode==GDECL) { getsym(); conv->static_(); stmode=STATIC; } else error(DCERR); } else if(sym==REGISTER) { if(mode!=LDECL) error(DCERR); stmode=REGISTER; getsym(); conv->register_(); } else if(sym==EXTRN) { getsym(); conv->extern_(); stmode=EXTRN; } else if(sym==TYPEDEF) { if(mode==GDECL) { getsym(); conv->typedef_(); mode=GTDECL; } else if(mode==LDECL) { getsym(); conv->typedef_(); mode=LTDECL; } else error(DCERR); } if((t=typespec())==0) return; if(sym==SM) { conv->return_type_(t,0,stypedecl); conv->sm_(); return; } type=t;sd=stypedecl; n=decl0(); reverse(t); if (n == &null_nptr) { error(DCERR); return; } if(sym==LC || ( sym!=SM && sym!=COMMA && sym!=ASS )) { stypedecl=sd; if (car(type)==CODE) { code_decl(n); return; } else if (car(type)==FUNCTION) { fdecl(n); return; } else error(TYERR); } conv->return_type_(type,n,sd); def(n); while(sym==COMMA) { conv->comma_(); getsym(); type=t; n=decl0(); reverse(t); if(n == &null_nptr) error(DCERR); /* if(args) error(DCERR); */ conv->return_type_(type,n,1); def(n); } if(sym!=SM) error(DCERR); conv->sm_(); if(mode==GTDECL) mode=GDECL; if(mode==STADECL||mode==LTDECL) mode=LDECL; } static int typespec(void) { int t = INT; stypedecl = 0; while (sym==KONST) { getsym(); } switch(sym) { case VOID: case INT: case CHAR: case CODE: case FLOAT: case DOUBLE: t= sym; getsym(); break; case STRUCT: case UNION: t=sdecl(sym); break; case UNSIGNED: t = UNSIGNED; if(getsym()==INT) getsym(); break; case SHORT: t=INT; if(getsym()==INT) getsym(); break; case LONG: t=INT; getsym(); if(sym==LONG) { getsym(); t=LONGLONG; } if(sym==INT) getsym(); break; default: if(sym==IDENT) { if(nptr->sc==TYPE) { t=nptr->ty; typedefed=glist2((int)nptr,typedefed); getsym(); break; } else if(nptr->sc==EMPTY && gnptr->sc==TYPE) { getsym(); break; } } while (sym==KONST) { getsym(); } if(mode==LDECL) return 0; t= INT; } while (sym==KONST) { getsym(); } return t; } static struct nametable * decl0(void) { NMTBL *n; if(sym==MUL) { getsym(); n=decl0(); type=list2(POINTER,type); return n; } return decl1(); } static NMTBL * decl1(void) { NMTBL *n; int i,t,sstmode; if(sym==LPAR) { getsym(); n=decl0(); checksym(RPAR); } else if (sym == IDENT) { n=nptr; getsym(); } else { /* error(DCERR); */ n= &null_nptr; } while(1) { if(sym==LBRA) { if(getsym()==RBRA) { getsym(); if(mode==ADECL) { type=list2(POINTER,type); } else if (mode==GDECL) { type=list3(ARRAY,type,0); } else { error(DCERR); } } else { t=type; i=cexpr(expr(1)); checksym(RBRA); type=list3(ARRAY,t,i); } } else if(sym==LPAR) { if(mode==GDECL) { mode=ADECL;getsym();mode=GDECL; /* ??? */ } else getsym(); n->dsp=0; if(stmode==EXTRN) n->sc=EXTRN; if(stmode==STATIC) n->sc=STATIC; else n->sc=EXTRN; /* this is odd... */ if (type==CODE) { n->ty=CODE; if(sym==RPAR) { getsym();t=0; } else { sstmode=stmode; stmode=REGISTER; t=adecl(n); stmode=sstmode; } type=glist3(CODE,CODE,t); } else { if(sym==RPAR) { getsym();t=0; } else { sstmode=stmode; stmode=REGISTER; t=adecl(n); stmode=sstmode; } type=glist3(FUNCTION,type,t); } n->ty=type; /* in GDECL mode dsp contains real parameter, if not, it contains arg type list. Real parameter list is compatible with arg type list. See def/ADECL */ if (mode!=GDECL) n->dsp=t; } else return n; } /* NOT REACHED */ } static int adecl(NMTBL *n) { NMTBL *arg,*sfnptr; int sreg_var,t; int stype,smode,sd,sargs; int argtypes; stype=type; sfnptr=fnptr; fnptr=n; sd = sdecl_f; sdecl_f = 0; sreg_var=reg_var; reg_var=0; argtypes = 0; smode = mode; mode=ADECL; args = 0; n->dsp=0; for(;;) { if(sym==IDENT && nptr->sc!=TYPE) { type=INT; /* naked argument, old K&R C */ def(nptr); getsym(); if(sym==RPAR) break; } else { if(sym==DOTS) { argtypes=list2(DOTS,argtypes); getsym(); break; } if((t=typespec())==0) { error(DCERR); break; } type=t; if(sym!=COMMA && sym!=RPAR) { sargs = args; arg=decl0(); args = sargs; reverse(t); if (arg != &null_nptr) { if (smode==GDECL) def(arg); } } argtypes=list2(type,argtypes); if(sym==RPAR) break; } if (sym!=COMMA) error(DCERR); getsym(); } argtypes=reverse0(argtypes); n->dsp=reverse0(n->dsp); checksym(RPAR); mode=smode; reg_var=sreg_var; fnptr=sfnptr; type=stype; sdecl_f = sd; return argtypes; } static void reverse(int t1) { int t2,t3; t2=t1; while(type!=t1) { t3=cadr(type); rplacad(type,t2); t2=type; type=t3; } type = t2; } int reverse0(int t1) { int t2,t3; t2=0; while(t1) { t3=cadr(t1); rplacad(t1,t2); t2=t1; t1=t3; } return t2; } int size(int t) { if(t==CHAR) return 1; if(t==VOID) return 0; if(t==REGISTER) return size_of_int; /* could be float? */ if(scalar(t)) return size_of_int; if(t==FLOAT) return size_of_float; if(t==DOUBLE) return size_of_double; if(t==LONGLONG) return size_of_longlong; if(car(t)==STRUCT||car(t)==UNION) { if(cadr(t)==-1) error(DCERR); return(cadr(t)); } if(car(t)==ARRAY) return(size(cadr(t))*caddr(t)); else if(car(t)==CODE) return size_of_int; else if(car(t)==FUNCTION) return size_of_int; else error(DCERR); return 0; } int new_lvar0(int sz) { return disp -= sz; } static int lvar_list,lvar_free_list; int new_lvar(int size) { int lvar,plvar; for (plvar = 0,lvar = lvar_free_list;lvar;lvar = cadr(lvar)) { if (caddr(lvar)==size) { if (plvar) cadr(plvar) = cadr(lvar); else lvar_free_list = cadr(lvar); break; } plvar = lvar; } if (!lvar) { lvar_list = glist3((lvar=new_lvar0(size)),lvar_list,size); } else { cadr(lvar) = lvar_list; lvar_list = lvar; lvar = car(lvar_list); } return lvar; } void free_lvar(int disp) { int lvar,plvar; for (plvar = 0,lvar = lvar_list;lvar;lvar = cadr(lvar)) { if (car(lvar)==disp) { if (plvar) cadr(plvar) = cadr(lvar); else lvar_list = cadr(lvar); break; } plvar = lvar; } if (!lvar) error(-1); cadr(lvar) = lvar_free_list; lvar_free_list = lvar; } void init_free_lvar_list() { int lvar; while((lvar=lvar_list)) { lvar_list=cadr(lvar_list); free_glist3(lvar); } while((lvar=lvar_free_list)) { lvar_free_list=cadr(lvar_free_list); free_glist3(lvar); } } static NMTBL * def(NMTBL *n) { int sz,nsc,ndsp; conv->def_(n); if (n==0) { n=free_nptr(); n->nm = "_"; } nsc=ndsp=0; if(type>0&&(car(type)==FUNCTION || car(type)==CODE)) { if (/* stmode==EXTRN ||*/ (mode==GDECL)) { fcheck(n); return n; } } if (n->sc!=EMPTY && !((n->sc&~1)==EXTRN)&& (mode!=ADECL || n->sc!=LVAR || n->ty!=INT) && (mode!=ADECL || n->sc!=REGISTER || n->ty!=INT) && ((mode!=GSDECL&&mode!=LSDECL) || n->sc!=FIELD || n->dsp!=disp) && ((mode!=GUDECL&&mode!=LUDECL) || n->sc!=FIELD || n->dsp!=0) ) error(DCERR); sz = size(n->ty = type); switch(mode) { case GDECL: gen_gdecl(n->nm,gpc); case STADECL: nsc = GVAR; ndsp = gpc; n->dsp = ndsp; /* emit_data will override this */ if (stmode==EXTRN) nsc = EXTRN; else if (stmode==STATIC) nsc = STATIC; n->sc = nsc; if (stmode==LDECL) { copy(n,n->nm); cheapp[-1] = '.'; ndsp = ++stat_no; while(ndsp>0) { *cheapp++ = ndsp%10+'0'; ndsp /= 10; } *cheapp++ = 0; } if(sym==ASS) { conv->op_(sym); decl_data(type,n,0); emit_data_closing(n); /* gpc is incremented by emit_data */ } else gpc +=sz; return n; case GSDECL: nsc = FIELD; ndsp = disp; disp += sz; break; case GUDECL: nsc = FIELD; ndsp = 0; if (disp < sz) disp = sz; break; case GTDECL: nsc = TYPE; if (gnptr!=n) error(-1); gtypedefed=glist2((int)gnptr,gtypedefed); break; case ADECL: if(!integral(type)&&(car(type)==FUNCTION||car(type)==CODE)) { type=list2(POINTER,type); n->ty = type; } fnptr->dsp=list4(type,fnptr->dsp,(int)n,0); n->sc = LVAR; if(type==CHAR) { if (n->dsp==0) { n->dsp = args; if (endian) n->dsp += size_of_int-1; } args += size_of_int; } else { /* if (n->dsp==0) (argument list in ADECL is useless, type list can be found in type ) */ n->dsp = args; args += sz; } cadddr(fnptr->dsp)=sz; if(type==VOID) { } else { n->ty = type; } return n; case STAT: /* of course this is wrong */ case LDECL: if (stmode==REGISTER) { if(scalar(type)) { ndsp = get_register_var(n); } else if (type==FLOAT||type==DOUBLE) { ndsp = get_fregister_var(n); } else error(DCERR); nsc = car(ndsp); ndsp = cadr(ndsp); } else { nsc = LVAR; ndsp = new_lvar(sz); } n->sc = nsc; n->dsp = ndsp; if(sym==ASS) { conv->op_(sym); decl_data(type,n,0); } return n; case LSDECL: nsc = FIELD; ndsp = disp; disp += sz; break; case LUDECL: nsc = FIELD; ndsp = 0; if (disp < sz) disp = sz; break; case LTDECL: nsc = TYPE; break; default: error(DCERR); } n->sc = nsc; n->dsp = ndsp; if (stmode==EXTRN) n->sc = EXTRN; return n; } static void emit_init_vars(void) { if (!init_vars) return; init_vars = reverse0(init_vars); while(init_vars) { gexpr(car(init_vars),0); init_vars = cadr(init_vars); } } int assign_data(int e, int t, NMTBL *n,int offset) { int ass; if(mode==GDECL) { emit_data(e,t,n); return offset+size(t); } else if(mode==LDECL) { ass = assign_expr0(list2(LVAR,n->dsp+offset),e,t,type); init_vars = list2(ass,init_vars); return offset+size(t); } else { error(DCERR); } return 0; /* not reached */ } static int decl_data(int t, NMTBL *n,int offset) { int t1,e,i,mode_save; conv->decl_data_(); mode_save = mode; mode=STAT; getsym(); if (scalar(t)) { e=expr1(); mode = mode_save; if(car(e)!=CONST && t==CHAR) error(TYERR); offset = assign_data(e,t,n,offset); type=t; return offset; } if (t==FLOAT||t==DOUBLE) { e=expr1(); mode = mode_save; offset = assign_data(e,t,n,offset); type=t; return offset; } t1 = car(t); if (t1==ARRAY) { if (sym==LC) { conv->decl_data_begin_(); mode = mode_save; t1 = cadr(t); for(i=0;;i++) { if (sym!=RC) offset=decl_data(t1,n,offset); /* array of some thing */ if (sym==COMMA) { conv->comma_(); continue; } else if (sym==RC) { conv->decl_data_end_(); if (caddr(t)==0) { /* size not defined */ heap[t+2]=i+1; /* define array size */ } else if (caddr(t)!=i+1) { /* size match? */ error(TYERR); } getsym(); return offset; } else { error(TYERR); } } /* NOT REACHED */ } else if (cadr(t)==CHAR) { e=expr1(); mode = mode_save; if(car(e)!=STRING) error(TYERR); offset=assign_data(e,list3(ARRAY,CHAR,size(type)),n,offset); if (caddr(t)==0) { /* size not defined */ heap[t+2]=size(type); /* define array size */ } else if (caddr(t)!=size(type)) { /* size match? */ error(TYERR); } } else error(DCERR); } else if (t1==STRUCT) { if (sym==LC) { conv->lc_(); conv->decl_data_begin_(); mode = mode_save; if(cadr(t)==-1) error(DCERR); t1 = caddr(t); /* list of fields */ while(t1) { offset = decl_data(car(t1),n,offset); /* alignment? */ t1 = cadr(t1); if ( t1 && sym==COMMA) { conv->comma_(); continue; } if (!t1 && sym!=RC) error(DCERR); } conv->decl_data_end_(); conv->rc_(); getsym(); return offset; } else error(DCERR); } else { mode = mode_save; error(TYERR); /* should be initialization error */ } return offset; /* not reached */ } static int sdecl(int s) { int smode,sdisp,type0=0; NMTBL *nptr0,*gnptr0; int tags; smode=mode; if (mode==GDECL || mode==GSDECL || mode==GUDECL || mode==GTDECL) mode=(s==STRUCT?GSDECL:GUDECL); else mode=(s==STRUCT?LSDECL:LUDECL); sdisp=disp; disp=0; if (sdecl_f) conv->sdecl_(s); if (getsym() == IDENT) { nptr0 = nptr; gnptr0 = gnptr; if (sdecl_f) conv->id_(sym,nptr); if (getsym() == LC) { if (sdecl_f) conv->lc_(); if (nptr0->sc != EMPTY) error(DCERR); nptr0->sc = TAG; tags = 0; nptr0->ty = list4(s,-1,tags,(int)nptr0); while (getsym() != RC) { decl(); tags = list3(type,tags,(int)nptr); } if (sdecl_f) conv->rc_(); getsym(); tags=reverse0(tags); heap[nptr0->ty+2]=tags; rplacad(type0 = nptr0->ty,disp); } else { /* struct tag name */ if(nptr0->sc == EMPTY) nptr0=gnptr0; if(nptr0->sc == EMPTY) error(UDERR); if(nptr0->sc != TAG) error(TYERR); tags = caddr(nptr0->ty); disp = cadr(nptr0->ty); conv->comment_(' '); } type0 = list4(s,disp,tags,(int)nptr0); } else if(sym==LC) { if (sdecl_f) conv->lc_(); tags = 0; while(getsym() != RC) { decl(); tags = list3(type,tags,(int)nptr); } if (sdecl_f) conv->rc_(); getsym(); tags=reverse0(tags); type0 = list4(s,disp,tags,0); } else error(DCERR); stypedecl=1; disp=sdisp; mode=smode; return type0; } static void code_decl(NMTBL *n) { int t,arglist; if(!chk) code_enter(n->nm); fnptr=n; n->sc = CODE; disp = -args; mode=ADECL; if (sym!=LC) { reg_var=0; args=0; fnptr->dsp=0; while (sym!=LC) { /* argument declaration !ANSI */ decl(); getsym(); } fnptr->dsp=reverse0(fnptr->dsp); disp = -args; } /* reverse all argument offset (with size) */ arglist = fnptr->dsp; for(t=arglist;t;t=cadr(t)) { n=(NMTBL *)caddr(t); if(n->sc==LVAR) n->dsp = -n->dsp-cadddr(t); } arg_register(fnptr); conv->code_(fnptr); typedefed=0; /* local variable declaration */ stmode=0; mode=STAT; init_vars=0; while (typeid(getsym()) || sym==STATIC || sym==EXTRN || sym==TYPEDEF) { mode=LDECL; decl(); mode=STAT; } conv->localvar_end_(); control=1; if(!chk) code_enter1(args); emit_init_vars(); while(sym!=RC) statement(); if(control) error(STERR); control=0; conv->code_end_(); if(!chk) code_leave(n->nm); args = 0; } static NMTBL *tmp_struct; static void fdecl(NMTBL *n) { int sd = stypedecl; if(!chk) enter(n->nm); fnptr=n; retlabel=fwdlabel(); retcont = 0; tmp_struct = 0; reg_var=0; fcheck(n); n->sc = FUNCTION; mode=ADECL; if (sym!=LC) { args=0; fnptr->dsp=0; while (sym!=LC) { /* argument declaration !ANSI */ stmode=0; decl(); getsym(); } } else fnptr->dsp=reverse0(fnptr->dsp); fdecl_struct(fnptr->ty); disp=0; arg_register(fnptr); typedefed=0; conv->function_(fnptr,sd); conv->lc_(); init_vars=0; /* local variable declaration */ stmode=0; mode=STAT; while (typeid(getsym()) || sym==STATIC || sym==EXTRN || sym==REGISTER || sym==TYPEDEF) { mode=LDECL; stmode=0; decl(); mode=STAT; } conv->localvar_end_(); control=1; if(!chk) enter1(); emit_init_vars(); while(sym!=RC) statement(); conv->function_end_(); conv->rc_(); if(!chk) leave(control,n->nm); retpending = 0; control=0; arglist=0; } extern NMTBL str_ret; NMTBL str_ret; /* If function has structure return value, it has extra argument for where to write the structure. It have to be a first argument. We add it here and we have to fix all arguments' offset. If it is the last value, we don't have to fix, but gcc has a first argument convention. */ static void fdecl_struct(int fntype) { int type_save,mode_save,t,sz; NMTBL *n; t = cadr(fntype); if (t>0 && (car(t)==STRUCT||car(t)==UNION)) { mode_save = mode; mode=ADECL; type_save = type; /* extra argument for struct return */ /* this extra dummy arguments are set at calling sequence */ str_ret.nm = "str_ret"; str_ret.sc = EMPTY; str_ret.dsp = 0; str_ret.ty = 0; type=list2(POINTER,t); /* fix all arguments's offset */ sz = size(type); for(t=fnptr->dsp;t;t=cadr(t)) { n=(NMTBL *)caddr(t); n->dsp += sz; } fnptr->dsp = reverse0(fnptr->dsp); if ((sz=size(cadr(fntype)))==-1) error(TYERR); else { args = 0; def(&str_ret); struct_return = list3(list2(LVAR,str_ret.dsp),sz,type); } type = type_save; mode = mode_save; } else { struct_return = 0; fnptr->dsp = reverse0(fnptr->dsp); } } void fcheck(NMTBL *n) { if(!(mode==GDECL||mode==ADECL)|| (car(type)!=FUNCTION&&car(type)!=CODE)) error(DCERR); if(is_code(n)) compatible(cadr(n->ty),cadr(type)); else if(is_function(n)) compatible(cadr(n->ty),cadr(type)); else { if (n->sc==EMPTY) { n->sc=EXTRN; n->ty=type; } else error(DCERR); } } static void compatible(int t1, int t2) { if(integral(t1)) { if(t1!=t2) error(TYERR); } else if(car(t1)!=car(t2)) error(TYERR); else if((car(t1)==STRUCT || car(t1)==UNION) && cadr(t1)!=cadr(t2)) error(TYERR); else if(car(t1)==POINTER || car(t1)==ARRAY ||car(t1)==FUNCTION) compatible(cadr(t1),cadr(t2)); } int scalar(int t) { return(integral(t)||car(t)==POINTER); } int integral(int t) { return(t==INT||t==CHAR||t==UNSIGNED); } static void checkret(void) { if (retpending) { ret(); control=0; retpending=0; } } static void statement(void) { int slfree; if(sym==SM) { conv->sm_(); getsym(); return; } checkret(); switch(sym) { case IF: doif(); return; case WHILE: dowhile(); return; case DO: dodo(); return; case FOR: dofor(); return; case SWITCH: doswitch(); return; case LC: docomp(); return; case BREAK: conv->break_(); jmp(blabel); getsym(); checksym(SM); return; case CONTINUE: conv->continue_(); jmp(clabel); getsym(); checksym(SM); return; case CASE: docase(); statement(); return; case DEFAULT: dodefault(); statement(); return; case RETURN: doreturn(); return; case GOTO: dogoto(); return; default: if(sym==IDENT&&skipspc()==':') { dolabel(); statement(); } else { slfree=lfree; gexpr(expr(0),0); lfree=slfree; conv->sm_(); checksym(SM); } } } static void doif(void) { int l1,l2,slfree; getsym(); checksym(LPAR); conv->if_(); slfree=lfree; bexpr(expr(0),0,l1=fwdlabel()); lfree=slfree; conv->if_then_(); checksym(RPAR); statement(); checkret(); if(sym==ELSE) { conv->if_else_(); if ((l2 = control)) jmp(l2=fwdlabel()); fwddef(l1); getsym(); statement(); checkret(); if (l2) fwddef(l2); } else fwddef(l1); conv->if_endif_(); } static void dowhile(void) { int sbreak,scontinue,slfree,e; sbreak=blabel; scontinue=clabel; blabel=fwdlabel(); clabel=backdef(); conv->while_(); getsym(); checksym(LPAR); slfree=lfree; e=expr(0); checksym(RPAR); conv->while_body_(); if(sym==SM) { bexpr(e,1,clabel); lfree=slfree; conv->sm_(); getsym(); } else { bexpr(e,0,blabel); lfree=slfree; statement(); checkret(); if(control) jmp(clabel); } conv->while_end_(); fwddef(blabel); clabel=scontinue; blabel=sbreak; } static void dodo(void) { int sbreak,scontinue,l,slfree; sbreak=blabel; scontinue=clabel; blabel=fwdlabel(); clabel=fwdlabel(); l=backdef(); conv->dowhile_(); getsym(); statement(); checkret(); fwddef(clabel); checksym(WHILE); checksym(LPAR); slfree=lfree; conv->dowhile_cond_(); bexpr(expr(0),1,l); lfree=slfree; checksym(RPAR); conv->dowhile_end_(); checksym(SM); fwddef(blabel); clabel=scontinue; blabel=sbreak; } static void dofor(void) { int sbreak,scontinue,l,e,slfree; sbreak=blabel; scontinue=clabel; blabel=fwdlabel(); conv->for_(); getsym(); checksym(LPAR); slfree=lfree; if(sym!=SM) { gexpr(expr(0),0); checksym(SM); conv->for1_(); } else { conv->for1_(); getsym(); } lfree=slfree; l=backdef(); if(sym!=SM) { bexpr(expr(0),0,blabel); checksym(SM); conv->for2_(); } else { conv->for2_(); getsym(); } lfree=slfree; if(sym==RPAR) { clabel=l; conv->for_body_(); getsym(); statement(); checkret(); } else { clabel=fwdlabel(); e=expr(0); conv->for_body_(); checksym(RPAR); statement(); checkret(); fwddef(clabel); gexpr(e,0); lfree=slfree; } conv->for_end_(); jmp(l); fwddef(blabel); clabel=scontinue; blabel=sbreak; } static void doswitch(void) { int sbreak,scase,sdefault,slfree,svalue; sbreak=blabel; /* save parents break label */ blabel=fwdlabel(); sdefault=dlabel; /* save parents default label */ dlabel=0; scase=cslabel; /* save parents next case label */ conv->switch_(); getsym(); checksym(LPAR); slfree=lfree; svalue=csvalue1; /* save parents switch value */ gexpr(expr(0),1); csvalue1=csvalue() ; lfree=slfree; checksym(RPAR); conv->switch_body_(); cslabel = control = 0; /* should be case statement but... */ statement(); conv->switch_end_(); checkret(); if(dlabel) def_label(cslabel,dlabel); else fwddef(cslabel); csvalue1=svalue; cslabel=scase; dlabel=sdefault; fwddef(blabel); blabel=sbreak; } static void docomp(void) { conv->lc_(); getsym(); while(sym!=RC) { statement(); checkret();} conv->rc_(); getsym(); } static void docase(void) { int c,l,slfree; c=0; slfree=lfree; while(sym==CASE) { conv->case_begin_(c,0); getsym(); c=list2(cexpr(expr(1)),c); conv->case_(c,0); checksym(COLON); } l=fwdlabel(); if (control) { control=0; jmp(l); } if (cslabel) fwddef(cslabel); while(cadr(c)) { cmpdimm(car(c),csvalue1); jcond(l,0); c=cadr(c); } lfree=slfree; cmpdimm(car(c),csvalue1); jcond(cslabel=fwdlabel(),1); fwddef(l); } static void dodefault(void) { getsym(); checksym(COLON); if (dlabel) error(STERR); if (!cslabel) jmp(cslabel = fwdlabel()); dlabel = backdef(); conv->case_(0,1); } static void doreturn(void) { int slfree,e,e1; if(getsym()==SM) { conv->return_(); conv->return_end_(); getsym(); retpending = 1; return; } conv->return_(); slfree=lfree; if (struct_return) { e = expr(0); if ((car(type)==STRUCT || car(type)==UNION)&& size(type)==cadr(struct_return)) { if(car(e)==RSTRUCT && car(cadr(e))==FUNCTION) { /* pass the return pointer to the called function */ replace_return_struct(cadr(e), rvalue_t(car(struct_return),caddr(struct_return))); gexpr(cadr(e),0); } else { type = caddr(struct_return); e1 = rvalue_t(cadr(struct_return),INT); /* size */ gexpr(list4(SASS,rvalue(car(struct_return)),e,e1),0); } } else { error(TYERR); /* should check compatible */ } } else { gexpr(correct_type(expr(0),cadr(fnptr->ty)),1); } lfree=slfree; conv->return_end_(); checksym(SM); /* control = 0; still control continue until pending return emittion */ retpending = 1; } void replace_return_struct(int func,int left) { int e = caddr(func); /* arg lists */ while(cadr(e)) e=cadr(e); /* find first arg */ e = car(e); /* return_struct arg */ rplacad(e,left); } static void dogoto(void) { NMTBL *nptr0; int t,e1,e2,env; conv->goto_(); getsym(); e1 = expr(0); t=car(e1); if (t==FNAME) { nptr0 = (NMTBL *)cadr(e1); t = nptr0->sc; if (t==EMPTY) { nptr0->sc = FLABEL; jmp(nptr0->dsp = fwdlabel()); } else if (t==FLABEL||t==BLABEL) { jmp(nptr0->dsp); } control=0; conv->sm_(); checksym(SM); conv->goto_label_(nptr0); return; } if (t==COMMA) { env = caddr(e1); e1 = cadr(e1); t = car(e1); } else { env = 0; } if (t==FUNCTION) { conv->jump_(env); e2 = cadr(e1); if (car(e2) == FNAME) { nptr0=(NMTBL *)cadr(e2); if (nptr0->sc==EMPTY) nptr0->sc = EXTRN1; else if(nptr0->sc==FUNCTION) nptr0->sc = CODE; if (nptr0->ty>0&&car(nptr0->ty)==FUNCTION) car(nptr0->ty)=CODE; } gexpr(list3(CODE,e1,env),0); control=0; conv->sm_(); checksym(SM); return; } error(STERR); return; } static void dolabel(void) { if(nptr->sc == FLABEL) fwddef(nptr->dsp); else if(nptr->sc != EMPTY) error(TYERR); nptr->sc = BLABEL; nptr->dsp = backdef(); conv->label_(); getsym(); checksym(COLON); } int float_value(int e2,int type) { if (car(e2)==CONST) return dlist2(DCONST,(double)cadr(e2)); if(type==FLOAT||type==DOUBLE) return e2; if(type==UNSIGNED) return list3(CONV,rvalue_t(e2,type),U2D); if(integral(type)) return list3(CONV,rvalue_t(e2,type),I2D); error(TYERR); return dlist2(DCONST,1.0); } int int_value(int e2,int type) { if (car(e2)==DCONST||car(e2)==FCONST) return list2(CONST,(int)dcadr(e2)); if(scalar(type)||car(type)==ARRAY) return e2; if(type==FLOAT||type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2I); error(TYERR); return list2(CONST,1); } int unsigned_value(int e2,int type) { if(scalar(type)) return e2; if (car(e2)==DCONST||car(e2)==FCONST) return list2(CONST,(unsigned)dcadr(e2)); if(type==FLOAT||type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2U); error(TYERR); return e2; } int assign_expr0(int e1,int e2,int t,int type0) { int stype; stype=type; type = type0; e2 = rvalue(e2); e1=assign_expr(e1,e2,t,type); type=stype; return e1; } int assign_expr(int e1,int e2,int t,int type) { if(t==VOID) error(TYERR); if(t==CHAR) { e2=int_value(e2,type); if (!integral(type)) error(TYERR); type= INT;return(list3(CASS,e1,e2)); } else if(t==DOUBLE) { e2=float_value(e2,type); type= t;return(list3(DASS,e1,e2)); } else if(t==FLOAT) { e2=float_value(e2,type); type= t;return(list3(FASS,e1,e2)); } else if(scalar(t)) { e2=(t==UNSIGNED)?unsigned_value(e2,type):int_value(e2,type); type=t; return(list3(ASS,e1,e2)); } else if((car(t)==STRUCT||car(t)==UNION)) { if (size(t)!=size(type)) error(TYERR); type=t; if(car(e2)==RSTRUCT && car(cadr(e2))==FUNCTION) { replace_return_struct(cadr(e2),e1); return cadr(e2); } else { return (list4(SASS,e1,e2,size(t))); } } else { error(TYERR); return list3(ASS,e1,e2); } } int expr(int noconv) { int r; conv->noconv_(noconv); r=rvalue(expr0()); return r; } static int expr0(void) { int e; e=expr1(); while(sym==COMMA) { conv->op_(sym); getsym();e=list3(COMMA,e,rvalue(expr1())); } return e; } static int expr1(void) { int e1,e2,t,op; e1=expr2(); switch (sym) { case ASS: conv->op_(sym); lcheck(e1); t=type; getsym(); e2=rvalue(expr1()); return assign_expr(e1,e2,t,type); case ADD+AS: case SUB+AS: case MUL+AS: case DIV+AS: case MOD+AS: case RSHIFT+AS: case LSHIFT+AS: case BAND+AS: case EOR+AS: case BOR+AS: conv->op_(sym); op = sym-AS; lcheck(e1); t=type; getsym(); e2=rvalue(expr1()); if(!(integral(type)||type==FLOAT||type==DOUBLE)) error(TYERR); if (t==FLOAT) { e2=float_value(e2,type); type=t; return(list4(FASSOP,e1,e2,op+DOP)); } if (t==DOUBLE) { e2=float_value(e2,type); type=t; return(list4(DASSOP,e1,e2,op+DOP)); } if(!integral(type)) error(TYERR); if((t==UNSIGNED||type==UNSIGNED)&& (op==MUL||op==DIV||op==MOD||op==RSHIFT||op==LSHIFT)) op=op+US; if(t==CHAR) { type= INT; return(list4(CASSOP,e1,e2,op)); } type=t; if(integral(t)) return(list4(ASSOP,e1,e2,op)); if((op!=ADD&&op!=SUB)||car(t)!=POINTER) error(TYERR); e2=binop(MUL,e2,list2(CONST,size(cadr(t))),INT,UNSIGNED); type=t; return list4(ASSOP,e1,e2,op); default: return(e1); } } static int expr2(void) { int e1,e2,e3,t; e1=expr3(); if(sym==COND) { conv->cond_(); e1=rvalue(e1); getsym(); conv->cond1_(); e2=rvalue(expr2()); t=type; conv->cond2_(); checksym(COLON); e3=rvalue(expr2()); conv->cond_end_(); if(car(e1)==CONST) { if(cadr(e1)) { type=t;return e2; } else return e3; } if(type==FLOAT||type==DOUBLE||t==FLOAT||t==DOUBLE) { e2=float_value(e2,t); e3=float_value(e3,type); t=type=DOUBLE; return(list4(DCOND,e1,e2,e3)); } if(type==INT||(t!=INT&&type==UNSIGNED)) type=t; /* if (t!=type) error(TYERR); */ return(list4(COND,e1,e2,e3)); } return(e1); } static int expr3(void) { int e; e=expr4(); while(sym==LOR) { conv->op_(sym); e=rvalue(e); getsym(); e=list3(LOR,e,rvalue(expr4())); type= INT; } return(e); } static int expr4(void) { int e; e=expr5(); while(sym==LAND) { conv->op_(sym); e=rvalue(e); getsym(); e=list3(LAND,e,rvalue(expr5())); type= INT; } return(e); } static int expr5(void) { int e1,e2,t; e1=expr6(); while(sym==BOR) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr6()); e1=binop(BOR,e1,e2,t,type); } return(e1); } static int expr6(void) { int e1,e2,t; e1=expr7(); while(sym==EOR) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr7()); e1=binop(EOR,e1,e2,t,type); } return(e1); } static int expr7(void) { int e1,e2,t; e1=expr8(); while(sym==BAND) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr8()); e1=binop(BAND,e1,e2,t,type); } return(e1); } static int expr8(void) { int e1,e2,op,t; e1=expr9(); while((op=sym)==EQ||op==NEQ) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr9()); e1=binop(op,e1,e2,t,type); type= INT; } return e1; } static int expr9(void) { int e1,e2,t,op; e1=expr10(); while((op=sym)==GT||op==GE||op==LT||op==LE) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr10()); if(t==INT&&type==INT) e1=binop(op,e1,e2,t,type); else if(t==DOUBLE||type==DOUBLE|| t==FLOAT||type==FLOAT) /* binop will handle op+DOP */ e1=binop(op,e1,e2,t,type); else e1=binop(op+US,e1,e2,t,type); type= INT; } return e1; } static int expr10(void) { int e1,e2,t,op; e1=expr11(); while((op=sym)==RSHIFT||op==LSHIFT) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr11()); e1=binop(op,e1,e2,t,type); } return e1; } static int expr11(void) { int e1,e2,t,op; e1=expr12(); while((op=sym)==ADD||op==SUB) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr12()); e1=binop(op,e1,e2,t,type); } return e1; } static int expr12(void) { int e1,e2,t,op; e1=expr13(); while((op=sym)==MUL||op==DIV||op==MOD) { conv->op_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr13()); e1=binop(op,e1,e2,t,type); } return e1; } static int expr13(void) { int e,op; switch (op = sym) { case INC: case DEC: conv->prefix_(sym); getsym(); lcheck(e=expr13()); if(type==CHAR) { type= INT; return(list2(op==INC?CPREINC:CPREDEC,e)); } if(integral(type)) return(list3(PREINC,e,op==INC?1:-1)); if(type==FLOAT) return(list3(FPREINC,e,op==INC?1:-1)); if(type==DOUBLE) return(list3(DPREINC,e,op==INC?1:-1)); if(car(type)!=POINTER) error(TYERR); return(list3(PREINC,e, op==INC?size(cadr(type)):-size(cadr(type)) )); case MUL: conv->prefix_(sym); getsym(); e=rvalue(expr13()); return(indop(e)); case BAND: conv->prefix_(sym); getsym(); switch(car(e=expr13())) { case INDIRECT: e=cadr(e); break; case DREGISTER: case REGISTER: case GVAR: case LVAR: e=list2(ADDRESS,e); break; default:error(LVERR); } type=list2(POINTER,type); return e; case SUB: conv->prefix_(sym); getsym(); e=rvalue(expr13()); if(type==FLOAT||type==DOUBLE) { return list2(DMINUS,e); return(car(e)==DCONST?dlist2(DCONST,-dcadr(e)):list2(DMINUS,e)); } if(!integral(type)) error(TYERR); return(car(e)==CONST?list2(CONST,-cadr(e)):list2(MINUS,e)); case BNOT: conv->prefix_(sym); getsym(); e=rvalue(expr13()); if(!integral(type)) error(TYERR); return(car(e)==CONST?list2(CONST,~cadr(e)):list2(BNOT,e)); case LNOT: conv->prefix_(sym); getsym(); e=rvalue(expr13()); if(type==FLOAT||type==DOUBLE) return(car(e)==DCONST?list2(CONST,!dcadr(e)): list3(DOP+NEQ,list2(CONST,0),e)); if(!scalar(type)) error(TYERR); return(car(e)==CONST?list2(CONST,!cadr(e)):list2(LNOT,e)); case SIZEOF: conv->prefix_(sym); if(getsym()==LPAR) { if(typeid(getsym())) { e=list2(CONST,size(typename())); type=INT; checksym(RPAR); return e; } else { e=expr0(); checksym(RPAR); expr16(e); if(sym==INC||sym==DEC) { getsym(); if(type==CHAR) type=INT; else if(!scalar(type)&&type!=FLOAT&&type!=DOUBLE) error(TYERR); } } } else expr13(); e=list2(CONST,size(type)); type=INT; return e; } e=expr14(); if((op=sym)==INC||op==DEC) { conv->postfix_(sym); lcheck(e); getsym(); if(type==CHAR) { type= INT; return(list2(op==INC?CPOSTINC:CPOSTDEC,e)); } if(integral(type)) return(list3(POSTINC,e,op==INC?1:-1)); if(type==FLOAT) return(list3(FPOSTINC,e,op==INC?1:-1)); if(type==DOUBLE) return(list3(DPOSTINC,e,op==INC?1:-1)); if(car(type)!=POINTER) error(TYERR); return (list3(POSTINC,e, op == INC ? size(cadr(type)): -size(cadr(type)) )); } return e; } static void extrn_use(NMTBL *nptr) { if(nptr->sc==EXTRN) nptr->sc=EXTRN1; } static int fname(NMTBL *nptr) { int e1; e1=list2(FNAME,(int)nptr); type=list3(car(nptr->ty),cadr(nptr->ty),caddr(nptr->ty)); getsym(); extrn_use(nptr); return expr16(e1); } static int expr14(void) { int e1=0,t; switch(sym) { case IDENT: conv->id_(sym,nptr); switch(nptr->sc) { case EXTRN: case EXTRN1: extrn_use(nptr); case STATIC: if(is_code(nptr)||is_function(nptr)) { return fname(nptr); } case GVAR: e1=list2(GVAR,(int)nptr); type=nptr->ty; getsym(); extrn_use(nptr); break; case FLABEL: case BLABEL: case FUNCTION: case CODE: return fname(nptr); case LVAR: e1=list2(LVAR,nptr->dsp); type=nptr->ty; getsym(); break; case DREGISTER: e1=list3(DREGISTER,nptr->dsp,(int)nptr); type=nptr->ty; getsym(); break; case REGISTER: e1=list3(REGISTER,nptr->dsp,(int)nptr); type=nptr->ty; getsym(); break; case EMPTY: if(getsym()==LPAR) { nptr->sc = EXTRN1; type= glist3(FUNCTION,INT,0); nptr->ty= type; e1=expr15(list2(FNAME,(int)nptr)); break; } else { nptr->sc = EXTRN1; nptr->ty= glist3(FUNCTION,INT,0); e1=list2(FNAME,(int)nptr); type=list3(nptr->sc,nptr->ty,nptr->dsp); break; } default:error(UDERR); } break; case STRING: conv-> string_(sptr); e1=list3(STRING,(int)sptr,symval); type=list3(ARRAY,CHAR,symval); getsym(); break; case CONST: conv-> const_(symval); type= INT; e1=list2(CONST,symval); getsym(); break; case DCONST: conv-> const_(symval); type= DOUBLE; e1=dlist2(DCONST,dsymval); getsym(); break; case RETURN: conv-> return_f_(); if (!is_function(fnptr)) { error(STERR); } type=list2(POINTER,CODE); e1=list2(RETURN,(int)fnptr); getsym(); break; case DEFINED: getsym(); t = mode; mode = IFDEF; checksym(LPAR); conv-> defined_(name); mode = t; type= INT; e1=list2(CONST,symval); getsym(); checksym(RPAR); break; case ENVIRONMENT: conv-> environment_(); type=list2(POINTER,VOID); e1=list2(ENVIRONMENT,0); getsym(); break; case LPAR: conv->lpar_(); if(typeid(getsym())) { t=typename(); conv->return_type_(t,0,0); conv->rpar_(); checksym(RPAR); e1=expr13(); if (integral(t)) { if(t==UNSIGNED) e1=unsigned_value(e1,type); else e1=int_value(e1,type); } else if(t==FLOAT||t==DOUBLE) { if(integral(type)) e1=float_value(e1,type); } type=t; return e1; } e1=expr0(); conv->rpar_(); checksym(RPAR); break; default:error(EXERR); } return expr16(e1); } static int expr16(int e1) { int e2,t; while(1) { if(sym==LBRA) { conv->lbra_(sym); e1=rvalue(e1); t=type; getsym(); e2=rvalue(expr0()); checksym(RBRA); conv->rbra_(sym); e1=binop(ADD,e1,e2,t,type); e1=indop(e1); } else if(sym==LPAR) e1=expr15(e1); else { if(sym==PERIOD) { conv->op_(sym);e1=strop(e1); } else if(sym==ARROW) { conv->op_(sym);e1=strop(indop(rvalue(e1))); } else break; } } if(car(e1)==FNAME) type=list2(POINTER,type); return e1; } static int rvalue(int e) { int t; if(type==CHAR) { type= INT; switch(car(e)) { case GVAR: return(list2(CRGVAR,cadr(e))); case LVAR: return(list2(CRLVAR,cadr(e))); case INDIRECT: return(list2(CRINDIRECT,cadr(e))); default:return(e); } } if(type==FLOAT) { switch(car(e)) { case GVAR: return(list2(FRGVAR,cadr(e))); case LVAR: return(list2(FRLVAR,cadr(e))); case INDIRECT: return(list2(FRINDIRECT,cadr(e))); default:return(e); } } if(type==DOUBLE) { switch(car(e)) { case GVAR: return(list2(DRGVAR,cadr(e))); case LVAR: return(list2(DRLVAR,cadr(e))); case INDIRECT: return(list2(DRINDIRECT,cadr(e))); default:return(e); } } if(type==LONGLONG) { switch(car(e)) { case GVAR: return(list2(LRGVAR,cadr(e))); case LVAR: return(list2(LRLVAR,cadr(e))); case INDIRECT: return(list2(LRINDIRECT,cadr(e))); default:return(e); } } if(!integral(type)&&type!=VOID) { if(type==CODE) { return e; } if((t=car(type))==ARRAY) { type=list2(POINTER,cadr(type)); if(car(e)==INDIRECT) return cadr(e); return list2(ADDRESS,e); } else if(t==STRUCT || t==UNION) { if(car(e)==RSTRUCT) return e; /* ??? */ t = cadr(type); /* size */ return list3(RSTRUCT,e,t); } else if(t==FUNCTION) { type=cadr(type); return e; } else if(t==CODE) { return e; } else if(t!=POINTER) error(TYERR); } switch(car(e)) { case GVAR: return(list2(RGVAR,cadr(e))); case LVAR: return(list2(RLVAR,cadr(e))); case INDIRECT: return(list2(RINDIRECT,cadr(e))); default:return(e); } } int rvalue_t(int e,int t) { int stype = type; type = t; e = rvalue(e); type = stype; return e; } static void lcheck(int e) { int t; if(!(scalar(type)||type==DOUBLE||type==FLOAT)|| (car(e)!=GVAR&&car(e)!=LVAR&&car(e)!=INDIRECT&&car(e)!=REGISTER)) if ((t=car(type))<0 && t!=STRUCT && t!=UNION) error(LVERR); } static int indop(int e) { if(type!=INT&&type!=UNSIGNED) { if(car(type)==POINTER) type=cadr(type); else if(car(type)==CODE || car(type)==FUNCTION) type=type; else error(TYERR); } else type= CHAR; if(car(e)==ADDRESS) return(cadr(e)); return(list2(INDIRECT,e)); } static int strop(int e) { getsym(); if (sym!=IDENT||nptr->sc!=FIELD) error(TYERR); conv->id_(sym,nptr); if (integral(type)||(car(type)!=STRUCT && car(type)!=UNION)) e=rvalue(e); type = nptr->ty; if(nptr->dsp) { switch(car(e)) { case GVAR: e=list2(INDIRECT,list3(ADD,e,list2(CONST,nptr->dsp))); break; case LVAR: e=list2(LVAR,cadr(e) + nptr->dsp); break; case INDIRECT: e=list2(INDIRECT,list3(ADD,cadr(e),list2(CONST,nptr->dsp))); break; default: e=list2(INDIRECT,list3(ADD,e,list2(CONST,nptr->dsp))); } } else { switch(car(e)) { case GVAR: case LVAR: case INDIRECT: break; default: e=list2(INDIRECT,e); } } getsym(); return e; } static int dbinop(int op, int e1, int e2, int t1, int t2) { double d1,d2,d; int b=0; type= DOUBLE; if (integral(t1)) { e1=float_value(e1,t1); t1=DOUBLE; } if (integral(t2)) { e2=float_value(e2,t2); t2=DOUBLE; } if(car(e1)==DCONST&&car(e2)==DCONST) { d1=dcadr(e1); d2=dcadr(e2); switch(op) { case ADD: d=d1+d2; break; case SUB: d=d1-d2; break; case MUL: d=d1*d2;break; case DIV: if(!d2) error(EXERR);d=d1/d2;break; default: switch(op) { case GT: b=(d1>d2);break; case GE: b=(d1>=d2);break; case LT: b=(d1<d2);break; case LE: b=(d1<=d2);break; case EQ: b=(d1==d2);break; case NEQ: b=(d1!=d2);break; default: error(EXERR); } type = INT; return list2(CONST,b); } return dlist2(DCONST,d); } if(car(e1)==DCONST) { if ((op==SUB||op==ADD)&&dcadr(e1)==0.0) { return e2; } else if (op==MUL&&dcadr(e1)==1.0) { return e2; } else if (op==MUL&&-dcadr(e1)==1.0) { return list2(DMINUS,e2); } } if(car(e2)==DCONST) { if ((op==SUB||op==ADD)&&dcadr(e2)==0.0) { return e1; } if ((op==DIV||op==MUL)&&dcadr(e2)==1.0) { return e1; } if ((op==DIV||op==MUL)&&-dcadr(e2)==1.0) { return list2(DMINUS,e1); } if (op==SUB) { op=ADD; dcadr(e2) = -dcadr(e2); } else if(op==DIV) { if(dcadr(e2)==0.0) error(EXERR); op=MUL; dcadr(e2)=1/dcadr(e2); } } if (car(e1)==DCONST && (op==ADD||op==MUL)) { return(list3(op+DOP,e2,e1)); } if(op==GT||op==GE||op==LT||op==LE||op==EQ||op==NEQ) { type=INT; return(list3(op+DOP,e1,e2)); } else if(ADD||SUB||MUL||DIV) return(list3(op+DOP,e1,e2)); else error(-1); } static int binop(int op, int e1, int e2, int t1, int t2) { int e=0; if(t1==DOUBLE||t2==DOUBLE||t1==FLOAT||t2==FLOAT) return dbinop(op,e1,e2,t1,t2); if(car(e1)==CONST&&car(e2)==CONST) { e1=cadr(e1); e2=cadr(e2); type= INT; switch(op) { case BOR: e=e1|e2;break; case EOR: e=e1^e2;break; case BAND: e=e1&e2;break; case ADD: if(integral(t1)) { if(integral(t2)) { e=e1+e2; } else { if(car(t2)!=POINTER) error(TYERR); e=size(cadr(t2))*e1+e2; type=t2; } } else { if(car(t1)!=POINTER) error(TYERR); e=e1+size(cadr(t1))*e2; type=t1; } break; case SUB: if(integral(t1)) { e=e1-e2; } else { if(car(t1)!=POINTER) error(TYERR); e=e1-size(cadr(t1))*e2; type=t1; } break; case MUL: e=e1*e2;break; case DIV: if(!e2) error(EXERR);e=e1/e2;break; case MOD: if(!e2) error(EXERR);e=e1%e2;break; case RSHIFT: e=e1>>e2;break; case LSHIFT: e=e1<<e2;break; case EQ: e=(e1==e2);break; case NEQ: e=(e1!=e2);break; case GT: e=(e1>e2);break; case GE: e=(e1>=e2);break; case LT: e=(e1<e2);break; case LE: e=(e1<=e2);break; case UGT: e=((unsigned)e1>(unsigned)e2);break; case UGE: e=((unsigned)e1>=(unsigned)e2);break; case ULT: e=((unsigned)e1<(unsigned)e2);break; case ULE: e=((unsigned)e1<=(unsigned)e2);break; } return list2(CONST,e); } if(op==GT||op==GE||op==LT||op==LE|| op==UGT||op==UGE||op==ULT||op==ULE|| op==EQ||op==NEQ ) return(list3(op,e1,e2)); if(op==SUB&&car(e2)==CONST) { op=ADD; cadr(e2)=-cadr(e2); } if((op==ADD||op==MUL||op==BOR||op==EOR||op==BAND)&& (car(e1)==CONST||(car(e2)!=CONST&& (car(e1)==RGVAR||car(e1)==RLVAR)))) { e=e1;e1=e2;e2=e;e=t1;t1=t2;t2=e; } if(op==ADD) { if(integral(t1)) { if(integral(t2)) { if(t1==INT) type=t2;else type=t1; return(list3(ADD,e1,e2)); } if(car(t2)!=POINTER) error(TYERR); e=binop(MUL,e1,list2(CONST,size(cadr(t2))),t1,INT); type=t2; return(list3(ADD,e,e2)); } if(car(t1)!=POINTER||!integral(t2)) error(TYERR); e=binop(MUL,e2,list2(CONST,size(cadr(t1))),t2,INT); type=t1; if (car(e)==CONST && cadr(e)==0) return(e1); if(car(e1)==ADDRESS&&car(e)==CONST&&car(cadr(e1))!=GVAR) return(list2(ADDRESS,list2(car(cadr(e1)), cadr(cadr(e1))+cadr(e)))); return(list3(ADD,e1,e)); } if(op==SUB) { if(integral(t1)) { if(!integral(t2)) error(TYERR); if(t1==INT) type=t2;else type=t1; return(list3(SUB,e1,e2)); } if(car(t1)!=POINTER) error(TYERR); if(integral(t2)) { e=binop(MUL,e2,list2(CONST,size(cadr(t1))),t2,INT); type=t1; return(list3(SUB,e1,e)); } if(car(t2)!=POINTER) error(TYERR); compatible(t1,t2); e=list3(SUB,e1,e2); e=binop(DIV,e,list2(CONST,size(cadr(t1))),UNSIGNED,INT); type= INT; return e; } if(!integral(t1)||!integral(t2)) error(TYERR); if(t1==INT) type=t2; else type=t1; if((op==MUL||op==DIV)&&car(e2)==CONST&&cadr(e2)==1) return e1; if(op==BOR||op==EOR||op==BAND) return(list3(op,e1,e2)); return(list3(type==UNSIGNED?op+US:op,e1,e2)); } int correct_type(int e,int t) { int t1; /* e = rvalue(e); */ if (type==FLOAT && t==DOTS) { type=DOUBLE;} if (type==CHAR && t==DOTS) { type=INT;} if (t==DOTS) return e; if (t==UNSIGNED) e = unsigned_value(e,type); else if (integral(t)) e = int_value(e,type); else if (t==FLOAT||t==DOUBLE) e = float_value(e,type); else if ((t1=car(t))==STRUCT||t1==UNION) { if(size(t)!=size(type)) error(TYERR); } type = t; return e; } static int expr15(int e1) { int t,arglist,e,sz,argtypes,at; /* function call */ if(car(type)==POINTER) { if (car(cadr(type))==FUNCTION||car(cadr(type))==CODE) { e1=rvalue(e1); type=cadr(type); } /* else error */ } if(integral(type)|| ((car(type)!=FUNCTION)&&(car(type)!=CODE))) { error(TYERR); } conv->funcall_(type); argtypes = caddr(type); if (!integral(t=cadr(type))&&(car(t)==STRUCT||car(t)==UNION)) { /* skip return struct pointer */ if (argtypes==0) error(-1); argtypes = cadr(argtypes); } t=type; arglist=0; getsym(); while(sym!=RPAR) { e=rvalue(expr1()); if(argtypes==0) at=DOTS; else if(car(argtypes)==DOTS) at=DOTS; else { at=car(argtypes); argtypes=cadr(argtypes); } e = correct_type(e,at); arglist=list3(e,arglist,type); if(sym!=COMMA) break; conv->comma_(); getsym(); } checksym(RPAR); conv->funcall_args_(); if(car(t)==CODE) return list4(FUNCTION,e1,arglist,0); type=t; type = cadr(type); /* return type */ if(type==CHAR) type=INT; else if(car(type)==STRUCT||car(type)==UNION) { /* make temporaly struct for return value */ /* but it is better to see we can reuse old one */ if (tmp_struct) { sz = size(tmp_struct->ty); if (sz>=size(type)) { /* reuse it */ } else if (tmp_struct->dsp-sz==disp) { /* extendable */ disp -= tmp_struct->dsp-sz; tmp_struct->dsp = disp; } else { tmp_struct = def(0); } } else { tmp_struct = def(0); } e = list2(LVAR,tmp_struct->dsp); /* pass the pointer as an argument */ /* this is recognized by called function declaration */ /* but I don't know this sequece is compatible with gcc */ append3(arglist,list2(ADDRESS,e),list2(POINTER,type)); } return list4(FUNCTION,e1,arglist,type); } static int typeid(int s) { return (integral(s) || s==CODE || s==SHORT || s==LONG || s==STRUCT || s==UNION || s==LONGLONG || s==FLOAT || s==DOUBLE || (s==IDENT && nptr->sc==TYPE)); } static int typename(void) { int t; type=t=typespec(); ndecl0(); reverse(t); return type; } static int ndecl0(void) { if(sym==MUL) { getsym(); return type=list2(POINTER,ndecl0()); } return ndecl1(); } static int ndecl1(void) { int i,t,arglist; if(sym==LPAR) { if(getsym()==RPAR) { type=list3(FUNCTION,type,0); getsym(); } else { ndecl0(); checksym(RPAR); } } while(1) { if(sym==LBRA) { getsym(); t=type; i=cexpr(expr(1)); checksym(RBRA); type=list3(ARRAY,t,i); } else if(sym==LPAR) { t = type; getsym(); arglist=0; while(sym!=RPAR) { ndecl0(); arglist=list2(type,arglist); if(sym!=COMMA) break; getsym(); } checksym(RPAR); type=list3(FUNCTION,t,arglist); } else return type; } } static int cexpr(int e) { conv->conv_(); if (car(e) != CONST) error(CNERR); return (cadr(e)); } static int in_comment = 0; extern double strtod(const char *nptr, char **endptr); static int getsym(void) { NMTBL *nptr0,*nptr1,*nptrm; int i,slfree,macrop,d; char *scheapp; char c; if (alpha(skipspc())) { i = hash = 0; name = namebuf; while (alpha(ch) || digit(ch)) { if (i < LBUFSIZE-1) hash=(((7*hash)&0xfffffff) ^ (name[i++]=ch)); getch(); } name[i++] = '\0'; /* printf("# hash %u %s\n",hash,name); */ nptrm=msearch(name); if (mode==MDECL) { nptr = nptrm; return (sym==MACRO); } if (mode==IFDEF) { if (nptrm->sc == MACRO||nptrm->sc==FMACRO) { return (symval=1); } else { return (symval=0); } } if (nptrm->sc!=EMPTY&&(nptrm->sc!=FMACRO||ch=='(')) { i = mode; mode = STAT; macrop = 0; slfree = lfree; macropp = macro_buf; if (nptrm->sc == FMACRO) { macrop=macro_function(macrop,&chptr,nptrm,0); } else { macrop=macro_eval(macrop,(char *)car(nptrm->dsp),0); } macropp = macro_buf; mappend(reverse0(macrop)); macropp[-1] ='\n'; *macropp =0; lfree = slfree; if (lsrc && !asmf && nptrm->sc==FMACRO) gen_comment(macro_buf); macropp[-1] =0; chptrsave = list2((int)chptr,chptrsave); chsave = list2(chptr[-1],chsave); chptr = macro_buf; ch = *chptr++; mode = i; return getsym(); } nptr0 = gsearch(); if (nptr0->sc == RESERVE) return sym = nptr0->dsp; sym = IDENT; gnptr=nptr=nptr0; if (mode==ADECL && nptr0->sc ==TYPE) return sym; if (mode==GDECL || mode==GSDECL || mode==GUDECL || mode==GTDECL || mode==TOP) { return sym; } nptr1=lsearch(nptr0->nm); if (mode==STAT) { if (nptr1->sc == EMPTY) return sym; } nptr=nptr1; return sym; } else if (digit(ch)||ch=='.') { symval=0; d=0; scheapp = cheapp; if(ch=='.') { getch(); if(ch=='.') { getch(); if (ch=='.') { getch(); return sym=DOTS; } error(CHERR); return getsym(); } else if (!digit(ch)) return sym=PERIOD; d=1; *cheapp++ = '.'; /* .0 case */ } else if (ch == '0') { if (getch() == 'x' || ch == 'X') { while(1) { if(digit(getch())) symval=symval*16+ch-'0'; else if('a'<=ch&&ch<='f') symval=symval*16+ch-'a'+10; else if('A'<=ch&&ch<='F') symval=symval*16+ch-'A'+10; else break; } return sym=CONST; } else if (ch!='.') { while (digit(ch)) { symval=symval*8+ch-'0';getch(); } return sym=CONST; } d=1; *cheapp++ = '0'; /* 0. case */ } else { while(digit(ch)) { *cheapp++ = ch; symval=symval*10+ch-'0';getch(); } if (!(ch=='.'||ch=='e')) { cheapp=scheapp; return sym=CONST; } } while(digit(ch)|| ch=='.'||ch=='e') { *cheapp++ = ch; getch(); if (ch=='-' && cheapp[-1]=='e') { *cheapp++ = ch; getch(); } else if (ch=='+' && cheapp[-1]=='e') { *cheapp++ = ch; getch(); } } *cheapp++ = 0; dsymval = strtod(scheapp,0); cheapp=scheapp; return sym=DCONST; } else if(ch=='\'') { getch(); symval=escape(); if(ch!='\'') error(CHERR); getch(); return sym=CONST; } else if(ch=='"') { getstring(); return sym= STRING; } c=ch; getch(); switch(c) { case '*': return postequ(MUL,MUL+AS); case '&': if(ch=='&') {getch();return sym=LAND;} return postequ(BAND,BAND+AS); case '-': if(ch=='>') {getch();return sym=ARROW;} if(ch=='-') {getch();return sym=DEC;} return postequ(SUB,SUB+AS); case '!': return postequ(LNOT,NEQ); case '~': return sym=BNOT; case '+': if(ch=='+') {getch();return sym=INC;} return postequ(ADD,ADD+AS); case '%': return postequ(MOD,MOD+AS); case '^': return postequ(EOR,EOR+AS); case '|': if(ch=='|') {getch();return sym=LOR;} return postequ(BOR,BOR+AS); case '=': return postequ(ASS,EQ); case '>': if(ch=='>') {getch();return postequ(RSHIFT,RSHIFT+AS);} return postequ(GT,GE); case '<': if(ch=='<') {getch();return postequ(LSHIFT,LSHIFT+AS);} return postequ(LT,LE); case '(': return sym=LPAR; case ')': return sym=RPAR; case '[': return sym=LBRA; case ']': return sym=RBRA; case '{': return sym=LC; case '}': return sym=RC; case ',': return sym=COMMA; case ';': return sym=SM; case ':': return sym=COLON; case '?': return sym=COND; case '/': if(ch=='/') { in_comment = 1; conv->comment_('/'); conv->comment_('/'); while(ch!='\n') { getch(); conv->comment_(ch); } in_comment = 0; getch(); return getsym(); } if(ch!='*') return postequ(DIV,DIV+AS); in_comment = 1; conv->comment_('/'); conv->comment_('*'); do { c=ch; getch(); conv->comment_(ch); } while(!(c=='*'&&ch=='/')); in_comment = 0; getch(); return getsym(); case 0: case '\n': getch(); return getsym(); default: error(CHERR); return getsym(); } } static int postequ(int s1, int s2) { if(ch=='=') {getch();return sym=s2;} return sym=s1; } static int alpha(char c) { return(('a'<=c&&c<='z')||('A'<=c&&c<='Z')||c=='_'); } static int digit(char c) { return('0'<=c&&c<='9'); } int dummy_count = 0; static NMTBL * free_nptr() { NMTBL *nptr,*iptr; iptr=nptr= &ntable[hash % GSYMS]; while(nptr->sc!=0) { if (++nptr== &ntable[GSYMS]) nptr=ntable; if (nptr==iptr) error(GSERR); } copy(nptr,"_00000"); dummy_count++; if (dummy_count>999) error(STRERR); nptr->nm[5]='0'+dummy_count%10; nptr->nm[4]='0'+(dummy_count/10)%10; nptr->nm[3]='0'+(dummy_count/100)%10; nptr->sc=EMPTY; return nptr; } static NMTBL * gsearch(void) { NMTBL *nptr,*iptr; iptr=nptr= &ntable[hash % GSYMS]; while(nptr->sc!=0 && neqname(nptr->nm,name)) { if (++nptr== &ntable[GSYMS]) nptr=ntable; if (nptr==iptr) error(GSERR); } if (nptr->sc == 0) { copy(nptr,name); nptr->sc=EMPTY; } return nptr; } static NMTBL * lsearch(char *name) { NMTBL *nptr,*iptr; iptr=nptr= &ntable[hash%LSYMS+GSYMS]; while(nptr->sc!=0 && neqname(nptr->nm,name)) { if (++nptr== &ntable[LSYMS+GSYMS]) nptr= &ntable[GSYMS]; if (nptr==iptr) error(LSERR); } if (nptr->sc == 0) { nptr->nm=name; /* already saved in gsearch */ nptr->sc=EMPTY; nptr->dsp=0; } return nptr; } static NMTBL * msearch(char *name) { NMTBL *nptr,*iptr; iptr=nptr= &mtable[hash%MSYMS]; while(nptr->sc!=0 && neqname(nptr->nm,name)) { if (++nptr== &mtable[MSYMS]) nptr= &mtable[0]; if (nptr==iptr) error(MSERR); } if (nptr->sc == 0) { copy(nptr,name); nptr->sc=EMPTY; nptr->dsp=0; nptr->ty=0; } return nptr; } static NMTBL * msearch0(char *name) { NMTBL *nptr,*iptr; int hash,i; i = 0; hash = 0; while((name[i])) { hash=(((7*hash)&0xfffffff) ^ (name[i++])); } iptr=nptr= &mtable[hash%MSYMS]; while(nptr->sc!=0 && neqname(nptr->nm,name)) { if (++nptr== &mtable[MSYMS]) nptr= &mtable[0]; if (nptr==iptr) error(MSERR); } if (nptr->sc == 0) { copy(nptr,name); nptr->sc=EMPTY; nptr->dsp=0; nptr->ty=0; } return nptr; } static void copy(NMTBL *nptr, char *s) { nptr->nm = cheapp; while((*cheapp++ = *s++)); } static int neqname(char *p,char *q) { if (!p) return 0; while(*p && *p!='.') if(*p++ != *q++) return 1; return (*q!=0); } static void getstring(void) { getch(); symval = 0; sptr = cheapp; while (ch != '"') { *cheapp++ = escape(); symval++; if (cheapp >= cheap+CHEAPSIZE) error(STRERR); } getch(); *cheapp++ = '\0'; symval++; } static int topspc = 0; static int skipspc(void) { /* static int topspc = 0; */ while(ch=='\t'||ch=='\n'||ch==' '||ch=='\r') { if (ch=='\n'||ch=='\r') topspc=1; if (topspc) conv->comment_(ch); getch(); } topspc=0; return ch; } static int getch(void) { if(*chptr) return ch = *chptr++; else if (chptrsave) { chptr = (char *)car(chptrsave); ch = car(chsave); chptrsave = cadr(chptrsave); chsave = cadr(chsave); return ch; } getline(); return getch(); } char escape(void) { char c; if ((c=ch) == '\\') { if (digit(c=getch())) { c = ch-'0'; if (digit(getch())) { c = c*8+ch-'0'; if (digit(getch())) { c=c*8+ch-'0';getch(); } } return c; } getch(); switch(c) { case 'n': return '\n'; case 't': return '\t'; case 'b': return '\b'; case 'r': return '\r'; case 'f': return '\f'; case '\\': return '\\'; case '\n': return escape(); default: return c; } } if (c == '\n') error(EXERR); getch(); return c; } static FILE * getfname(void) { int i; char *s,name[LBUFSIZE]; FILE *fp; getch(); if(skipspc()!='"') error(INCERR); for(i=0;(getch()!='"' && ch!='\n');) { if(i<LBUFSIZE-1) name[i++]=ch; } if(ch=='\n') error(INCERR); name[i]=0; fp = fopen(name,"r") ; s = name; (filep+1)->name0 = cheapp; while((*cheapp++ = *s++)); return ( (filep+1)->fcb = fp ); } static int macro_if_depth ; static int macro_if_current ; static int macro_if_skip ; static void getline(void) { int i; int c; do { lineno++; glineno++; chptr=linebuf; i=0; while ((*chptr++ = c = getc(filep->fcb)) != '\n') { if (++i > LBUFSIZE-2) error(LNERR); if (c==EOF) { error(EOFERR); --chptr; } } *chptr = '\0'; if (lsrc && !asmf && !macro_if_skip) gen_comment(linebuf); if (*(chptr = linebuf) == '#' && !in_comment) { macro_processing(); } } while(macro_if_skip || linebuf[0] == '#'); } static void macro_processing() { int i; int c; int mode_save; ++chptr; if (macroeq("ifdef") || macroeq("ifndef")) { c = (chptr[-4]=='n'); macro_if_current++; if (!macro_if_skip) { mode_save = mode; mode = IFDEF; ch= *chptr; i = getsym(); mode = mode_save; macro_if_depth = macro_if_current; macro_if_skip = (!i)^c; } return; } else if (macroeq("if")) { macro_if_current++; if (!macro_if_skip) { for(c=0;chptr[c];c++); chptr[c] = ';'; /* this can't happen in macro expression */ ch= *chptr; getsym(); i=cexpr(expr(1)); macro_if_depth = macro_if_current; macro_if_skip = !i; } return; } else if (macroeq("else")) { if (macro_if_current==0) { error(MCERR); /* extra #else */ return; } if (macro_if_current == macro_if_depth) macro_if_skip = !macro_if_skip; return; } else if (macroeq("endif")) { if (macro_if_current == macro_if_depth) { macro_if_skip = 0; macro_if_depth = --macro_if_current; } else { if (macro_if_current<=0) { error(MCERR); /* extra #if */ return; } macro_if_current--; } return; } if (macro_if_skip) return; if (macroeq("define")) { macro_define0(); *(chptr = linebuf) = '\0'; } else if (macroeq("undef")) { i=mode; mode=LDECL; ch= *chptr; if (getsym() == IDENT) { if (nptr->sc == MACRO) { nptr->sc = EMPTY; } else if (nptr->sc == FMACRO) { nptr->sc = EMPTY; /* we cannot reclaim it's arg */ } else error(MCERR); } mode=i; } else if (macroeq("include")) { if(filep+1 >= filestack + FILES) error(FILERR); if ( ((filep+1)->fcb=getfname()) == NULL) error(FILERR); (filep+1)->ln=lineno; lineno=0; ++filep; *(chptr = linebuf) = '\0'; } else if (macroeq("asm")) { if (asmf) error(MCERR); asmf = 1; getline(); while (asmf) { gen_source(linebuf); getline(); } } else if (macroeq("endasm")) { if (!asmf) error(MCERR); asmf = 0; } else if (macroeq(" ")) getline(); else error(MCERR); } static int macroeq(char *s) { char *p; for (p = chptr; *s;) if (*s++ != *p++) return 0; chptr = p; return 1; } void extern_define(char *s,int d,int type,int use) { NMTBL *nptr0; int i; hash=0; name=namebuf; i=0; while((name[i++] = *s)) { hash=(((7*hash)&0xfffffff) ^ (*s)); s++; } if (cheapp+i >= cheap+CHEAPSIZE) error(STRERR); name[i++] = 0; (nptr0 = gsearch())->sc = EXTRN; nptr0->dsp = d; nptr0->ty=type; if (use) extrn_use(nptr0); } static void macro_define(char *macro) { char *chptr_save; int chsave; chptr_save = chptr; chsave = ch; chptr = macro; ch= *chptr++; macro_define0(); chptr = chptr_save; ch = chsave; } static void macro_define0() { int i,args,c; i=mode; mode=MDECL; ch= *chptr; getsym(); /* fprintf(stderr,"macro def: %s =>",name); */ if (nptr->sc != EMPTY) { /* override exisiting macro */ } args = 0; if (ch=='(') { nptr->sc = FMACRO; args = macro_args(&cheapp,cheap+CHEAPSIZE,&chptr); } else { nptr->sc = MACRO; nptr->ty = -1; } nptr->dsp = list2((int)cheapp,args); /* macro body */ while ((*cheapp++ = c = *chptr++) && c != '\n') { if (c=='\\' && chptr[1]=='\n') { cheapp--; getline(); } } *cheapp++ = '\0'; if (cheapp >= cheap+CHEAPSIZE) /* too late? */ error(STRERR); /* fprintf(stderr,"%s\n",(char *)car(nptr->dsp)); */ mode=i; } static int macro_args(char **pcheapp,char *maxcheap,char **pchptr) { int c; int in_quote = 0; int in_wquote = 0; int plevel = 0; char *cheapp = *pcheapp; char *chptr = *pchptr; int args = list2((int)cheapp,0); for(;;) { *cheapp++ = c = *chptr++; if (cheapp >= maxcheap) error(MCERR); if (!c) { chptr--; error(MCERR); *pchptr = chptr; *pcheapp = cheapp; return reverse0(args); } if (in_quote) { if (c=='\\') { if (*chptr != '\n') { *cheapp++ = *chptr++; } else { getline(); } } else if (c=='\'') { in_quote = 0; } } else if (in_wquote) { if (c=='\\') { if (*chptr !='\n') { *cheapp++ = *chptr++; } else { *cheapp = '\n'; getline(); } } else if (c=='"') { in_wquote = 0; } } else if (c=='"') { in_wquote = 1; } else if (c=='\'') { in_quote = 1; } if (plevel==0) { if (c==',') { cheapp[-1] = 0; args = list2((int)cheapp,args); } else if (c==')') { cheapp[-1] = 0; break; } else if (c=='(') { plevel++; } else if (c=='\\') { if (*chptr=='\n') { cheapp--; getline(); } } else if (c==' '||c=='\t') { cheapp--; } else if (c=='\n') { cheapp--; getline(); chptr = *pchptr; } } else if (c==')') { plevel--; } else if (c=='(') { plevel++; } else if (c=='\n') { cheapp--; getline(); chptr = *pchptr; } } ch = *chptr; if (ch) chptr++; *pchptr = chptr; *pcheapp = cheapp; return reverse0(args); } /* output macro expansion result into macrobuf (macropp) */ static int macro_function(int macrop,char **pchptr,NMTBL *nptr,int history) { int args,sargs,values,evalues; char *macro; sargs = args = cadr(nptr->dsp); values = macro_args(¯opp,macro_buf+MACROSIZE,pchptr); evalues = 0; while(values) { evalues = list2(macro_eval(0,(char *)car(values),history),evalues); values = cadr(values); } evalues = reverse0(evalues); while(args) { local_define((char *)car(args),mappend(reverse0(car(evalues)))); /* fprintf(stderr,"%s: %s => %s\n",nptr->nm,(char *)car(args),(char *)car(msearch0((char *)car(args))->dsp)); */ args = cadr(args); evalues = cadr(evalues); } macro = (char *)car(nptr->dsp); macrop = macro_eval(macrop,macro,list2((int)macro,history)); /* fprintf(stderr,"%s: result %s => %s\n",nptr->nm,macro,(char *)car(macrop)); */ args = sargs; while(args) { local_undef((char *)car(args)); args = cadr(args); } return macrop; } static void local_define(char *macro,char *value) { NMTBL *nptr0; nptr0 = msearch0(macro); nptr0->ty=list3(nptr0->sc,nptr0->ty,nptr0->dsp); nptr0->sc=MACRO; nptr0->dsp=list2((int)value,0); } static void local_undef(char *macro) { NMTBL *nptr0; int save; nptr0 = msearch0(macro); save = nptr0->ty; nptr0->sc=car(save); nptr0->dsp=caddr(save); nptr0->ty=cadr(save); } static int macro_eval(int macrop,char *body0,int history) { int c; int in_quote = 0; int in_wquote = 0; char *macro; char *body = body0; int i; NMTBL *nptrm; c = 1; macrop = list2((int)macropp,macrop); while(c && (*macropp++ = c = *body++)) { if (macropp>macro_buf+MACROSIZE) error(STRERR); if (in_quote) { if (c=='\\') { *macropp++ = c = *body++; } else if (c=='\'') { in_quote = 0; } } else if (in_wquote) { if (c=='\\') { *macropp++ = c = *body++; } else if (c=='"') { in_wquote = 0; } } else if (c=='"') { in_wquote = 1; } else if (c=='\'') { in_quote = 1; } else if (alpha(c)) { macropp--; for(i=0;alpha(c)||digit(c);i++) { namebuf[i] = c; c=*body++;} namebuf[i]=0; nptrm = msearch0(namebuf); macro = (char *)car(nptrm->dsp); if (nptrm->sc==MACRO) { while((*macropp++ = *macro++)); macropp[-1]=c; } else if (nptrm->sc==FMACRO) { if(c!='(') error(MCERR); *macropp++=0; macrop = macro_function(macrop,&body,nptrm, list2((int)macro,history)); if (ch) { *macropp++=ch; *macropp++=0; macrop = list2((int)macropp-2,macrop); } } else { macro = namebuf; while((*macropp++ = *macro++)); macropp[-1]=c; } } } *macropp++=0; return macrop; } int dlist2(int e1, double d1) { int e; e=getfree((size_of_int+size_of_double)/size_of_int); heap[e]=e1; dcadr(e)=d1; return e; } int dlist3(int e1, int e2,double d1) { int e; e=getfree((size_of_int*2+size_of_double)/size_of_int); heap[e]=e1; heap[e+1]=e2; dcaddr(e)=d1; return e; } int list2(int e1, int e2) { int e; e=getfree(2); heap[e]=e1; heap[e+1]=e2; return e; } int list3(int e1, int e2, int e3) { int e; e=getfree(3); heap[e]=e1; heap[e+1]=e2; heap[e+2]=e3; return e; } int list4(int e1, int e2, int e3, int e4) { int e; e=getfree(4); heap[e]=e1; heap[e+1]=e2; heap[e+2]=e3; heap[e+3]=e4; return e; } static int getfree(int n) { int e; switch (mode) { case GDECL: case GSDECL: case GUDECL: case GTDECL: case MDECL: case ADECL: case LSDECL: case LUDECL: e=gfree; gfree+=n; break; default: lfree-=n; e=lfree; } if(lfree<gfree) error(HPERR); return e; } static int free_glist2_list = 0; static int free_glist3_list = 0; int glist2(int e1,int e2) { int smode,ret; if (free_glist2_list) { ret = free_glist2_list; free_glist2_list = cadr(free_glist2_list); car(ret)=e1; cadr(ret)=e2; return ret; } smode = mode; mode = GDECL; ret = list2(e1,e2); mode = smode; return ret; } void free_glist2(int e1) { if (e1==gfree) { gfree-=2; } else { cadr(e1) = free_glist2_list; free_glist2_list = e1; } } int glist3(int e1,int e2,int e3) { int smode,ret; if (free_glist3_list) { ret = free_glist3_list; free_glist3_list = cadr(free_glist3_list); car(ret)=e1; cadr(ret)=e2; caddr(ret)=e3; return ret; } smode = mode; mode = GDECL; ret = list3(e1,e2,e3); mode = smode; return ret; } void free_glist3(int e1) { if (e1==gfree) { gfree-=3; } else { cadr(e1) = free_glist3_list; free_glist3_list = e1; } } int rplacad(int e, int n) { heap[e+1]=n; return e; } int rplacadd(int e, int n) { heap[e+2]=n; return e; } int append4(int p,int a1,int a2,int a3) { int p1; if(!p) return list4(a1,0,a2,a3); p1=p; while(cadr(p)) p = cadr(p); rplacad(p,list4(a1,0,a2,a3)); return p1; } int append3(int p,int a1,int a2) { int p1; if(!p) return list3(a1,0,a2); p1=p; while(cadr(p)) p = cadr(p); rplacad(p,list3(a1,0,a2)); return p1; } static char * mappend(int lists) { char *p; char *result = macropp; while(lists) { if (macropp>macro_buf+MACROSIZE) error(STRERR); p = (char *)car(lists); while((*macropp++=*p++)) if (p[-1]=='\n') macropp[-1]=' '; macropp--; lists = cadr(lists); } macropp++; return result; } void display_ntable(NMTBL *n, char *s) { fprintf(stderr,"\n%s %0x %0x ",s,(int)n,(int)ntable); fprintf(stderr,"nptr->sc %d ",n->sc); fprintf(stderr,"nptr->dsp %d ",n->dsp); fprintf(stderr,"nptr->ty %d ",n->ty); fprintf(stderr,"nptr->nm %s\n",n->nm); } int c0(int d) { fprintf(stderr,"heap[%d]=",d);return car(d); } int c1(int d) { fprintf(stderr,"heap[%d]=",d);return cadr(d); } int c2(int d) { fprintf(stderr,"heap[%d]=",d);return caddr(d); } int c3(int d) { fprintf(stderr,"heap[%d]=",d);return cadddr(d); } char *cc0(int d) { fprintf(stderr,"heap[%d]=",d);return (char *)car(d); } char *cc1(int d) { fprintf(stderr,"heap[%d]=",d);return (char *)cadr(d); } char *cc2(int d) { fprintf(stderr,"heap[%d]=",d);return (char *)caddr(d); } char *cc3(int d) { fprintf(stderr,"heap[%d]=",d);return (char *)cadddr(d); } /* end */