/* * Higher-level symtab functions to construct specific forms of symtab entries, * and perform specialized forms of lookup and entry. */ #include #include #include "std-macros.h" #include "options.h" #include "parse-tree.h" #include "parser.h" #include "sym.h" #include "sym-aux.h" #include "parser-aux.h" #include "tokens.h" #include "interp.h" #include "built-ins.h" #include "token-mapping.h" #include "type-preds.h" /* * Enter a module name in the appropriate symtab. If we're in the Main symtab, * then go up to the Level0Symtab to enter a top-level module. If we're any * place other than the Main symtab, then enter the module name where we are. * This non-uniform treatment of module entry supports the chosen scoping rules * of SpecL. I.e., * * (1) Top-level, non-module definitions go into the "grab bag" Main * module, at Level 1. * * (2) Top-level module definitions go into Level0Symtab, making them * siblings of Main, not sub-modules of main. * * (3) Explicitly-declared sub-modules go into the super-module scope in * which they're declared */ void EnterModule( nodep namenode, SymClasses moduleType) /* YPROCEDURE used for local module */ { int size; SymtabEntry *sym; char *name = namenode->components.atom.val.text; char *iname; /* * If we're in Main, move out of its symtab, up to level 0. Due to syntax * error, we may already be at level 0. */ if ((not CurSymtab->Level == 0) and streq(CurSymtab->ParentEntry->Symbol, "Main")) { MoveToSymtab(Level0Symtab); } switch (moduleType) { case YMODULE: size = 256; break; } /* * Enter module name, if not yet declared in the CurrentScope */ if (LookupThisScope(name)) { lerror(namenode, "Redeclaration of module %s\n", name); return; } Enter(sym=AllocSymtabEntry(name, C_Module, null, CurSymtab->Level+1)); sym->Loc = namenode->header.loc; NewLevel(sym, size, namenode, null); /* ^^^^ NOTE. Should be changed. */ /* * Set the module's error counter to the fully global counter. In this * way, all modules tally a single total error count. This could be * changed to have modules use local error tallies. */ SetErrorCounter(&(CurSymtab->Errors)); } /* * Exit a module by: * (1) saving its parse tree in its symtab * (2) adding its symtab onto the module list for upcoming type checking * (see typechk.c:chkSpec) * (3) leaving this module's level, up to its lexical parent * (4) entering the Main symtab if leaving has put us back a level 0 * * Step (4) matches EnterModule's non-uniform treatment "Main" as a level-1 * sibling of other top-level modules. See the EnterModule comment for further * discussion. */ void ExitModule( nodep t) { nodep ex; SymtabEntry *s, *sl; bool q; char *n; if (PARSE_ERROR) return; /* chkExports(t); */ /* * Store the whole module parse tree in the symtab for later checking. */ CurSymtab->Tree = t; /* * Enqueue this module onto a list so that all modules can be checked in * order of presentation to the parser. */ PutCppList(ModuleList, CurSymtab); LeaveLevel(); /* * If we've moved all the way back out to level 0, then go into Main, for * subsequent entry of top-level decls. */ if (CurSymtab->Level == 0) { MoveToSymtab(MainSymtab); } } /* * Enter a list of vars in the cur symtab. */ void EnterVars( nodep idlist, /* A chain of ATOM_NODEs. */ TypeStruct type) /* A parse tree type structure. */ { nodep id; TypeStruct ltype; /* * Enter each var if its name is not already declared in this scope. Note * that this is before the var's type is checked, since there is no * declare-before-use policy in SpecL. */ for (id = idlist; id; id = id->components.atom.next) { EnterVar(id, type); } } /* * Enter one var in CurSymtab. Used by both EnterVars and chkRecType. The * latter's in typechk.c. */ bool EnterVar( nodep id, TypeStruct t) { SymtabEntry *sym; if (! LookupThisScope(id->components.atom.val.text)) { /* * Enter symbol if it's not already defined. Note level computation: * if we're in a module at any level, the level of the var being * entered is 1. This is because all module vars, including local * modules, are static, and therefore at the same level. */ Enter(sym = AllocSymtabEntry(id->components.atom.val.text, C_Var, t, (CurSymtab->ParentEntry->Class == C_Module) ? 1 : CurSymtab->Level)); /* * Set storage class. It's static if we're in a module. */ if (CurSymtab->ParentEntry->Class == C_Module) { SetSymFlag(sym, isStatic); } return true; } else { lerror(id, "Redeclaration of %s\n", id->components.atom.val.text); return false; } } /* * Build a type struct for an array open parm. The type is an array with * bounds from 0 to size. * * It's worth noting that this proc is not really needed semantically, since * the arrayParm symtab flag is enough for both the type checker and * interpreter. However, building this structure will have the type "look * right", say to a browser. */ TypeStruct BuildOpenArrayTypeSize( TypeStruct t, /* The base type of the open array. */ int size, /* The number of elements in the array */ List* ilist) /* List of inferred base types */ { TypeStruct at, bt; nodep n; SrcLoc s; /* * Guard against null tree, which apparently can happen if someone leaves * off the arg to "list" as a prefix op. */ if ((t == null) || (size <= 0)) return null; at = NewNode(TYPE_NODE, YARRAY, s = t->header.loc); at->components.type.kind.arraytype.bound = at->components.type.kind.arraytype.bounds = bt = NewNode(TYPE_NODE, '[', s); bt->components.type.kind.subrange.basetype = CardType; bt->components.type.kind.subrange.lower = (n = NewNode(ATOM_NODE, Yinteger, s)); n->components.atom.val.integer = 0; bt->components.type.kind.subrange.upper = (n = NewNode(ATOM_NODE, Yinteger, s)); n->components.atom.val.integer = size; if ((not ilist) or (ListLen(ilist) == 1)) { at->components.type.kind.arraytype.basetype = t; at->components.type.kind.arraytype.anon_base = false; } else { at->components.type.kind.arraytype.basetype = BuildAnonUnion(t, ilist); at->components.type.kind.arraytype.anon_base = true; } at->header.attachment.count = size * TypeSize(t); at->components.type.kind.arraytype.lowerboundval = 0; at->components.type.kind.arraytype.normalizedubval = size; at->components.type.tag = ListTag; return at; } /* * Build an anonymous union type from the list of distinct types collected by a * list constructor. The built type is a "bare bones" union, without a symtab, * or names for any of the fields. This is possible since it is illegal to * index a list with an anon union basetype. The only one who cares about its * structure is orCompat, q.v., the body of which was used as a guide for the * code in this function. */ TypeStruct BuildAnonUnion( nodep t, /* Only needed for src loc */ List* types) /* List of distinct types to be unionized */ { TypeStruct aut; /* The type to be returned */ void* le; /* Working loop var to hold each elem of types list */ nodep l; /* Head of field decl list of union componenrts */ nodep n; /* New node for each union component */ /* * Construct the type node and init its number of fields to the length of * the types list. */ aut = NewNode(TYPE_NODE, YOR, t->header.loc); aut->components.type.kind.record.numfields = ListLen(types); /* * Cruise the types list, making an unnamed union element for each type, * and inserting the elements into the union field list. * Cf. BuildAndOrFields and its subfunctions, in particular * AllocFieldNode. */ l = InitDeclList(NewNode(DECL_NODE, 'f', EmptyLoc)); l->components.decl.kind.field.type = (nodep) EnumList(types); for (le = EnumList(types); le; le = EnumList(types)) { n = NewNode(DECL_NODE, 'f', EmptyLoc); n->components.decl.kind.field.type = (nodep) le; AddToDeclList(l, n); } aut->components.type.kind.record.fields = FixDeclList(l); return aut; } /* * Build a type struct for an array open parm. The type is an array with * bounds from 0 to MAXCARD. * * It's worth noting that this proc is not really needed semantically, since * the arrayParm symtab flag is enough for both the type checker and * interpreter. However, building this structure will have the type "look * right", say to a browser. */ TypeStruct BuildOpenArrayType( TypeStruct t, /* The base type of the open array. */ List* il) /* List of inferred base types */ { return BuildOpenArrayTypeSize(t, MAXCARD, il); } /* * Next three functions handle pre-processing for record symtabs. We dont * build the symtabs in the parsing pass because we want to count the number of * fields in a record first, and then alloc a symtab of an appropriate size. * The actual construction of record symtabs is then done in the type checking * pass, in chkRecordType, q.v. */ /* * Upon entering a record scope, alloc a small temp symtab for folk below who * may need a current context. In particular, EnterAnonOp needs such a * context. Counting the number of fields and checking each is not done here, * but rather in the type check pass, in the BuildXXX functions q.q.v. */ void EnterRecord() { Symtab *st; st = AllocSymtab(1); st->ParentTab = CurSymtab; CurSymtab = st; } /* * Bump the field count in the current record context. NOW OBSOLETE, but * retained for possible future resurrection. */ void EnterField() { CurSymtab->Size++; } /* * Upon record exit, install the number of fields in the record type tree node, * which will be used in the type checking pass to alloc the real symtab. * Discard the temp symtab. */ void ExitRecord( nodep t) /* A record type struct. */ { Symtab *st; t->components.type.kind.record.numfields = CurSymtab->Size; st = CurSymtab; CurSymtab = st->ParentTab; free(st); } /* * Check if a type struct is an type identifier. */ bool isTypeIdent( TypeStruct t) { return (t and (t->header.kind == TYPE_NODE) and (t->header.name == Yident)); } /*** ** The next several functions are specialized forms of Lookup **/ /* * Do a lookup in the current scope only, i.e., do not follow the parent link * out, even if we should otherwise. */ SymtabEntry *LookupThisScope( char *s) { int i; SymtabEntry *e; i = hash2(s, CurSymtab); for (e = CurSymtab->Entries[i]; e != null; e = e->Next) if (e->Symbol == s) return e; return null; } /* * Call LookupThisScope with an unhashed string. */ SymtabEntry* LookupStringThisScope(char* s) { return LookupThisScope(hash(s)); } /* * Parameterized version of LookupThisScope. Would that they all were. Soon. */ SymtabEntry* LookupInThisScope(s, st) Symtab* st; char* s; { SymtabEntry* rtn; PushSymtab(); CurSymtab = st; rtn = LookupThisScope(s); PopSymtab(); return rtn; } SymtabEntry *LookupQid(nodep qid, nodep* found_node) { return LookupQid1(qid, false, found_node); } SymtabEntry *LookupQidNoError(nodep qid, nodep* found_node) { return LookupQid1(qid, true, found_node); } /* * Common workdoer for LookupQid and LookupQidNoError a qual ident by cruising * through each of its parts. */ SymtabEntry *LookupQid1( nodep qid, bool noerror, nodep* found_node) { nodep ql, qr; SymtabEntry *syml, *symr; char *nl, *nr; /* * Lookup first (possible only) qid component and quit if not found. */ if (not (syml = Lookup(nl = qid->components.atom.val.text))) { if (not noerror) { lchastise(qid, "%s is not defined in this scope.\n", nl); } *found_node = qid; return null; } /* * If the first component is an object or operation, and the second * component is non-null, then look for the lead-name module one level up. * This implements the name overloading rule that allows a module to have * the same name as an object or operation. * * This may very well go away if we disallow obj/module overloading. TBD * at the time of this writing. This is left in here to allow current * regression tests to pass. Once we're over that hump, we'll come back * and deal with this. If it goes, a potentially large number of examples * need to change. */ if (((syml->Class == C_Obj) or (syml->Class == C_Op)) and (qid->components.atom.next != null)) { syml = LookupIn(nl, CurSymtab->ParentTab); } /* * Prepare to move into new symtab(s) by saving CurSymtab. */ PushSymtab(); /* * Move through each qid component to the end, confirming that each name * on the left of a dot is a module and each name on the right is an export * thereof. */ for (ql = qid, qr = qid->components.atom.next; qr; ql = qr, qr = qr->components.atom.next, syml = symr) { /* * Confirm that left operand is a module. */ if (syml->Class != C_Module) { /* if (not noerror) { */ lerror(ql, "Left operand of '.' is not a module.\n"); /* } */ PopSymtab(); *found_node = ql; return null; } /* * Move into the scope of the left operand. */ MoveToSymtab(syml->Info.Module.Symtab); /* * Lookup right oprnd and confirm that it's an export of the left * oprnd. */ symr = Lookup(nr = qr->components.atom.val.text); if ((not symr) or (not ChkSymFlag(symr, isExport))) { /* if (not noerror) { */ lerror(qr, "%s is not an export of %s.\n", nr, syml->Symbol); /* } */ PopSymtab(); *found_node = ql; return null; } } /* * Finally, return the Lookup of the last (only) qid component, restoring * entering symtab before return. */ PopSymtab(); *found_node = ql; return syml; } /* * Lookup the typestruct for a type identifier. */ TypeStruct LookupType( nodep n) /* n points to a ATOM_NODE that must be a type ident */ { SymtabEntry *sym; nodep rtn_node; /* Tree node returned from LookupQid */ if (sym = LookupQid(n, &rtn_node)) { if ((sym->Class == C_Type) || sym->Class == C_Obj) return sym->Type; else { lerror(n, "%s is not a type.\n", sym->Symbol); return null; } } /* * Issue an error message for an undeclared type. Note that the assumption * here is that it's OK to issue the error message, since in all but one * case (viz., pointers), types must be declared before use. This one case * is handled differently in the parser and type checker. See the action * routine for PointerType in parser.y and chkPointerType in typechk.c */ lerror(n, "Type %s is not declared.\n", n->components.atom.val.text); return null; /* * NOTE: code below to handle forw type refs is an extension of Mod-2. * It's not currently enabled. */ /* * Make an unresolved type node, which will later be patched when type it's * resolved. I.e., the resolved field will point to the resolving * TypeStruct. * t = NewNode(TYPE_NODE, null, EmptyLoc); t->components.type.kind.resolved = null; EnterType(MangleQid(n), t); * */ } /* * Lookup an identifier as a particular class, in the face of overloading. The * rules are: * * For C_Module: first lookup local; if not there, but locally overloaded * as obj or op, then look up in immediate parent scope. * * For C_Obj: first lookup local, traversing through bucket of overloads * that may contain ops and at most one module; if necessary; if not found * local, then proceed up parent chain in the normal way, performing * LookupAs at each level. * * For C_Op: as for C_Obj, since at present, DoProcCall and BindDesigCall * deal with the overloading. With name manling, or some such scheme, * overload resolution could be done here, or someplace thereabouts. * * This function's implementation is pending rethink of obj/module * overloading. */ SymtabEntry* LookupAs(char* name) { return null; } /* * Move attention by changing CurSymtab. This function is used to avoid too * many refs to the global var itself, in case the rep ever changes. */ MoveToSymtab( Symtab *symt) { CurSymtab = symt; } /* * Install built-in symbols. Note that the single-char type is not available * at the source level in SpecL, but is used internally for historical reasons. * It should be refactored out at some point. */ void InstallBuiltInSyms() { /* * Install the built-in types and objs. The types are from Mod-2, the * objs are RSL's. */ InstallObj("boolean", sizeof(Value*), BoolTag); InstallObj("integer", sizeof(Value*), IntTag); InstallObj("real", sizeof(Value*), RealTag); InstallObj("number", sizeof(Value*), RealTag); InstallObj("string", sizeof(Value*), StringTag); InstallObj("intlit", sizeof(Value*), IntTag); /* special integer literal type used in typechk */ InstallObj("symlit", sizeof(Value*), SymLitTag); InstallObj("nilType", sizeof(Value*), NilTag); /* special nil type used in typechk */ /* * Intialize the base type structs. Note that this function needs to be * called here and no later, since subsequent functions reference the base * types it initializes. */ InitBaseTypes(); /* * Install the built-in constants. */ InstallConst("empty", NilType, 0); InstallConst("false", BoolType, 0); InstallConst("nil", NilType, 0); InstallConst("true", BoolType, 1); ComputeMaxes(); /* * Install the built-in procs. The isSpecial flag means that its signature * is generic and/or varargs, so it cannot be defined in Mod-2. At present * in rsl, all are defined special since we're not loading any of the .mod * lib files that define the signatures of the non-special ones. This * clearly needs to be fixed. */ /* isSpecial? Signature: */ InstallProc("abs", abs_, true, /* numeric -> same */ Chk_abs_); InstallProc("cap", cap_, true, /* char -> char */ Chk_cap_); InstallProc("chr", chr_, true, /* card -> char */ Chk_chr_); InstallProc("dec", dec_, true, /* enum|char|int|card[,card] -> same */ Chk_dec_); InstallProc("excl", excl_, true, /* s:set,base(s) -> type(s) */ Chk_excl_); InstallProc("float", float_, true, /* int -> real */ Chk_float_); InstallProc("halt", halt_, true, /* -> */ Chk_halt_); InstallProc("high", high_, true, /* array -> card [0..MAXCARD] */ Chk_high_); InstallProc("inc", inc_, true, /* enum|char|int|card[,card] -> same */ Chk_inc_); InstallProc("incl", incl_, true, /* s:set,base(s) -> type(s) */ Chk_incl_); InstallProc("max", max_, true, /* numeric -> same */ Chk_max_); InstallProc("min", min_, true, /* numeric -> same */ Chk_min_); InstallProc("new", new_, true, /* var x:t -> pointer to t */ Chk_new_); InstallProc("odd", odd_, true, /* int -> bool */ Chk_odd_); InstallProc("ord", ord_, true, /* enum|char|int|card -> card */ Chk_ord_); InstallProc("print", print_, true, /* ?T -> OutStream */ Chk_print_); InstallProc("println", println_, true,/* ?T -> OutStream */ Chk_print_); InstallProc("size", size_, true, /* type -> card */ Chk_size_); InstallProc("sqrt", sqrt_, true, /* real -> real */ Chk_sqrt_); InstallProc("trunc", trunc_, true, /* real -> card */ Chk_trunc_); InstallProc("val", val_, true, /* t:type,x:t -> t */ Chk_val_); /* NOTE on standard proc float vs MathLib0-supplied real: * Since we're making all keywords lowercase, there's no way to * distinguish between the use of the name "real" as a type * transfer vs type conversion function. Therefore, float takes * the place of real as a conversion function. This is fine * anyway, since card and int are assmnt compat, so that the std * version of float that takes a card should also take an int. */ /* * Remaining calls to InstallXXXProc call installation functions within * other built-in modules, such as io.c and debug.c, q.q.v. */ InstallIOProcs(); InstallDebugProcs(); /* * Also preinstalled are these attribute names. */ InstallAttr("description"); InstallAttr("descrip"); InstallAttr("picture"); InstallAttr("pictures"); InstallAttr("pic"); } /* * NOTE: the installation funcions below take a UNhashed strings, and hence * use LookupString and hashsave before installing the string in the tree and * symtab. */ /* * Install a built-in obj, including its type struct. */ void InstallObj( char *name, int size, /* Size of type in bytes. */ ValTag tag) { SymtabEntry *sym; nodep n,nn; char *hname; n = NewNode(TYPE_NODE, Yident, EmptyLoc); n->header.attachment.count = size; n->components.type.tag = tag; // n->components.type.litval = null; /* subject to removal */ n->components.type.kind.ident.type = (nn = NewNode(ATOM_NODE, null, EmptyLoc)); hname = nn->components.atom.val.text = hashsave(name); nn->components.atom.next = null; Enter(sym=HashAllocSymtabEntry(name, C_Obj, n, null)); SetSymFlag(sym, isBuiltIn); } /* * Install built-in spec attributes. */ void InstallAttr(char *name) { Enter(HashAllocSymtabEntry(name, C_Attr, null, 0)); } /* * Install a standard built-in type. */ InstallType( char *name, int size, /* Size of type in bytes. */ ValTag tag) { nodep n,nn; char *hname; n = NewNode(TYPE_NODE, Yident, EmptyLoc); n->header.attachment.count = size; n->components.type.tag = tag; n->components.type.kind.ident.type = (nn = NewNode(ATOM_NODE, null, EmptyLoc)); hname = nn->components.atom.val.text = hashsave(name); nn->components.atom.next = null; Enter(AllocSymtabEntry(hname, C_Type, n, 0)); } /* * Initialize global vars to point to the base types, since these are ref'd a * lot. Note that the StringCharType is a fictitous type used to faciltate * the type checking rule that single-char string literals are compatible with * type char. As noted in comment for InstallBuiltInSyms, the single-char type * is used internally in the type checker, but is not accessible as a type at * the source level. */ InitBaseTypes() { IntType = LookupString("integer")->Type; RealType = LookupString("real")->Type; BoolType = LookupString("boolean")->Type; StringType = LookupString("string")->Type; StringCharType = NewNode(TYPE_NODE, null, EmptyLoc); IntLitType = LookupString("intlit")->Type; SymLitType = LookupString("symlit")->Type; NilType = LookupString("nilType")->Type; /* * Make LookupString("number")->Type point to RealType. */ LookupString("number")->Type = RealType; } /* * Install a standard built-in constant. */ InstallConst( char *name, TypeStruct type, ValueStruct val) { nodep n,nn; SymtabEntry *sym; ValueStruct v; char *hname; n = NewNode(DECL_NODE, YCONST, EmptyLoc); n->components.type.kind.ident.type = (nn = NewNode(ATOM_NODE, null, EmptyLoc)); hname = nn->components.atom.val.text = hashsave(name); nn->components.atom.next = null; Enter(sym = AllocSymtabEntry(hname, C_Const, type, 0)); sym->Info.Consta.valTree = (nodep) val; v = sym->Info.Consta.val = MakeVal(RVAL, sym->Type); /* * We can be lazy here, since any installed type value has to be * integerizeable in C. */ v->val.IntVal = (intptr_t) val; } /* * Compute the values of MAXCARD and MAXINT. */ ComputeMaxes() { MAXCARD = (int) pow(2.0, (double) ((sizeof(int)*4) - 1)) - 1; MAXINT = (int) pow(2.0, (double) (sizeof(int)*4)) - 1; } /* * Install a standard built-in proc. The isSpecial flag indicates that the * proc has a non-standard signature that cannot be defined in Moduula-2. * If the isSpecial parm is true, the specialProc flag is set on in the symtab * entry for the proc. All built-in procs, whether special or not, have the * compiledProc flag set in their symtab entry. * * There are three possible settings for the specialProc and compiledProc * flags, each of which leads to a different handling of the proc at runtime. * Here is a summary (see also interp.c:doProcCall): * * specialProc compiledProc How handled in doProcCall: * =================================================================== * on on The compiled body of the proc is called * immediately, without binding parms. * This is necessary since the generic * parms cannot be handled by the normal * strongly typed parm binding scheme. * The compiled code will eval and bind * its own parms. * off on The parms are bound, and then the * compiled body of the proc is called. * off off The parms are bound, and the tree body * of the proc is interpreted. * on off Not a possible combination in standard * Mod-2, since user-defined generic procs * are not defineable. */ SymtabEntry *InstallProc( char *name, /* String name */ ValueStruct (*func)(), /* Executable function */ bool isSpecial, /* Special flag as describe above */ TypeStruct (*cfunc)()) /* Type checking function (see chkSpecialProc * in typechk.c). */ { SymtabEntry *sym; Enter(sym = HashAllocSymtabEntry(name, C_Proc, null, 0)); if (isSpecial) SetSymFlag(sym, specialProc); SetSymFlag(sym, compiledProc); sym->Info.Proc.Code.Func = func; sym->Info.Proc.ChkFunc = cfunc; sym->Info.Proc.Symtab = AllocSymtab(0); return sym; } /* * Install a formal parm in a pre-defined proc decl. * ************ IMPORTANT NOTE *************** * To install more than one formal in a pre-defined proc, call InstallFormal in * REVERSE ORDER over the formals. This is because InstallFormal just splices * into the front of the parms chain to save time and effort. */ SymtabEntry *InstallFormal( SymtabEntry *p, /* Symtab entry for proc to enter in */ char *name, /* Name of formal */ TypeStruct type, /* Type of formal */ int level, /* Level -- at present always 0 */ int offset) /* Offset -- could be computed locally */ { SymtabEntry *sym; sym = HashAllocSymtabEntry(name, C_Parm, type, level); sym->Info.Parm.Link = p->Info.Proc.Parms; sym->Info.Parm.Offset = offset; p->Info.Proc.Parms = sym; return sym; } /**** **** New for RSL ****/ /***************************************************************************** * Name: EnterObject * * Purpose: Enters an object spec into the symbol table. * * Inputs: t is a pointer to an object spec parse tree. * * Returns: none * * Pre: Object has not already been entered into the symbol table. * * Post: If t is null, the symbol table is unchanged else the object is * * entered into the symbol table. * * Notes: See YOBJ def in parse-tree.h for full parse tree representation of * * an object. See C_Object def in sym.h for symbol representation of * * an object. The Type field in the symbol table contains the parse * * tree for parts. Ops and Eqs are not saved in the symbol table. * * Instead they remain in separate lists in the object parse tree * * and the object parse trees are strung in a list off the module * * symtab entry. A list of parts requiring specialization is created * * as is a list of parts names. The parts of parent classes requiring * * specialization but not specialized are added to the list of parts. * * Completed Checks: * * Referenced classes are validated. * * All parts requiring specialization are at the first parts level. * *****************************************************************************/ void EnterObject(nodep t) { SymtabEntry *sym, *sym1; char *name; bool found = false; nodep t1; /* for debugging in sdb */ nodep n,nn; nodep parent, newnd, speclpart, part; nodep MakePartsList(nodep t, bool notClass); nodep MakeSpecialList(nodep t); nodep ConcatAtomLists(nodep l1, nodep l2); nodep MakeNameList(nodep t); bool isdup; if (not t) return; /* * NOT CLEAR WHY WE DO THIS. Fetch the name from the tree and look it up. */ name = t->components.decl.kind.obj.name->components.atom.val.text; if (not (sym = t->components.decl.kind.obj.sym)) return; sym->Loc.line = t->components.decl.kind.obj.name->header.loc.line; /* * Flags, instance of, attrs, and eqns come straight from the parse tree. */ sym->Flags = t->components.decl.kind.obj.flags; sym->Info.Obj.inheritsfrom = t->components.decl.kind.obj.inheritsfrom; sym->Info.Obj.attrs = t->components.decl.kind.obj.attrs; sym->Info.Obj.eqns = t->components.decl.kind.obj.eqns; /* * Build flattened list of parts. */ if (t->components.decl.kind.obj.flags == isDef) sym->Info.Obj.partslist = t->components.decl.kind.obj.parts; else if (t->components.decl.kind.obj.flags == isOpaque) /* Parts symbol table is not built for opaques so get rid of it */ /* NOT, free(sym->Type->components.type.kind.parts.parts); */ ; else { /* * Full parse tree for parts goes in the parts field for later * processing. Also, Mod-2-rep symtab goes in Parts field for later * type checking and execution. */ sym->Info.Obj.parts = t->components.decl.kind.obj.parts; sym->Info.Obj.speclreq = t->components.decl.kind.obj.parts; /* if (sym->Flags & isInstance) { */ sym->Info.Obj.namelist = MakeNameList(t->components.decl.kind.obj.parts); sym->Type = BuildCompType(t); /* } */ } /* * If this is a second obj def, union its components with the components of * the extant object. */ isdup = MergeDupObjDefs(sym); /* * Build the built-in constructor op for this obj. */ BuildConstructorOp(sym, isdup); /* * NOTE: This must be done last, since it changes sym to point to the new * entry put in the browser symtab. */ BrowserEnter(&sym); } /* * Build the built-in constructor op for an object. Before we get to fully * unifying op sigs and comp exprs, this construction will check the obj type * and construct an op with a comparable input sig, and an output sig that is * an ident type for the object name. */ void BuildConstructorOp(SymtabEntry* sym, bool isdup) { ; } bool MergeDupObjDefs(SymtabEntry* sym) { return false; } /* * Enter an operation def in CurSymtab. */ SymtabEntry* EnterOperation(nodep t) { SymtabEntry *sym, *sym1; char *name; bool found = false; nodep t1; /* for debugging in sdb */ nodep n,nn; nodep parent, newnd, speclpart, part; nodep MakePartsList(nodep t, bool notClass); nodep MakeSpecialList(nodep t); nodep ConcatAtomLists(nodep l1, nodep l2); nodep MakeNameList(nodep t); nodep ot; if (!t) return null; /* * Fetch the name from the tree. */ name = t->components.decl.kind.op.name->components.atom.val.text; /* else */ if (not (sym = t->components.decl.kind.op.sym)) return null; sym->Loc.line = t->components.decl.kind.op.name->header.loc.line; /* * Flags, instance of, and attrs come straight from the parse tree. */ sym->Flags = t->components.decl.kind.op.flags; sym->Info.Op.inheritsfrom = t->components.decl.kind.op.inheritsfrom; sym->Info.Op.attrs = t->components.decl.kind.op.attrs; /* * Build flattened list of parts and required specialization lists. */ if (t->components.decl.kind.op.flags == isOpaque) { /* Parts symbol table is not built for opaques so get rid of it */ /* NOT! free(sym->Info.Op.ins->components.type.kind.parts.parts); free(sym->Info.Op.parts->components.type.kind.parts.parts); free(sym->Type->components.type.kind.parts.parts); */ } else { sym->Info.Op.ins = MakeNameList(t->components.decl.kind.op.ins); sym->Info.Op.outs = MakeNameList(t->components.decl.kind.op.outs); sym->Info.Op.instree = t->components.decl.kind.op.ins; sym->Info.Op.outstree = ot = t->components.decl.kind.op.outs; if (isInitNameTypePair(ot)) ot->components.decl.kind.initdecl.iscoarity = true; /* Coarity flag line used below and thence BuildCompType1, q.v. */ sym->Info.Op.partstree = t->components.decl.kind.op.parts; sym->Info.Op.precond = t->components.decl.kind.op.precond; sym->Info.Op.postcond = t->components.decl.kind.op.postcond; /* if (sym->Flags & isInstance) */ if (t->components.decl.kind.parts->header.name == YPARTS) sym->Info.Op.namelist = MakeNameList(t->components.decl.kind.op.parts); else sym->Info.Op.namelist = null; if (sym->Flags & isClass) sym->Info.Op.speclreq = MakeSpecialList(t->components.decl.kind.op.parts); } /* * The shit here is fucking out of control. With the new parser, the * location of the list output UNOP_NODE has moved, and things have been * hacked further to accomodate this. The original comment (that follows) * is childish to the point of being nausiating, and needs to be removed * after things are fixed and tested fully. * * Note how we set the op type here -- interesting, if not cute. * * Oh, but to dampen the cutitude, we must remember that the outstree comes * from an ins_parts_spec, base elememnts of which are init decls, * descending down into which we must do, lest BuildCompType1 return us * caca. * * And yet further dampitude abounds with the requirement to check the * nullness of the outstree, less we barf resoundingly. Ooh, we *love* our * test suite for finding this so promptly. */ sym->Type = (ot = sym->Info.Op.outstree) ? BuildCompType1( (ot->header.kind == BINOP_NODE) or (ot->header.kind == UNOP_NODE) ? ot : ot->components.decl.kind.initdecl.decl) : null; /* * The following is a dreadful hack that was put in to debug why ~/work/ * rolodex/specification/change-operational was not working. */ FixRecordFieldsIfNecessary(sym->Type); /* * NOTE: With the new parser, the coarity list type is already built, * sometimes. It's built when the output explicitly declared, but not when * inferred from the expr. * * Fucking more hacking. Clean this shit up. * * The immediately following paragraph is NOT the deal anymore -- we build * list types for arities too, now. See near the end of EnterOpParm below. * * Check for starred coarity. The deal here is that, unlike starred types * in the arity, in the coarity we need to build the list type explicitly. * This is because starred arity types enable the var-args-style syntactic * sugaring, whereas with the coarity, there's no need for this, and we * need the full type for subsequent type checking. */ if (isCoarityList(ot) and (not isListType(sym->Type))) sym->Type = BuildListFromBasetype(sym->Type); /* * For the new parser, the list indicator can get put into the one-tuple * field. Pull it out here. * * This is totally out of control. */ if (isOneTupleList(sym->Type)) { sym->Type->components.type.kind.record.fields-> components.decl.kind.field.type = sym->Type->components.type.kind.record.fields-> components.decl.kind.field.type-> components.type.kind.arraytype.basetype; sym->Type = BuildListFromBasetype(sym->Type); } /* * Build the built-in operation type for op. */ BuildOpType(sym); /* * NOTE: This must be done last, since it changes sym to point to the new * entry put in the browser symtab. */ BrowserEnter(&sym); /* * Return sym to anyone who may want it, e.g., EnterFunction. */ return sym; } /* * Just like EnterOperation, but sets isFunc symtab entry flag. This is used * subsequently to distinguish between an op and a func, e.g., for more * accurate error messaging. At present it is not used. */ SymtabEntry* EnterFunction(nodep t) { SymtabEntry* sym = EnterOperation(t); if (sym) { SetSymFlag(sym, isFunc); } return sym; } /* * By a tortured path through BuildCompType1, the field list of a one-type op * return type may not have been fixed, i.e., it's a tight cyclic loop. This * function detects and fixes the situation. This is all crap that needs to be * fixed in the rewrite. * * This can also happen for any length coarity type, so the comments were added * below. But it doesn't apparently work, so the comments are back out. */ void FixRecordFieldsIfNecessary(TypeStruct t) { if (t) { if (t->header.name == YRECORD) { if (t->components.type.kind.record.fields) { /* */ if (t->components.type.kind.record.fields->components.decl.next == t->components.type.kind.record.fields) { /* */ FixDeclList(t->components.type.kind.record.fields); /* */ } /* */ } } } } bool isInitNameTypePair(nodep t) { return t and (t->header.kind == DECL_NODE) and (t->header.name == YASSMNT); } /* * Enter an object name in CurSymtab then go to a new level for entering * variables. */ SymtabEntry* EnterObjectName( nodep obj, /* Obj decl node containing flags, if nec. */ nodep namenode) /* Atom node containing name of abstract object * or name/type pair containing name/type of * concrete object. */ { char *name; SymtabEntry *sym; int isConc = ChkSubnodeFlag(obj->components.decl.kind.obj.flags, isDef); /* * In the new parser, there is no diff between the locale of name in obj vs * val decls. The comment that follows refers to the now commented out * code. I'm leaving this here for now until values are fully debugged in * the new-parser version of things. There's a LOG entry to clean this up, * if I ever get to it. F me for making this so complicated. * * Grab the string name. Note different locale of name in concrete vs * abstract object. The former may have a ": type" defined, so the * namenode is a full name/type pair. * if (isConc) name = namenode->components.decl.kind.attr.name-> components.atom.val.text; else */ name = namenode->components.atom.val.text; /* * Check if name already def'd in this scope. */ chkForObjRedef(name, namenode); /* * Again, in the new parser, there is no diff between the locale of name in * obj vs val decls. F me, again. I've left the entering of the type for * values, in case it's necessary. The deal is that objects don't have the * same type/value conceptual structure as values, but they still share a * common underlying tree and symtab representation. This is the result of * the original (way old) notion that values were a "special case" of * object, the latter be "concrete" kinds of objects. This notion is crap * at this point, but the bad underlying representation persists. * * Note again bifarcation on concrete vs abstract object. In the case of * the former, the sym is class C_Obj, the isDef flag set, and the type is * entered from the name/type pair. Subsequently, the value tree will be * stored in the Info.Obj.parts field. */ if (isConc) { Enter(sym=HashAllocSymtabEntry(name, C_Obj, obj->components.decl.kind.obj.type, CurSymtab->Level+1)); SetSymFlag(sym, isDef); } else Enter(sym=HashAllocSymtabEntry(name, C_Obj, null, CurSymtab->Level+1)); sym->Loc = namenode->header.loc; /* * Put a pointer to the sym in the decl-order symtab list. */ PutCppList(CurSymtab->DeclOrderList, (CppListElem) NewAuxCppListElem( sym->Symbol, sym)); NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ return sym; } /* * Check if an obj is being redefined and warn that new def is being or'd onto * extant def. */ void chkForObjRedef(char* name, nodep namenode) { SymtabEntry* sym; if (sym=LookupThisScope(name)) { if (WarnOnObjRedefOn()) { lchastise(namenode, "Identifier %s already defined in this module, on line %d\n", name, sym->Loc.line); /* ClearObjEntry(sym); */ } } } /* * Enter an operation name in CurSymtab then go to a new level for entering * variables. */ void EnterOpName( nodep namenode) /* Atom node containing name of object */ { char *name; SymtabEntry *sym; /* * Grab the string name. */ name = namenode->components.atom.val.text; /* * Check if name already def'd in this scope as something other than an op. * This check will allow overloaded proc names. The strategy for * overloading begins simply by allowing multiple entries of the same proc * name. Given bucket hashing, this is fine. The only hackish nature of * the strategy is that we'll access the bucket list directly, but this * could easily be fixed by providing a public bucket generator function, * which we'll certainly do in the rewrite. * * VERY IMPORTANT NOTE: With a name type equiv rule, we *could* check for * duplicate overloaded signatures here in the first pass. However, if we * ever switch to a structural equiv rule, then this wont be possible. To * retain flexibility, we wait until the second pass to check for duplicate * signatures in overloaded ops. See typechk.c:chkBindingsNameCall. */ if (sym=LookupThisScope(name)) { if (not chkForLegalOpOverload(sym)) { lchastise(namenode, "Identifier %s already defined in this module, on line %d\n", name, sym->Loc.line); /* ClearObjEntry(sym); */ } } Enter(sym=HashAllocSymtabEntry(name, C_Op, null, CurSymtab->Level+1)); sym->Loc = namenode->header.loc; NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ } /* * Check if an op overload attempt is legal. This is the case if the class of * the given sym is is C_Op, or C_Obj and the sig of the new sym is the same as * the comp expr of the extant obj. The latter is the case when the use is * explicitly def'ing the auto-def'd constructor op for an obj. */ bool chkForLegalOpOverload(SymtabEntry* sym) { /* * Return true if it's a normal op overload; */ if ((sym->Class == C_Proc) or (sym->Class == C_Op)) { return true; } /* * If the new ident is an obj, then allow an op def if it has the same sig * as the extant op. * * Hmm, with name type equiv and no declar before use, it looks this just * needs to be passed through just like a op, and checked later in the typ * checker 2nd pass. We'll leave the at present redundant check if we want * later to attempt to at least partially enforce things here in the 1st * pass. */ if (sym->Class == C_Obj) return true; return false; } /* * Enter a symtab for an anonymous op type. */ void EnterAnonOpName(int num) { char namebuf[100]; nodep namenode; namenode = NewNode(ATOM_NODE, Yident, EmptyLoc); sprintf(namebuf, "??AnonOp%d", num); namenode->components.atom.val.text = hashsave(namebuf); EnterOpName(namenode); } /* * Build the constrained type for an op decl. */ BuildOpType(SymtabEntry* sym) { nodep n; n = NewNode(TYPE_NODE, YOP, EmptyLoc); n->components.type.kind.op.entry = sym; sym->Info.Op.OpType = n; } /* * Leave an object level after the object has been fully parsed. * * 20jun92 glf: Browser hooks. * * 17oct94 glf: Compute the type struct defined by the parts spec and store it * in the type field of the symtab entry. */ void ExitObject(nodep objDecl, int startpos, int endpos) { char *name; struct namelist *components; struct namelist *operations; SymtabEntry* sym; if (objDecl) { name = objDecl->components.decl.kind.obj.name-> components.atom.val.text; components = NULL; /* should be namelist eventually */ operations = NULL; /* should be namelist eventually */ addObject (name,components,operations,startpos,endpos); /* addObject ($2, $5, $6, startp, endp);}; */ objDecl->components.decl.kind.obj.sym = CurSymtab->ParentEntry; /* * For value decls, store full parse tree in the symtab entry, so it * can be used to incrementally resolve forward value references. */ sym = CurSymtab->ParentEntry; if (sym and (sym->Class == C_Obj) and ChkSymFlag(sym, isDef)) { sym->Info.Obj.theTree = ShallowCopyNode(objDecl); } } LeaveLevel(); } /* * Leave an operation level after the object has been fully parsed. * * 20jun92 glf: Browser hooks. */ void ExitOperation(nodep opDecl, int startpos, int endpos) { char *name; struct namelist *components; struct namelist *inputs; struct namelist *outputs; if (opDecl) { name = opDecl->components.decl.kind.op.name-> components.atom.val.text; components = NULL; /* should be namelist eventually */ inputs = NULL; /* should be namelist eventually */ outputs = NULL; /* should be namelist eventually */ addOperation (name,components,inputs,outputs,startpos,endpos); opDecl->components.decl.kind.op.sym = CurSymtab->ParentEntry; } /* * Fix the tconc-style parms chains. See EnterOp{In,Out}Parms() for * further discussion. */ if (CurSymtab->ParentEntry->Info.Op.InParms) { SymtabEntry* temp = CurSymtab->ParentEntry->Info.Op.InParms; CurSymtab->ParentEntry->Info.Op.InParms = CurSymtab->ParentEntry->Info.Op.InParms->Info.Parm.Link; temp->Info.Parm.Link = null; } if (CurSymtab->ParentEntry->Info.Op.OutParms) { SymtabEntry* temp = CurSymtab->ParentEntry->Info.Op.OutParms; CurSymtab->ParentEntry->Info.Op.OutParms = CurSymtab->ParentEntry->Info.Op.OutParms->Info.Parm.Link; temp->Info.Parm.Link = null; /* * NEWS FLASH: I'm not really sure why we left the processing described * below to EnterOperation. It would seem that it would be fine here, * in as much as EnterOperation happens virtually immediately after * this function exits. * IMPORTANT: * See the end of EnterOperation for the setting of the op return type, * which has not yet been computed. I.e., we've built an out parms * list, but we've not computed the single functional return type which * we'll use in type checking. */ } LeaveLevel(); } /**************************************************************************** Name: MakePartsList Purpose: Make a linked list of parts for an object. Inputs: t is a pointer to a node. notClass is a flag indicating whether object is a class or not Returns: a pointer to the list. Pre: none. Post: If t is null then a null pointer is returned else a list of parts is returned. ****************************************************************************/ /* * Make the flattened list of parts for the object. This is done by * traversing the tree to find all referenced subobject names and stringing * them together in a serial list, independent of their composed expression * structure. The list is used to perform basic completeness checking -- i.e., * when an entity def is checked, this list is traversed, and each element of * it is looked up in current module symtab, * * In the same pass, make the specialization required list. This is the list * of parts in a class of the form "name:". Later when checking is * performed, this list will be checked to ensure that all fields requiring * specialization are in fact specialized all instances, at some level in the * specialization hierarchy. * * Note that "name:" fields should be disallowed in non-class entities. * This is checked relatively easily. */ nodep MakePartsList(nodep t, bool notClass) { nodep MakePartsList1(nodep t, bool notClass); if (!t) return null; if (t->components.decl.kind.obj.flags == isDef) return null; /* Just no time for this now. */ else return MakePartsList1(t, notClass); } /* * LIttle bro' */ nodep MakePartsList1(nodep t, bool notClass) { nodep t1; /* for debugging */ nodep ConcatAtomLists(nodep l1, nodep l2); if (!t) return null; switch (t->header.kind) { case BINOP_NODE: return ConcatAtomLists( MakePartsList1(t->components.binop.left_operand, notClass), MakePartsList1(t->components.binop.right_operand, notClass)); case UNOP_NODE: return MakePartsList1(t->components.unop.operand, notClass); default: if (t->components.decl.kind.attr.colon && notClass) error(" Component %s: parts requiring specialization not \ permitted in non-class objects\n", t->components.decl.kind.attr.name); else /* if (t->components.decl.kind.attr.colon or (t->components.decl.kind.attr.value->header.name != Yident)) return null; else return t->components.decl.kind.attr.value; */ return t->components.decl.kind.attr.name; } } /* * Make the flattened list of parts for the object. This is done by * traversing the tree to find all referenced subobject names and stringing * them together in a serial list, independent of their composed expression * structure. The list is used to perform basic completeness checking -- i.e., * when an entity def is checked, this list is traversed, and each element of * it is looked up in current module symtab. * * Note that although the name here is Make*Name*List, it's really making a * *Value* list, strictly speaking. I.e., it makes a list of the value parts * of name/value pairs. Since the purpose of the list is for checking, we want * the value parts, since these are the names to be looked up. The name parts * of a name/value pair are just local names. * */ nodep MakeNameList(nodep t) { nodep MakeNameList1(nodep t); if (!t) return null; if (t->components.decl.kind.obj.flags == isDef) return null; /* Just no time for this now. */ /* TODO */ else return MakeNameList1(t); } /* * LIttle bro' */ nodep MakeNameList1(nodep t) { nodep t1; /* for debugging */ nodep ConcatAtomLists(nodep l1, nodep l2); if (!t) return null; switch (t->header.kind) { case BINOP_NODE: /* * In a list binop, the 2nd operand is not another type but the * integer size, on which don't want to call MakeNameList1. */ if (t->header.name == YLIST) { return MakeNameList1(t->components.binop.left_operand); } else { return ConcatAtomLists( MakeNameList1(t->components.binop.left_operand), MakeNameList1(t->components.binop.right_operand)); } case UNOP_NODE: return MakeNameList1(t->components.unop.operand); case DECL_NODE: switch (t->header.name) { case ':': if (t->components.decl.kind.attr.colon or (t->components.decl.kind.attr.name->header.name != Yident)) return null; else if (not t->components.decl.kind.attr.value) { return MakeNameList1(t->components.decl.kind.attr.name); } else { return MakeNameList1(t->components.decl.kind.attr.value); } case YASSMNT: return MakeNameList1(t->components.decl.kind.initdecl.decl); } break; case ATOM_NODE: return CopyAtomNode(t); case TYPE_NODE: /* With the new parser, there can be ident type nodes here now, in * op sigs. What we want is to extract the name of the type. */ if (t->header.name != Yident) { lerror(t, "Ill-structured list.\n"); return null; } else { return CopyAtomNode(t->components.type.kind.ident.type); } case TRINOP_NODE: /* Must be op type */ return ConcatAtomLists( MakeNameList1(t->components.trinop.left_operand), MakeNameList1(t->components.trinop.middle_operand)); default: lerror(t, "Ill-structured list.\n"); } } /* * Copy the given atom node and return the copy. This works like the copy in * MakeSpecialList, in that it copies the value part. It also "partially * demotes" the atom node to level-2 status, in that the returned copy has the * value of the copiED atom's next field in its next2 field. This allows * qualident atom nodes, which themselves are lists, to be put in a * browser-supporting name list. This is pretty funky, but it works. See the * use of the next2 field, and accompanying comments, in * typechk.c:chkObjPartsDecl. */ nodep CopyAtomNode(nodep t) { nodep temp; temp = NewNode(ATOM_NODE, t->header.name, t->header.loc); temp->components.atom.val.text = t->components.atom.val.text; temp->components.atom.next = null; temp->components.atom.next2 = t->components.atom.next; return temp; } /* * Enter a precondition scope. */ void EnterPrecond() { SymtabEntry *sym; Enter(sym=HashAllocSymtabEntry("A Precondition", null, null, CurSymtab->Level+1)); NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ } /* * Exit a precondition scope. */ void ExitPrecond( nodep t) /* Pointer to the full scope parse tree. */ { if (t != null) { t->components.decl.kind.pre.symtab = CurSymtab; } LeaveLevel(); } /* * Enter a postcondition scope. */ void EnterPostcond() { SymtabEntry *sym; Enter(sym=HashAllocSymtabEntry("A Postcondition", null, null, CurSymtab->Level+1)); NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ } /* * Exit a postcondition scope. */ void ExitPostcond( nodep t) /* Pointer to the full scope parse tree. */ { if (t != null) { t->components.decl.kind.post.symtab = CurSymtab; } LeaveLevel(); } /* * Enter an axiom. */ void EnterAxiom(nodep namenode, int num) { SymtabEntry* sym; sym = EnterFormalDecl(namenode, namenode ? namenode->components.atom.val.text : "Axiom", num); SetSymFlag(sym, isAx); } /* * Enter a theorem. */ void EnterTheorem(nodep namenode, int num) { EnterFormalDecl(namenode, namenode ? namenode->components.atom.val.text : "Theorem", num); } /* * Enter an axiom or theorem scope. Note that anonymous axioms are not * currently supported in the syntax. */ SymtabEntry* EnterFormalDecl(nodep namenode, char* name, int num) { char namebuf[100]; SymtabEntry *sym; /* * Non-null namenode means an named axiom, othewise it's anonymous. */ if (namenode) { if (sym = LookupThisScope(name)) { lchastise(namenode, "Identifier %s already defined in this module, on line %d\n", name, sym->Loc.line); } } else { sprintf(namebuf, "??Anon%s%d", name, num); name = hashsave(namebuf); } Enter(sym = HashAllocSymtabEntry(name, null, null, CurSymtab->Level+1)); sym->Loc = namenode ? namenode->header.loc : EmptyLoc; if (namenode) { SetSymFlag(sym, hasName); } NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ return sym; } /* * Exit an axiom or theorem name, then go to a new level for entering * variables. At present, the new level is not necessary, but it's here in * case things expand in future to make formal decls a first-class scope. */ void ExitFormalDecl( nodep t) /* Pointer to the full scope parse tree. */ { t->components.decl.kind.formaldef.symtab = CurSymtab; LeaveLevel(); } /* * Enter a quantifier or equations scope. Disabled 8nov01. Reenabled 9nov01. */ void EnterQuant() { SymtabEntry *sym; Enter(sym=HashAllocSymtabEntry("A Quantifier", null, null, CurSymtab->Level+1)); NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ } /* * Exit a quantifier or equations scope. Disabled 8nov01. Reenabled 9nov01. */ void ExitQuant( nodep t) /* Pointer to the full scope parse tree. */ { t->components.decl.kind.quant.symtab = CurSymtab; LeaveLevel(); } /* * Enter an equations scope. Note that Enter/ExitEqns might be merged with * Enter/ExitQuant, but we'll leave them separate for possible future * enhancements. */ void EnterEqns() { SymtabEntry *sym; Enter(sym=HashAllocSymtabEntry("Equations", null, null, CurSymtab->Level+1)); NewLevel(sym, 128, 0, null); /* ^^^^ NOTE. Should be changed. */ } /* * Exit a quantifier or equations scope. */ void ExitEqns( nodep t) /* Pointer to the full scope parse tree. */ { t->components.decl.kind.eqns.symtab = CurSymtab; LeaveLevel(); } /* * OLD CRAP TO NUKE. */ /**************************************************************************** * Name: MakeSpecialList * Purpose: Make a linked list of parts that need specialization for an object. * Inputs: t is a pointer to a node. * Returns: a pointer to the list. * Pre: none. * Post: If t is null then a null pointer is returned else a list of parts * is returned. ****************************************************************************/ /* * In the same pass, make the specialization required list. This is the list * of parts in a class of the form "name:". Later when checking is * performed, this list will be checked to ensure that all fields requiring * specialization are in fact specialized all instances, at some level in the * specialization hierarchy. */ nodep MakeSpecialList(nodep t) { nodep MakeSpecialList1(nodep t, int level, nodep p); if (!t) return null; if (t->components.decl.kind.obj.flags == isDef) return null; /* Just no time for this now. */ else return MakeSpecialList1(t, 1, t); } /* * Little bro' */ nodep MakeSpecialList1(nodep t, int level, nodep p) { nodep t1; /* for debugging */ nodep temp; nodep ConcatAtomLists(nodep l1, nodep l2); if (!t) return null; switch (t->header.kind) { case BINOP_NODE: switch (t->header.name) { case '(': if (p->header.name != YLIST) /* return ConcatAtomLists( MakeSpecialList1(t->components.binop.left_operand,level+1,t), MakeSpecialList1(t->components.binop.right_operand,level+1,t)); */ return(MakeSpecialList1(t->components.binop.right_operand,level+1,t)); else /* return ConcatAtomLists( MakeSpecialList1(t->components.binop.left_operand,level,t), MakeSpecialList1(t->components.binop.right_operand, level,t)); */ return(MakeSpecialList1(t->components.binop.right_operand, level,t)); default: return ConcatAtomLists( MakeSpecialList1(t->components.binop.left_operand,level,t), MakeSpecialList1(t->components.binop.right_operand, level,t)); } break; case UNOP_NODE: switch (t->header.name) { case '(': if (p->header.name != YLIST) return MakeSpecialList1(t->components.unop.operand, level+1,t); else return MakeSpecialList1(t->components.unop.operand, level,t); default: return MakeSpecialList1(t->components.unop.operand, level,t); } break; case DECL_NODE: switch (t->header.name) { case YASSMNT: return(MakeSpecialList1( t->components.decl.kind.initdecl.decl,level,t)); case ':': if (t->components.decl.kind.attr.colon) { if (level == 1) { temp = NewNode(t->header.kind, t->header.name, EmptyLoc); bcopy( t->components.decl.kind.attr.name, temp, sizeof(struct node)); temp->components.atom.next = null; return temp; } else { error( " specialization of parts allowed on first level only\n"); return null; } } else return null; } break; default: printf("MakeSpecialList1: default, something not caught\n"); } } /* * Glue together two atom lists inefficiently. Oh for Icon. */ nodep ConcatAtomLists(nodep l1, nodep l2) { nodep n; if (!l1) return l2; for (n=l1; n->components.atom.next; n=n->components.atom.next) ; n->components.atom.next = l2; return l1; } /* * Init higher-level symtab stuff, including the main list and the main symtab. */ InitSymtabAux() { ModuleList = NewCppList(); InitList(); InstallMain(); InitBrowserSymtab(); } /*** * Some browser-specific goodies. See the comments at the top of * ../rbrowse/trans-interface.c. */ /* * Having just checked a phrase of the form * * instance of * * [ obj_heading | op_heading ] YINSTANCE YOF class_name_list * * add the name in the heading to the instances list(s) of the classes in * class_name_list. */ /*AddToInstanceList(instanceName, parentName*/ /* * Enter the elements of an op signature into the op's symtab (CurSymtab). */ /* * The effort on the next two functions has been abandonded, and the grammar * has been comprimised to distinguish between input and output parms in an * operation_signature. The reason for the abandoment is that formal parms are * not in a simple list, but rather in a binary tree with 'and' operators. * This makes the parm tree more difficult to travarse than a simple list, and * I don't feel like wasting the time to make it happen, right now, if ever. * * Enter a list of input parms. This function is here make the grammar * simpler. Specifically, it avoids the need for separate grammar rules for * input and output parm lists, or some kind of global hack of an inherited * attribute that distinguishes between input vs output parms * meta-grammatically. */ void EnterOpInParms(nodep parms) { } /* * Enter a list of output parms. The rationale for EnterOpInParms applies to * this function. */ void EnterOpOutParms(nodep parms) { } /* * Enter an op input parm into the symtab. The real work is done in * EnterOpParm, defined below. */ void EnterOpInParm( nodep nametypepair, /* A ':' DECL_NODE */ bool islist) /* True if this is a list parm */ { SymtabEntry* sym; /* * Do the stuff common to both in and out parms. */ sym = EnterOpParm(nametypepair, islist); /* * Splice this parm into the in parms thread, tconc-style. */ if (not CurSymtab->ParentEntry->Info.Op.InParms) { CurSymtab->ParentEntry->Info.Op.InParms = sym; sym->Info.Parm.Link = sym; } else { sym->Info.Parm.Link = CurSymtab->ParentEntry->Info.Op.InParms->Info.Parm.Link; CurSymtab->ParentEntry->Info.Op.InParms->Info.Parm.Link = sym; CurSymtab->ParentEntry->Info.Op.InParms = sym; } } /* * Clone of EnterOpInParm. It calls the common function then accesses * Info.Op.OutParms instead of .InParms. */ void EnterOpOutParm( nodep nametypepair, /* A ':' DECL_NODE */ bool islist) /* True if this is a list parm */ { SymtabEntry* sym; /* * Do the stuff common to both in and out parms. */ sym = EnterOpParm(nametypepair, islist); /* * Splice this parm into the out parms thread, tconc-style. */ if (not CurSymtab->ParentEntry->Info.Op.OutParms) { CurSymtab->ParentEntry->Info.Op.OutParms = sym; sym->Info.Parm.Link = sym; } else { sym->Info.Parm.Link = CurSymtab->ParentEntry->Info.Op.OutParms->Info.Parm.Link; CurSymtab->ParentEntry->Info.Op.OutParms->Info.Parm.Link = sym; CurSymtab->ParentEntry->Info.Op.OutParms = sym; } } /* * Enter an op parm into its symtab, whether or not it has a name. Note that * we use a tconc list to do the parm threading, which is different than the * Mod-2 approach used above in EnterParms. Therefore, we wait until we have a * full list, and link as we traverse the list. Here, in contrast, we use the * Info.Proc.Parms field as a running tconc pointer to grow the list. As * always, the list must be fixed when we're done, which we do upon exiting * this symtab level (i.e., in ExitOperation). * * Re. "whether or not it has a name", we must pay attention to how a name/type * pair is built by the parser. Viz., if there is only one item in the pair, * then it is put in the name field, and the type field is empty. If there is * a colon-separated pair of items, then the name field is the first in the * pair, and the type is the second. In future, we'll probably want to change * this, but we'll leave it for now since it's not clear where else the current * scheme is assumed. * * See further comments below about why we enter even if parm has no name. */ SymtabEntry* EnterOpParm(nodep nametypepair, bool islist) { nodep name; TypeStruct type; char* strname; SymtabEntry* sym; SrcLoc loc; TypeStruct raw_type; /* Used to strip off UN_OP put in by new parser */ /* * Enter it under the name "??" if there's no user-supplied name. We want * to do the entry so we can easily access all sig args via the parm chain * during type checking (see typechk.c:chkOpParms). * * Later we might want to enter under name "p#n" for default access. */ if (not nametypepair->components.decl.kind.attr.value) { strname = hashsave("??"); /* * The use of raw_type is a tricky hack. The deal is that the new * parser more cleanly and uniformly represents type designators * syntactically. Specifically, it puts the unary list operator * directly in the type designator tree. The old parser did not do * this. After much dicking around, I figured the easiest way to deal * with it is the code that's here. It uses the IslistTypeDesig * function to check if there's a UNOP list in the type, and if so, * grabs the list's bastype to send off to BuildCompType1. It's * crappy, but it works until this whole puppy is re-written, which is * becoming an increasingly unlikely prospect. */ raw_type = nametypepair->components.decl.kind.attr.name; if (IsListTypeDesig(raw_type)) { raw_type = raw_type->components.unop.operand; } type = BuildCompType1(raw_type); loc = nametypepair->components.decl.kind.attr.name ? nametypepair->components.decl.kind.attr.name->header.loc : EmptyLoc; } else { /* * Extract the two fields. */ name = nametypepair->components.decl.kind.attr.name; /* * Preceding comment about raw_type applies here as well. */ raw_type = nametypepair->components.decl.kind.attr.value; if (IsListTypeDesig(raw_type)) { raw_type = raw_type->components.unop.operand; } type = BuildCompType1(raw_type); loc = nametypepair->components.decl.kind.attr.value->header.loc; /* * Complain if parm of given name already decl'd for current op. Note * that we dont return after this error, which means we do the entering * anyway. Again, we want to type check all parms via the parm chain, * so we chain 'em all up, even without names or with duplicate names. */ if (LookupThisScope(strname = name->components.atom.val.text)) { lerror(name, "Parameter named %s already declared for this operation.\n", strname); } } /* * Do the entering. Note that the src loc is set to the loc of the type, * since there may not be a name. Also, the loc of the type is used to * report the position of an undef'd type in typechk.c:chkOpParms, q.v. */ Enter(sym=AllocSymtabEntry(strname, C_Parm, type, CurSymtab->Level)); sym->Loc = loc; /* * Note that we'll set a listParm flag in both the parm entry as well as * its type struct directly. The former is necessary for the unbundling * stuff, handled predominately in chkBindingsSingleListArity, q.v. The * latter is necessary when checking a list-parm formal in an op body. * Oops -- this latter thang aint a gonna work, I dont thank. The prob is * that we caint mark a type we aint made a copy of. */ if (islist) { SetSymFlag(sym, listParm); sym->Type = BuildListFromBasetype(sym->Type); } return sym; }