Mercurial > hg > CbC > old > device
view mc-parse.c @ 291:7b6df595b205
ia32 code_bool.
| author | kono |
|---|---|
| date | Fri, 04 Jun 2004 03:32:19 +0900 |
| parents | a0779a414855 |
| children | 6d4231b6f9fe |
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,int sc); static NMTBL *gsearch(int sc); 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(int); 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 edecl(); 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_define0(); static int macro_processing(); static void check_macro_eof(); 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 arg_reorder(int old_arg,int new_arg); static int struct_return = 0; static int sdecl_f = 1; static int stypedecl; static int fields; static int in_macro_if = 0; static Converter *conv = &null_converter; /* Converter *conv = &c_converter; */ static char *ccout = 0; #define MAX_INCLUDE_PATH_COUNT 10 static char *include_path[MAX_INCLUDE_PATH_COUNT]; int include_path_count; extern char *l_include_path[]; static char current_file_dir[LBUFSIZE]; int main(int argc, char **argv) { NMTBL *nptr; int i; if(argc==1) exit(1); lsrc = chk = asmf = 0; ac=argc; av=argv; current_file_dir[0] = 0; include_path[include_path_count++] = current_file_dir; 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 'D': break; case 'C': if (av[ac2+1]) set_converter(av[ac2]+2); chk = 1; ccout=0; break; case 'I': include_path[include_path_count++] = av[ac2]+2; if (include_path_count<MAX_INCLUDE_PATH_COUNT) 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; while (chptrsave!=0) { i = cadr(chptrsave); free_glist2(chptrsave); chptrsave = i; } while (chsave!=0) { i = cadr(chsave); free_glist2(chsave); chsave = i; } while(getsym(0)==SM) conv->sm_(); mode=GDECL; stmode=0; args=0; decl(); } /*NOTREACHED*/ } static void copy_current_file_dir(char *name); void error(int n) { if(n == EOFERR) { if(filep!=filestack) { fclose(filep->fcb); lineno=filep->ln; --filep; copy_current_file_dir(filep->name0); 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(0); } static void reinit(void) { int i; NMTBL *nptr; 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("signed",SIGNED); 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); reserve("inline",INLINE); reserve("enum",ENUM); reserve("volatile",VOLATILE); gpc=glineno=0; gfree=ilabel=1; labelno=2; lfree=HEAPSIZE; codegen_init(); macro_define("__micro_c__ 1\n"); macro_define("__restrict\n"); macro_define("__micro_c__ 1\n"); #ifdef __APPLE__ macro_define("__APPLE__ 1\n"); #endif #ifdef bsd macro_define("bsd 1\n"); #endif for(i=0;av[i]&&av[i][0]=='-'&&av[i][1]=='D';i++) { macro_define(av[i]+2); } } static void init(void) { reinit(); filep=filestack; newfile(); getline(); getch(); } static void copy_current_file_dir(char *name) { char *s = name; char *d = current_file_dir; char *p; for(p = d;d<current_file_dir+LBUFSIZE && *s; ) { if (*s=='/') p = d+1; *d++ = *s++; } *p = 0; } static int first_newfile = 1; static void newfile(void) { char *s; int flag = 0; if (!first_newfile) { closing(); reinit(); } else first_newfile = 0; lineno=0; if (chk) fprintf(stderr,"%s:\n",av[ac2]); if ( (filep->fcb = fopen(av[ac2++],"r")) == NULL ) error(FILERR); s = av[ac2-1]; copy_current_file_dir(s); filep->name0 = cheapp; filep->inc = 0; 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'; flag =1; } } if (flag) { if ( (freopen(ccout,"w",stdout)) == NULL ) error(FILERR); } else { if ( (freopen("mcout.s","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(0))->sc = RESERVE; if (d==0) { nptr->sc = MACRO; nptr->dsp = (int)""; nptr->ty=0; } else { nptr->dsp = d; } } static void storage_class() { if(sym==VOLATILE) { getsym(0); } if(sym==STATIC) { if(mode==LDECL) { getsym(0); conv->static_(); mode=STADECL; stmode=LDECL; } else if(mode==GDECL) { getsym(0); conv->static_(); stmode=STATIC; } else error(DCERR); } else if(sym==REGISTER) { if(mode!=LDECL) error(DCERR); stmode=REGISTER; getsym(0); conv->register_(); } else if(sym==EXTRN) { if(mode==LDECL) { getsym(0); conv->static_(); mode=GDECL; stmode=EXTRN; } else if(mode==GDECL) { getsym(0); conv->extern_(); stmode=EXTRN; } else error(DCERR); } else if(sym==TYPEDEF) { if(mode==GDECL) { getsym(0); conv->typedef_(); mode=GTDECL; } else if(mode==LDECL) { getsym(0); conv->typedef_(); mode=LTDECL; } else error(DCERR); } } static void decl(void) { NMTBL *n; int t,sd; if (mode==GDECL) { typedefed=0; } storage_class(); 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(DCERR); } conv->return_type_(type,n,sd); def(n); while(sym==COMMA) { conv->comma_(); getsym(0); type=t; n=decl0(); reverse(t); if(n == &null_nptr) 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(0); } if (sym==INLINE) { getsym(0); } switch(sym) { case VOID: case INT: case CHAR: case CODE: case FLOAT: case DOUBLE: t= sym; getsym(0); break; case ENUM: t = edecl(); break; case STRUCT: case UNION: t=sdecl(sym); break; case SIGNED: t = INT; if(getsym(0)==INT) getsym(0); else if (sym==CHAR) { getsym(0); t = CHAR; } else if (sym==SHORT) { t = SHORT; if(getsym(0)==INT) getsym(0); } else if (sym==LONG) { getsym(0); t = INT; if(sym==LONG) { if(getsym(0)==INT) getsym(0); t=LONGLONG; } else if(sym==INT) { getsym(0); t=INT; } } break; case UNSIGNED: t = UNSIGNED; if(getsym(0)==INT) getsym(0); else if (sym==CHAR) { getsym(0); t = UCHAR; } else if (sym==SHORT) { t = USHORT; if(getsym(0)==INT) getsym(0); } else if (sym==LONG) { getsym(0); t = UNSIGNED; if(sym==LONG) { if(getsym(0)==INT) getsym(0); t=ULONGLONG; } else if(sym==INT) { getsym(0); t=UNSIGNED; } } break; case SHORT: t=SHORT; if(getsym(0)==INT) getsym(0); break; case LONG: t=INT; getsym(0); if(sym==LONG) { getsym(0); t=LONGLONG; if (sym==INT) getsym(0); else if (sym==UNSIGNED) { t=ULONGLONG; getsym(0); break; } } else if(sym==DOUBLE) { getsym(0); t=DOUBLE; } else if(sym==INT) { getsym(0); } else if(sym==UNSIGNED) { t=UNSIGNED; getsym(0); } break; default: if(sym==IDENT) { if(nptr->sc==TYPE) { t=nptr->ty; typedefed=glist2((int)nptr,typedefed); getsym(0); break; } else if(nptr->sc==EMPTY && gnptr->sc==TYPE) { getsym(0); break; } } while (sym==KONST) { getsym(0); } if(mode==LDECL) return 0; t= INT; } while (sym==KONST) { getsym(0); } return t; } static struct nametable * decl0(void) { NMTBL *n; if(sym==MUL) { getsym(0); while (sym==KONST) { getsym(0); } n=decl0(); type=list2(POINTER,type); return n; } return decl1(); } static NMTBL * decl1(void) { NMTBL *n; int i,array_type,arg; if(sym==LPAR) { getsym(0); n=decl0(); checksym(RPAR); } else if (sym == IDENT) { n=nptr; getsym(0); } else { /* error(DCERR); */ n= &null_nptr; } while(1) { if(sym==LBRA) { /* array */ if(getsym(0)==RBRA) { getsym(0); if(mode==ADECL) { type=list2(POINTER,type); } else if (mode==GDECL || stmode==EXTRN) { type=list3(ARRAY,type,0); } else { error(DCERR); } } else { array_type=type; i=cexpr(expr(1)); checksym(RBRA); type=list3(ARRAY,array_type,i); } } else if(sym==LPAR) { /* function or code segment */ if(mode==GDECL) { mode=ADECL;getsym(0);mode=GDECL; /* ??? */ } else getsym(0); n->dsp=0; if(stmode==EXTRN) n->sc=EXTRN; else if(stmode==STATIC) n->sc=STATIC; if (type==CODE) { n->ty=CODE; if(sym==RPAR) { getsym(0);arg=0; } else { arg=adecl(n); } type=glist3(CODE,CODE,arg); } else { if(sym==RPAR) { getsym(0);arg=0; } else { arg=adecl(n); } type=glist3(FUNCTION,type,arg); } /* Do not set n->ty here. It could be K&R style arguments or struct field names */ /* in GDECL n->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=arg; } else return n; } /* NOT REACHED */ } static int adecl(NMTBL *n) { NMTBL *arg,*sfnptr; int sreg_var,t; int stype,smode,sd,sargs,sstmode; int argtypes; sstmode=stmode; stmode=REGISTER; 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(0); if(sym==RPAR) break; } else { if(sym==DOTS) { argtypes=list2(DOTS,argtypes); getsym(0); 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(0); } argtypes=reverse0(argtypes); n->dsp=reverse0(n->dsp); checksym(RPAR); mode=smode; reg_var=sreg_var; fnptr=sfnptr; type=stype; sdecl_f = sd; stmode=sstmode; return argtypes; } /* reverse modifies type also */ static void reverse(int t1) { int t2,t3; t2=t1; while(type!=t1) { t3=cadr(type); cadr(type) = t2; t2=type; type=t3; } type = t2; } int reverse0(int t1) { int t2,t3; t2=0; while(t1) { t3=cadr(t1); cadr(t1) = t2; t2=t1; t1=t3; } return t2; } int size(int t) { if (t<0) { if(t==CHAR) return 1; if(t==UCHAR) return 1; if(t==VOID) return 0; if(t==SHORT) return size_of_short; if(t==USHORT) return size_of_short; if(t==REGISTER) return size_of_int; if(t==DREGISTER) return size_of_double; if(t==FREGISTER) return size_of_float; if(t==LREGISTER) return size_of_longlong; 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(t==ULONGLONG) return size_of_longlong; if(t==ENUM) return size_of_int; error(DCERR); } /* type represented in a list */ 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 if(car(t)==POINTER) return size_of_int; else error(DCERR); return 0; } int new_lvar0(int sz) { return disp -= sz; } /* temporal local variable free list */ 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 (stmode==EXTRN||mode==GDECL) n->ty = type; /* must be in global table/heap */ if(type>0&&(car(type)==FUNCTION || car(type)==CODE)) { if ((mode==GDECL)) { fcheck(n); return n; /* function and code segement are defined using fdecl/code_decl */ /* in decl() */ } } if (mode==GSDECL||mode==LSDECL|| mode==GUDECL||mode==LUDECL) { /* Struct fileds name lists are in the struct type or tag. */ /* Only name in the table is used. */ fields = list4(type,fields,(int)(n->nm),disp); sz = size(type); } else { if (n->sc!=EMPTY && !(n->sc==EXTRN||n->sc==EXTRN1||n->sc==STATIC)) { /* redefined case */ if (mode==ADECL) { /* K&R arguments case */ if (n->sc==LVAR && n->ty==INT); else if ( n->sc==REGISTER && n->ty==INT); else error(DCERR); } else error(DCERR); } sz = size(n->ty = type); } switch(mode) { case GDECL: gen_gdecl(n->nm,gpc); case STADECL: nsc = GVAR; ndsp = gpc; if (n->dsp!=-1) /* don't set dsp if initialzed static */ 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) { if (n->dsp==-1) error(-1); // already initialized 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: case LSDECL: disp += sz; return n; case GUDECL: case LUDECL: if (disp < sz) disp = sz; return n; case GTDECL: nsc = TYPE; gtypedefed=glist2((int)gnptr,gtypedefed); break; case LTDECL: nsc = TYPE; 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||type==UCHAR) { if (n->dsp==0) { n->dsp = args; if (endian) n->dsp += size_of_int-1; } args += size_of_int; } else if(type==SHORT||type==USHORT) { if (n->dsp==0) { n->dsp = args; if (endian) n->dsp += size_of_int-size_of_short; } args += size_of_int; } else if(type>0&&(type==UNION||type==STRUCT)) { n->dsp = args; args += ((sz+(size_of_int-1))&~(size_of_int-1)); } 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: /* return (struct hoge)f() case? */ case LDECL: if (stmode==REGISTER) { if(scalar(type)) { ndsp = get_register_var(n); #if FLOAT_CODE } else if (type==FLOAT) { ndsp = get_dregister_var(n,0); } else if (type==DOUBLE) { ndsp = get_dregister_var(n,1); #endif #if LONGLONG_CODE } else if (type==LONGLONG||type==ULONGLONG) { ndsp = get_lregister_var(n); #endif } 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; 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==STADECL) { 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(0); if (sym==RC) { /* premature end */ conv->decl_data_end_(); mode = mode_save; return offset; } 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||t==LONGLONG||t==ULONGLONG) { 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 */ caddr(t)=i+1; /* define array size */ } else if (0 && caddr(t)!=i+1) { /* size match? */ error(TYERR); } getsym(0); 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 */ caddr(t)=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==COMMA) getsym(0); /* extra comma */ if (sym==RC) break; // premature end } conv->decl_data_end_(); conv->rc_(); getsym(0); return offset; } else if (sym==RC) { /* empty case */ conv->lc_(); return offset; } else error(DCERR); } else { mode = mode_save; error(TYERR); /* should be initialization error */ } return offset; /* not reached */ } static void sdecl_field() { while (getsym(0) != RC) { decl(); } if (sdecl_f) conv->rc_(); getsym(0); fields = reverse0(fields); } #if 0 static void print_fields(int fields,char *s) { for(;fields;fields=cadr(fields)) { fprintf(stderr,"%s %s %d %d\n",s,(char*)caddr(fields),car(fields),cadddr(fields)); } fprintf(stderr,"\n"); } #endif /* struct/union tag ... struct/union name nptr0->sc = TAG; nptr0->ty = list4(...) type ... list4(STRUCT,disp,fields,(int)nptr0); filed ... assoc list defined in def(); */ static int sdecl(int s) { int smode,sdisp,type0=0; NMTBL *nptr0,*gnptr0; int sfields = fields; fields = 0; 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(TAG) == IDENT) { nptr0 = nptr; gnptr0 = gnptr; if (sdecl_f) conv->id_(sym,nptr); if (getsym(0) == LC) { if (sdecl_f) conv->lc_(); if(nptr0->sc == EMPTY) nptr0=gnptr0; if (nptr0->sc!=TAG && nptr0->sc != EMPTY) error(DCERR); nptr0->sc = TAG; nptr0->ty = list4(s,-1,0,(int)nptr0); sdecl_field(); caddr(nptr0->ty)=fields; cadr((type0 = nptr0->ty))=disp; /* type0 = list4(s,disp,fields,0); now ... */ } else { /* struct tag name */ if(nptr0->sc == EMPTY) nptr0=gnptr0; if(nptr0->sc == EMPTY) nptr0->sc = TAG; if(nptr0->sc != TAG) error(TYERR); fields = caddr(nptr0->ty); disp = cadr(nptr0->ty); conv->comment_(' '); type0 = list4(s,disp,fields,(int)nptr0); } } else if(sym==LC) { if (sdecl_f) conv->lc_(); sdecl_field(); type0 = list4(s,disp,fields,0); } else error(DCERR); stypedecl=1; disp=sdisp; mode=smode; fields = sfields; return type0; } /* enum */ static int edecl() { int smode=mode; int sdisp=disp; NMTBL *nptr0; if (mode==GDECL || mode==GTDECL) mode=GEDECL; else mode=LEDECL; if (getsym(0) == IDENT) { nptr->sc = TAG; getsym(0); } if(sym==LC) { while (getsym(0) == IDENT) { nptr->sc = ENUM; nptr->ty = INT; nptr0 = nptr; if (getsym(0) == ASS) { getsym(0); disp = cexpr(expr1()); } nptr0->dsp = disp; if (sym!=COMMA) break; disp++; } checksym(RC); } type = ENUM; disp=sdisp; mode=smode; return type; } /* code sgement simpler than fdecl, because it does not have return value. */ static void code_decl(NMTBL *n) { int t,arglist; if(!chk) code_enter(n->nm); fnptr=n; n->sc = CODE; n->ty = type; fcheck(n); disp = -args; mode=ADECL; if (sym!=LC) { reg_var=0; arglist=fnptr->dsp; args=fnptr->dsp=0; while (sym!=LC) { /* argument declaration !ANSI */ decl(); getsym(0); } disp = -args; fnptr->dsp = arg_reorder(arglist,fnptr->dsp); // fnptr->dsp = reverse0(fnptr->dsp); } /* 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(0)) || 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(fnptr->nm); args = 0; } static NMTBL *tmp_struct; /* local decl can be used, after {} */ /* but it's lexical scope remains after {} */ /* my be in for(int i=....) not yet */ static void local_decl() { init_vars=0; /* local variable declaration */ stmode=0; mode=STAT; while (typeid(getsym(0)) || sym==STATIC || sym==EXTRN || sym==REGISTER || sym==TYPEDEF) { mode=LDECL; stmode=0; decl(); mode=STAT; } conv->localvar_end_(); } /* function define */ static int arg_reorder(int arg,int new_arg) { /* list4(type,fnptr->dsp,(int)n,size); */ int i,j,sz; int dsp = 0; NMTBL *n,*n1; /* f(a,b,c) { int c; short a; char* b;} case */ // fprintf(stderr,"arg_reorder old:\n"); // for(j=new_arg;j;j=cadr(j)) { // n=(NMTBL *)caddr(j); // fprintf(stderr,"dsp %d %s sz %d type %d\n",n->dsp,n->nm,cadddr(j),car(j)); // } // fprintf(stderr,"arg_reorder new:\n"); for(j=arg;j;j=cadr(j)) { n=(NMTBL *)caddr(j); for(i=new_arg;i;i=cadr(i)) { n1=(NMTBL *)caddr(i); if (!neqname(n1->nm,n->nm)) break; // if (n1==n) break; } // fprintf(stderr,"dsp %d %s %s sz %d type %d\n",dsp,n->nm,n1->nm,cadddr(i),car(i)); if (!i) { /* f(a,b,c) { int c; } case (what?!) */ i = j; } if(n->sc==LVAR) { n->dsp = dsp; car(j)=car(i); caddr(j)=caddr(i); cadddr(j)=sz= cadddr(i); if (sz==1||sz==size_of_short) sz = size_of_int; dsp += sz; } } // fprintf(stderr,"arg_reorder end:\n"); return arg; } static void fdecl(NMTBL *n) { int sd = stypedecl; int arglist; if(!chk) enter(n->nm); fnptr=n; retlabel=fwdlabel(); retcont = 0; tmp_struct = 0; /* a = f().filed */ reg_var=0; n->ty = type; fcheck(n); n->sc = FUNCTION; mode=ADECL; if (sym!=LC) { arglist = fnptr->dsp; fnptr->dsp =args=0; while (sym!=LC) { /* argument declaration !ANSI */ stmode=0; decl(); getsym(0); } // This order can be different from proto type. Proto type is correct. // Recalculate offset using prototype list. // arglist is set by adecl() and is reversed. fnptr->dsp = arg_reorder(arglist,fnptr->dsp); } fnptr->dsp=reverse0(fnptr->dsp); fdecl_struct(fnptr->ty); /* insert extra argument for struct passing */ disp=0; arg_register(fnptr); typedefed=0; conv->function_(fnptr,sd); conv->lc_(); init_vars=0; /* local variable declaration */ local_decl(); 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 an 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); caddr(fnptr->ty) = glist2(POINTER,caddr(fnptr->ty)); } 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 (n->sc==EMPTY) { n->sc=EXTRN; n->ty=type; } else if(is_code(n)) compatible(cadr(n->ty),cadr(type)); else if(is_function(n)) compatible(cadr(n->ty),cadr(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==SIGNED||t==CHAR||t==UNSIGNED|| t==UCHAR||t==SHORT||t==USHORT||t==ENUM); } static void checkret(void) { if (retpending) { ret(); control=0; retpending=0; } } static void statement(void) { int slfree; if(sym==SM) { conv->sm_(); getsym(0); 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(0); checksym(SM); return; case CONTINUE: conv->continue_(); jmp(clabel); getsym(0); 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(0); 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(0); 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(0); checksym(LPAR); slfree=lfree; e=expr(0); checksym(RPAR); conv->while_body_(); if(sym==SM) { bexpr(e,1,clabel); lfree=slfree; conv->sm_(); getsym(0); } 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(0); 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(0); checksym(LPAR); slfree=lfree; if(sym!=SM) { gexpr(expr(0),0); checksym(SM); conv->for1_(); } else { conv->for1_(); getsym(0); } lfree=slfree; l=backdef(); if(sym!=SM) { bexpr(expr(0),0,blabel); checksym(SM); conv->for2_(); } else { conv->for2_(); getsym(0); } lfree=slfree; if(sym==RPAR) { clabel=l; conv->for_body_(); getsym(0); 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(0); 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_(); local_decl(); emit_init_vars(); while(sym!=RC) { statement(); checkret();} conv->rc_(); getsym(0); } static void docase(void) { int c,l,slfree; c=0; slfree=lfree; while(sym==CASE) { conv->case_begin_(c,0); getsym(0); 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,l,0); c=cadr(c); } lfree=slfree; cmpdimm(car(c),csvalue1,cslabel=fwdlabel(),1); fwddef(l); } static void dodefault(void) { getsym(0); 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(0)==SM) { conv->return_(); conv->return_end_(); getsym(0); 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(STASS,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 */ cadr(e) = left; } static void dogoto(void) { NMTBL *nptr0; int t,e1,e2,env; conv->goto_(); getsym(0); e1 = expr(0); t=car(e1); if (t==FNAME) { nptr0 = (NMTBL *)cadr(e1); t = nptr0->sc; if (t==EMPTY||t==EXTRN1||t==EXTRN) { 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 && nptr->sc != EXTRN1) error(TYERR); nptr->sc = BLABEL; nptr->dsp = backdef(); conv->label_(); getsym(0); checksym(COLON); } /* numerical type conversion */ int double_value(int e2,int type) { #if FLOAT_CODE if (car(e2)==CONST) return dlist2(DCONST,(double)cadr(e2)); if (car(e2)==FCONST) return dlist2(DCONST,dcadr(e2)); if(type==DOUBLE) return e2; if(type==FLOAT) return list3(CONV,rvalue_t(e2,type),F2D); if(type==UNSIGNED) return list3(CONV,rvalue_t(e2,type),U2D); if(integral(type)) return list3(CONV,rvalue_t(e2,type),I2D); if(type==LONGLONG) return list3(CONV,rvalue_t(e2,type),LL2D); if(type==ULONGLONG) return list3(CONV,rvalue_t(e2,type),ULL2D); error(TYERR); return dlist2(DCONST,1.0); #else error(TYERR); return list2(CONST,0); #endif } int float_value(int e2,int type) { #if FLOAT_CODE #if LONGLONG_CODE if (car(e2)==LCONST) return dlist2(FCONST,(double)lcadr(e2)); if(type==LONGLONG) return list3(CONV,rvalue_t(e2,type),LL2F); if(type==ULONGLONG) return list3(CONV,rvalue_t(e2,type),ULL2F); #endif if (car(e2)==CONST) return dlist2(FCONST,(double)cadr(e2)); if (car(e2)==DCONST) return dlist2(FCONST,dcadr(e2)); if(type==FLOAT) return e2; if(type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2F); if(type==UNSIGNED) return list3(CONV,rvalue_t(e2,type),U2F); if(integral(type)) return list3(CONV,rvalue_t(e2,type),I2F); error(TYERR); return dlist2(DCONST,1.0); #else error(TYERR); return list2(CONST,0); #endif } int longlong_value(int e2,int type) { #if LONGLONG_CODE if (car(e2)==CONST) return llist2(LCONST,(long long)cadr(e2)); if (car(e2)==LCONST) return e2; #if FLOAT_CODE if (car(e2)==DCONST||car(e2)==FCONST) return llist2(LCONST,(long long)dcadr(e2)); if(type==FLOAT) return list3(CONV,rvalue_t(e2,type),F2LL); if(type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2LL); #endif if(type==UNSIGNED) return list3(CONV,rvalue_t(e2,type),U2LL); if(type==LONGLONG) return e2; if(type==ULONGLONG) return e2; if(integral(type)) return list3(CONV,rvalue_t(e2,type),I2LL); error(TYERR); return llist2(LCONST,0LL); #else error(TYERR); return list2(CONST,0); #endif } int ulonglong_value(int e2,int type) { #if LONGLONG_CODE if (car(e2)==CONST) return llist2(LCONST,(unsigned long long)cadr(e2)); if (car(e2)==LCONST) return e2; #if FLOAT_CODE if (car(e2)==DCONST||car(e2)==FCONST) return llist2(LCONST,(unsigned long long)dcadr(e2)); if(type==FLOAT) return list3(CONV,rvalue_t(e2,type),F2ULL); if(type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2ULL); #endif if(type==UNSIGNED) return list3(CONV,rvalue_t(e2,type),U2ULL); if(type==LONGLONG) return e2; if(type==ULONGLONG) return e2; if(integral(type)) return list3(CONV,rvalue_t(e2,type),I2ULL); error(TYERR); return llist2(LCONST,0LL); #else error(TYERR); return list2(CONST,0); #endif } int int_value(int e2,int type) { if(scalar(type)) return e2; #if FLOAT_CODE if (car(e2)==DCONST||car(e2)==FCONST) return list2(CONST,(int)dcadr(e2)); if(type==FLOAT) return list3(CONV,rvalue_t(e2,type),F2I); if(type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2I); #endif #if LONGLONG_CODE if (car(e2)==LCONST) return list2(CONST,(int)lcadr(e2)); if(type==LONGLONG) return list3(CONV,rvalue_t(e2,type),LL2I); if(type==ULONGLONG) return list3(CONV,rvalue_t(e2,type),ULL2I); #endif if(car(type)==ARRAY) return e2; error(TYERR); return list2(CONST,1); } int unsigned_value(int e2,int type) { if(scalar(type)) return e2; #if FLOAT_CODE // if (car(e2)==DCONST||car(e2)==FCONST) return list2(CONST,(unsigned)dcadr(e2)); if (car(e2)==DCONST||car(e2)==FCONST) return list2(CONST,(int)dcadr(e2)); if(type==FLOAT) return list3(CONV,rvalue_t(e2,type),F2U); if(type==DOUBLE) return list3(CONV,rvalue_t(e2,type),D2U); #endif #if LONGLONG_CODE if(type==LONGLONG) return list3(CONV,rvalue_t(e2,type),LL2U); if(type==ULONGLONG) return list3(CONV,rvalue_t(e2,type),ULL2U); #endif error(TYERR); return e2; } /* assign statement */ /* keep type */ 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; } /* with converion (will destroy type global variable) */ int assign_expr(int e1,int e2,int t,int type) { if(t==VOID) error(TYERR); if(t==CHAR||t==UCHAR) { e2=(t==UCHAR)?unsigned_value(e2,type):int_value(e2,type); if (!integral(type)) error(TYERR); type= INT;return(list3(CASS,e1,e2)); } else if(t==SHORT||t==USHORT) { e2=(t==USHORT)?unsigned_value(e2,type):int_value(e2,type); if (!integral(type)) error(TYERR); type= t;return(list3(SASS,e1,e2)); #if FLOAT_CODE } else if(t==DOUBLE) { e2=double_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)); #endif #if LONGLONG_CODE } else if(t==LONGLONG) { e2=longlong_value(e2,type); type= t;return(list3(LASS,e1,e2)); } else if(t==ULONGLONG) { e2=ulonglong_value(e2,type); type= t;return(list3(LASS,e1,e2)); #endif } 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(STASS,e1,e2,size(t))); } } else { error(TYERR); return list3(ASS,e1,e2); } } /* C expression */ 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(0);e=list3(COMMA,e,rvalue(expr1())); } return e; } static int expr1(void) { int e1,e2,t,op,no_float; e1=expr2(); no_float = 0; switch (sym) { case ASS: conv->op_(sym); lcheck(e1); t=type; getsym(0); e2=rvalue(expr1()); e1 = assign_expr(e1,e2,t,type); type = t; return e1; case RSHIFT+AS: case LSHIFT+AS: case BAND+AS: case EOR+AS: case BOR+AS: case MOD+AS: no_float = 1; case ADD+AS: case SUB+AS: case MUL+AS: case DIV+AS: conv->op_(sym); op = sym-AS; lcheck(e1); t=type; getsym(0); e2=rvalue(expr1()); if(!(integral(type)||type==FLOAT||type==DOUBLE|| type==LONGLONG||type==ULONGLONG )) error(TYERR); #if FLOAT_CODE if (t==FLOAT) { if (no_float) error(TYERR); e2=float_value(e2,type); type=t; return(list4(FASSOP,e1,e2,op+FOP)); } else if (t==DOUBLE) { if (no_float) error(TYERR); e2=double_value(e2,type); type=t; return(list4(DASSOP,e1,e2,op+DOP)); } #endif #if LONGLONG_CODE if (t==LONGLONG) { e2=longlong_value(e2,type); type=t; return(list4(LASSOP,e1,e2,op+LOP)); } else if (t==ULONGLONG) { e2=ulonglong_value(e2,type); type=t; return(list4(LASSOP,e1,e2,op+LOP+((op==MUL+AS||op==DIV+AS)?US:0))); } #endif if(!integral(type)) error(TYERR); if((t==UNSIGNED||type==UNSIGNED)&& (op==MUL||op==DIV||op==MOD)) op=op+US; if(t==UNSIGNED&&(op==RSHIFT||op==LSHIFT)) op=op+US; if(t==CHAR) { type= INT; return(list4(CASSOP,e1,e2,op)); } /* if(t==SHORT) { type= INT; return(list4(SASSOP,e1,e2,op)); } */ type=t; if(integral(t)) return(list4(ASSOP,e1,e2,op)); /* pointer += ... */ 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) { // e1?e2:e3 conv->cond_(); e1=rvalue(e1); getsym(0); conv->cond1_(); e2=rvalue(expr0()); 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 FLOAT_CODE if(type==DOUBLE||t==DOUBLE) { e2=double_value(e2,t); e3=double_value(e3,type); t=type=DOUBLE; return(list4(DCOND,e1,e2,e3)); } if(type==FLOAT||t==FLOAT) { e2=float_value(e2,t); e3=float_value(e3,type); t=type=FLOAT; return(list4(FCOND,e1,e2,e3)); } #endif #if LONGLONG_CODE if(type==LONGLONG||t==LONGLONG) { e2=longlong_value(e2,t); e3=longlong_value(e3,type); t=type=LONGLONG; return(list4(LCOND,e1,e2,e3)); } if(type==ULONGLONG||t==ULONGLONG) { e2=ulonglong_value(e2,t); e3=ulonglong_value(e3,type); t=type=ULONGLONG; return(list4(LCOND,e1,e2,e3)); } #endif 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,e1; e=expr4(); while(sym==LOR) { /* || */ conv->op_(sym); e=rvalue(e); getsym(0); e1=rvalue(expr4()); if(car(e)==CONST) e = cadr(e )?e:e1; else if(car(e1)==CONST) e = cadr(e1)?e1:e; else e=list3(LOR,e,e1); type = INT; } return(e); } static int expr4(void) { int e,e1; e=expr5(); while(sym==LAND) { /* && */ conv->op_(sym); e=rvalue(e); getsym(0); e1=rvalue(expr5()); if(car(e)==CONST) e = cadr(e )?e1:e; else if(car(e1)==CONST) e = cadr(e1)?e:e1; else e=list3(LAND,e,e1); 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(0); 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(0); 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(0); 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(0); 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(0); e2=rvalue(expr10()); e1=binop(op,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(0); 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(0); 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(0); e2=rvalue(expr13()); e1=binop(op,e1,e2,t,type); } return e1; } /* unary operators */ static int expr13(void) { int e,op,dir; switch (op = sym) { case INC: case DEC: conv->prefix_(sym); getsym(0); lcheck(e=expr13()); dir = op==INC?1:-1; if(type==CHAR) { type= INT; return(list4(PREINC,e,dir,1)); } else if(type==UCHAR) { type= UNSIGNED; return(list4(UPREINC,e,dir,1)); } else if(type==SHORT) { type= INT; return(list4(PREINC,e,dir,size_of_short)); } else if(type==USHORT) { type= UNSIGNED; return(list4(UPREINC,e,dir,size_of_short)); } else if(type==INT) { type= INT; return(list4(PREINC,e,dir,size_of_int)); #if LONGLONG_CODE } else if(type==LONGLONG) { type= LONGLONG; return(list4(LPREINC,e,dir,size_of_longlong)); } else if(type==ULONGLONG) { type= ULONGLONG; return(list4(LUPREINC,e,dir,size_of_longlong)); #endif } if(integral(type)) return(list4(PREINC,e,dir,size_of_int)); #if FLOAT_CODE if(type==FLOAT) return(list3(FPREINC,e,dir)); if(type==DOUBLE) return(list3(DPREINC,e,dir)); #endif if(car(type)!=POINTER) error(TYERR); return(list4(UPREINC,e, op==INC?size(cadr(type)):-size(cadr(type)),size_of_int )); case MUL: /* *p */ conv->prefix_(sym); getsym(0); e=rvalue(expr13()); return(indop(e)); case BAND: /* &p */ conv->prefix_(sym); getsym(0); switch(car(e=expr13())) { case INDIRECT: e=cadr(e); break; case DREGISTER: /* should be error? */ case FREGISTER: case LREGISTER: case REGISTER: case GVAR: case LVAR: e=list2(ADDRESS,e); break; case FNAME: break; default:error(LVERR); } type=list2(POINTER,type); return e; case SUB: /* -p */ conv->prefix_(sym); getsym(0); e=rvalue(expr13()); #if FLOAT_CODE if(type==FLOAT) { return(car(e)==DCONST?dlist2(DCONST,-dcadr(e)):list2(FMINUS,e)); } else if(type==DOUBLE) { return(car(e)==DCONST?dlist2(DCONST,-dcadr(e)):list2(DMINUS,e)); } #endif #if LONGLONG_CODE if(type==LONGLONG||type==ULONGLONG) { // return list2(LMINUS,e); return(car(e)==LCONST?llist2(LCONST,-lcadr(e)):list2(LMINUS,e)); } #endif if(!integral(type)) error(TYERR); return(car(e)==CONST?list2(CONST,-cadr(e)):list2(MINUS,e)); case BNOT: /* ~p */ conv->prefix_(sym); getsym(0); e=rvalue(expr13()); // LONGLONG? if(!integral(type)) error(TYERR); return(car(e)==CONST?list2(CONST,~cadr(e)):list2(BNOT,e)); case LNOT: /* !p */ conv->prefix_(sym); getsym(0); e=rvalue(expr13()); type=INT; #if FLOAT_CODE if (car(e)==DCONST) return list2(CONST,!dcadr(e)); #endif #if LONGLONG_CODE if (car(e)==LCONST) return list2(CONST,!lcadr(e)); #endif if (car(e)==CONST) return list2(CONST,!cadr(e)); if(!scalar(type)) error(TYERR); return list2(LNOT,e); case SIZEOF: conv->prefix_(sym); if(getsym(0)==LPAR) { if(typeid(getsym(0))) { e=list2(CONST,size(typename())); type=INT; checksym(RPAR); return e; } else { e=expr0(); checksym(RPAR); expr16(e); if(sym==INC||sym==DEC) { /* after this operation, type is extended */ getsym(0); if(type==CHAR) type=INT; else if(type==SHORT) type=INT; else if(type==UCHAR) type=UNSIGNED; else if(type==USHORT) type=UNSIGNED; else if(!scalar(type)&&type!=FLOAT&&type!=DOUBLE) error(TYERR); } } } else expr13(); e=list2(CONST,size(type)); type=INT; return e; } e=expr14(); /* postfix unary operators */ if((op=sym)==INC||op==DEC) { conv->postfix_(sym); lcheck(e); getsym(0); dir = op==INC?1:-1; if(type==CHAR) { type= INT; return(list4(POSTINC,e,dir,1)); } else if(type==UCHAR) { type= UNSIGNED; return(list4(UPOSTINC,e,dir,1)); } else if(type==SHORT) { type= INT; return(list4(POSTINC,e,dir,size_of_short)); } else if(type==USHORT) { type= UNSIGNED; return(list4(UPOSTINC,e,dir,size_of_short)); } else if(type==INT) { type= INT; return(list4(POSTINC,e,dir,size_of_int)); } if(integral(type)) return(list4(POSTINC,e,dir,size_of_int)); #if FLOAT_CODE if(type==FLOAT) return(list3(FPOSTINC,e,dir)); if(type==DOUBLE) return(list3(DPOSTINC,e,dir)); #endif #if LONGLONG_CODE if(type==LONGLONG) return(list3(LPOSTINC,e,dir)); if(type==ULONGLONG) return(list3(LUPOSTINC,e,dir)); #endif if(car(type)!=POINTER) error(TYERR); return(list4(UPOSTINC,e, op==INC?size(cadr(type)):-size(cadr(type)),size_of_int )); } return e; } static void extrn_use(NMTBL *nptr) { /* EXTRN1 means that defined extern is used in this source */ if(nptr->sc==EXTRN) nptr->sc=EXTRN1; } static int fname(NMTBL *nptr) { int e1; e1=list2(FNAME,(int)nptr); // type=list3(FUNCTION,type,arg); type=list3(car(nptr->ty),cadr(nptr->ty),caddr(nptr->ty)); getsym(0); extrn_use(nptr); return expr16(e1); } /* term */ static int expr14(void) { int e1=0,t,t1; 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(0); 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(0); break; case LREGISTER: case DREGISTER: case FREGISTER: case REGISTER: e1=list3(nptr->sc,nptr->dsp,(int)nptr); type=nptr->ty; getsym(0); break; case ENUM: e1=list2(CONST,nptr->dsp); type=INT; getsym(0); break; case EMPTY: if(getsym(0)==LPAR) { type= glist3(FUNCTION,INT,0); nptr->sc = EXTRN1; nptr->ty= type; e1=expr15(list2(FNAME,(int)nptr)); break; } else if (in_macro_if) { type = INT; e1= list2(CONST,0); 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(0); break; case CONST: conv-> const_(symval); type= INT; e1=list2(CONST,symval); getsym(0); break; #if FLOAT_CODE case DCONST: conv-> const_(symval); type= DOUBLE; e1=dlist2(DCONST,dsymval); getsym(0); break; #endif #if LONGLONG_CODE case LCONST: conv-> const_(symval); type= LONGLONG; e1=llist2(LCONST,lsymval); getsym(0); break; #endif case RETURN: conv-> return_f_(); if (!is_function(fnptr)) { error(STERR); } type=list2(POINTER,CODE); e1=list2(RETURN,(int)fnptr); getsym(0); break; case DEFINED: t = mode; mode = IFDEF; getsym(0); if (sym==LPAR) { t1 = 1; getsym(0); } else t1 = 0; conv-> defined_(name); mode = t; type= INT; e1=list2(CONST,symval); getsym(0); if (t1) checksym(RPAR); break; case ENVIRONMENT: conv-> environment_(); type=list2(POINTER,VOID); e1=list2(ENVIRONMENT,0); getsym(0); break; case LPAR: conv->lpar_(); if(typeid(getsym(0))) { /* cast */ 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) { e1=float_value(e1,type); } else if(t==DOUBLE) { e1=double_value(e1,type); } else if(t==LONGLONG) { e1=longlong_value(e1,type); } else if(t==ULONGLONG) { e1=ulonglong_value(e1,type); } type=t; return e1; } e1=expr0(); conv->rpar_(); checksym(RPAR); break; default:error(EXERR); } return expr16(e1); } /* post fix binary operator (struct . -> or array[] */ static int expr16(int e1) { int e2,t; while(1) { if(sym==LBRA) { /* a[3] */ conv->lbra_(sym); e1=rvalue(e1); t=type; getsym(0); 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); /* f() */ 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; } /* right value , get the value of the variable */ static int indirect(int t,int e1) { int e2,e3,e4,offset; e2 = e1; offset = 0; e3 = cadr(e2); if (car(e2)==ADD) { e4=caddr(e2); if (car(e4)==CONST) { offset=cadr(e4); e1=e3; } } return list3(t,e1,offset); } static int rvalue(int e) { int op; op = 0; switch(type) { case INT: break; case UNSIGNED: break; case VOID: break; case CHAR: op=COP; type=INT; break; case UCHAR: op=COP+US; type=UNSIGNED; break; case SHORT: op=SOP; type=SIGNED; break; case USHORT: op=SOP+US; type=UNSIGNED; break; case LONGLONG: op=LOP; break; case ULONGLONG: op=LOP+US; break; case FLOAT: op=FOP; break; case DOUBLE: op=DOP; break; case CODE: return e; default: if (integral(type)) break; switch(car(type)) { case ARRAY: type=list2(POINTER,cadr(type)); if(car(e)==INDIRECT) return cadr(e); return list2(ADDRESS,e); case STRUCT: case UNION: if(car(e)==RSTRUCT) return e; /* ??? */ return list3(RSTRUCT,e,cadr(type) /* size */); case FUNCTION: type=cadr(type); return e; case CODE: return e; case POINTER: break; default: error(TYERR); } } switch(car(e)) { case GVAR: return(list2(RGVAR+op,cadr(e))); case LVAR: return(list2(RLVAR+op,cadr(e))); case INDIRECT: return(indirect(RINDIRECT+op,cadr(e))); default:return(e); /* idempotent case? */ } } 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|| type==LONGLONG||type==ULONGLONG)|| (car(e)!=GVAR&&car(e)!=LVAR&&car(e)!=INDIRECT && car(e)!=REGISTER && car(e)!=DREGISTER && car(e)!=FREGISTER && car(e)!=LREGISTER) ) 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)); } /* filed name search */ static int search_struct_type(int t,char *name,int *dsp) { for(;t;t = cadr(t)) { if (neqname((char *)caddr(t),name)==0) { *dsp = cadddr(t); return car(t); } } return 0; } static int strop(int e) { int dsp = 0; getsym(0); if (sym!=IDENT) error(TYERR); conv->id_(sym,nptr); if (integral(type)||(car(type)!=STRUCT && car(type)!=UNION)) e=rvalue(e); /* type = list4(s,disp,fields,tag_nptr); */ /* print_fields(caddr(type),"strop"); */ type = search_struct_type(caddr(type),nptr->nm,&dsp); if (!type) { error(TYERR); return INT; } if(dsp) { switch(car(e)) { case GVAR: e=list2(INDIRECT,list3(ADD,e,list2(CONST,dsp))); break; case LVAR: e=list2(LVAR,cadr(e) + dsp); break; case INDIRECT: e=list2(INDIRECT,list3(ADD,cadr(e),list2(CONST,dsp))); break; default: e=list2(INDIRECT,list3(ADD,e,list2(CONST,dsp))); } } else { switch(car(e)) { case GVAR: case LVAR: case INDIRECT: break; default: e=list2(INDIRECT,e); } } getsym(0); return e; } #if FLOAT_CODE /* binary floating compuation */ #define DTYPE(dop) (dop==DOP?DOUBLE:FLOAT) static int fdbinop(int op, int e1, int e2, int t1, int t2, int dop) { double d1,d2,d; int b=0; type= DTYPE(dop); if (dop==DOP) { e1=double_value(e1,t1); e2=double_value(e2,t2); } else { e1=float_value(e1,t1); e2=float_value(e2,t2); } t1=t2=DTYPE(dop); if(car(e1)==dop+CONST&&car(e2)==dop+CONST) { 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(dop+CONST,d); } if(car(e1)==dop+CONST) { 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(dop+MINUS,e2); } } if(car(e2)==dop+CONST) { 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 ((op==ADD||op==MUL) && ( car(e1)==dop+CONST || car(e2)==DRLVAR || car(e2)==DRGVAR || car(e2)==FRLVAR || car(e2)==FRGVAR )) { return(list3(op+dop,e2,e1)); } if(op==LT) { type=INT; return(list3(GT+dop,e2,e1)); } else if(op==LE) { type=INT; return(list3(GE+dop,e2,e1)); } else if(op==GT||op==GE||op==EQ||op==NEQ) { type=INT; return(list3(op+dop,e1,e2)); } else if(op==ADD||op==SUB||op==MUL||op==DIV) return(list3(op+dop,e1,e2)); else { error(-1); return e1; } } static int dbinop(int op, int e1, int e2, int t1, int t2) { return fdbinop(op, e1, e2, t1, t2,DOP); } static int fbinop(int op, int e1, int e2, int t1, int t2) { return fdbinop(op, e1, e2, t1, t2,FOP); } #endif #if LONGLONG_CODE static int lbinop(int op, int e1, int e2, int t1, int t2) { int e=0; long long le1, le2; long long le = 0; int us = (t1==ULONGLONG&&t2==ULONGLONG); if (us||(t1==ULONGLONG&&(op==LSHIFT||op==RSHIFT))) { e1=ulonglong_value(e1,t1); e2=ulonglong_value(e2,t2); type = ULONGLONG; } else { e1=longlong_value(e1,t1); e2=longlong_value(e2,t2); type = LONGLONG; } if(car(e1)==LCONST&&car(e2)==LCONST) { le1=lcadr(e1); le2=lcadr(e2); switch(op) { case BOR: le=le1|le2;break; case EOR: le=le1^le2;break; case BAND: le=le1&le2;break; case ADD: le=le1+le2;break; case SUB: le=le1-le2;break; case MUL: le=le1*le2;break; case DIV: if(!le2) error(EXERR); if (us) le=(((unsigned long long )le1)/((unsigned long long )le2)); else e=(le1/le2); case MOD: if(!le2) error(EXERR); if (us) le=(((unsigned long long )le1)%((unsigned long long )le2)); else e=(le1%le2); case RSHIFT: if (t1==ULONGLONG) le=(((unsigned long long)le1)<<le2); else le=le1<<le2; break; case LSHIFT: if (t1==ULONGLONG) le=(((unsigned long long)le1)>>le2); else le=le1>>le2; break; default: switch(op) { case EQ: e=(le1==le2);break; case NEQ: e=(le1!=le2);break; case LT: le=le1;le1=le2;le2=le; case GT: if (us) e=((unsigned long long)le1>(unsigned long long)le2); else e=(le1>le2); break; case LE: le=le1;le1=le2;le2=le; case GE: if (us) e=((unsigned long long)le1>=(unsigned long long)le2); else e=(le1>=le2); break; default: error(-1); return list2(CONST,0); } type = INT; return list2(CONST,e); } return llist2(LCONST,le); } if(op==LT) { type = INT; return(list3(GT+LOP+us,e2,e1)); } else if(op==LE) { type = INT; return(list3(GE+LOP+us,e2,e1)); } else if(op==GT||op==GE||op==LT||op==LE) { type = INT; return(list3(op+LOP+us,e1,e2)); } if(op==SUB&&car(e2)==LCONST) { op=ADD; lcadr(e2)=-lcadr(e2); } if((op==ADD||op==MUL||op==BOR||op==EOR||op==BAND)&& (car(e1)!=LCONST) && ( car(e2)==LRGVAR||car(e2)==LRLVAR|| car(e2)==LURGVAR||car(e2)==LURLVAR )) { e=e1;e1=e2;e2=e;e=t1;t1=t2;t2=e; } if((op==MUL||op==DIV)&&car(e2)==LCONST&&lcadr(e2)==1) return e1; if(op==BOR||op==EOR||op==BAND||op==ADD||op==SUB||op==EQ||op==NEQ) return(list3(op+LOP,e1,e2)); if(op==LSHIFT||op==RSHIFT) return(list3(op+LOP+(t1==ULONGLONG),e1,e2)); return(list3(op+LOP+us,e1,e2)); } #endif /* binary integer compuation */ static int binop(int op, int e1, int e2, int t1, int t2) { int e=0; int us = (t1==UNSIGNED&&t2==UNSIGNED); if(t1>0&&car(t1)==POINTER) { e2= int_value(e2,t2); t2=INT; } else if(t2>0&&car(t2)==POINTER) { e1= int_value(e1,t1); t1=INT; } #if FLOAT_CODE else if(t1==DOUBLE||t2==DOUBLE) return dbinop(op,e1,e2,t1,t2); else if(t1==FLOAT||t2==FLOAT) return fbinop(op,e1,e2,t1,t2); #endif #if LONGLONG_CODE else if(t1==LONGLONG||t2==LONGLONG||t1==ULONGLONG||t2==ULONGLONG) return lbinop(op,e1,e2,t1,t2); #endif 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); if (us) e=(((unsigned)e1)/((unsigned)e2)); else e=e1/e2; break; case MOD: if(!e2) error(EXERR); if (us) e=(((unsigned)e1)%((unsigned)e2)); else e=e1%e2; break; case RSHIFT: if (t1==UNSIGNED) e=(((unsigned)e1)>>((unsigned)e2)); else e=e1>>e2; break; case LSHIFT: if (t1==UNSIGNED) e=(((unsigned)e1)<<((unsigned)e2)); else e=e1<<e2; break; case EQ: e=(e1==e2);break; case NEQ: e=(e1!=e2);break; case LT: e=e1;e1=e2;e2=e; case GT: if (us) e=(((unsigned)e1)>((unsigned)e2)); else e=(e1>e2); break; case LE: e=e1;e1=e2;e2=e; case GE: if (us) e=(((unsigned)e1)>=((unsigned)e2)); else e=(e1>=e2); break; e=(e1<=e2);break; default: error(-1); return list2(CONST,0); } return list2(CONST,e); } if(op==LT) { return(list3(GT+us,e2,e1)); } else if(op==LE) { return(list3(GE+us,e2,e1)); } else if(op==GT||op==GE||op==LT||op==LE) { return(list3(op+us,e1,e2)); } else if(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)==RGVAR||car(e2)==RLVAR|| car(e2)==URGVAR||car(e2)==URLVAR|| car(e2)==SRGVAR||car(e2)==SRLVAR|| car(e2)==SURGVAR||car(e2)==SURLVAR|| car(e2)==CRGVAR||car(e2)==CRLVAR|| car(e2)==CURGVAR||car(e2)==CURLVAR ))) { 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)); if(op==LSHIFT||op==RSHIFT) return(list3(op+(t1==UNSIGNED?US:0),e1,e2)); // which ops remain? return(list3(op+us,e1,e2)); } /* coarse for function/code segments arguments */ int correct_type(int e,int t) { int t1; /* e = rvalue(e); */ if (type==FLOAT && t==DOTS) { t=DOUBLE;} // fall thru if (type==CHAR && t==DOTS) { t=INT;} // fall thru if (t==DOTS) return e; if (t==UNSIGNED) e = unsigned_value(e,type); else if (integral(t)) e = int_value(e,type); #if FLOAT_CODE else if (t==FLOAT) e = float_value(e,type); else if (t==DOUBLE) e = double_value(e,type); #endif #if LONGLONG_CODE else if (t==LONGLONG) e = longlong_value(e,type); else if (t==ULONGLONG) e = ulonglong_value(e,type); #endif 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,ftype; /* function call target */ 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); } ftype = type; conv->funcall_(type); /* function argments */ argtypes = caddr(type); if ((t=cadr(type))>=0 && (car(t)==STRUCT||car(t)==UNION)) { /* skip return struct pointer */ if (argtypes==0) error(-1); argtypes = cadr(argtypes); } arglist=0; getsym(0); 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(0); } checksym(RPAR); conv->funcall_args_(); if(car(t)==CODE) return list4(FUNCTION,e1,arglist,ftype); /* return type */ type = cadr(ftype); 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 sequence is compatible with gcc */ arglist = append3(arglist,list2(ADDRESS,e),list2(POINTER,type)); } return list4(FUNCTION,e1,arglist,ftype); } static int typeid(int s) { return (integral(s) || s==CODE || s==SHORT || s==LONG || s==STRUCT || s==UNION || s==ENUM || s==LONGLONG || s==FLOAT || s==DOUBLE || s==VOID || s==ULONGLONG || (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(0); return type=list2(POINTER,ndecl0()); } return ndecl1(); } static int ndecl1(void) { int i,t,arglist; if(sym==LPAR) { if(getsym(0)==RPAR) { type=list3(FUNCTION,type,0); getsym(0); } else { ndecl0(); checksym(RPAR); } } while(1) { if(sym==LBRA) { getsym(0); t=type; i=cexpr(expr(1)); checksym(RBRA); type=list3(ARRAY,t,i); } else if(sym==LPAR) { t = type; getsym(0); arglist=0; while(sym!=RPAR) { ndecl0(); arglist=list2(type,arglist); if(sym!=COMMA) break; getsym(0); } 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 void get_name() { int i = 0; hash = 0; name = namebuf; while (alpha(ch) || digit(ch)) { if (i < LBUFSIZE-1) hash=(((7*hash)&0xfffffff) ^ (name[i++]=ch)); getch(); } name[i++] = '\0'; } static void macro_expansion(NMTBL *nptrm) { int i = mode; int macrop = 0; int slfree = lfree; mode = STAT; 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; if (macro_buf[0]==0) { mode = i; return; } chptrsave = glist2((int)chptr,chptrsave); chsave = glist2(chptr[-1],chsave); chptr = macro_buf; ch = *chptr++; mode = i; } static int get_numerical() { int d; char *scheapp; /* numerical */ symval=0; d=0; scheapp = cheapp; if(ch=='.') { getch(); if(ch=='.') { getch(); if (ch=='.') { getch(); return sym=DOTS; } error(CHERR); return getsym(0); } else if (!digit(ch)) return sym=PERIOD; d=1; *cheapp++ = '.'; /* .0 case */ } else if (ch == '0') { if (getch() == 'x' || ch == 'X') { /* hexadicimal */ 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!='.'&&ch!='L') { /* octal */ while (digit(ch)) { symval=symval*8+ch-'0';getch(); } return sym=CONST; } else if (ch=='L') { /* 0L or 0LL case */ if (getch()=='L') { #if LONGLONG_CODE getch(); lsymval = 0; return sym=LCONST; #else symval = 0; return sym=CONST; #endif } else { symval = 0; 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'||ch=='L')) { cheapp=scheapp; return sym=CONST; } } if (!d && ch=='L') { getch(); if (ch=='L') { #if LONGLONG_CODE getch(); /*LONGLONG*/ *cheapp++ = 0; lsymval = strtoll(scheapp,0,0); cheapp=scheapp; return sym=LCONST; #else error(CHERR); symval = 0; return sym=CONST; #endif } return sym=CONST; } #if FLOAT_CODE /* floating point case */ 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 symval = 0; return sym=CONST; #endif } static int getsym(int sc) { NMTBL *nptr0,*nptr1,*nptrm; char c; if (alpha(skipspc())) { get_name(); nptrm=msearch(name); if (mode==MDECL) { nptr = nptrm; return (sym==MACRO); } if (mode==IFDEF) { nptr = nptrm; if (nptrm->sc == MACRO||nptrm->sc==FMACRO) { return (symval=1); } else { return (symval=0); } } if ((nptrm->sc==MACRO&&neqname((char *)car(nptrm->dsp),name)) || (nptrm->sc==FMACRO&&skipspc()=='(')) { macro_expansion(nptrm); return getsym(0); } /* global variable name table */ nptr0 = gsearch(sc); 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 || mode==GEDECL) { return sym; } /* local variable name table */ nptr1=lsearch(nptr0->nm,sc); if (mode==STAT) { if (nptr1->sc == EMPTY) return sym; } nptr=nptr1; return sym; } else if (digit(ch)||ch=='.') { return get_numerical(); } else if(ch=='\'') { getch(); symval=escape(); if(ch!='\'') error(CHERR); getch(); return sym=CONST; } else if(ch=='"') { getstring(); return sym= STRING; } /* 2 letters literal */ 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=COLON; case '?': return sym=COND; case ';': return sym=SM; case '/': if(ch=='/') { in_comment = 1; conv->comment_('/'); conv->comment_('/'); while(ch!='\n') { getch(); conv->comment_(ch); } in_comment = 0; getch(); return getsym(0); } 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(0); case 0: case '\n': case '\f': case '\\': return getsym(0); default: error(CHERR); return getsym(0); } } 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(int sc) { NMTBL *nptr,*iptr; iptr=nptr= &ntable[hash % GSYMS]; while(nptr->sc!=0 && (neqname(nptr->nm,name) || !(sc?(nptr->sc==sc):(nptr->sc!=TAG)))) { if (++nptr== &ntable[GSYMS]) nptr=ntable; if (nptr==iptr) error(GSERR); } if (nptr->sc == 0) { copy(nptr,name); nptr->sc=EMPTY; nptr->dsp=0; } return nptr; } static NMTBL * lsearch(char *name,int sc) { NMTBL *nptr,*iptr; iptr=nptr= &ntable[hash%LSYMS+GSYMS]; while(nptr->sc!=0 && (neqname(nptr->nm,name) || !(sc?(nptr->sc==sc):(nptr->sc!=TAG)))) { 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; } 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(0))->sc = EXTRN; nptr0->dsp = d; nptr0->ty=type; if (use) extrn_use(nptr0); } 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 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) { int i,j; if(*chptr) return ch = *chptr++; else if (chptrsave) { chptr = (char *)car(chptrsave); ch = car(chsave); i = cadr(chptrsave); j = cadr(chsave); free_glist2(chptrsave); free_glist2(chsave); chptrsave = i; chsave = j; return ch; } getline(); if (in_macro_if) check_macro_eof(); 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 char * expand_file_name(char *path,char *name,int pos,int lbufsize) { char *p = name+pos; int i,j; j = 0; for(i=0;path[i];i++,j++); for(i=0;name[i];i++,j++); if (pos+j+1>lbufsize) { error(FILERR); return ""; } while((name[pos++] = *path++)); pos--; if (name[pos]!='/') name[pos]='/'; for(i = 0; ((name[pos++] = name[i++]));); return p; } /* preprocessor part */ /* file inclusion */ static FILE * getfname(void) { int i,end='"',err=0; char *s,*p,**pp,name[LBUFSIZE]; FILE *fp; getch(); if(skipspc()=='"') { end = '"'; } else if (ch=='<') { end = '>'; } else { error(INCERR); err=1; } for(i=0;(getch()!=end && ch!='\n');) { if(i<LBUFSIZE-1) name[i++]=ch; } if(ch=='\n') error(INCERR); if (err) return filep->fcb; name[i]=0; fp = fopen(name,"r") ; if (fp) { p = name; } else { for(pp=(end=='>'||filep->inc=='>') ?l_include_path:include_path;*pp;pp++) { p = expand_file_name(*pp,name,i+1,LBUFSIZE); if ((fp = fopen(p,"r"))) break ; } } if(!fp) { error(FILERR); return filep->fcb; } copy_current_file_dir(s=p); (filep+1)->name0 = cheapp; (filep+1)->inc = end; while((*cheapp++ = *s++)); return ( (filep+1)->fcb = fp ); } /* line input and conversion */ static int macro_if_depth ; static int macro_if_current ; static int macro_if_skip ; static int skip_rest_of_line() { getch(); do { while(ch!='\n'&&ch!='\r') { if (!in_comment) { if (ch=='/') { getch(); if (ch=='/') in_comment=2; else if (ch=='*') { in_comment=1; } else continue; } } else if (ch=='*') { getch(); if (ch=='/') { in_comment=0; return macro_if_skip?0:1; } else continue; } getch(); } if (in_comment==1) { getline(); getch(); } } while(in_comment==1); in_comment=0; return 0; } 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) { if (macro_processing()) return; } } while(macro_if_skip || linebuf[0] == '#'); } /* preprocessor directive */ /* line continuation \\ */ static void check_macro_eof() { int c; for(c=0;c<LBUFSIZE-3&&chptr[c];c++); if (c>0&&chptr[c-1]=='\\') { return; } else if (c>0&&chptr[c-1]=='\n') { if (c>0&&chptr[c-2]=='\\') { return; } else { c--; } } chptr[c] = ';'; chptr[c+1] = '\n'; chptr[c+2] = 0; } static void macro_if() { int i; ch= *chptr; in_macro_if = 1; check_macro_eof(); getsym(0); /* i=cexpr(expr(1)); #if allow undefined symbols.. */ i=expr(1); in_macro_if = 0; if (car(i)==CONST) i=cadr(i); else i=0; if (ch) { if (chptr[-1]==ch) { /* we are fall into getch(), which lost the last ch */ /* chptr[-1]==ch check is fanatic, but ... */ chptr--; } else error(-1); } macro_if_depth = macro_if_current; macro_if_skip = !i; } static int macro_processing() { int i; int c; int mode_save; ++chptr; while (*chptr==' '||*chptr=='\t') ++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(0); mode = mode_save; macro_if_depth = macro_if_current; macro_if_skip = (!i)^c; } return 0; } else if (macroeq("elif")) { if (macro_if_current==0) { error(MCERR); /* extra #else */ return 0; } if (macro_if_current == macro_if_depth) { if (!macro_if_skip || macro_if_skip==2) { macro_if_skip=2; return 0; } macro_if(); } return 0; } else if (macroeq("if")) { macro_if_current++; if (!macro_if_skip) { macro_if(); } return 0; } else if (macroeq("else")) { if (macro_if_current==0) { error(MCERR); /* extra #else */ return 0; } if (macro_if_current == macro_if_depth) { if (macro_if_skip==2) ; else if (macro_if_skip) macro_if_skip=0; else macro_if_skip=1; } return skip_rest_of_line(); } 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 0; } macro_if_current--; } return skip_rest_of_line(); } if (macro_if_skip) return 0; if (macroeq("define")) { ch= *chptr; macro_define0(); *(chptr = linebuf) = '\0'; } else if (macroeq("undef")) { i=mode; mode=IFDEF; ch= *chptr; if (getsym(0)) { 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); return 0; } static int macroeq(char *s) { char *p; for (p = chptr; *s;) if (*s++ != *p++) return 0; chptr = p; return 1; } /* macro interpreter */ 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; char *scheapp; i=mode; mode=MDECL; // ch= *chptr; ?? // fprintf(stderr,"macro def: ch %c *chptr %c\n",ch,*chptr); getsym(0); // 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; } // equal is allowed for -Dhoge=aho option if (ch=='=') chptr++; while((c=*chptr)==' '||c=='\t') chptr++; nptr->dsp = list2((int)cheapp,args); /* macro body */ scheapp = cheapp; while ((*cheapp++ = c = *chptr++) && c != '\n') { if (c=='/'&&chptr[0]=='/') { cheapp--; while(*chptr++); break; } else if (c=='/'&&chptr[0]=='*') { cheapp--; chptr++; while((c = *chptr++)) { if (c=='*'&&chptr[0]=='/') { c = *chptr++; break; } } if (!c) break; } else if (c=='\\' && (*chptr=='\n'||*chptr==0)) { chptr++; cheapp--; getline(); } } *cheapp++ = '\0'; while(cheapp>scheapp&&(*cheapp=='\n'||*cheapp==0)) cheapp--; *++cheapp = '\0'; cheapp++; 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); /* save nptr previous contents in a list */ nptr0->ty=list3(nptr0->sc,nptr0->ty,nptr0->dsp); /* set new value */ nptr0->sc=LMACRO; 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==LMACRO) { while((*macropp++ = *macro++)); macropp[-1]=c; } else if (nptrm->sc==MACRO && neqname(namebuf,macro)) { if (macro[0]==0) { continue; } *macropp++=0; macrop=macro_eval(macrop,macro,list2((int)macro,history)); if (c) { *macropp++=c; macrop = list2((int)macropp-1,macrop); } else { macrop = list2((int)macropp,macrop); } } 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; macrop = list2((int)macropp-1,macrop); } else { macrop = list2((int)macropp,macrop); } } else { macro = namebuf; while((*macropp++ = *macro++)); macropp[-1]=c; } } } *macropp++=0; return macrop; } /* node management (cdr coding ) */ #if LONGLONG_CODE int llist2(int e1, long long d1) { int e; e=getfree((size_of_int+size_of_longlong)/size_of_int); heap[e]=e1; lcadr(e)=d1; return e; } int llist3(int e1, int e2,long long d1) { int e; e=getfree((size_of_int+size_of_longlong)/size_of_int); heap[e]=e1; heap[e+1]=e2; lcaddr(e)=d1; return e; } #endif #if FLOAT_CODE 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; } #endif 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: case GEDECL: 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) return; /* freeing local heap */ 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) return; /* freeing local heap */ if (e1==gfree) { gfree-=3; } else { cadr(e1) = free_glist3_list; free_glist3_list = e1; } } /* we can use cadr(e) = n; now. 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); cadr(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); cadr(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 */