121624Sdist /* 238105Sbostic * Copyright (c) 1983 The Regents of the University of California. 338105Sbostic * All rights reserved. 438105Sbostic * 5*42685Sbostic * %sccs.include.redist.c% 621624Sdist */ 718234Slinton 816623Ssam #ifndef lint 9*42685Sbostic static char sccsid[] = "@(#)stabstring.c 5.5 (Berkeley) 06/01/90"; 1038105Sbostic #endif /* not lint */ 1116623Ssam 1216623Ssam /* 1316623Ssam * String information interpretation 1416623Ssam * 1516623Ssam * The string part of a stab entry is broken up into name and type information. 1616623Ssam */ 1716623Ssam 1816623Ssam #include "defs.h" 1916623Ssam #include "stabstring.h" 2016623Ssam #include "object.h" 2116623Ssam #include "main.h" 2216623Ssam #include "symbols.h" 2316623Ssam #include "names.h" 2416623Ssam #include "languages.h" 2518234Slinton #include "tree.h" 2616623Ssam #include <a.out.h> 2716623Ssam #include <ctype.h> 2816623Ssam 2916623Ssam #ifndef public 3016623Ssam #endif 3116623Ssam 3216623Ssam /* 3316623Ssam * Special characters in symbol table information. 3416623Ssam */ 3516623Ssam 3618234Slinton #define CONSTNAME 'c' 3716623Ssam #define TYPENAME 't' 3816623Ssam #define TAGNAME 'T' 3916623Ssam #define MODULEBEGIN 'm' 4016623Ssam #define EXTPROCEDURE 'P' 4116623Ssam #define PRIVPROCEDURE 'Q' 4216623Ssam #define INTPROCEDURE 'I' 4316623Ssam #define EXTFUNCTION 'F' 4416623Ssam #define PRIVFUNCTION 'f' 4516623Ssam #define INTFUNCTION 'J' 4616623Ssam #define EXTVAR 'G' 4716623Ssam #define MODULEVAR 'S' 4816623Ssam #define OWNVAR 'V' 4916623Ssam #define REGVAR 'r' 5016623Ssam #define VALUEPARAM 'p' 5116623Ssam #define VARIABLEPARAM 'v' 5216623Ssam #define LOCALVAR /* default */ 5316623Ssam 5416623Ssam /* 5516623Ssam * Type information special characters. 5616623Ssam */ 5716623Ssam 5816623Ssam #define T_SUBRANGE 'r' 5916623Ssam #define T_ARRAY 'a' 6018234Slinton #define T_OLDOPENARRAY 'A' 6118234Slinton #define T_OPENARRAY 'O' 6218234Slinton #define T_DYNARRAY 'D' 6318234Slinton #define T_SUBARRAY 'E' 6416623Ssam #define T_RECORD 's' 6516623Ssam #define T_UNION 'u' 6616623Ssam #define T_ENUM 'e' 6716623Ssam #define T_PTR '*' 6816623Ssam #define T_FUNCVAR 'f' 6916623Ssam #define T_PROCVAR 'p' 7016623Ssam #define T_IMPORTED 'i' 7116623Ssam #define T_SET 'S' 7216623Ssam #define T_OPAQUE 'o' 7318234Slinton #define T_FILE 'd' 7416623Ssam 7516623Ssam /* 7616623Ssam * Table of types indexed by per-file unique identification number. 7716623Ssam */ 7816623Ssam 7916623Ssam #define NTYPES 1000 8016623Ssam 8116623Ssam private Symbol typetable[NTYPES]; 8216623Ssam 8316623Ssam public initTypeTable () 8416623Ssam { 8516623Ssam bzero(typetable, sizeof(typetable)); 8616623Ssam (*language_op(curlang, L_MODINIT))(typetable); 8716623Ssam } 8816623Ssam 8916623Ssam /* 9016623Ssam * Put an nlist entry into the symbol table. 9116623Ssam * If it's already there just add the associated information. 9216623Ssam * 9316623Ssam * Type information is encoded in the name following a ":". 9416623Ssam */ 9516623Ssam 9616623Ssam private Symbol constype(); 9716623Ssam private Char *curchar; 9816623Ssam 9916623Ssam #define skipchar(ptr, ch) \ 10016623Ssam { \ 10116623Ssam if (*ptr != ch) { \ 10216623Ssam panic("expected char '%c', found '%s'", ch, ptr); \ 10316623Ssam } \ 10416623Ssam ++ptr; \ 10516623Ssam } 10616623Ssam 10716623Ssam #define optchar(ptr, ch) \ 10816623Ssam { \ 10916623Ssam if (*ptr == ch) { \ 11016623Ssam ++ptr; \ 11116623Ssam } \ 11216623Ssam } 11316623Ssam 11433336Sdonn #ifdef sun 11533336Sdonn # define chkcont(ptr) \ 11616623Ssam { \ 11733336Sdonn if (*ptr == '\\' or *ptr == '?') { \ 11833336Sdonn ptr = getcont(); \ 11933336Sdonn } \ 12033336Sdonn } 12133336Sdonn #else if notsun 12233336Sdonn # define chkcont(ptr) \ 12333336Sdonn { \ 12416623Ssam if (*ptr == '?') { \ 12516623Ssam ptr = getcont(); \ 12616623Ssam } \ 12716623Ssam } 12833336Sdonn #endif 12916623Ssam 13016623Ssam #define newSym(s, n) \ 13116623Ssam { \ 13216623Ssam s = insert(n); \ 13316623Ssam s->level = curblock->level + 1; \ 13416623Ssam s->language = curlang; \ 13516623Ssam s->block = curblock; \ 13616623Ssam } 13716623Ssam 13816623Ssam #define makeVariable(s, n, off) \ 13916623Ssam { \ 14016623Ssam newSym(s, n); \ 14116623Ssam s->class = VAR; \ 14216623Ssam s->symvalue.offset = off; \ 14316623Ssam getType(s); \ 14416623Ssam } 14516623Ssam 14616623Ssam #define makeParameter(s, n, cl, off) \ 14716623Ssam { \ 14834259Sdonn if ((s = lookup(n)) == nil or s->block != curblock) { \ 14934259Sdonn newSym(s, n); \ 15034259Sdonn s->storage = STK; \ 15134259Sdonn s->class = cl; \ 15234259Sdonn s->symvalue.offset = off; \ 15334259Sdonn getType(s); \ 15434259Sdonn } \ 15516623Ssam curparam->chain = s; \ 15616623Ssam curparam = s; \ 15716623Ssam } 15816623Ssam 15916623Ssam public entersym (name, np) 16016623Ssam String name; 16116623Ssam struct nlist *np; 16216623Ssam { 16333336Sdonn Symbol s; 16433336Sdonn register char *p, *q, *r; 16516623Ssam register Name n; 16616623Ssam char c; 16716623Ssam 16816623Ssam p = index(name, ':'); 16916623Ssam *p = '\0'; 17016623Ssam c = *(p+1); 17133336Sdonn if (autostrip and streq(language_name(curlang), "c++")) { 17233336Sdonn /* 17333336Sdonn * Strip off redundant prefixes from C++ names. 17433336Sdonn * Static variables are prefixed with _static_. 17533336Sdonn * Formal arguments of functions are prefixed with _au0_. 17633336Sdonn * Automatic variables are prefixed with _au[1-9][0-9]*_. 17733336Sdonn * Class members are prefixed with _T_, where T is a class tag. 17833336Sdonn */ 17933336Sdonn if (strncmp("_static_", name, 8) == 0 and name[8] != '\0') { 18033336Sdonn name += 8; 18133336Sdonn } 18233336Sdonn q = name; 18333336Sdonn if (*q++ == '_' and *q++ == 'a' and *q++ == 'u' and isdigit(*q++)) { 18433336Sdonn while (isdigit(*q)) 18533336Sdonn ++q; 18633336Sdonn if (*q++ == '_' and *q != '\0') 18733336Sdonn name = q; 18833336Sdonn } 18933336Sdonn q = name; 19033336Sdonn if (*q++ == '_' and c == EXTFUNCTION) { 19133336Sdonn /* 19233336Sdonn * Punt on static class members, for speed. 19333336Sdonn */ 19433336Sdonn for (r = q; (r = index(r, '_')) != nil; ++r) { 19533336Sdonn if (r == q) { 19633336Sdonn continue; 19733336Sdonn } 19833336Sdonn *r = '\0'; 19933336Sdonn s = lookup(identname(q, true)); 20033336Sdonn if (s != nil and s->class == TYPE) { 20133336Sdonn char *newname = r + 1; 20233336Sdonn if (*newname != '\0') { 20333336Sdonn name = newname; 20433336Sdonn break; 20533336Sdonn } 20633336Sdonn } 20733336Sdonn *r = '_'; 20833336Sdonn } 20933336Sdonn } 21033336Sdonn } 21116623Ssam n = identname(name, true); 21216623Ssam chkUnnamedBlock(); 21316623Ssam curchar = p + 2; 21416623Ssam switch (c) { 21518234Slinton case CONSTNAME: 21618234Slinton newSym(s, n); 21718234Slinton constName(s); 21818234Slinton break; 21918234Slinton 22016623Ssam case TYPENAME: 22116623Ssam newSym(s, n); 22216623Ssam typeName(s); 22316623Ssam break; 22416623Ssam 22516623Ssam case TAGNAME: 22618234Slinton s = symbol_alloc(); 22718234Slinton s->name = n; 22818234Slinton s->level = curblock->level + 1; 22918234Slinton s->language = curlang; 23018234Slinton s->block = curblock; 23116623Ssam tagName(s); 23216623Ssam break; 23316623Ssam 23416623Ssam case MODULEBEGIN: 23518234Slinton publicRoutine(&s, n, MODULE, np->n_value, false); 23616623Ssam curmodule = s; 23716623Ssam break; 23816623Ssam 23916623Ssam case EXTPROCEDURE: 24018234Slinton publicRoutine(&s, n, PROC, np->n_value, false); 24116623Ssam break; 24216623Ssam 24316623Ssam case PRIVPROCEDURE: 24416623Ssam privateRoutine(&s, n, PROC, np->n_value); 24516623Ssam break; 24616623Ssam 24716623Ssam case INTPROCEDURE: 24818234Slinton publicRoutine(&s, n, PROC, np->n_value, true); 24916623Ssam break; 25016623Ssam 25116623Ssam case EXTFUNCTION: 25218234Slinton publicRoutine(&s, n, FUNC, np->n_value, false); 25316623Ssam break; 25416623Ssam 25516623Ssam case PRIVFUNCTION: 25616623Ssam privateRoutine(&s, n, FUNC, np->n_value); 25716623Ssam break; 25816623Ssam 25916623Ssam case INTFUNCTION: 26018234Slinton publicRoutine(&s, n, FUNC, np->n_value, true); 26116623Ssam break; 26216623Ssam 26316623Ssam case EXTVAR: 26418234Slinton extVar(&s, n, np->n_value); 26516623Ssam break; 26616623Ssam 26716623Ssam case MODULEVAR: 26816623Ssam if (curblock->class != MODULE) { 26916623Ssam exitblock(); 27016623Ssam } 27116623Ssam makeVariable(s, n, np->n_value); 27233336Sdonn s->storage = EXT; 27316623Ssam s->level = program->level; 27416623Ssam s->block = curmodule; 27516623Ssam getExtRef(s); 27616623Ssam break; 27716623Ssam 27816623Ssam case OWNVAR: 27916623Ssam makeVariable(s, n, np->n_value); 28016623Ssam ownVariable(s, np->n_value); 28116623Ssam getExtRef(s); 28216623Ssam break; 28316623Ssam 28416623Ssam case REGVAR: 28516623Ssam makeVariable(s, n, np->n_value); 28633336Sdonn s->storage = INREG; 28716623Ssam break; 28816623Ssam 28916623Ssam case VALUEPARAM: 29016623Ssam makeParameter(s, n, VAR, np->n_value); 29133336Sdonn # ifdef IRIS 29233336Sdonn /* 29333336Sdonn * Bug in SGI C compiler -- generates stab offset 29433336Sdonn * for parameters with size added in. 29533336Sdonn */ 29634259Sdonn if (s->storage == STK and curlang == findlanguage(".c")) { 29733336Sdonn s->symvalue.offset -= size(s); 29833336Sdonn } 29933336Sdonn # endif 30016623Ssam break; 30116623Ssam 30216623Ssam case VARIABLEPARAM: 30316623Ssam makeParameter(s, n, REF, np->n_value); 30416623Ssam break; 30516623Ssam 30616623Ssam default: /* local variable */ 30716623Ssam --curchar; 30816623Ssam makeVariable(s, n, np->n_value); 30933336Sdonn s->storage = STK; 31016623Ssam break; 31116623Ssam } 31216623Ssam if (tracesyms) { 31316623Ssam printdecl(s); 31416623Ssam fflush(stdout); 31516623Ssam } 31616623Ssam } 31716623Ssam 31816623Ssam /* 31918234Slinton * Enter a named constant. 32018234Slinton */ 32118234Slinton 32218234Slinton private constName (s) 32318234Slinton Symbol s; 32418234Slinton { 32518234Slinton integer i; 32618234Slinton double d; 32718234Slinton char *p, buf[1000]; 32818234Slinton 32918234Slinton s->class = CONST; 33018234Slinton skipchar(curchar, '='); 33118234Slinton p = curchar; 33218234Slinton ++curchar; 33318234Slinton switch (*p) { 33418234Slinton case 'b': 33518234Slinton s->type = t_boolean; 33618234Slinton s->symvalue.constval = build(O_LCON, getint()); 33718234Slinton break; 33818234Slinton 33918234Slinton case 'c': 34018234Slinton s->type = t_char; 34118234Slinton s->symvalue.constval = build(O_LCON, getint()); 34218234Slinton break; 34318234Slinton 34418234Slinton case 'i': 34518234Slinton s->type = t_int; 34618234Slinton s->symvalue.constval = build(O_LCON, getint()); 34718234Slinton break; 34818234Slinton 34918234Slinton case 'r': 35018234Slinton sscanf(curchar, "%lf", &d); 35118234Slinton while (*curchar != '\0' and *curchar != ';') { 35218234Slinton ++curchar; 35318234Slinton } 35418234Slinton --curchar; 35518234Slinton s->type = t_real; 35618234Slinton s->symvalue.constval = build(O_FCON, d); 35718234Slinton break; 35818234Slinton 35918234Slinton case 's': 36018234Slinton p = &buf[0]; 36118234Slinton skipchar(curchar, '\''); 36218234Slinton while (*curchar != '\'') { 36318234Slinton *p = *curchar; 36418234Slinton ++p; 36518234Slinton ++curchar; 36618234Slinton } 36718234Slinton *p = '\0'; 36818234Slinton s->symvalue.constval = build(O_SCON, strdup(buf)); 36918234Slinton s->type = s->symvalue.constval->nodetype; 37018234Slinton break; 37118234Slinton 37218234Slinton case 'e': 37318234Slinton getType(s); 37418234Slinton skipchar(curchar, ','); 37518234Slinton s->symvalue.constval = build(O_LCON, getint()); 37618234Slinton break; 37718234Slinton 37818234Slinton case 'S': 37918234Slinton getType(s); 38018234Slinton skipchar(curchar, ','); 38118234Slinton i = getint(); /* set size */ 38218234Slinton skipchar(curchar, ','); 38318234Slinton i = getint(); /* number of bits in constant */ 38418234Slinton s->symvalue.constval = build(O_LCON, 0); 38518234Slinton break; 38618234Slinton 38718234Slinton default: 38818234Slinton s->type = t_int; 38918234Slinton s->symvalue.constval = build(O_LCON, 0); 39018234Slinton printf("[internal error: unknown constant type '%c']", *p); 39118234Slinton break; 39218234Slinton } 39318234Slinton s->symvalue.constval->nodetype = s->type; 39418234Slinton } 39518234Slinton 39618234Slinton /* 39716623Ssam * Enter a type name. 39816623Ssam */ 39916623Ssam 40016623Ssam private typeName (s) 40116623Ssam Symbol s; 40216623Ssam { 40316623Ssam register integer i; 40416623Ssam 40516623Ssam s->class = TYPE; 40616623Ssam s->language = curlang; 40716623Ssam s->block = curblock; 40816623Ssam s->level = curblock->level + 1; 40916623Ssam i = getint(); 41016623Ssam if (i == 0) { 41116623Ssam panic("bad input on type \"%s\" at \"%s\"", symname(s), curchar); 41216623Ssam } else if (i >= NTYPES) { 41316623Ssam panic("too many types in file \"%s\"", curfilename()); 41416623Ssam } 41516623Ssam /* 41616623Ssam * A hack for C typedefs that don't create new types, 41716623Ssam * e.g. typedef unsigned int Hashvalue; 41816623Ssam * or typedef struct blah BLAH; 41916623Ssam */ 42016623Ssam if (*curchar != '=') { 42116623Ssam s->type = typetable[i]; 42216623Ssam if (s->type == nil) { 42316623Ssam s->type = symbol_alloc(); 42416623Ssam typetable[i] = s->type; 42516623Ssam } 42616623Ssam } else { 42716623Ssam if (typetable[i] != nil) { 42816623Ssam typetable[i]->language = curlang; 42916623Ssam typetable[i]->class = TYPE; 43016623Ssam typetable[i]->type = s; 43116623Ssam } else { 43216623Ssam typetable[i] = s; 43316623Ssam } 43416623Ssam skipchar(curchar, '='); 43516623Ssam getType(s); 43616623Ssam } 43716623Ssam } 43816623Ssam 43916623Ssam /* 44016623Ssam * Enter a tag name. 44116623Ssam */ 44216623Ssam 44316623Ssam private tagName (s) 44416623Ssam Symbol s; 44516623Ssam { 44616623Ssam register integer i; 44716623Ssam 44816623Ssam s->class = TAG; 44916623Ssam i = getint(); 45016623Ssam if (i == 0) { 45116623Ssam panic("bad input on tag \"%s\" at \"%s\"", symname(s), curchar); 45216623Ssam } else if (i >= NTYPES) { 45316623Ssam panic("too many types in file \"%s\"", curfilename()); 45416623Ssam } 45516623Ssam if (typetable[i] != nil) { 45616623Ssam typetable[i]->language = curlang; 45716623Ssam typetable[i]->class = TYPE; 45816623Ssam typetable[i]->type = s; 45916623Ssam } else { 46016623Ssam typetable[i] = s; 46116623Ssam } 46216623Ssam skipchar(curchar, '='); 46316623Ssam getType(s); 46416623Ssam } 46516623Ssam 46616623Ssam /* 46716623Ssam * Setup a symbol entry for a public procedure or function. 46818234Slinton * 46918234Slinton * If it contains nested procedures, then it may already be defined 47018234Slinton * in the current block as a MODULE. 47116623Ssam */ 47216623Ssam 47318234Slinton private publicRoutine (s, n, class, addr, isinternal) 47418234Slinton Symbol *s; 47518234Slinton Name n; 47616623Ssam Symclass class; 47716623Ssam Address addr; 47818234Slinton boolean isinternal; 47916623Ssam { 48018234Slinton Symbol nt, t; 48118234Slinton 48218234Slinton newSym(nt, n); 48318234Slinton if (isinternal) { 48418234Slinton markInternal(nt); 48518234Slinton } 48618234Slinton enterRoutine(nt, class); 48718234Slinton find(t, n) where 48818234Slinton t != nt and t->class == MODULE and t->block == nt->block 48918234Slinton endfind(t); 49018234Slinton if (t == nil) { 49118234Slinton t = nt; 49218234Slinton } else { 49318234Slinton t->language = nt->language; 49418234Slinton t->class = nt->class; 49518234Slinton t->type = nt->type; 49618234Slinton t->chain = nt->chain; 49718234Slinton t->symvalue = nt->symvalue; 49818234Slinton nt->class = EXTREF; 49918234Slinton nt->symvalue.extref = t; 50018234Slinton delete(nt); 50118234Slinton curparam = t; 50218234Slinton changeBlock(t); 50318234Slinton } 50418234Slinton if (t->block == program) { 50518234Slinton t->level = program->level; 50618234Slinton } else if (t->class == MODULE) { 50718234Slinton t->level = t->block->level; 50818234Slinton } else if (t->block->class == MODULE) { 50918234Slinton t->level = t->block->block->level; 51018234Slinton } else { 51118234Slinton t->level = t->block->level + 1; 51218234Slinton } 51318234Slinton *s = t; 51416623Ssam } 51516623Ssam 51616623Ssam /* 51716623Ssam * Setup a symbol entry for a private procedure or function. 51816623Ssam */ 51916623Ssam 52016623Ssam private privateRoutine (s, n, class, addr) 52116623Ssam Symbol *s; 52216623Ssam Name n; 52316623Ssam Symclass class; 52416623Ssam Address addr; 52516623Ssam { 52616623Ssam Symbol t; 52716623Ssam boolean isnew; 52816623Ssam 52916623Ssam find(t, n) where 53016623Ssam t->level == curmodule->level and t->class == class 53116623Ssam endfind(t); 53216623Ssam if (t == nil) { 53316623Ssam isnew = true; 53416623Ssam t = insert(n); 53516623Ssam } else { 53616623Ssam isnew = false; 53716623Ssam } 53816623Ssam t->language = curlang; 53916623Ssam enterRoutine(t, class); 54016623Ssam if (isnew) { 54116623Ssam t->symvalue.funcv.src = false; 54216623Ssam t->symvalue.funcv.inline = false; 54316623Ssam t->symvalue.funcv.beginaddr = addr; 54416623Ssam newfunc(t, codeloc(t)); 54516623Ssam findbeginning(t); 54616623Ssam } 54716623Ssam *s = t; 54816623Ssam } 54916623Ssam 55016623Ssam /* 55116623Ssam * Set up for beginning a new procedure, function, or module. 55216623Ssam * If it's a function, then read the type. 55316623Ssam * 55416623Ssam * If the next character is a ",", then read the name of the enclosing block. 55516623Ssam * Otherwise assume the previous function, if any, is over, and the current 55616623Ssam * routine is at the same level. 55716623Ssam */ 55816623Ssam 55916623Ssam private enterRoutine (s, class) 56016623Ssam Symbol s; 56116623Ssam Symclass class; 56216623Ssam { 56316623Ssam s->class = class; 56416623Ssam if (class == FUNC) { 56516623Ssam getType(s); 56616623Ssam } 56716623Ssam if (s->class != MODULE) { 56816623Ssam getExtRef(s); 56916623Ssam } else if (*curchar == ',') { 57016623Ssam ++curchar; 57116623Ssam } 57216623Ssam if (*curchar != '\0') { 57316623Ssam exitblock(); 57416623Ssam enterNestedBlock(s); 57516623Ssam } else { 57616623Ssam if (curblock->class == FUNC or curblock->class == PROC) { 57716623Ssam exitblock(); 57816623Ssam } 57916623Ssam if (class == MODULE) { 58016623Ssam exitblock(); 58116623Ssam } 58216623Ssam enterblock(s); 58316623Ssam } 58416623Ssam curparam = s; 58516623Ssam } 58616623Ssam 58716623Ssam /* 58818234Slinton * Handling an external variable is tricky, since we might already 58918234Slinton * know it but need to define it's type for other type information 59018234Slinton * in the file. So just in case we read the type information anyway. 59118234Slinton */ 59218234Slinton 59318234Slinton private extVar (symp, n, off) 59418234Slinton Symbol *symp; 59518234Slinton Name n; 59618234Slinton integer off; 59718234Slinton { 59818234Slinton Symbol s, t; 59918234Slinton 60018234Slinton find(s, n) where 60118234Slinton s->level == program->level and s->class == VAR 60218234Slinton endfind(s); 60318234Slinton if (s == nil) { 60418234Slinton makeVariable(s, n, off); 60533336Sdonn s->storage = EXT; 60618234Slinton s->level = program->level; 60718234Slinton s->block = curmodule; 60818234Slinton getExtRef(s); 60918234Slinton } else { 61018234Slinton t = constype(nil); 61118234Slinton } 61218234Slinton *symp = s; 61318234Slinton } 61418234Slinton 61518234Slinton /* 61616623Ssam * Check to see if the stab string contains the name of the external 61716623Ssam * reference. If so, we create a symbol with that name and class EXTREF, and 61816623Ssam * connect it to the given symbol. This link is created so that when 61916623Ssam * we see the linker symbol we can resolve it to the given symbol. 62016623Ssam */ 62116623Ssam 62216623Ssam private getExtRef (s) 62316623Ssam Symbol s; 62416623Ssam { 62516623Ssam char *p; 62616623Ssam Name n; 62716623Ssam Symbol t; 62816623Ssam 62916623Ssam if (*curchar == ',' and *(curchar + 1) != '\0') { 63016623Ssam p = index(curchar + 1, ','); 63116623Ssam *curchar = '\0'; 63216623Ssam if (p != nil) { 63316623Ssam *p = '\0'; 63416623Ssam n = identname(curchar + 1, false); 63516623Ssam curchar = p + 1; 63616623Ssam } else { 63716623Ssam n = identname(curchar + 1, true); 63816623Ssam } 63916623Ssam t = insert(n); 64016623Ssam t->language = s->language; 64116623Ssam t->class = EXTREF; 64216623Ssam t->block = program; 64316623Ssam t->level = program->level; 64416623Ssam t->symvalue.extref = s; 64516623Ssam } 64616623Ssam } 64716623Ssam 64816623Ssam /* 64916623Ssam * Find a block with the given identifier in the given outer block. 65016623Ssam * If not there, then create it. 65116623Ssam */ 65216623Ssam 65316623Ssam private Symbol findBlock (id, m) 65416623Ssam String id; 65516623Ssam Symbol m; 65616623Ssam { 65716623Ssam Name n; 65816623Ssam Symbol s; 65916623Ssam 66016623Ssam n = identname(id, true); 66116623Ssam find(s, n) where s->block == m and isblock(s) endfind(s); 66216623Ssam if (s == nil) { 66316623Ssam s = insert(n); 66416623Ssam s->block = m; 66516623Ssam s->language = curlang; 66616623Ssam s->class = MODULE; 66716623Ssam s->level = m->level + 1; 66816623Ssam } 66916623Ssam return s; 67016623Ssam } 67116623Ssam 67216623Ssam /* 67316623Ssam * Enter a nested block. 67416623Ssam * The block within which it is nested is described 67516623Ssam * by "module{:module}[:proc]". 67616623Ssam */ 67716623Ssam 67816623Ssam private enterNestedBlock (b) 67916623Ssam Symbol b; 68016623Ssam { 68116623Ssam register char *p, *q; 68216623Ssam Symbol m, s; 68316623Ssam Name n; 68416623Ssam 68516623Ssam q = curchar; 68616623Ssam p = index(q, ':'); 68716623Ssam m = program; 68816623Ssam while (p != nil) { 68916623Ssam *p = '\0'; 69016623Ssam m = findBlock(q, m); 69116623Ssam q = p + 1; 69216623Ssam p = index(q, ':'); 69316623Ssam } 69416623Ssam if (*q != '\0') { 69516623Ssam m = findBlock(q, m); 69616623Ssam } 69716623Ssam b->level = m->level + 1; 69816623Ssam b->block = m; 69916623Ssam pushBlock(b); 70016623Ssam } 70116623Ssam 70216623Ssam /* 70316623Ssam * Enter a statically-allocated variable defined within a routine. 70416623Ssam * 70516623Ssam * Global BSS variables are chained together so we can resolve them 70616623Ssam * when the start of common is determined. The list is kept in order 70716623Ssam * so that f77 can display all vars in a COMMON. 70816623Ssam */ 70916623Ssam 71016623Ssam private ownVariable (s, addr) 71116623Ssam Symbol s; 71216623Ssam Address addr; 71316623Ssam { 71433336Sdonn s->storage = EXT; 71533336Sdonn /* s->level = 1; */ 71616623Ssam if (curcomm) { 71716623Ssam if (commchain != nil) { 71816623Ssam commchain->symvalue.common.chain = s; 71916623Ssam } else { 72016623Ssam curcomm->symvalue.common.offset = (integer) s; 72116623Ssam } 72216623Ssam commchain = s; 72316623Ssam s->symvalue.common.offset = addr; 72416623Ssam s->symvalue.common.chain = nil; 72516623Ssam } 72616623Ssam } 72716623Ssam 72816623Ssam /* 72916623Ssam * Get a type from the current stab string for the given symbol. 73016623Ssam */ 73116623Ssam 73216623Ssam private getType (s) 73316623Ssam Symbol s; 73416623Ssam { 73533336Sdonn Symbol t, addtag(); 73633336Sdonn 73716623Ssam if (s->class == TAG) { 73833336Sdonn t = addtag(s); 73933336Sdonn t->type = constype(nil); 74033336Sdonn s->type = t->type; 74133336Sdonn } else { 74233336Sdonn s->type = constype(nil); 74316623Ssam } 74416623Ssam } 74516623Ssam 74616623Ssam /* 74716623Ssam * Construct a type out of a string encoding. 74816623Ssam */ 74916623Ssam 75016623Ssam private Rangetype getRangeBoundType(); 75116623Ssam 75216623Ssam private Symbol constype (type) 75316623Ssam Symbol type; 75416623Ssam { 75516623Ssam register Symbol t; 75616623Ssam register integer n; 75716623Ssam char class; 75818234Slinton char *p; 75916623Ssam 76018234Slinton while (*curchar == '@') { 76118234Slinton p = index(curchar, ';'); 76218234Slinton if (p == nil) { 76318234Slinton fflush(stdout); 76418234Slinton fprintf(stderr, "missing ';' after type attributes"); 76518234Slinton } else { 76618234Slinton curchar = p + 1; 76718234Slinton } 76818234Slinton } 76916623Ssam if (isdigit(*curchar)) { 77016623Ssam n = getint(); 77116623Ssam if (n >= NTYPES) { 77216623Ssam panic("too many types in file \"%s\"", curfilename()); 77316623Ssam } 77416623Ssam if (*curchar == '=') { 77516623Ssam if (typetable[n] != nil) { 77616623Ssam t = typetable[n]; 77716623Ssam } else { 77816623Ssam t = symbol_alloc(); 77916623Ssam typetable[n] = t; 78016623Ssam } 78116623Ssam ++curchar; 78216623Ssam constype(t); 78316623Ssam } else { 78416623Ssam t = typetable[n]; 78516623Ssam if (t == nil) { 78616623Ssam t = symbol_alloc(); 78716623Ssam typetable[n] = t; 78816623Ssam } 78916623Ssam } 79016623Ssam } else { 79116623Ssam if (type == nil) { 79216623Ssam t = symbol_alloc(); 79316623Ssam } else { 79416623Ssam t = type; 79516623Ssam } 79616623Ssam t->language = curlang; 79716623Ssam t->level = curblock->level + 1; 79816623Ssam t->block = curblock; 79916623Ssam class = *curchar++; 80016623Ssam switch (class) { 80116623Ssam case T_SUBRANGE: 80216623Ssam consSubrange(t); 80316623Ssam break; 80416623Ssam 80516623Ssam case T_ARRAY: 80616623Ssam t->class = ARRAY; 80716623Ssam t->chain = constype(nil); 80816623Ssam skipchar(curchar, ';'); 80916623Ssam chkcont(curchar); 81016623Ssam t->type = constype(nil); 81116623Ssam break; 81216623Ssam 81318234Slinton case T_OLDOPENARRAY: 81418234Slinton t->class = DYNARRAY; 81518234Slinton t->symvalue.ndims = 1; 81618234Slinton t->type = constype(nil); 81718234Slinton t->chain = t_int; 81818234Slinton break; 81918234Slinton 82016623Ssam case T_OPENARRAY: 82133336Sdonn consDynarray(t, OPENARRAY); 82233336Sdonn break; 82333336Sdonn 82418234Slinton case T_DYNARRAY: 82533336Sdonn consDynarray(t, DYNARRAY); 82618234Slinton break; 82718234Slinton 82818234Slinton case T_SUBARRAY: 82918234Slinton t->class = SUBARRAY; 83018234Slinton t->symvalue.ndims = getint(); 83118234Slinton skipchar(curchar, ','); 83216623Ssam t->type = constype(nil); 83318234Slinton t->chain = t_int; 83416623Ssam break; 83516623Ssam 83616623Ssam case T_RECORD: 83716623Ssam consRecord(t, RECORD); 83816623Ssam break; 83916623Ssam 84016623Ssam case T_UNION: 84116623Ssam consRecord(t, VARNT); 84216623Ssam break; 84316623Ssam 84416623Ssam case T_ENUM: 84516623Ssam consEnum(t); 84616623Ssam break; 84716623Ssam 84816623Ssam case T_PTR: 84916623Ssam t->class = PTR; 85016623Ssam t->type = constype(nil); 85116623Ssam break; 85216623Ssam 85316623Ssam /* 85416623Ssam * C function variables are different from Modula-2's. 85516623Ssam */ 85616623Ssam case T_FUNCVAR: 85716623Ssam t->class = FFUNC; 85816623Ssam t->type = constype(nil); 85933336Sdonn if (streq(language_name(curlang), "modula-2")) { 86016623Ssam skipchar(curchar, ','); 86116623Ssam consParamlist(t); 86216623Ssam } 86316623Ssam break; 86416623Ssam 86516623Ssam case T_PROCVAR: 86616623Ssam t->class = FPROC; 86716623Ssam consParamlist(t); 86816623Ssam break; 86916623Ssam 87016623Ssam case T_IMPORTED: 87116623Ssam consImpType(t); 87216623Ssam break; 87316623Ssam 87416623Ssam case T_SET: 87516623Ssam t->class = SET; 87616623Ssam t->type = constype(nil); 87716623Ssam break; 87816623Ssam 87916623Ssam case T_OPAQUE: 88016623Ssam consOpaqType(t); 88116623Ssam break; 88216623Ssam 88318234Slinton case T_FILE: 88418234Slinton t->class = FILET; 88518234Slinton t->type = constype(nil); 88618234Slinton break; 88718234Slinton 88816623Ssam default: 88916623Ssam badcaseval(class); 89016623Ssam } 89116623Ssam } 89216623Ssam return t; 89316623Ssam } 89416623Ssam 89516623Ssam /* 89616623Ssam * Construct a subrange type. 89716623Ssam */ 89816623Ssam 89916623Ssam private consSubrange (t) 90016623Ssam Symbol t; 90116623Ssam { 90216623Ssam t->class = RANGE; 90316623Ssam t->type = constype(nil); 90416623Ssam skipchar(curchar, ';'); 90516623Ssam chkcont(curchar); 90616623Ssam t->symvalue.rangev.lowertype = getRangeBoundType(); 90716623Ssam t->symvalue.rangev.lower = getint(); 90816623Ssam skipchar(curchar, ';'); 90916623Ssam chkcont(curchar); 91016623Ssam t->symvalue.rangev.uppertype = getRangeBoundType(); 91116623Ssam t->symvalue.rangev.upper = getint(); 91216623Ssam } 91316623Ssam 91416623Ssam /* 91516623Ssam * Figure out the bound type of a range. 91616623Ssam * 91716623Ssam * Some letters indicate a dynamic bound, ie what follows 91816623Ssam * is the offset from the fp which contains the bound; this will 91916623Ssam * need a different encoding when pc a['A'..'Z'] is 92016623Ssam * added; J is a special flag to handle fortran a(*) bounds 92116623Ssam */ 92216623Ssam 92316623Ssam private Rangetype getRangeBoundType () 92416623Ssam { 92516623Ssam Rangetype r; 92616623Ssam 92716623Ssam switch (*curchar) { 92816623Ssam case 'A': 92916623Ssam r = R_ARG; 93016623Ssam curchar++; 93116623Ssam break; 93216623Ssam 93316623Ssam case 'T': 93416623Ssam r = R_TEMP; 93516623Ssam curchar++; 93616623Ssam break; 93716623Ssam 93816623Ssam case 'J': 93916623Ssam r = R_ADJUST; 94016623Ssam curchar++; 94116623Ssam break; 94216623Ssam 94316623Ssam default: 94416623Ssam r = R_CONST; 94516623Ssam break; 94616623Ssam } 94716623Ssam return r; 94816623Ssam } 94916623Ssam 95016623Ssam /* 95118234Slinton * Construct a dynamic array descriptor. 95218234Slinton */ 95318234Slinton 95433336Sdonn private consDynarray (t, c) 95518234Slinton register Symbol t; 95633336Sdonn Symclass c; 95718234Slinton { 95833336Sdonn t->class = c; 95918234Slinton t->symvalue.ndims = getint(); 96018234Slinton skipchar(curchar, ','); 96118234Slinton t->type = constype(nil); 96218234Slinton t->chain = t_int; 96318234Slinton } 96418234Slinton 96518234Slinton /* 96616623Ssam * Construct a record or union type. 96716623Ssam */ 96816623Ssam 96916623Ssam private consRecord (t, class) 97016623Ssam Symbol t; 97116623Ssam Symclass class; 97216623Ssam { 97316623Ssam register Symbol u; 97416623Ssam register char *cur, *p; 97516623Ssam Name name; 97616623Ssam integer d; 97716623Ssam 97816623Ssam t->class = class; 97916623Ssam t->symvalue.offset = getint(); 98016623Ssam d = curblock->level + 1; 98116623Ssam u = t; 98233336Sdonn chkcont(curchar); 98316623Ssam cur = curchar; 98416623Ssam while (*cur != ';' and *cur != '\0') { 98516623Ssam p = index(cur, ':'); 98616623Ssam if (p == nil) { 98716623Ssam panic("index(\"%s\", ':') failed", curchar); 98816623Ssam } 98916623Ssam *p = '\0'; 99033336Sdonn if ( 99133336Sdonn autostrip and 99233336Sdonn *cur == '_' and 99333336Sdonn streq(language_name(curlang), "c++") 99433336Sdonn ) { 99533336Sdonn /* 99633336Sdonn * Strip off redundant prefixes from C++ names. 99733336Sdonn * Class members are prefixed with _T_, where T is a class tag. 99833336Sdonn */ 99933336Sdonn register char *q, *r; 100033336Sdonn Symbol s; 100133336Sdonn 100233336Sdonn /* 100333336Sdonn * The slow way... Check for members defined in the base class. 100433336Sdonn */ 100533336Sdonn for (q = cur + 1, r = q; (r = index(r, '_')) != nil; ++r) { 100633336Sdonn if (r == q) { 100733336Sdonn continue; 100833336Sdonn } 100933336Sdonn *r = '\0'; 101033336Sdonn s = lookup(identname(q, true)); 101133336Sdonn if (s != nil and s->class == TYPE) { 101233336Sdonn char *newcur = r + 1; 101333336Sdonn if (*newcur != '\0') { 101433336Sdonn cur = newcur; 101533336Sdonn break; 101633336Sdonn } 101733336Sdonn } 101833336Sdonn *r = '_'; 101933336Sdonn } 102033336Sdonn } 102116623Ssam name = identname(cur, true); 102216623Ssam u->chain = newSymbol(name, d, FIELD, nil, nil); 102316623Ssam cur = p + 1; 102416623Ssam u = u->chain; 102516623Ssam u->language = curlang; 102616623Ssam curchar = cur; 102716623Ssam u->type = constype(nil); 102816623Ssam skipchar(curchar, ','); 102916623Ssam u->symvalue.field.offset = getint(); 103016623Ssam skipchar(curchar, ','); 103116623Ssam u->symvalue.field.length = getint(); 103216623Ssam skipchar(curchar, ';'); 103316623Ssam chkcont(curchar); 103416623Ssam cur = curchar; 103516623Ssam } 103616623Ssam if (*cur == ';') { 103716623Ssam ++cur; 103816623Ssam } 103916623Ssam curchar = cur; 104016623Ssam } 104116623Ssam 104216623Ssam /* 104316623Ssam * Construct an enumeration type. 104416623Ssam */ 104516623Ssam 104616623Ssam private consEnum (t) 104716623Ssam Symbol t; 104816623Ssam { 104916623Ssam register Symbol u; 105016623Ssam register char *p; 105116623Ssam register integer count; 105216623Ssam 105316623Ssam t->class = SCAL; 105416623Ssam count = 0; 105516623Ssam u = t; 105633336Sdonn while (*curchar != ';' and *curchar != '\0' and *curchar != ',') { 105716623Ssam p = index(curchar, ':'); 105816623Ssam assert(p != nil); 105916623Ssam *p = '\0'; 106016623Ssam u->chain = insert(identname(curchar, true)); 106116623Ssam curchar = p + 1; 106216623Ssam u = u->chain; 106316623Ssam u->language = curlang; 106416623Ssam u->class = CONST; 106516623Ssam u->level = curblock->level + 1; 106616623Ssam u->block = curblock; 106716623Ssam u->type = t; 106818234Slinton u->symvalue.constval = build(O_LCON, (long) getint()); 106916623Ssam ++count; 107016623Ssam skipchar(curchar, ','); 107116623Ssam chkcont(curchar); 107216623Ssam } 107316623Ssam if (*curchar == ';') { 107416623Ssam ++curchar; 107516623Ssam } 107616623Ssam t->symvalue.iconval = count; 107716623Ssam } 107816623Ssam 107916623Ssam /* 108016623Ssam * Construct a parameter list for a function or procedure variable. 108116623Ssam */ 108216623Ssam 108316623Ssam private consParamlist (t) 108416623Ssam Symbol t; 108516623Ssam { 108616623Ssam Symbol p; 108716623Ssam integer i, d, n, paramclass; 108816623Ssam 108916623Ssam n = getint(); 109016623Ssam skipchar(curchar, ';'); 109116623Ssam p = t; 109216623Ssam d = curblock->level + 1; 109316623Ssam for (i = 0; i < n; i++) { 109416623Ssam p->chain = newSymbol(nil, d, VAR, nil, nil); 109516623Ssam p = p->chain; 109616623Ssam p->type = constype(nil); 109716623Ssam skipchar(curchar, ','); 109816623Ssam paramclass = getint(); 109916623Ssam if (paramclass == 0) { 110016623Ssam p->class = REF; 110116623Ssam } 110216623Ssam skipchar(curchar, ';'); 110316623Ssam chkcont(curchar); 110416623Ssam } 110516623Ssam } 110616623Ssam 110716623Ssam /* 110816623Ssam * Construct an imported type. 110916623Ssam * Add it to a list of symbols to get fixed up. 111016623Ssam */ 111116623Ssam 111216623Ssam private consImpType (t) 111316623Ssam Symbol t; 111416623Ssam { 111516623Ssam register char *p; 111616623Ssam Symbol tmp; 111716623Ssam 111816623Ssam p = curchar; 111916623Ssam while (*p != ',' and *p != ';' and *p != '\0') { 112016623Ssam ++p; 112116623Ssam } 112216623Ssam if (*p == '\0') { 112316623Ssam panic("bad import symbol entry '%s'", curchar); 112416623Ssam } 112516623Ssam t->class = TYPEREF; 112616623Ssam t->symvalue.typeref = curchar; 112716623Ssam if (*p == ',') { 112816623Ssam curchar = p + 1; 112916623Ssam tmp = constype(nil); 113018234Slinton } else { 113118234Slinton curchar = p; 113216623Ssam } 113316623Ssam skipchar(curchar, ';'); 113416623Ssam *p = '\0'; 113516623Ssam } 113616623Ssam 113716623Ssam /* 113816623Ssam * Construct an opaque type entry. 113916623Ssam */ 114016623Ssam 114116623Ssam private consOpaqType (t) 114216623Ssam Symbol t; 114316623Ssam { 114416623Ssam register char *p; 114516623Ssam register Symbol s; 114616623Ssam register Name n; 114716623Ssam boolean def; 114816623Ssam 114916623Ssam p = curchar; 115016623Ssam while (*p != ';' and *p != ',') { 115116623Ssam if (*p == '\0') { 115216623Ssam panic("bad opaque symbol entry '%s'", curchar); 115316623Ssam } 115416623Ssam ++p; 115516623Ssam } 115616623Ssam def = (Boolean) (*p == ','); 115716623Ssam *p = '\0'; 115816623Ssam n = identname(curchar, true); 115916623Ssam find(s, n) where s->class == TYPEREF endfind(s); 116016623Ssam if (s == nil) { 116116623Ssam s = insert(n); 116216623Ssam s->class = TYPEREF; 116316623Ssam s->type = nil; 116416623Ssam } 116516623Ssam curchar = p + 1; 116616623Ssam if (def) { 116716623Ssam s->type = constype(nil); 116816623Ssam skipchar(curchar, ';'); 116916623Ssam } 117016623Ssam t->class = TYPE; 117116623Ssam t->type = s; 117216623Ssam } 117316623Ssam 117416623Ssam /* 117516623Ssam * Read an integer from the current position in the type string. 117616623Ssam */ 117716623Ssam 117816623Ssam private integer getint () 117916623Ssam { 118016623Ssam register integer n; 118116623Ssam register char *p; 118216623Ssam register Boolean isneg; 118316623Ssam 118416623Ssam n = 0; 118516623Ssam p = curchar; 118616623Ssam if (*p == '-') { 118716623Ssam isneg = true; 118816623Ssam ++p; 118916623Ssam } else { 119016623Ssam isneg = false; 119116623Ssam } 119216623Ssam while (isdigit(*p)) { 119316623Ssam n = 10*n + (*p - '0'); 119416623Ssam ++p; 119516623Ssam } 119616623Ssam curchar = p; 119716623Ssam return isneg ? (-n) : n; 119816623Ssam } 119916623Ssam 120016623Ssam /* 120116623Ssam * Add a tag name. This is a kludge to be able to refer 120216623Ssam * to tags that have the same name as some other symbol 120316623Ssam * in the same block. 120416623Ssam */ 120516623Ssam 120633336Sdonn private Symbol addtag (s) 120716623Ssam register Symbol s; 120816623Ssam { 120916623Ssam register Symbol t; 121016623Ssam char buf[100]; 121116623Ssam 121233336Sdonn if (streq(language_name(curlang), "c++")) { 121333336Sdonn t = insert(s->name); 121433336Sdonn t->class = TYPE; 121533336Sdonn } else { 121633336Sdonn sprintf(buf, "$$%.90s", ident(s->name)); 121733336Sdonn t = insert(identname(buf, false)); 121833336Sdonn t->class = TAG; 121933336Sdonn } 122016623Ssam t->language = s->language; 122116623Ssam t->block = s->block; 122233336Sdonn return t; 122316623Ssam } 1224