/* * Auxiliary functions called in action routines of parser2.y. * Well, as you can see, this has been gutted. */ #include #include #include "std-macros.h" #include "parse-tree.h" #include "parser.h" #include "tokens.h" #include "sym.h" #include "sym-aux.h" #include "parser-aux.h" #include "token-mapping.h" /* * Start a list of decl nodes to be built left recursively. */ nodep InitDeclList(nodep t) { if (PARSE_ERROR or !t) return null; t->components.decl.next = t; return t; } /* * Add to a list of left-recursively-building decl nodes. */ nodep AddToDeclList(nodep list, nodep item) { if (PARSE_ERROR) return null; if (!list) return InitDeclList(item); if (!item) return list; item->components.decl.next = list->components.decl.next; list->components.decl.next = item; return item; } /* * Fix up a list of left-recursively-built decl nodes. */ nodep FixDeclList(nodep t) { nodep head; if (PARSE_ERROR or !t) return null; head = t->components.decl.next; t->components.decl.next = null; return head; } /** ** The following groups of three are clones of prev three. **/ /* * Start a list of atom nodes to be built left recursively. */ nodep InitAtomList(nodep t) { t->components.atom.next = t; return t; } /* * Add to a list of left-recursively-building atom nodes. */ nodep AddToAtomList(nodep list, nodep item) { if (PARSE_ERROR) return null; if (!list) return item; if (!item) return list; item->components.atom.next = list->components.atom.next; list->components.atom.next = item; return item; } /* * Fix up a list of left-recursively-built atom nodes. */ nodep FixAtomList(nodep t) { nodep head; if (PARSE_ERROR or !t) return null; head = t->components.atom.next; t->components.atom.next = null; if (head != null) { head->components.atom.tail = t; } return head; } /* * Start a list of atom nodes to be built left recursively, using the next2 * link. */ nodep InitAtomList2(nodep t) { if (!t) return null; t->components.atom.next2 = t; return t; } /* * Add to a list of left-recursively-building atom nodes, using the next2 * link. */ nodep AddToAtomList2(nodep list, nodep item) { if (PARSE_ERROR) return null; if (!list) return item; if (!item) return list; item->components.atom.next2 = list->components.atom.next2; list->components.atom.next2 = item; return item; } /* * Fix up a list of left-recursively-built atom nodes, using the next2 link. */ nodep FixAtomList2(nodep t) { nodep head; if (PARSE_ERROR or !t) return null; head = t->components.atom.next2; t->components.atom.next2 = null; return head; } /* * Start a list of atom nodes to be built left recursively. */ nodep InitObjList(nodep t) { t->components.atom.next = null; return t; } /* * Add to a list of left-recursively-building atom nodes. */ nodep AddToObjList(nodep list, nodep item) { nodep t; if (PARSE_ERROR) return null; if (!list) return item; if (!item) return list; for (t = list; t->components.atom.next; t = t->components.atom.next); t->components.atom.next = item; return list; } /* * Fix up a list of left-recursively-built atom nodes. */ nodep FixObjList(nodep t) { nodep tail, head; if (PARSE_ERROR or !t) return null; tail = NewNode(ATOM_NODE, ']', EmptyLoc); for (head = t; t->components.atom.next; t = t->components.atom.next); t->components.atom.next = tail; return head; } /** ** Clone again. **/ /* * Start a list of expr list nodes to be built left recursively. */ nodep InitExprList(nodep t) { if (PARSE_ERROR or !t) return null; t->components.exprlist.next = t; return t; } /* * Add to a list of left-recursively-building expr list nodes. */ nodep AddToExprList(nodep list, nodep item) { if (PARSE_ERROR) return null; if (!list) return item; if (!item) return list; item->components.exprlist.next = list->components.exprlist.next; list->components.exprlist.next = item; return item; } /* * Fix up a list of left-recursively-built expr list nodes. */ nodep FixExprList(nodep t) { nodep head; if (PARSE_ERROR or !t) return null; head = t->components.exprlist.next; t->components.exprlist.next = null; return head; } /* * Merge two decl lists, retaining the tconc structure. */ nodep MergeDeclLists(nodep t1, nodep t2) { nodep temp; temp = t2->components.decl.next; t2->components.decl.next = t1->components.decl.next; t1->components.decl.next = temp; return t2; } /*** *** From here to end of file is old crap from Daisy. ***/ /* * Enter spec decls into the symtab and check them. */ void CreateSpecSymtab() { } /* * Create a spec object by mapping its components to a Pascal-class type and * recording all its other info, including ops, as attr/value pairs. Hence, * an object is just a type. The precise mapping of obj components to * Pascal-class typs is as follows: * * Obj Comp Op Pascal-Class Type * and record * or variant record (aka, union) * * open array * recursion pointer -- *not yet implmented* * */ void CreateObjDecl() { /* The main business here is to scan the parse tree and turn an infix 'and' and 'or' operators into records and unions resp. '*' op is a bit eaiser, since it goes to an open array type. Recursive defs will be the harderst of the lot, since they have to go to pointers in general, and will, it seems, require a good deal of mucking about. */ /* switch case */ /* CreateObjDecl1() */ } /* * ORIGINAL IDEA: * Create a spec operation by mappings its components to a proc calls list, * its inputs to val parms, its outputs to var parms, and all other info as * attr/value pairs. Hence, an operation is just a proc. * * NEW IMPROVED IDEA: * An operation will be a SymtabEntry class in its own right. It will * represent the canonical function prototype for all languages. Specifically: * * A proc decl'd in a Mod-2 def module * A C/C++ function prototype * It has the in-in/out-out features needed for Ada procs * * In SR parlance, a operation will be `serviced by', i.e., implemented by a * some Pascal-class proc/func. */ void CreateOpDecl() { } /* Simply enter an obj decl into the CurSymtab. */ void EnterObjDecl() { } /* Simply enter an op decl into the CurSymtab. */ void EnterOpDecl() { } void CheckSpec() { } /* * Functions to check and define attribute names. */ bool IsAttrName(char *ident) { SymtabEntry *sym; sym = LookupString(ident); return (sym and (sym->Class == C_Attr)); } bool IsQuesIdent(char *ident) { return ident[0] == '?'; } void DefineAttrNames(nodep t) { for (; t; t=t->components.atom.next) Enter(HashAllocSymtabEntry(t->components.atom.val.text, C_Attr, null, CurSymtab->Level+1)); } /* * Inputs are the following: * (1) pointer to the obj decl node to be completed * (2) a possibly empty pointer to a parts_spec * (3) a possbily empty pointer to an unfixed attr list. * * Do the following processing with these: * (a) FixDeclList on (3) * (b) If (2) is non-empty, then * (i) install it in (1)->...parts * (ii) bitch if there is a "components:" attr in (3) * (c) Else install the "components:" of (3) in (1)->...parts * (d) In either case, remove the "components:" from (3) * (e) Do similar processing for "ops:" and "eqns:" attrs of (3), including * removing them from (3) * (f) Store the fixed up (3) in (1)->...attrs. */ void ProcessAbsObjAttrs(nodep objdecl, nodep parts, nodep attrs) { nodep ca; /* * This is the default, for starters. */ objdecl->components.decl.kind.obj.parts = parts; if (ca = FindComponentsAttribute(attrs)) { if (parts) { lerror(parts, "Components attribute redundant and ignored.\n"); } else { objdecl->components.decl.kind.obj.parts = ca; } } } /* * Same as preceding, except (2) is pointer to obj expr instead of parts expr. */ void ProcessConcObjAttrs(nodep objdecl, nodep parts, nodep attrs) { objdecl->components.decl.kind.obj.parts = parts; } /* * Do comparable processing for an op decl. Given decl contains parms, which * needed to be bundled in order to do name mangling for symtab entry. */ void ProcessOpAttrs(nodep opdecl, nodep parts, nodep attrs) {} /* * Locate a built-in attribute by the token value of its name field, if present * in the given attr list. Return the value of the attribute, which is a * pointer to a components expr. Check for more than one copy of the attr, and * issue a message if found. */ nodep FindAttr(nodep attrs, TokenType name) { nodep a, rtn; for (a=attrs, rtn=null; a; a=a->components.decl.next) { if (a->header.name == name) { if (not rtn) { switch (name) { case YPARTS: rtn = a->components.decl.kind.parts; break; case YWHERE: rtn = a->components.decl.kind.where; break; case YOPS: rtn = a->components.decl.kind.opsig.list; break; case YEQUATIONS: rtn = a; /* NOTE: user will pull apart. */ break; case YINPUTS: rtn = a->components.decl.kind.ins; break; case YOUTPUTS: rtn = a->components.decl.kind.outs; break; case YPRE: rtn = a; /* NOTE: user will pull apart. */ break; case YPOST: rtn = a; /* NOTE: user will pull apart. */ break; } } else { lerror(a, "Duplicate attribute ignored.\n"); } } } /* * Make a shallow copy, and set the components.decl.next field to null. * This will keep execution from running through the next chain, which is * an entire attribute list for an object or operation. */ return rtn; } /* * Locate a user-defined attribute by string name. */ nodep FindUserAttr(nodep attrs, char* name) { nodep a; if (! attrs) return null; for (a=attrs; a; a=a->components.decl.next) { if ((a->header.name == ':') && streq(a->components.decl.kind.attr.name-> components.atom.val.text, "description")) return a->components.decl.kind.attr.value; } return null; } /* * Locate a components attribute, if present in the given attribute list. * Return the value of the attribute, which is a pointer to a components expr. * This function is almost superceded by the general FindAttr, except that this * function has a slightly more specific error message. */ nodep FindComponentsAttribute(nodep attrs) { nodep a, rtn; for (a=attrs, rtn=null; a; a=a->components.decl.next) { if (a->header.name == YPARTS) { if (not rtn) { rtn = a->components.decl.kind.parts; } else { lerror(a, "Extra components attribute ignored.\n"); } } } return rtn; } /* * Return the source code string between the given two source locs. The source * file is assumed not to be open. */ char* GetSource(SrcLoc l1, SrcLoc l2) { char* fname = l1.file; /* Source file name */ FILE* file; /* Opened source file */ /* * Open the source file. */ if ((file = fopen(fname, "r")) == NULL) { perror("Problem opening file \"fname\""); return; } /* * Call the helper function. */ return GetSourceFromFile(l1, l2, file); } /* * Like GetSource, but with pre-opened file. */ char* GetSourceFromFile(SrcLoc l1, SrcLoc l2, FILE* file) { int pos; /* Working char position in source file */ char* rtn; /* Return string */ int size = /* Size of the returned string, including null */ l1.abschar + l2.abschar + 1; /* * Alloc the string to be returned. */ rtn = (char*) malloc(size); /* * Advance char pos up to l1.char. */ if (lseek(file, l1.abschar, SEEK_SET) == -1) { perror("Problem reading file \"fname\""); } /* * Read in the chars. */ for (pos = 0; pos < size; pos++) { rtn[pos] = fgetc(file); } /* * Null terminate. */ rtn[size] = null; /* * Done. */ return rtn; } bool IsListTypeDesig(nodep t) { return t and (t->header.kind == UNOP_NODE) and (t->header.name == YLIST); } /* * Access loc field of given node. Protect against node being null. */ SrcLoc loc(nodep t) { if (t == null) { return EmptyLoc; } else { return t->header.loc; } }