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(&macropp,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 */