xref: /csrg-svn/old/dbx/object.c (revision 13838)
19673Slinton /* Copyright (c) 1982 Regents of the University of California */
29673Slinton 
3*13838Slinton static char sccsid[] = "@(#)object.c 1.9 07/07/83";
49673Slinton 
59673Slinton /*
69673Slinton  * Object code interface, mainly for extraction of symbolic information.
79673Slinton  */
89673Slinton 
99673Slinton #include "defs.h"
109673Slinton #include "object.h"
119673Slinton #include "main.h"
129673Slinton #include "symbols.h"
139673Slinton #include "names.h"
149673Slinton #include "languages.h"
159673Slinton #include "mappings.h"
169673Slinton #include "lists.h"
179673Slinton #include <a.out.h>
189673Slinton #include <stab.h>
199673Slinton #include <ctype.h>
209673Slinton 
219673Slinton #ifndef public
229673Slinton 
239673Slinton struct {
249673Slinton     unsigned int stringsize;	/* size of the dumped string table */
259673Slinton     unsigned int nsyms;		/* number of symbols */
269673Slinton     unsigned int nfiles;	/* number of files */
279673Slinton     unsigned int nlines;	/* number of lines */
289673Slinton } nlhdr;
299673Slinton 
309673Slinton #endif
319673Slinton 
329673Slinton public String objname = "a.out";
339673Slinton public Integer objsize;
349673Slinton public char *stringtab;
359673Slinton 
369673Slinton private String progname = nil;
379673Slinton private Language curlang;
389673Slinton private Symbol curmodule;
399673Slinton private Symbol curparam;
409673Slinton private Boolean warned;
4112542Scsvaf private Symbol curcomm;
4212542Scsvaf private Symbol commchain;
4312542Scsvaf private Boolean strip_ = false;
449673Slinton 
459673Slinton private Filetab *filep;
4611875Slinton private Linetab *linep, *prevlinep;
479673Slinton private Address curfaddr;
489673Slinton 
499673Slinton #define curfilename() (filep-1)->filename
509673Slinton 
519673Slinton /*
529673Slinton  * Blocks are figured out on the fly while reading the symbol table.
539673Slinton  */
549673Slinton 
559673Slinton #define MAXBLKDEPTH 25
569673Slinton 
579673Slinton private Symbol curblock;
589673Slinton private Symbol blkstack[MAXBLKDEPTH];
599673Slinton private Integer curlevel;
609673Slinton 
619673Slinton #define enterblock(b) { \
629673Slinton     blkstack[curlevel] = curblock; \
639673Slinton     ++curlevel; \
649673Slinton     b->level = curlevel; \
659673Slinton     b->block = curblock; \
669673Slinton     curblock = b; \
679673Slinton }
689673Slinton 
699673Slinton #define exitblock() { \
7011875Slinton     if (curblock->class == FUNC or curblock->class == PROC) { \
7111875Slinton 	if (prevlinep != linep) { \
7211875Slinton 	    curblock->symvalue.funcv.src = true; \
7311875Slinton 	} \
7411875Slinton     } \
759673Slinton     --curlevel; \
769673Slinton     curblock = blkstack[curlevel]; \
779673Slinton }
789673Slinton 
799673Slinton /*
809673Slinton  * Enter a source line or file name reference into the appropriate table.
819673Slinton  * Expanded inline to reduce procedure calls.
829673Slinton  *
839673Slinton  * private enterline(linenumber, address)
849673Slinton  * Lineno linenumber;
859673Slinton  * Address address;
869673Slinton  *  ...
879673Slinton  */
889673Slinton 
899673Slinton #define enterline(linenumber, address) \
909673Slinton { \
919673Slinton     register Linetab *lp; \
929673Slinton  \
939673Slinton     lp = linep - 1; \
949673Slinton     if (linenumber != lp->line) { \
959673Slinton 	if (address != lp->addr) { \
969673Slinton 	    ++lp; \
979673Slinton 	} \
989673Slinton 	lp->line = linenumber; \
999673Slinton 	lp->addr = address; \
1009673Slinton 	linep = lp + 1; \
1019673Slinton     } \
1029673Slinton }
1039673Slinton 
1049673Slinton #define NTYPES 1000
1059673Slinton 
1069673Slinton private Symbol typetable[NTYPES];
1079673Slinton 
1089673Slinton /*
1099673Slinton  * Read in the namelist from the obj file.
1109673Slinton  *
1119673Slinton  * Reads and seeks are used instead of fread's and fseek's
1129673Slinton  * for efficiency sake; there's a lot of data being read here.
1139673Slinton  */
1149673Slinton 
1159673Slinton public readobj(file)
1169673Slinton String file;
1179673Slinton {
1189673Slinton     Fileid f;
1199673Slinton     struct exec hdr;
1209673Slinton     struct nlist nlist;
1219673Slinton 
1229673Slinton     f = open(file, 0);
1239673Slinton     if (f < 0) {
1249673Slinton 	fatal("can't open %s", file);
1259673Slinton     }
1269673Slinton     read(f, &hdr, sizeof(hdr));
1279673Slinton     objsize = hdr.a_text;
1289673Slinton     nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
1299673Slinton     nlhdr.nfiles = nlhdr.nsyms;
1309673Slinton     nlhdr.nlines = nlhdr.nsyms;
1319673Slinton     lseek(f, (long) N_STROFF(hdr), 0);
1329673Slinton     read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
1339673Slinton     nlhdr.stringsize -= 4;
1349673Slinton     stringtab = newarr(char, nlhdr.stringsize);
1359673Slinton     read(f, stringtab, nlhdr.stringsize);
1369673Slinton     allocmaps(nlhdr.nfiles, nlhdr.nlines);
1379673Slinton     lseek(f, (long) N_SYMOFF(hdr), 0);
1389673Slinton     readsyms(f);
1399673Slinton     ordfunctab();
1409673Slinton     setnlines();
1419673Slinton     setnfiles();
1429673Slinton     close(f);
1439673Slinton }
1449673Slinton 
1459673Slinton /*
1469673Slinton  * Read in symbols from object file.
1479673Slinton  */
1489673Slinton 
1499673Slinton private readsyms(f)
1509673Slinton Fileid f;
1519673Slinton {
1529673Slinton     struct nlist *namelist;
1539673Slinton     register struct nlist *np, *ub;
1549673Slinton     register int index;
1559673Slinton     register String name;
1569673Slinton     register Boolean afterlg;
1579673Slinton 
1589673Slinton     initsyms();
1599673Slinton     namelist = newarr(struct nlist, nlhdr.nsyms);
1609673Slinton     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
1619673Slinton     afterlg = false;
1629673Slinton     ub = &namelist[nlhdr.nsyms];
1639673Slinton     for (np = &namelist[0]; np < ub; np++) {
1649673Slinton 	index = np->n_un.n_strx;
1659673Slinton 	if (index != 0) {
1669673Slinton 	    name = &stringtab[index - 4];
16712542Scsvaf 	    /*
16812542Scsvaf              *  if the program contains any .f files a trailing _ is stripped
16912542Scsvaf        	     *  from the name on the assumption it was added by the compiler.
17012542Scsvaf 	     *  This only affects names that follow the sdb N_SO entry with
17112542Scsvaf              *  the .f name.
17212542Scsvaf              */
17312542Scsvaf             if(strip_ && *name != '\0' ) {
17412542Scsvaf                  register char *p, *q;
17512542Scsvaf                  for(p=name,q=(name+1); *q != '\0'; p=q++);
17612542Scsvaf                  if (*p == '_')  *p = '\0';
17712542Scsvaf             }
17812542Scsvaf 
1799673Slinton 	} else {
1809673Slinton 	    name = nil;
18112542Scsvaf 	}
1829673Slinton 	/*
1839673Slinton 	 * assumptions:
1849673Slinton 	 *	not an N_STAB	==> name != nil
1859673Slinton 	 *	name[0] == '-'	==> name == "-lg"
1869673Slinton 	 *	name[0] != '_'	==> filename or invisible
1879673Slinton 	 *
1889673Slinton 	 * The "-lg" signals the beginning of global loader symbols.
18912542Scsvaf          *
1909673Slinton 	 */
1919673Slinton 	if ((np->n_type&N_STAB) != 0) {
1929673Slinton 	    enter_nl(name, np);
1939673Slinton 	} else if (name[0] == '-') {
1949673Slinton 	    afterlg = true;
1959673Slinton 	    if (curblock->class != PROG) {
1969673Slinton 		exitblock();
1979673Slinton 		if (curblock->class != PROG) {
1989673Slinton 		    exitblock();
1999673Slinton 		}
2009673Slinton 	    }
2019673Slinton 	    enterline(0, (linep-1)->addr + 1);
20211104Slinton 	} else if (afterlg) {
20311104Slinton 	    if (name[0] == '_') {
2049673Slinton 		check_global(&name[1], np);
2059673Slinton 	    }
20611104Slinton 	} else if (name[0] == '_') {
20711104Slinton 	    check_local(&name[1], np);
2089673Slinton 	} else if ((np->n_type&N_TEXT) == N_TEXT) {
2099673Slinton 	    check_filename(name);
2109673Slinton 	}
2119673Slinton     }
2129673Slinton     dispose(namelist);
2139673Slinton }
2149673Slinton 
2159673Slinton /*
2169673Slinton  * Initialize symbol information.
2179673Slinton  */
2189673Slinton 
2199673Slinton private initsyms()
2209673Slinton {
2219673Slinton     curblock = nil;
2229673Slinton     curlevel = 0;
2239673Slinton     if (progname == nil) {
2249673Slinton 	progname = strdup(objname);
2259673Slinton 	if (rindex(progname, '/') != nil) {
2269673Slinton 	    progname = rindex(progname, '/') + 1;
2279673Slinton 	}
2289673Slinton 	if (index(progname, '.') != nil) {
2299673Slinton 	    *(index(progname, '.')) = '\0';
2309673Slinton 	}
2319673Slinton     }
2329673Slinton     program = insert(identname(progname, true));
2339673Slinton     program->class = PROG;
23411769Slinton     program->symvalue.funcv.beginaddr = 0;
23511769Slinton     findbeginning(program);
2369673Slinton     newfunc(program);
2379673Slinton     enterblock(program);
2389673Slinton     curmodule = program;
2399673Slinton     t_boolean = maketype("$boolean", 0L, 1L);
2409673Slinton     t_int = maketype("$integer", 0x80000000L, 0x7fffffffL);
2419673Slinton     t_char = maketype("$char", 0L, 127L);
242*13838Slinton     t_real = maketype("$real", 8L, 0L);
2439673Slinton     t_nil = maketype("$nil", 0L, 0L);
2449673Slinton }
2459673Slinton 
2469673Slinton /*
2479673Slinton  * Free all the object file information that's being stored.
2489673Slinton  */
2499673Slinton 
2509673Slinton public objfree()
2519673Slinton {
2529673Slinton     symbol_free();
2539673Slinton     keywords_free();
2549673Slinton     names_free();
2559673Slinton     dispose(stringtab);
2569673Slinton     clrfunctab();
2579673Slinton }
2589673Slinton 
2599673Slinton /*
2609673Slinton  * Enter a namelist entry.
2619673Slinton  */
2629673Slinton 
2639673Slinton private enter_nl(name, np)
2649673Slinton String name;
2659673Slinton register struct nlist *np;
2669673Slinton {
2679673Slinton     register Symbol s;
2689673Slinton     String mname, suffix;
26911875Slinton     register Name n, nn;
2709673Slinton 
2719673Slinton     s = nil;
2729673Slinton     if (name == nil) {
2739673Slinton 	n = nil;
2749673Slinton     } else {
2759673Slinton 	n = identname(name, true);
2769673Slinton     }
2779673Slinton     switch (np->n_type) {
27812542Scsvaf 
27912542Scsvaf /* Build a symbol for the common; all GSYMS that follow will be chained;
28012542Scsvaf  * the head of this list is kept in common.offset, the tail in common.chain
28112542Scsvaf  */
28212542Scsvaf  	case N_BCOMM:
28312542Scsvaf  	    if(curcomm) {
28412542Scsvaf 	    curcomm->symvalue.common.chain = commchain;
28512542Scsvaf 	    }
28612542Scsvaf 	    curcomm = lookup(n);
28712542Scsvaf 	    if (  curcomm == nil) {
28812542Scsvaf 		  curcomm = insert(n);
28912542Scsvaf 		  curcomm->class = COMMON;
29012542Scsvaf 		  curcomm->block = curblock;
29112542Scsvaf 		  curcomm->level = program->level;
29212542Scsvaf 		  curcomm->symvalue.common.chain = nil;
29312542Scsvaf 	    }
29412542Scsvaf 	    commchain = curcomm->symvalue.common.chain;
29512542Scsvaf 	break;
29612542Scsvaf 
29712542Scsvaf 	case N_ECOMM:
29812542Scsvaf 	    if(curcomm) {
29912542Scsvaf 	    curcomm->symvalue.common.chain = commchain;
30012542Scsvaf 	    curcomm = nil;
30112542Scsvaf 	    }
30212542Scsvaf 	    break;
30312542Scsvaf 
3049673Slinton 	case N_LBRAC:
3059673Slinton 	    s = symbol_alloc();
3069673Slinton 	    s->class = PROC;
3079673Slinton 	    enterblock(s);
3089673Slinton 	    break;
3099673Slinton 
3109673Slinton 	case N_RBRAC:
3119673Slinton 	    exitblock();
3129673Slinton 	    break;
3139673Slinton 
3149673Slinton 	case N_SLINE:
3159673Slinton 	    enterline((Lineno) np->n_desc, (Address) np->n_value);
3169673Slinton 	    break;
3179673Slinton 
3189673Slinton 	/*
3199673Slinton 	 * Compilation unit.  C associates scope with filenames
3209673Slinton 	 * so we treat them as "modules".  The filename without
3219673Slinton 	 * the suffix is used for the module name.
3229673Slinton 	 *
3239673Slinton 	 * Because there is no explicit "end-of-block" mark in
3249673Slinton 	 * the object file, we must exit blocks for the current
3259673Slinton 	 * procedure and module.
3269673Slinton 	 */
3279673Slinton 	case N_SO:
3289673Slinton 	    mname = strdup(ident(n));
3299673Slinton 	    if (rindex(mname, '/') != nil) {
3309673Slinton 		mname = rindex(mname, '/') + 1;
3319673Slinton 	    }
3329673Slinton 	    suffix = rindex(mname, '.');
3339673Slinton 	    curlang = findlanguage(suffix);
33412542Scsvaf 	    if(curlang == findlanguage(".f")) {
33512542Scsvaf                             strip_ = true;
33612542Scsvaf             }
3379673Slinton 	    if (suffix != nil) {
3389673Slinton 		*suffix = '\0';
3399673Slinton 	    }
3409673Slinton 	    if (curblock->class != PROG) {
3419673Slinton 		exitblock();
3429673Slinton 		if (curblock->class != PROG) {
3439673Slinton 		    exitblock();
3449673Slinton 		}
3459673Slinton 	    }
34611875Slinton 	    nn = identname(mname, true);
34711875Slinton 	    if (curmodule == nil or curmodule->name != nn) {
34811875Slinton 		s = insert(nn);
34911875Slinton 		s->class = MODULE;
35011875Slinton 		s->symvalue.funcv.beginaddr = 0;
35111875Slinton 		findbeginning(s);
35211875Slinton 	    } else {
35311875Slinton 		s = curmodule;
35411875Slinton 	    }
3559673Slinton 	    s->language = curlang;
3569673Slinton 	    enterblock(s);
3579673Slinton 	    curmodule = s;
3589673Slinton 	    if (program->language == nil) {
3599673Slinton 		program->language = curlang;
3609673Slinton 	    }
3619673Slinton 	    warned = false;
3629673Slinton 	    enterfile(ident(n), (Address) np->n_value);
36311769Slinton 	    bzero(typetable, sizeof(typetable));
3649673Slinton 	    break;
3659673Slinton 
3669673Slinton 	/*
3679673Slinton 	 * Textually included files.
3689673Slinton 	 */
3699673Slinton 	case N_SOL:
3709673Slinton 	    enterfile(name, (Address) np->n_value);
3719673Slinton 	    break;
3729673Slinton 
3739673Slinton 	/*
3749673Slinton 	 * These symbols are assumed to have non-nil names.
3759673Slinton 	 */
3769673Slinton 	case N_GSYM:
3779673Slinton 	case N_FUN:
3789673Slinton 	case N_STSYM:
3799673Slinton 	case N_LCSYM:
3809673Slinton 	case N_RSYM:
3819673Slinton 	case N_PSYM:
3829673Slinton 	case N_LSYM:
3839673Slinton 	case N_SSYM:
3849673Slinton 	    if (index(name, ':') == nil) {
3859673Slinton 		if (not warned) {
3869673Slinton 		    warned = true;
3879673Slinton 		    /*
3889673Slinton 		     * Shouldn't do this if user might be typing.
3899673Slinton 		     *
3909673Slinton 		    warning("old style symbol information found in \"%s\"",
3919673Slinton 			curfilename());
3929673Slinton 		     *
3939673Slinton 		     */
3949673Slinton 		}
3959673Slinton 	    } else {
3969673Slinton 		entersym(name, np);
3979673Slinton 	    }
3989673Slinton 	    break;
3999673Slinton 
4009673Slinton 	case N_PC:
4019673Slinton 	    break;
4029673Slinton 
4039840Slinton 	case N_LENG:
40411558Slinton 	default:
4059840Slinton 	    /*
4069840Slinton 	     * Should complain out this, obviously the wrong symbol format.
40711558Slinton 	     *
4089673Slinton 	    if (name != nil) {
4099673Slinton 		printf("%s, ", name);
4109673Slinton 	    }
4119673Slinton 	    printf("ntype %2x, desc %x, value %x\n",
4129673Slinton 		np->n_type, np->n_desc, np->n_value);
41311558Slinton 	     *
41411558Slinton 	     */
4159673Slinton 	    break;
4169673Slinton     }
4179673Slinton }
4189673Slinton 
4199673Slinton /*
4209673Slinton  * Check to see if a global _name is already in the symbol table,
4219673Slinton  * if not then insert it.
4229673Slinton  */
4239673Slinton 
4249673Slinton private check_global(name, np)
4259673Slinton String name;
4269673Slinton register struct nlist *np;
4279673Slinton {
4289673Slinton     register Name n;
42912542Scsvaf     register Symbol t, u;
4309673Slinton 
4319673Slinton     if (not streq(name, "end")) {
4329673Slinton 	n = identname(name, true);
4339673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
4349673Slinton 	    find(t, n) where
4359673Slinton 		t->level == program->level and isblock(t)
4369673Slinton 	    endfind(t);
4379673Slinton 	    if (t == nil) {
4389673Slinton 		t = insert(n);
4399673Slinton 		t->language = findlanguage(".s");
4409673Slinton 		t->class = FUNC;
4419673Slinton 		t->type = t_int;
4429673Slinton 		t->block = curblock;
4439673Slinton 		t->level = program->level;
44411875Slinton 		t->symvalue.funcv.src = false;
4459673Slinton 	    }
4469673Slinton 	    t->symvalue.funcv.beginaddr = np->n_value;
4479673Slinton 	    newfunc(t);
4489673Slinton 	    findbeginning(t);
44912542Scsvaf 	}  else if ( (np->n_type&N_TYPE) == N_BSS ){
4509673Slinton 	    find(t, n) where
45112542Scsvaf 		t->class  == COMMON
45212542Scsvaf 	    endfind(t);
45312542Scsvaf 	    if(t != nil) {
45412542Scsvaf 		for(u= (Symbol) t->symvalue.common.offset;
45512542Scsvaf                         u != nil ;u=u->symvalue.common.chain){
45612542Scsvaf 		   u->symvalue.offset = u->symvalue.common.offset + np->n_value;
45712542Scsvaf 		   }
45812542Scsvaf             }
45912542Scsvaf         }
46012542Scsvaf         else {
46112542Scsvaf 	    find(t, n) where
4629673Slinton 		t->class == VAR and t->level == program->level
4639673Slinton 	    endfind(t);
4649673Slinton 	    if (t == nil) {
4659673Slinton 		t = insert(n);
4669673Slinton 		t->language = findlanguage(".s");
4679673Slinton 		t->class = VAR;
4689673Slinton 		t->type = t_int;
4699673Slinton 		t->block = curblock;
4709673Slinton 		t->level = program->level;
4719673Slinton 	    }
4729673Slinton 	    t->symvalue.offset = np->n_value;
4739673Slinton 	}
4749673Slinton     }
4759673Slinton }
4769673Slinton 
4779673Slinton /*
4789673Slinton  * Check to see if a local _name is known in the current scope.
4799673Slinton  * If not then enter it.
4809673Slinton  */
4819673Slinton 
4829673Slinton private check_local(name, np)
4839673Slinton String name;
4849673Slinton register struct nlist *np;
4859673Slinton {
4869673Slinton     register Name n;
4879673Slinton     register Symbol t, cur;
4889673Slinton 
4899673Slinton     n = identname(name, true);
4909673Slinton     cur = ((np->n_type&N_TYPE) == N_TEXT) ? curmodule : curblock;
4919673Slinton     find(t, n) where t->block == cur endfind(t);
4929673Slinton     if (t == nil) {
4939673Slinton 	t = insert(n);
4949673Slinton 	t->language = findlanguage(".s");
4959673Slinton 	t->type = t_int;
4969673Slinton 	t->block = cur;
4979673Slinton 	t->level = cur->level;
4989673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
4999673Slinton 	    t->class = FUNC;
50011875Slinton 	    t->symvalue.funcv.src = false;
5019673Slinton 	    t->symvalue.funcv.beginaddr = np->n_value;
5029673Slinton 	    newfunc(t);
5039673Slinton 	    findbeginning(t);
5049673Slinton 	} else {
5059673Slinton 	    t->class = VAR;
5069673Slinton 	    t->symvalue.offset = np->n_value;
5079673Slinton 	}
5089673Slinton     }
5099673Slinton }
5109673Slinton 
5119673Slinton /*
5129673Slinton  * Check to see if a symbol corresponds to a object file name.
5139673Slinton  * For some reason these are listed as in the text segment.
5149673Slinton  */
5159673Slinton 
5169673Slinton private check_filename(name)
5179673Slinton String name;
5189673Slinton {
5199673Slinton     register String mname;
5209673Slinton     register Integer i;
5219673Slinton     register Symbol s;
5229673Slinton 
5239673Slinton     mname = strdup(name);
5249673Slinton     i = strlen(mname) - 2;
5259673Slinton     if (i >= 0 and mname[i] == '.' and mname[i+1] == 'o') {
5269673Slinton 	mname[i] = '\0';
5279673Slinton 	--i;
5289673Slinton 	while (mname[i] != '/' and i >= 0) {
5299673Slinton 	    --i;
5309673Slinton 	}
5319673Slinton 	s = insert(identname(&mname[i+1], true));
5329673Slinton 	s->language = findlanguage(".s");
5339673Slinton 	s->class = MODULE;
53411769Slinton 	s->symvalue.funcv.beginaddr = 0;
53511769Slinton 	findbeginning(s);
5369673Slinton 	if (curblock->class != PROG) {
5379673Slinton 	    exitblock();
5389673Slinton 	    if (curblock->class != PROG) {
5399673Slinton 		exitblock();
5409673Slinton 	    }
5419673Slinton 	}
5429673Slinton 	enterblock(s);
5439673Slinton 	curmodule = s;
5449673Slinton     }
5459673Slinton }
5469673Slinton 
5479673Slinton /*
5489673Slinton  * Put an nlist into the symbol table.
5499673Slinton  * If it's already there just add the associated information.
5509673Slinton  *
5519673Slinton  * Type information is encoded in the name following a ":".
5529673Slinton  */
5539673Slinton 
5549673Slinton private Symbol constype();
5559673Slinton private Char *curchar;
5569673Slinton 
5579673Slinton #define skipchar(ptr, ch) { \
5589673Slinton     if (*ptr != ch) { \
5599673Slinton 	panic("expected char '%c', found char '%c'", ch, *ptr); \
5609673Slinton     } \
5619673Slinton     ++ptr; \
5629673Slinton }
5639673Slinton 
5649673Slinton private entersym(str, np)
5659673Slinton String str;
5669673Slinton struct nlist *np;
5679673Slinton {
5689673Slinton     register Symbol s;
5699673Slinton     register char *p;
5709673Slinton     register int c;
5719673Slinton     register Name n;
5729673Slinton     register Integer i;
5739673Slinton     Boolean knowtype, isnew;
5749673Slinton     Symclass class;
5759673Slinton     Integer level;
5769673Slinton 
5779673Slinton     p = index(str, ':');
5789673Slinton     *p = '\0';
5799673Slinton     c = *(p+1);
5809673Slinton     n = identname(str, true);
5819673Slinton     if (index("FfGV", c) != nil) {
5829673Slinton 	if (c == 'F' or c == 'f') {
5839673Slinton 	    class = FUNC;
5849673Slinton 	} else {
5859673Slinton 	    class = VAR;
5869673Slinton 	}
5879673Slinton 	level = (c == 'f' ? curmodule->level : program->level);
5889673Slinton 	find(s, n) where s->level == level and s->class == class endfind(s);
5899673Slinton 	if (s == nil) {
5909673Slinton 	    isnew = true;
5919673Slinton 	    s = insert(n);
5929673Slinton 	} else {
5939673Slinton 	    isnew = false;
5949673Slinton 	}
5959673Slinton     } else {
5969673Slinton 	isnew = true;
5979673Slinton 	s = insert(n);
5989673Slinton     }
5999673Slinton 
6009673Slinton     /*
6019673Slinton      * Default attributes.
6029673Slinton      */
6039673Slinton     s->language = curlang;
6049673Slinton     s->class = VAR;
6059673Slinton     s->block = curblock;
6069673Slinton     s->level = curlevel;
6079673Slinton     s->symvalue.offset = np->n_value;
6089673Slinton     curchar = p + 2;
6099673Slinton     knowtype = false;
6109673Slinton     switch (c) {
6119673Slinton 	case 't':	/* type name */
6129673Slinton 	    s->class = TYPE;
6139673Slinton 	    i = getint();
6149673Slinton 	    if (i == 0) {
6159673Slinton 		panic("bad input on type \"%s\" at \"%s\"", symname(s),
6169673Slinton 		    curchar);
6179673Slinton 	    } else if (i >= NTYPES) {
6189673Slinton 		panic("too many types in file \"%s\"", curfilename());
6199673Slinton 	    }
6209673Slinton 	    /*
6219673Slinton 	     * A hack for C typedefs that don't create new types,
6229673Slinton 	     * e.g. typedef unsigned int Hashvalue;
62311558Slinton 	     *  or  typedef struct blah BLAH;
6249673Slinton 	     */
6259673Slinton 	    if (*curchar == '\0') {
6269673Slinton 		s->type = typetable[i];
6279673Slinton 		if (s->type == nil) {
62811558Slinton 		    s->type = symbol_alloc();
62911558Slinton 		    typetable[i] = s->type;
6309673Slinton 		}
6319673Slinton 		knowtype = true;
6329673Slinton 	    } else {
6339673Slinton 		typetable[i] = s;
6349673Slinton 		skipchar(curchar, '=');
6359673Slinton 	    }
6369673Slinton 	    break;
6379673Slinton 
6389673Slinton 	case 'T':	/* tag */
6399673Slinton 	    s->class = TAG;
6409673Slinton 	    i = getint();
6419673Slinton 	    if (i == 0) {
6429673Slinton 		panic("bad input on tag \"%s\" at \"%s\"", symname(s),
6439673Slinton 		    curchar);
6449673Slinton 	    } else if (i >= NTYPES) {
6459673Slinton 		panic("too many types in file \"%s\"", curfilename());
6469673Slinton 	    }
6479673Slinton 	    if (typetable[i] != nil) {
6489673Slinton 		typetable[i]->language = curlang;
6499673Slinton 		typetable[i]->class = TYPE;
6509673Slinton 		typetable[i]->type = s;
6519673Slinton 	    } else {
6529673Slinton 		typetable[i] = s;
6539673Slinton 	    }
6549673Slinton 	    skipchar(curchar, '=');
6559673Slinton 	    break;
6569673Slinton 
6579673Slinton 	case 'F':	/* public function */
6589673Slinton 	case 'f':	/* private function */
6599673Slinton 	    s->class = FUNC;
6609673Slinton 	    if (curblock->class == FUNC or curblock->class == PROC) {
6619673Slinton 		exitblock();
6629673Slinton 	    }
6639673Slinton 	    enterblock(s);
6649673Slinton 	    if (c == 'F') {
6659673Slinton 		s->level = program->level;
6669673Slinton 		isnew = false;
6679673Slinton 	    }
6689673Slinton 	    curparam = s;
6699673Slinton 	    if (isnew) {
67011875Slinton 		s->symvalue.funcv.src = false;
6719673Slinton 		s->symvalue.funcv.beginaddr = np->n_value;
6729673Slinton 		newfunc(s);
6739673Slinton 		findbeginning(s);
6749673Slinton 	    }
6759673Slinton 	    break;
6769673Slinton 
6779673Slinton 	case 'G':	/* public variable */
6789673Slinton 	    s->level = program->level;
6799673Slinton 	    break;
6809673Slinton 
6819673Slinton 	case 'S':	/* private variable */
6829673Slinton 	    s->level = curmodule->level;
6839673Slinton 	    s->block = curmodule;
6849673Slinton 	    break;
6859673Slinton 
68612542Scsvaf /*
68712542Scsvaf  *  keep global BSS variables chained so can resolve when get the start
68812542Scsvaf  *  of common; keep the list in order so f77 can display all vars in a COMMON
68912542Scsvaf */
6909673Slinton 	case 'V':	/* own variable */
6919673Slinton 	    s->level = 2;
69212542Scsvaf 	    if (curcomm) {
69312542Scsvaf 	      if (commchain != nil) {
69412542Scsvaf  		  commchain->symvalue.common.chain = s;
69512542Scsvaf 	      }
69612542Scsvaf 	      else {
69712542Scsvaf 		  curcomm->symvalue.common.offset = (int) s;
69812542Scsvaf 	      }
69912542Scsvaf               commchain = s;
70012542Scsvaf               s->symvalue.common.offset = np->n_value;
70112542Scsvaf               s->symvalue.common.chain = nil;
70212542Scsvaf 	    }
7039673Slinton 	    break;
7049673Slinton 
7059673Slinton 	case 'r':	/* register variable */
7069673Slinton 	    s->level = -(s->level);
7079673Slinton 	    break;
7089673Slinton 
7099673Slinton 	case 'p':	/* parameter variable */
7109673Slinton 	    curparam->chain = s;
7119673Slinton 	    curparam = s;
7129673Slinton 	    break;
7139673Slinton 
7149673Slinton 	case 'v':	/* varies parameter */
7159673Slinton 	    s->class = REF;
7169673Slinton 	    s->symvalue.offset = np->n_value;
7179673Slinton 	    curparam->chain = s;
7189673Slinton 	    curparam = s;
7199673Slinton 	    break;
7209673Slinton 
7219673Slinton 	default:	/* local variable */
7229673Slinton 	    --curchar;
7239673Slinton 	    break;
7249673Slinton     }
7259673Slinton     if (not knowtype) {
7269673Slinton 	s->type = constype(nil);
7279673Slinton 	if (s->class == TAG) {
7289673Slinton 	    addtag(s);
7299673Slinton 	}
7309673Slinton     }
7319673Slinton     if (tracesyms) {
7329673Slinton 	printdecl(s);
7339673Slinton 	fflush(stdout);
7349673Slinton     }
7359673Slinton }
7369673Slinton 
7379673Slinton /*
7389673Slinton  * Construct a type out of a string encoding.
7399673Slinton  *
7409673Slinton  * The forms of the string are
7419673Slinton  *
7429673Slinton  *	<number>
7439673Slinton  *	<number>=<type>
7449673Slinton  *	r<type>;<number>;<number>		$ subrange
7459673Slinton  *	a<type>;<type>				$ array[index] of element
7469673Slinton  *	s{<name>:<type>;<number>;<number>}	$ record
7479673Slinton  *	*<type>					$ pointer
7489673Slinton  */
7499673Slinton 
7509673Slinton private Symbol constype(type)
7519673Slinton Symbol type;
7529673Slinton {
7539673Slinton     register Symbol t, u;
7549673Slinton     register Char *p, *cur;
7559673Slinton     register Integer n;
7569673Slinton     Integer b;
7579673Slinton     Name name;
7589673Slinton     Char class;
7599673Slinton 
7609673Slinton     b = curlevel;
7619673Slinton     if (isdigit(*curchar)) {
7629673Slinton 	n = getint();
7639673Slinton 	if (n == 0) {
7649673Slinton 	    panic("bad type number at \"%s\"", curchar);
7659673Slinton 	} else if (n >= NTYPES) {
7669673Slinton 	    panic("too many types in file \"%s\"", curfilename());
7679673Slinton 	}
7689673Slinton 	if (*curchar == '=') {
7699673Slinton 	    if (typetable[n] != nil) {
7709673Slinton 		t = typetable[n];
7719673Slinton 	    } else {
7729673Slinton 		t = symbol_alloc();
7739673Slinton 		typetable[n] = t;
7749673Slinton 	    }
7759673Slinton 	    ++curchar;
7769673Slinton 	    constype(t);
7779673Slinton 	} else {
7789673Slinton 	    t = typetable[n];
7799673Slinton 	    if (t == nil) {
7809673Slinton 		t = symbol_alloc();
7819673Slinton 		typetable[n] = t;
7829673Slinton 	    }
7839673Slinton 	}
7849673Slinton     } else {
7859673Slinton 	if (type == nil) {
7869673Slinton 	    t = symbol_alloc();
7879673Slinton 	} else {
7889673Slinton 	    t = type;
7899673Slinton 	}
7909673Slinton 	t->language = curlang;
7919673Slinton 	t->level = b;
79212542Scsvaf 	t->block = curblock;
7939673Slinton 	class = *curchar++;
7949673Slinton 	switch (class) {
79512542Scsvaf 
7969673Slinton 	    case 'r':
7979673Slinton 		t->class = RANGE;
7989673Slinton 		t->type = constype(nil);
7999673Slinton 		skipchar(curchar, ';');
80012542Scsvaf                 /* some letters indicate a dynamic bound, ie what follows
80112542Scsvaf                    is the offset from the fp which contains the bound; this will
80212542Scsvaf                    need a different encoding when pc a['A'..'Z'] is
80312542Scsvaf                    added; J is a special flag to handle fortran a(*) bounds
80412542Scsvaf                 */
80512542Scsvaf 		switch(*curchar) {
80612542Scsvaf 			case 'A':
80712542Scsvaf 				t->symvalue.rangev.lowertype = R_ARG;
80812542Scsvaf                   		curchar++;
80912542Scsvaf 			        break;
81012542Scsvaf 
81112542Scsvaf 			case 'T':
81212542Scsvaf 				t->symvalue.rangev.lowertype = R_TEMP;
81312542Scsvaf                   		curchar++;
81412542Scsvaf 			        break;
81512542Scsvaf 
81612542Scsvaf 			case 'J':
81712542Scsvaf 				t->symvalue.rangev.lowertype = R_ADJUST;
81812542Scsvaf                   		curchar++;
81912542Scsvaf 			  	break;
82012542Scsvaf 
82112542Scsvaf 			default:
82212542Scsvaf 				 t->symvalue.rangev.lowertype = R_CONST;
82312542Scsvaf 			  	 break;
82412542Scsvaf 
82512542Scsvaf 		}
82612542Scsvaf 	        t->symvalue.rangev.lower = getint();
8279673Slinton 		skipchar(curchar, ';');
82812542Scsvaf 		switch(*curchar) {
82912542Scsvaf 			case 'A':
83012542Scsvaf 				t->symvalue.rangev.uppertype = R_ARG;
83112542Scsvaf                   		curchar++;
83212542Scsvaf 			        break;
83312542Scsvaf 
83412542Scsvaf 			case 'T':
83512542Scsvaf 				t->symvalue.rangev.uppertype = R_TEMP;
83612542Scsvaf                   		curchar++;
83712542Scsvaf 			        break;
83812542Scsvaf 
83912542Scsvaf 			case 'J':
84012542Scsvaf 				t->symvalue.rangev.uppertype = R_ADJUST;
84112542Scsvaf                   		curchar++;
84212542Scsvaf 			  	break;
84312542Scsvaf 
84412542Scsvaf 			default:
84512542Scsvaf 				 t->symvalue.rangev.uppertype = R_CONST;
84612542Scsvaf 			  	 break;
84712542Scsvaf 
84812542Scsvaf 		}
8499673Slinton 		t->symvalue.rangev.upper = getint();
8509673Slinton 		break;
8519673Slinton 
8529673Slinton 	    case 'a':
8539673Slinton 		t->class = ARRAY;
8549673Slinton 		t->chain = constype(nil);
8559673Slinton 		skipchar(curchar, ';');
8569673Slinton 		t->type = constype(nil);
8579673Slinton 		break;
8589673Slinton 
8599673Slinton 	    case 's':
8609673Slinton 	    case 'u':
8619673Slinton 		t->class = (class == 's') ? RECORD : VARNT;
8629673Slinton 		t->symvalue.offset = getint();
8639673Slinton 		u = t;
8649673Slinton 		cur = curchar;
8659673Slinton 		while (*cur != ';' and *cur != '\0') {
8669673Slinton 		    p = index(cur, ':');
8679673Slinton 		    if (p == nil) {
8689673Slinton 			panic("index(\"%s\", ':') failed", curchar);
8699673Slinton 		    }
8709673Slinton 		    *p = '\0';
8719673Slinton 		    name = identname(cur, true);
8729673Slinton 		    u->chain = newSymbol(name, b, FIELD, nil, nil);
8739673Slinton 		    cur = p + 1;
8749673Slinton 		    u = u->chain;
8759673Slinton 		    u->language = curlang;
8769673Slinton 		    curchar = cur;
8779673Slinton 		    u->type = constype(nil);
8789673Slinton 		    skipchar(curchar, ',');
8799673Slinton 		    u->symvalue.field.offset = getint();
8809673Slinton 		    skipchar(curchar, ',');
8819673Slinton 		    u->symvalue.field.length = getint();
8829673Slinton 		    skipchar(curchar, ';');
8839673Slinton 		    cur = curchar;
8849673Slinton 		}
8859673Slinton 		if (*cur == ';') {
8869673Slinton 		    ++cur;
8879673Slinton 		}
8889673Slinton 		curchar = cur;
8899673Slinton 		break;
8909673Slinton 
8919673Slinton 	    case 'e':
8929673Slinton 		t->class = SCAL;
8939673Slinton 		u = t;
8949673Slinton 		while (*curchar != ';' and *curchar != '\0') {
8959673Slinton 		    p = index(curchar, ':');
8969673Slinton 		    assert(p != nil);
8979673Slinton 		    *p = '\0';
8989673Slinton 		    u->chain = insert(identname(curchar, true));
8999673Slinton 		    curchar = p + 1;
9009673Slinton 		    u = u->chain;
9019673Slinton 		    u->language = curlang;
9029673Slinton 		    u->class = CONST;
9039673Slinton 		    u->level = b;
9049673Slinton 		    u->block = curblock;
9059673Slinton 		    u->type = t;
9069673Slinton 		    u->symvalue.iconval = getint();
9079673Slinton 		    skipchar(curchar, ',');
9089673Slinton 		}
9099673Slinton 		break;
9109673Slinton 
9119673Slinton 	    case '*':
9129673Slinton 		t->class = PTR;
9139673Slinton 		t->type = constype(nil);
9149673Slinton 		break;
9159673Slinton 
9169673Slinton 	    case 'f':
9179673Slinton 		t->class = FUNC;
9189673Slinton 		t->type = constype(nil);
9199673Slinton 		break;
9209673Slinton 
9219673Slinton 	    default:
9229673Slinton 		badcaseval(class);
9239673Slinton 	}
9249673Slinton     }
9259673Slinton     return t;
9269673Slinton }
9279673Slinton 
9289673Slinton /*
9299673Slinton  * Read an integer from the current position in the type string.
9309673Slinton  */
9319673Slinton 
9329673Slinton private Integer getint()
9339673Slinton {
9349673Slinton     register Integer n;
9359673Slinton     register char *p;
9369673Slinton     register Boolean isneg;
9379673Slinton 
9389673Slinton     n = 0;
9399673Slinton     p = curchar;
9409673Slinton     if (*p == '-') {
9419673Slinton 	isneg = true;
9429673Slinton 	++p;
9439673Slinton     } else {
9449673Slinton 	isneg = false;
9459673Slinton     }
9469673Slinton     while (isdigit(*p)) {
9479673Slinton 	n = 10*n + (*p - '0');
9489673Slinton 	++p;
9499673Slinton     }
9509673Slinton     curchar = p;
9519673Slinton     return isneg ? (-n) : n;
9529673Slinton }
9539673Slinton 
9549673Slinton /*
9559673Slinton  * Add a tag name.  This is a kludge to be able to refer
9569673Slinton  * to tags that have the same name as some other symbol
9579673Slinton  * in the same block.
9589673Slinton  */
9599673Slinton 
9609673Slinton private addtag(s)
9619673Slinton register Symbol s;
9629673Slinton {
9639673Slinton     register Symbol t;
9649673Slinton     char buf[100];
9659673Slinton 
9669673Slinton     sprintf(buf, "$$%.90s", ident(s->name));
9679673Slinton     t = insert(identname(buf, false));
9689673Slinton     t->language = s->language;
9699673Slinton     t->class = TAG;
9709673Slinton     t->type = s->type;
9719673Slinton     t->block = s->block;
9729673Slinton }
9739673Slinton 
9749673Slinton /*
9759673Slinton  * Allocate file and line tables and initialize indices.
9769673Slinton  */
9779673Slinton 
9789673Slinton private allocmaps(nf, nl)
9799673Slinton Integer nf, nl;
9809673Slinton {
9819673Slinton     if (filetab != nil) {
9829673Slinton 	dispose(filetab);
9839673Slinton     }
9849673Slinton     if (linetab != nil) {
9859673Slinton 	dispose(linetab);
9869673Slinton     }
9879673Slinton     filetab = newarr(Filetab, nf);
9889673Slinton     linetab = newarr(Linetab, nl);
9899673Slinton     filep = filetab;
9909673Slinton     linep = linetab;
9919673Slinton }
9929673Slinton 
9939673Slinton /*
9949673Slinton  * Add a file to the file table.
9959673Slinton  */
9969673Slinton 
9979673Slinton private enterfile(filename, addr)
9989673Slinton String filename;
9999673Slinton Address addr;
10009673Slinton {
10019673Slinton     if (addr != curfaddr) {
10029673Slinton 	filep->addr = addr;
10039673Slinton 	filep->filename = filename;
10049673Slinton 	filep->lineindex = linep - linetab;
10059673Slinton 	++filep;
10069673Slinton 	curfaddr = addr;
10079673Slinton     }
10089673Slinton }
10099673Slinton 
10109673Slinton /*
10119673Slinton  * Since we only estimated the number of lines (and it was a poor
10129673Slinton  * estimation) and since we need to know the exact number of lines
10139673Slinton  * to do a binary search, we set it when we're done.
10149673Slinton  */
10159673Slinton 
10169673Slinton private setnlines()
10179673Slinton {
10189673Slinton     nlhdr.nlines = linep - linetab;
10199673Slinton }
10209673Slinton 
10219673Slinton /*
10229673Slinton  * Similarly for nfiles ...
10239673Slinton  */
10249673Slinton 
10259673Slinton private setnfiles()
10269673Slinton {
10279673Slinton     nlhdr.nfiles = filep - filetab;
10289673Slinton     setsource(filetab[0].filename);
10299673Slinton }
1030