rsalz@uunet.uu.net (Rich Salz) (03/28/90)
Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu> Posting-number: Volume 21, Issue 59 Archive-name: p2c/part14 #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 14 (of 32)." # Contents: src/decl.c.3 # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:37 1990 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'src/decl.c.3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/decl.c.3'\" else echo shar: Extracting \"'src/decl.c.3'\" \(38042 characters\) sed "s/^X//" >'src/decl.c.3' <<'END_OF_FILE' X strcmp(tp->smax->val.s, "4294967295.0") <= 0) { X tp = tp_unsigned; X break; X } X tp->basetype = ord_type(tp->smin->val.type); X } else { X tp = tp_integer; X } X break; X } X if (sizespec >= 0) X note(format_d("Don't know how to interpret size = %d bits [111]", sizespec)); X return tp; X} X X X X X XType *p_funcdecl(isfunc, istype) Xint *isfunc, istype; X{ X Meaning *retmp = NULL, *mp, *firstmp, *lastmp, **prevm, **oldprevm; X Type *type, *tp; X enum meaningkind parkind; X int anyvarflag, constflag, volatileflag, num = 0; X Symbol *sym; X Expr *defval; X Token savetok; X Strlist *l1; X X if (*isfunc || modula2) { X sym = findsymbol(format_s(name_RETV, curctx->name)); X retmp = addmeaning(sym, MK_VAR); X retmp->isreturn = 1; X } X type = maketype(TK_FUNCTION); X if (curtok == TOK_LPAR) { X prevm = &type->fbase; X do { X gettok(); X p_mech_spec(1); X p_attributes(); X checkkeyword(TOK_ANYVAR); X if (curtok == TOK_VAR || curtok == TOK_ANYVAR) { X parkind = MK_VARPARAM; X anyvarflag = (curtok == TOK_ANYVAR); X gettok(); X } else if (curtok == TOK_PROCEDURE || curtok == TOK_FUNCTION) { X savetok = curtok; X gettok(); X wexpecttok(TOK_IDENT); X *prevm = firstmp = addmeaning(curtoksym, MK_PARAM); X prevm = &firstmp->xnext; X firstmp->anyvarflag = 0; X curtok = savetok; /* rearrange tokens to a proc ptr type! */ X firstmp->type = p_type(firstmp); X continue; X } else { X parkind = MK_PARAM; X anyvarflag = 0; X } X oldprevm = prevm; X if (modula2 && istype) { X firstmp = addmeaning(findsymbol(format_d("_A%d", ++num)), parkind); X } else { X wexpecttok(TOK_IDENT); X firstmp = addmeaning(curtoksym, parkind); X gettok(); X } X *prevm = firstmp; X prevm = &firstmp->xnext; X firstmp->isactive = 0; /* nit-picking Turbo compatibility */ X lastmp = firstmp; X while (curtok == TOK_COMMA) { X gettok(); X if (wexpecttok(TOK_IDENT)) { X *prevm = lastmp = addmeaning(curtoksym, parkind); X prevm = &lastmp->xnext; X lastmp->isactive = 0; X } X gettok(); X } X constflag = volatileflag = 0; X defval = NULL; X if (curtok != TOK_COLON && !modula2) { X if (parkind != MK_VARPARAM) X wexpecttok(TOK_COLON); X parkind = MK_VARPARAM; X tp = tp_anyptr; X anyvarflag = 1; X } else { X if (curtok == TOK_COLON) X gettok(); X if (curtok == TOK_IDENT && !curtokmeaning && X !strcicmp(curtokbuf, "UNIV")) { X if (parkind == MK_PARAM) X note("UNIV may not work for non-VAR parameters [112]"); X anyvarflag = 1; X gettok(); X } X p_attributes(); X if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) { X constflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) { X volatileflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "UNSAFE")) != NULL && X parkind == MK_VARPARAM) { X anyvarflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "REFERENCE")) != NULL) { X note("REFERENCE attribute treated like VAR [107]"); X parkind = MK_VARPARAM; X strlist_delete(&attrlist, l1); X } X checkkeyword(TOK_VARYING); X if (curtok == TOK_IDENT && curtokmeaning == mp_string && X !anyvarflag && parkind == MK_VARPARAM) { X anyvarflag = (varstrings > 0); X tp = tp_str255; X gettok(); X if (curtok == TOK_LBR) { X wexpecttok(TOK_SEMI); X skipparens(); X } X } else if (curtok == TOK_ARRAY || curtok == TOK_PACKED || X curtok == TOK_VARYING) { X prevm = oldprevm; X tp = p_conformant_array(firstmp->name, &prevm); X *prevm = firstmp; X while (*prevm) X prevm = &(*prevm)->xnext; X } else { X tp = p_type(firstmp); X } X if (!varfiles && isfiletype(tp)) X parkind = MK_PARAM; X if (parkind == MK_VARPARAM) X tp = makepointertype(tp); X } X if (curtok == TOK_ASSIGN) { /* check for parameter default */ X gettok(); X p_mech_spec(0); X defval = gentle_cast(p_expr(tp), tp); X if ((tp->kind == TK_STRING || tp->kind == TK_ARRAY) && X tp->basetype->kind == TK_CHAR && X tp->structdefd && /* conformant string */ X defval->val.type->kind == TK_STRING) { X mp = *oldprevm; X if (tp->kind == TK_ARRAY) { X mp->constdefn = makeexpr_long(1); X mp = mp->xnext; X } X mp->constdefn = strmax_func(defval); X } X } X while (firstmp) { X firstmp->type = tp; X firstmp->kind = parkind; /* in case it changed */ X firstmp->isactive = 1; X firstmp->anyvarflag = anyvarflag; X firstmp->constqual = constflag; X firstmp->volatilequal = volatileflag; X if (defval) { X if (firstmp == lastmp) X firstmp->constdefn = defval; X else X firstmp->constdefn = copyexpr(defval); X } X if (parkind == MK_PARAM && X (tp->kind == TK_STRING || X tp->kind == TK_ARRAY || X tp->kind == TK_SET || X ((tp->kind == TK_RECORD || tp->kind == TK_PROCPTR) && copystructs < 2))) { X firstmp->othername = stralloc(format_s(name_COPYPAR, firstmp->name)); X firstmp->rectype = makepointertype(tp); X } X if (firstmp == lastmp) X break; X firstmp = firstmp->xnext; X } X } while (curtok == TOK_SEMI || curtok == TOK_COMMA); X if (!wneedtok(TOK_RPAR)) X skippasttotoken(TOK_RPAR, TOK_SEMI); X } X if (modula2) { X if (curtok == TOK_COLON) { X *isfunc = 1; X } else { X unaddmeaning(retmp); X } X } X if (*isfunc) { X if (wneedtok(TOK_COLON)) { X retmp->type = type->basetype = p_type(NULL); X switch (retmp->type->kind) { X X case TK_RECORD: X case TK_PROCPTR: X if (copystructs >= 3) X break; X X /* fall through */ X case TK_ARRAY: X case TK_STRING: X case TK_SET: X type->basetype = retmp->type = makepointertype(retmp->type); X retmp->kind = MK_VARPARAM; X retmp->anyvarflag = 0; X retmp->xnext = type->fbase; X type->fbase = retmp; X retmp->refcount++; X break; X X default: X break; X } X } else X retmp->type = type->basetype = tp_integer; X } else X type->basetype = tp_void; X return type; X} X X X X X XSymbol *findlabelsym() X{ X if (curtok == TOK_IDENT && X curtokmeaning && curtokmeaning->kind == MK_LABEL) { X#if 0 X if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0) X curtokmeaning->val.i = --nonloclabelcount; X#endif X } else if (curtok == TOK_INTLIT) { X strcpy(curtokcase, curtokbuf); X curtoksym = findsymbol(curtokbuf); X curtokmeaning = curtoksym->mbase; X while (curtokmeaning && !curtokmeaning->isactive) X curtokmeaning = curtokmeaning->snext; X if (!curtokmeaning || curtokmeaning->kind != MK_LABEL) X return NULL; X#if 0 X if (curtokmeaning->ctx != curctx && curtokmeaning->val.i != 0) X if (curtokint == 0) X curtokmeaning->val.i = -1; X else X curtokmeaning->val.i = curtokint; X#endif X } else X return NULL; X return curtoksym; X} X X Xvoid p_labeldecl() X{ X Symbol *sp; X Meaning *mp; X X do { X gettok(); X if (curtok != TOK_IDENT) X wexpecttok(TOK_INTLIT); X sp = findlabelsym(); X mp = addmeaning(curtoksym, MK_LABEL); X mp->val.i = 0; X mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR, X mp->name)), X MK_VAR); X mp->xnext->type = tp_jmp_buf; X mp->xnext->refcount = 0; X gettok(); X } while (curtok == TOK_COMMA); X if (!wneedtok(TOK_SEMI)) X skippasttoken(TOK_SEMI); X} X X X X X XMeaning *findfieldname(sym, variants, nvars) XSymbol *sym; XMeaning **variants; Xint *nvars; X{ X Meaning *mp, *mp0; X X mp = variants[*nvars-1]; X while (mp && mp->kind == MK_FIELD) { X if (mp->sym == sym) { X return mp; X } X mp = mp->cnext; X } X while (mp) { X variants[(*nvars)++] = mp->ctx; X mp0 = findfieldname(sym, variants, nvars); X if (mp0) X return mp0; X (*nvars)--; X while (mp->cnext && mp->cnext->ctx == mp->ctx) X mp = mp->cnext; X mp = mp->cnext; X } X return NULL; X} X X X X XExpr *p_constrecord(type, style) XType *type; Xint style; /* 0=HP, 1=Turbo, 2=Oregon+VAX */ X{ X Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield; X Symbol *sym; X Value val; X Expr *ex, *cex; X int i, j, nvars, newnvars, varcounts[20]; X X if (!wneedtok(style ? TOK_LPAR : TOK_LBR)) X return makeexpr_long(0); X cex = makeexpr(EK_STRUCTCONST, 0); X nvars = 0; X varcounts[0] = 0; X curfield = type->fbase; X for (;;) { X if (style == 2) { X if (curfield) { X mp = curfield; X if (mp->kind == MK_VARIANT || mp->isforward) { X val = p_constant(mp->type); X if (mp->kind == MK_FIELD) { X insertarg(&cex, cex->nargs, makeexpr_val(val)); X mp = mp->cnext; X } X val.type = mp->val.type; X if (!valuesame(val, mp->val)) { X while (mp && !valuesame(val, mp->val)) X mp = mp->cnext; X if (mp) { X note("Attempting to initialize union member other than first [113]"); X curfield = mp->ctx; X } else { X warning("Tag value does not exist in record [129]"); X curfield = NULL; X } X } else X curfield = mp->ctx; X goto ignorefield; X } else { X i = cex->nargs; X insertarg(&cex, i, NULL); X if (mp->isforward && curfield->cnext) X curfield = curfield->cnext->ctx; X else X curfield = curfield->cnext; X } X } else { X warning("Too many fields in record constructor [130]"); X ex = p_expr(NULL); X freeexpr(ex); X goto ignorefield; X } X } else { X if (!wexpecttok(TOK_IDENT)) { X skiptotoken2(TOK_RPAR, TOK_RBR); X break; X } X sym = curtoksym; X gettok(); X if (!wneedtok(TOK_COLON)) { X skiptotoken2(TOK_RPAR, TOK_RBR); X break; X } X newnvars = 1; X newvariants[0] = type->fbase; X mp = findfieldname(sym, newvariants, &newnvars); X if (!mp) { X warning(format_s("Field %s not in record [131]", sym->name)); X ex = p_expr(NULL); /* good enough */ X freeexpr(ex); X goto ignorefield; X } X for (i = 0; i < nvars && i < newnvars; i++) { X if (variants[i] != newvariants[i]) { X warning("Fields are members of incompatible variants [132]"); X ex = p_subconst(mp->type, style); X freeexpr(ex); X goto ignorefield; X } X } X while (nvars < newnvars) { X variants[nvars] = newvariants[nvars]; X if (nvars > 0) { X for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ; X if (mp0->ctx != variants[nvars]) X note("Attempting to initialize union member other than first [113]"); X } X i = varcounts[nvars]; X for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext) X i++; X nvars++; X varcounts[nvars] = i; X while (cex->nargs < i) X insertarg(&cex, cex->nargs, NULL); X } X i = varcounts[newnvars-1]; X for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext) X i++; X if (cex->args[i]) X warning(format_s("Two constructors for %s [133]", mp->name)); X } X ex = p_subconst(mp->type, style); X if (ex->kind == EK_CONST && X (ex->val.type->kind == TK_RECORD || X ex->val.type->kind == TK_ARRAY)) X ex = (Expr *)ex->val.i; X cex->args[i] = ex; Xignorefield: X if (curtok == TOK_COMMA || curtok == TOK_SEMI) X gettok(); X else X break; X } X if (!wneedtok(style ? TOK_RPAR : TOK_RBR)) X skippasttoken2(TOK_RPAR, TOK_RBR); X if (style != 2) { X j = 0; X mp = variants[0]; X for (i = 0; i < cex->nargs; i++) { X while (!mp || mp->kind != MK_FIELD) X mp = variants[++j]; X if (!cex->args[i]) { X warning(format_s("No constructor for %s [134]", mp->name)); X cex->args[i] = makeexpr_name("<oops>", mp->type); X } X mp = mp->cnext; X } X } X val.type = type; X val.i = (long)cex; X val.s = NULL; X return makeexpr_val(val); X} X X X X XExpr *p_constarray(type, style) XType *type; Xint style; X{ X Value val; X Expr *ex, *cex; X int nvals, skipped; X long smin, smax; X X if (type->kind == TK_SMALLARRAY) X warning("Small-array constructors not yet implemented [135]"); X if (!wneedtok(style ? TOK_LPAR : TOK_LBR)) X return makeexpr_long(0); X if (type->smin && type->smin->kind == EK_CONST) X skipped = type->smin->val.i; X else X skipped = 0; X cex = NULL; X for (;;) { X if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) { X ex = p_subconst(type->basetype, style); X nvals = 1; X } else if (curtok == TOK_REPEAT) { X gettok(); X ex = p_expr(type->basetype); X if (ord_range(type->indextype, &smin, &smax)) { X nvals = smax - smin + 1; X if (cex) X nvals -= cex->nargs; X } else { X nvals = 1; X note("REPEAT not translatable for non-constant array bounds [114]"); X } X ex = gentle_cast(ex, type->basetype); X } else { X ex = p_expr(type->basetype); X if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING && X ex->val.i > 1 && !skipped && style == 0 && !cex && X type->basetype->kind == TK_CHAR && X checkconst(type->indextype->smin, 1)) { X if (!wneedtok(TOK_RBR)) X skippasttoken2(TOK_RBR, TOK_RPAR); X return ex; /* not quite right, but close enough */ X } X if (curtok == TOK_OF) { X ex = gentle_cast(ex, tp_integer); X val = eval_expr(ex); X freeexpr(ex); X if (!val.type) X warning("Expected a constant [127]"); X nvals = val.i; X gettok(); X ex = p_expr(type->basetype); X } else X nvals = 1; X ex = gentle_cast(ex, type->basetype); X } X nvals += skipped; X skipped = 0; X if (ex->kind == EK_CONST && X (ex->val.type->kind == TK_RECORD || X ex->val.type->kind == TK_ARRAY)) X ex = (Expr *)ex->val.i; X if (nvals != 1) { X ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex); X ex->val.i = nvals; X } X if (cex) X insertarg(&cex, cex->nargs, ex); X else X cex = makeexpr_un(EK_STRUCTCONST, type, ex); X if (curtok == TOK_COMMA) X gettok(); X else X break; X } X if (!wneedtok(style ? TOK_RPAR : TOK_RBR)) X skippasttoken2(TOK_RPAR, TOK_RBR); X val.type = type; X val.i = (long)cex; X val.s = NULL; X return makeexpr_val(val); X} X X X X XExpr *p_conststring(type, style) XType *type; Xint style; X{ X Expr *ex; X Token close = (style ? TOK_RPAR : TOK_RBR); X X if (curtok != (style ? TOK_LPAR : TOK_LBR)) X return p_expr(type); X gettok(); X ex = p_expr(tp_integer); /* should handle "OF" and "," for constructors */ X if (curtok == TOK_OF || curtok == TOK_COMMA) { X warning("Multi-element string constructors not yet supported [136]"); X skiptotoken(close); X } X if (!wneedtok(close)) X skippasttoken(close); X return ex; X} X X X X XExpr *p_subconst(type, style) XType *type; Xint style; X{ X Value val; X X if (curtok == TOK_IDENT && curtokmeaning && X curtokmeaning->kind == MK_TYPE) { X if (curtokmeaning->type != type) X warning("Type conflict in constant [137]"); X gettok(); X } X if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") && X !curtokmeaning) { /* VAX Pascal foolishness */ X gettok(); X if (type->kind == TK_STRING) X return makeexpr_string(""); X if (type->kind == TK_REAL) X return makeexpr_real("0.0"); X val.type = type; X if (type->kind == TK_RECORD || type->kind == TK_ARRAY || X type->kind == TK_SET) X val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0)); X else X val.i = 0; X val.s = NULL; X return makeexpr_val(val); X } X switch (type->kind) { X X case TK_RECORD: X if (curtok == (style ? TOK_LPAR : TOK_LBR)) X return p_constrecord(type, style); X break; X X case TK_SMALLARRAY: X case TK_ARRAY: X if (curtok == (style ? TOK_LPAR : TOK_LBR)) X return p_constarray(type, style); X break; X X case TK_SMALLSET: X case TK_SET: X if (curtok == TOK_LBR) X return p_setfactor(type); X break; X X default: X break; X X } X return gentle_cast(p_expr(type), type); X} X X X Xvoid p_constdecl() X{ X Meaning *mp; X Expr *ex, *ex2; X Type *oldtype; X char savetokcase[sizeof(curtokcase)]; X Symbol *savetoksym; X Strlist *sl; X int i, saveindent, outflag = (blockkind != TOK_IMPORT); X X if (outflag) X outsection(majorspace); X flushcomments(NULL, -1, -1); X gettok(); X oldtype = NULL; X while (curtok == TOK_IDENT) { X strcpy(savetokcase, curtokcase); X savetoksym = curtoksym; X gettok(); X strcpy(curtokcase, savetokcase); /* what a kludge! */ X curtoksym = savetoksym; X if (curtok == TOK_COLON) { /* Turbo Pascal typed constant */ X mp = addmeaning(curtoksym, MK_VAR); X decl_comments(mp); X gettok(); X mp->type = p_type(mp); X if (wneedtok(TOK_EQ)) { X if (mp->kind == MK_VARMAC) { X freeexpr(p_subconst(mp->type, 1)); X note("Initializer ignored for variable with VarMacro [115]"); X } else { X mp->constdefn = p_subconst(mp->type, 1); X if (blockkind == TOK_EXPORT) { X /* nothing */ X } else { X mp->isforward = 1; /* static variable */ X } X } X } X decl_comments(mp); X } else { X sl = strlist_find(constmacros, curtoksym->name); X if (sl) { X mp = addmeaning(curtoksym, MK_VARMAC); X mp->constdefn = (Expr *)sl->value; X strlist_delete(&constmacros, sl); X } else { X mp = addmeaning(curtoksym, MK_CONST); X } X decl_comments(mp); X if (!wexpecttok(TOK_EQ)) { X skippasttoken(TOK_SEMI); X continue; X } X mp->isactive = 0; /* A fine point indeed (see below) */ X gettok(); X if (curtok == TOK_IDENT && X curtokmeaning && curtokmeaning->kind == MK_TYPE && X (curtokmeaning->type->kind == TK_RECORD || X curtokmeaning->type->kind == TK_SMALLARRAY || X curtokmeaning->type->kind == TK_ARRAY)) { X oldtype = curtokmeaning->type; X gettok(); X ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2); X } else X ex = p_expr(NULL); X mp->isactive = 1; /* Re-enable visibility of the new constant */ X if (mp->kind == MK_CONST) X mp->constdefn = ex; X if (ord_type(ex->val.type)->kind == TK_INTEGER) { X i = exprlongness(ex); X if (i > 0) X ex->val.type = tp_integer; X else if (i < 0) X ex->val.type = tp_int; X } X decl_comments(mp); X mp->type = ex->val.type; X mp->val = eval_expr(ex); X if (mp->kind == MK_CONST) { X switch (ex->val.type->kind) { X X case TK_INTEGER: X case TK_BOOLEAN: X case TK_CHAR: X case TK_ENUM: X case TK_SUBR: X case TK_REAL: X if (foldconsts > 0) X mp->anyvarflag = 1; X break; X X case TK_STRING: X if (foldstrconsts > 0) X mp->anyvarflag = 1; X break; X X default: X break; X } X } X flushcomments(&mp->comments, CMT_PRE, -1); X if (ex->val.type->kind == TK_SET) { X mp->val.type = NULL; X if (mp->kind == MK_CONST) { X ex2 = makeexpr(EK_MACARG, 0); X ex2->val.type = ex->val.type; X mp->constdefn = makeexpr_assign(ex2, ex); X } X } else if (mp->kind == MK_CONST && outflag) { X if (ex->val.type != oldtype) { X outsection(minorspace); X oldtype = ex->val.type; X } X switch (ex->val.type->kind) { X X case TK_ARRAY: X case TK_RECORD: X select_outfile(codef); X outsection(minorspace); X if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM) X output("static "); X if (useAnyptrMacros == 1 || useconsts == 2) X output("Const "); X else if (useconsts > 0) X output("const "); X outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY); X output(" "); X outdeclarator(mp->type, mp->name, X ODECL_CHARSTAR|ODECL_FREEARRAY); X output(" = {"); X outtrailcomment(mp->comments, -1, declcommentindent); X saveindent = outindent; X moreindent(tabsize); X moreindent(structinitindent); X /* if (mp->val.s) X output(mp->val.s); X else */ X out_expr((Expr *)mp->val.i); X outindent = saveindent; X output("\n};\n"); X outsection(minorspace); X if (blockkind == TOK_EXPORT) { X select_outfile(hdrf); X if (usevextern) X output("vextern "); X if (useAnyptrMacros == 1 || useconsts == 2) X output("Const "); X else if (useconsts > 0) X output("const "); X outbasetype(mp->type, ODECL_CHARSTAR); X output(" "); X outdeclarator(mp->type, mp->name, ODECL_CHARSTAR); X output(";\n"); X } X break; X X default: X if (foldconsts > 0) break; X output(format_s("#define %s", mp->name)); X mp->isreturn = 1; X out_spaces(constindent, 0, 0, 0); X saveindent = outindent; X outindent = cur_column(); X out_expr_factor(ex); X outindent = saveindent; X outtrailcomment(mp->comments, -1, declcommentindent); X break; X X } X } X flushcomments(&mp->comments, -1, -1); X if (mp->kind == MK_VARMAC) X freeexpr(ex); X mp->wasdeclared = 1; X } X if (!wneedtok(TOK_SEMI)) X skippasttoken(TOK_SEMI); X } X if (outflag) X outsection(majorspace); X} X X X X Xvoid declaresubtypes(mp) XMeaning *mp; X{ X Meaning *mp2; X Type *tp; X struct ptrdesc *pd; X X while (mp) { X if (mp->kind == MK_VARIANT) { X declaresubtypes(mp->ctx); X } else { X tp = mp->type; X while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER) X tp = tp->basetype; X if (tp->meaning && !tp->meaning->wasdeclared && X (tp->kind == TK_RECORD || tp->kind == TK_ENUM) && X tp->meaning->ctx && tp->meaning->ctx != nullctx) { X pd = ptrbase; /* Do this now, just in case */ X while (pd) { X if (pd->tp->basetype == tp_abyte) { X mp2 = pd->sym->mbase; X while (mp2 && !mp2->isactive) X mp2 = mp2->snext; X if (mp2 && mp2->kind == MK_TYPE) { X pd->tp->basetype = mp2->type; X if (!mp2->type->pointertype) X mp2->type->pointertype = pd->tp; X } X } X pd = pd->next; X } X declaretype(tp->meaning); X } X } X mp = mp->cnext; X } X} X X Xvoid declaretype(mp) XMeaning *mp; X{ X int saveindent; X X switch (mp->type->kind) { X X case TK_RECORD: X if (mp->type->meaning != mp) { X output(format_ss("typedef %s %s;", X mp->type->meaning->name, X mp->name)); X } else { X declaresubtypes(mp->type->fbase); X outsection(minorspace); X if (record_is_union(mp->type)) X output("typedef union "); X else X output("typedef struct "); X output(format_s("%s {\n", format_s(name_STRUCT, mp->name))); X saveindent = outindent; X moreindent(tabsize); X moreindent(structindent); X outfieldlist(mp->type->fbase); X outindent = saveindent; X output(format_s("} %s;", mp->name)); X } X outtrailcomment(mp->comments, -1, declcommentindent); X mp->type->structdefd = 1; X if (mp->type->meaning == mp) X outsection(minorspace); X break; X X case TK_ARRAY: X case TK_SMALLARRAY: X output("typedef "); X if (mp->type->meaning != mp) { X output(format_ss("%s %s", X mp->type->meaning->name, X mp->name)); X } else { X outbasetype(mp->type, 0); X output(" "); X outdeclarator(mp->type, mp->name, 0); X } X output(";"); X outtrailcomment(mp->comments, -1, declcommentindent); X break; X X case TK_ENUM: X if (useenum) { X output("typedef "); X if (mp->type->meaning != mp) X output(mp->type->meaning->name); X else X outbasetype(mp->type, 0); X output(" "); X output(mp->name); X output(";"); X outtrailcomment(mp->comments, -1, X declcommentindent); X } X break; X X default: X break; X } X mp->wasdeclared = 1; X} X X X Xvoid declaretypes(outflag) Xint outflag; X{ X Meaning *mp; X X for (mp = curctx->cbase; mp; mp = mp->cnext) { X if (mp->kind == MK_TYPE && !mp->wasdeclared) { X if (outflag) { X flushcomments(&mp->comments, CMT_PRE, -1); X declaretype(mp); X flushcomments(&mp->comments, -1, -1); X } X mp->wasdeclared = 1; X } X } X} X X X Xvoid p_typedecl() X{ X Meaning *mp; X int outflag = (blockkind != TOK_IMPORT); X struct ptrdesc *pd; X X if (outflag) X outsection(majorspace); X flushcomments(NULL, -1, -1); X gettok(); X outsection(minorspace); X deferallptrs = 1; X anydeferredptrs = 0; X notephase = 1; X while (curtok == TOK_IDENT) { X mp = addmeaning(curtoksym, MK_TYPE); X mp->type = tp_integer; /* in case of syntax errors */ X gettok(); X decl_comments(mp); X if (curtok == TOK_SEMI) { X mp->type = tp_anyptr; /* Modula-2 opaque type */ X } else { X if (!wneedtok(TOK_EQ)) { X skippasttoken(TOK_SEMI); X continue; X } X mp->type = p_type(mp); X decl_comments(mp); X if (!mp->type->meaning) X mp->type->meaning = mp; X if (mp->type->kind == TK_RECORD) X mp->type->structdefd = 1; X if (!anydeferredptrs) X declaretypes(outflag); X } X if (!wneedtok(TOK_SEMI)) X skippasttoken(TOK_SEMI); X } X notephase = 0; X deferallptrs = 0; X while (ptrbase) { X pd = ptrbase; X if (pd->tp->basetype == tp_abyte) { X mp = pd->sym->mbase; X while (mp && !mp->isactive) X mp = mp->snext; X if (!mp || mp->kind != MK_TYPE) { X warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name)); X } else { X pd->tp->basetype = mp->type; X if (!mp->type->pointertype) X mp->type->pointertype = pd->tp; X } X } X ptrbase = ptrbase->next; X FREE(pd); X } X declaretypes(outflag); X outsection(minorspace); X flushcomments(NULL, -1, -1); X if (outflag) X outsection(majorspace); X} X X X X X XStatic void nameexternalvar(mp, name) XMeaning *mp; Xchar *name; X{ X if (!wasaliased) { X if (*externalias && my_strchr(externalias, '%')) X strchange(&mp->name, format_s(externalias, name)); X else X strchange(&mp->name, name); X } X} X X XStatic void handlebrackets(mp, skip, wasaliased) XMeaning *mp; Xint skip, wasaliased; X{ X Expr *ex; X X checkkeyword(TOK_ORIGIN); X if (curtok == TOK_ORIGIN) { X gettok(); X ex = p_expr(tp_integer); X mp->kind = MK_VARREF; X mp->constdefn = gentle_cast(ex, tp_integer); X } else if (curtok == TOK_LBR) { X gettok(); X ex = p_expr(tp_integer); X if (!wneedtok(TOK_RBR)) X skippasttotoken(TOK_RBR, TOK_SEMI); X if (skip) { X freeexpr(ex); X return; X } X if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) { X nameexternalvar(mp, ex->val.s); X mp->isfunction = 1; /* make it extern */ X } else { X note(format_s("Absolute-addressed variable %s was generated [116]", mp->name)); X mp->kind = MK_VARREF; X mp->constdefn = gentle_cast(ex, tp_integer); X } X } X} X X X XStatic void handleabsolute(mp, skip) XMeaning *mp; Xint skip; X{ X Expr *ex; X Value val; X long i; X X checkkeyword(TOK_ABSOLUTE); X if (curtok == TOK_ABSOLUTE) { X gettok(); X if (skip) { X freeexpr(p_expr(tp_integer)); X if (curtok == TOK_COLON) { X gettok(); X freeexpr(p_expr(tp_integer)); X } X return; X } X note(format_s("Absolute-addressed variable %s was generated [116]", mp->name)); X mp->kind = MK_VARREF; X if (curtok == TOK_IDENT && X curtokmeaning && (curtokmeaning->kind != MK_CONST || X ord_type(curtokmeaning->type)->kind != TK_INTEGER)) { X mp->constdefn = makeexpr_addr(p_expr(NULL)); X mp->isfunction = 1; /* make it extern */ X } else { X ex = gentle_cast(p_expr(tp_integer), tp_integer); X if (curtok == TOK_COLON) { X val = eval_expr(ex); X if (!val.type) X warning("Expected a constant [127]"); X i = val.i & 0xffff; X gettok(); X val = p_constant(tp_integer); X i = (i<<16) | (val.i & 0xffff); /* as good a notation as any! */ X ex = makeexpr_long(i); X insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer)); X } X mp->constdefn = ex; X } X } X} X X X Xvoid setupfilevar(mp) XMeaning *mp; X{ X if (mp->kind != MK_VARMAC && isfiletype(mp->type)) { X if (storefilenames && *name_FNVAR) X mp->namedfile = 1; X if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp)) X mp->bufferedfile = 1; X } X} X X X X Xvoid p_vardecl() X{ X Meaning *firstmp, *lastmp; X Type *tp; X int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag; X Strlist *l1; X Expr *initexpr; X X gettok(); X notephase = 1; X while (curtok == TOK_IDENT) { X firstmp = lastmp = addmeaning(curtoksym, MK_VAR); X lastmp->type = tp_integer; /* in case of syntax errors */ X aliasflag = wasaliased; X gettok(); X handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag); X decl_comments(lastmp); X while (curtok == TOK_COMMA) { X gettok(); X if (wexpecttok(TOK_IDENT)) { X lastmp = addmeaning(curtoksym, MK_VAR); X lastmp->type = tp_integer; X aliasflag = wasaliased; X gettok(); X handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag); X decl_comments(lastmp); X } X } X if (!wneedtok(TOK_COLON)) { X skippasttoken(TOK_SEMI); X continue; X } X p_attributes(); X volatileflag = constflag = staticflag = globalflag = externflag = 0; X if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) { X constflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) { X volatileflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) { X staticflag = 1; X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) { X /* This is the default! */ X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "AT")) != NULL) { X note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name)); X lastmp->kind = MK_VARREF; X lastmp->constdefn = makeexpr_long(l1->value); X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL || X (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) { X globalflag = 1; X if (l1->value != -1) X nameexternalvar(lastmp, (char *)l1->value); X if (l1->s[0] != 'W') X strlist_delete(&attrlist, l1); X } X if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL || X (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) { X externflag = 1; X if (l1->value != -1) X nameexternalvar(lastmp, (char *)l1->value); X if (l1->s[0] != 'W') X strlist_delete(&attrlist, l1); X } X tp = p_type(firstmp); X decl_comments(lastmp); X handleabsolute(lastmp, (lastmp->kind != MK_VAR)); X initexpr = NULL; X if (curtok == TOK_ASSIGN) { /* VAX Pascal initializer */ X gettok(); X initexpr = p_subconst(tp, 2); X if (lastmp->kind == MK_VARMAC) { X freeexpr(initexpr); X initexpr = NULL; X note("Initializer ignored for variable with VarMacro [115]"); X } X } X for (;;) { X if (firstmp->kind == MK_VARREF) { X firstmp->type = makepointertype(tp); X firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type); X } else { X firstmp->type = tp; X setupfilevar(firstmp); X if (initexpr) { X if (firstmp == lastmp) X firstmp->constdefn = initexpr; X else X firstmp->constdefn = copyexpr(initexpr); X } X } X firstmp->volatilequal = volatileflag; X firstmp->constqual = constflag; X firstmp->isforward |= staticflag; X firstmp->isfunction |= externflag; X firstmp->exported |= globalflag; X if (globalflag && (curctx->kind != MK_MODULE || mainlocals)) X declarevar(firstmp, -1); X if (firstmp == lastmp) X break; X firstmp = firstmp->cnext; X } X if (!wneedtok(TOK_SEMI)) X skippasttoken(TOK_SEMI); X } X notephase = 0; X} X X X X Xvoid p_valuedecl() X{ X Meaning *mp; X X gettok(); X while (curtok == TOK_IDENT) { X if (!curtokmeaning || X curtokmeaning->kind != MK_VAR) { X warning(format_s("Initializer ignored for variable %s [139]", X curtokmeaning->name)); X skippasttoken(TOK_SEMI); X } else { X mp = curtokmeaning; X gettok(); X if (curtok == TOK_DOT || curtok == TOK_LBR) { X note("Partial structure initialization not supported [117]"); X skippasttoken(TOK_SEMI); X } else if (wneedtok(TOK_ASSIGN)) { X mp->constdefn = p_subconst(mp->type, 2); X if (!wneedtok(TOK_SEMI)) X skippasttoken(TOK_SEMI); X } else X skippasttoken(TOK_SEMI); X } X } X} X X X X X X X X/* Make a temporary variable that must be freed manually (or at the end of X the current function by default) */ X XMeaning *maketempvar(type, name) XType *type; Xchar *name; X{ X struct tempvarlist *tv, **tvp; X Symbol *sym; X Meaning *mp; X char *fullname; X X tvp = &tempvars; /* find a freed but allocated temporary */ X while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) || X tv->tvar->refcount == 0 || X strcmp(tv->tvar->val.s, name))) X tvp = &(tv->next); X if (!tv) { X tvp = &tempvars; /* take over a now-cancelled temporary */ X while ((tv = *tvp) && (tv->tvar->refcount > 0 || X strcmp(tv->tvar->val.s, name))) X tvp = &(tv->next); X } X if (tv) { X tv->tvar->type = type; X *tvp = tv->next; X mp = tv->tvar; X FREE(tv); X mp->refcount++; X if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); } X } else { X tempvarcount = 0; /***/ /* experimental... */ X for (;;) { X if (tempvarcount) X fullname = format_s(name, format_d("%d", tempvarcount)); X else X fullname = format_s(name, ""); X ++tempvarcount; X sym = findsymbol(fullname); X mp = sym->mbase; X while (mp && !mp->isactive) X mp = mp->snext; X if (!mp) X break; X if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); } X } X mp = addmeaning(sym, MK_VAR); X mp->istemporary = 1; X mp->type = type; X mp->refcount = 1; X mp->val.s = stralloc(name); X if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); } X } X return mp; X} X X X X/* Make a temporary variable that will be freed at the end of this statement X (rather than at the end of the function) by default */ X XMeaning *makestmttempvar(type, name) XType *type; Xchar *name; X{ X struct tempvarlist *tv; X Meaning *tvar; X X tvar = maketempvar(type, name); X tv = ALLOC(1, struct tempvarlist, tempvars); X tv->tvar = tvar; X tv->active = 1; X tv->next = stmttempvars; X stmttempvars = tv; X return tvar; X} X X X XMeaning *markstmttemps() X{ X return (stmttempvars) ? stmttempvars->tvar : NULL; X} X X Xvoid freestmttemps(mark) XMeaning *mark; X{ X struct tempvarlist *tv; X X while ((tv = stmttempvars) && tv->tvar != mark) { X if (tv->active) X freetempvar(tv->tvar); X stmttempvars = tv->next; X FREE(tv); X } X} X X X X/* This temporary variable is no longer used */ X Xvoid freetempvar(tvar) XMeaning *tvar; X{ X struct tempvarlist *tv; X X if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); } X tv = stmttempvars; X while (tv && tv->tvar != tvar) X tv = tv->next; X if (tv) X tv->active = 0; X tv = ALLOC(1, struct tempvarlist, tempvars); X tv->tvar = tvar; X tv->next = tempvars; X tempvars = tv; X} X X X X/* The code that used this temporary variable has been deleted */ X Xvoid canceltempvar(tvar) XMeaning *tvar; X{ X if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); } X tvar->refcount--; X freetempvar(tvar); X} X X X X X X X X X/* End. */ X X END_OF_FILE if test 38042 -ne `wc -c <'src/decl.c.3'`; then echo shar: \"'src/decl.c.3'\" unpacked with wrong size! fi # end of 'src/decl.c.3' fi echo shar: End of archive 14 \(of 32\). cp /dev/null ark14isdone MISSING="" for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 32 archives. echo "Now see PACKNOTES and the README" rm -f ark[1-9]isdone ark[1-9][0-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- Please send comp.sources.unix-related mail to rsalz@uunet.uu.net. Use a domain-based address or give alternate paths, or you may lose out.