xref: /csrg-svn/old/dbx/object.c (revision 14653)
19673Slinton /* Copyright (c) 1982 Regents of the University of California */
29673Slinton 
3*14653Slinton static char sccsid[] = "@(#)object.c 1.12 08/16/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 
489673Slinton #define curfilename() (filep-1)->filename
499673Slinton 
509673Slinton /*
519673Slinton  * Blocks are figured out on the fly while reading the symbol table.
529673Slinton  */
539673Slinton 
549673Slinton #define MAXBLKDEPTH 25
559673Slinton 
569673Slinton private Symbol curblock;
579673Slinton private Symbol blkstack[MAXBLKDEPTH];
589673Slinton private Integer curlevel;
5914443Slinton private Integer bnum, nesting;
6014443Slinton private Address addrstk[MAXBLKDEPTH];
619673Slinton 
629673Slinton #define enterblock(b) { \
639673Slinton     blkstack[curlevel] = curblock; \
649673Slinton     ++curlevel; \
659673Slinton     b->level = curlevel; \
669673Slinton     b->block = curblock; \
679673Slinton     curblock = b; \
689673Slinton }
699673Slinton 
709673Slinton #define exitblock() { \
7111875Slinton     if (curblock->class == FUNC or curblock->class == PROC) { \
7211875Slinton 	if (prevlinep != linep) { \
7311875Slinton 	    curblock->symvalue.funcv.src = true; \
7411875Slinton 	} \
7511875Slinton     } \
769673Slinton     --curlevel; \
779673Slinton     curblock = blkstack[curlevel]; \
789673Slinton }
799673Slinton 
809673Slinton /*
819673Slinton  * Enter a source line or file name reference into the appropriate table.
829673Slinton  * Expanded inline to reduce procedure calls.
839673Slinton  *
849673Slinton  * private enterline(linenumber, address)
859673Slinton  * Lineno linenumber;
869673Slinton  * Address address;
879673Slinton  *  ...
889673Slinton  */
899673Slinton 
909673Slinton #define enterline(linenumber, address) \
919673Slinton { \
929673Slinton     register Linetab *lp; \
939673Slinton  \
949673Slinton     lp = linep - 1; \
959673Slinton     if (linenumber != lp->line) { \
969673Slinton 	if (address != lp->addr) { \
979673Slinton 	    ++lp; \
989673Slinton 	} \
999673Slinton 	lp->line = linenumber; \
1009673Slinton 	lp->addr = address; \
1019673Slinton 	linep = lp + 1; \
1029673Slinton     } \
1039673Slinton }
1049673Slinton 
1059673Slinton #define NTYPES 1000
1069673Slinton 
1079673Slinton private Symbol typetable[NTYPES];
1089673Slinton 
1099673Slinton /*
1109673Slinton  * Read in the namelist from the obj file.
1119673Slinton  *
1129673Slinton  * Reads and seeks are used instead of fread's and fseek's
1139673Slinton  * for efficiency sake; there's a lot of data being read here.
1149673Slinton  */
1159673Slinton 
1169673Slinton public readobj(file)
1179673Slinton String file;
1189673Slinton {
1199673Slinton     Fileid f;
1209673Slinton     struct exec hdr;
1219673Slinton     struct nlist nlist;
1229673Slinton 
1239673Slinton     f = open(file, 0);
1249673Slinton     if (f < 0) {
1259673Slinton 	fatal("can't open %s", file);
1269673Slinton     }
1279673Slinton     read(f, &hdr, sizeof(hdr));
1289673Slinton     objsize = hdr.a_text;
1299673Slinton     nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
1309673Slinton     nlhdr.nfiles = nlhdr.nsyms;
1319673Slinton     nlhdr.nlines = nlhdr.nsyms;
13214443Slinton     if (nlhdr.nsyms > 0) {
13314443Slinton 	lseek(f, (long) N_STROFF(hdr), 0);
13414443Slinton 	read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
13514443Slinton 	nlhdr.stringsize -= 4;
13614443Slinton 	stringtab = newarr(char, nlhdr.stringsize);
13714443Slinton 	read(f, stringtab, nlhdr.stringsize);
13814443Slinton 	allocmaps(nlhdr.nfiles, nlhdr.nlines);
13914443Slinton 	lseek(f, (long) N_SYMOFF(hdr), 0);
14014443Slinton 	readsyms(f);
14114443Slinton 	ordfunctab();
14214443Slinton 	setnlines();
14314443Slinton 	setnfiles();
14414443Slinton     }
1459673Slinton     close(f);
1469673Slinton }
1479673Slinton 
1489673Slinton /*
1499673Slinton  * Read in symbols from object file.
1509673Slinton  */
1519673Slinton 
1529673Slinton private readsyms(f)
1539673Slinton Fileid f;
1549673Slinton {
1559673Slinton     struct nlist *namelist;
1569673Slinton     register struct nlist *np, *ub;
1579673Slinton     register int index;
1589673Slinton     register String name;
1599673Slinton     register Boolean afterlg;
1609673Slinton 
1619673Slinton     initsyms();
1629673Slinton     namelist = newarr(struct nlist, nlhdr.nsyms);
1639673Slinton     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
1649673Slinton     afterlg = false;
1659673Slinton     ub = &namelist[nlhdr.nsyms];
1669673Slinton     for (np = &namelist[0]; np < ub; np++) {
1679673Slinton 	index = np->n_un.n_strx;
1689673Slinton 	if (index != 0) {
1699673Slinton 	    name = &stringtab[index - 4];
17012542Scsvaf 	    /*
17112542Scsvaf              *  if the program contains any .f files a trailing _ is stripped
17212542Scsvaf        	     *  from the name on the assumption it was added by the compiler.
17312542Scsvaf 	     *  This only affects names that follow the sdb N_SO entry with
17412542Scsvaf              *  the .f name.
17512542Scsvaf              */
17614443Slinton             if (strip_ and name[0] != '\0' ) {
17714443Slinton 		register char *p;
17814443Slinton 
17914443Slinton 		p = name;
18014443Slinton 		while (*p != '\0') {
18114443Slinton 		    ++p;
18214443Slinton 		}
18314443Slinton 		--p;
184*14653Slinton 		if (*p == '_') {
18514443Slinton 		    *p = '\0';
18614443Slinton 		}
18712542Scsvaf             }
18812542Scsvaf 
1899673Slinton 	} else {
1909673Slinton 	    name = nil;
19112542Scsvaf 	}
1929673Slinton 	/*
1939673Slinton 	 * assumptions:
1949673Slinton 	 *	not an N_STAB	==> name != nil
1959673Slinton 	 *	name[0] == '-'	==> name == "-lg"
1969673Slinton 	 *	name[0] != '_'	==> filename or invisible
1979673Slinton 	 *
1989673Slinton 	 * The "-lg" signals the beginning of global loader symbols.
19912542Scsvaf          *
2009673Slinton 	 */
2019673Slinton 	if ((np->n_type&N_STAB) != 0) {
2029673Slinton 	    enter_nl(name, np);
2039673Slinton 	} else if (name[0] == '-') {
2049673Slinton 	    afterlg = true;
2059673Slinton 	    if (curblock->class != PROG) {
2069673Slinton 		exitblock();
2079673Slinton 		if (curblock->class != PROG) {
2089673Slinton 		    exitblock();
2099673Slinton 		}
2109673Slinton 	    }
2119673Slinton 	    enterline(0, (linep-1)->addr + 1);
21211104Slinton 	} else if (afterlg) {
21311104Slinton 	    if (name[0] == '_') {
2149673Slinton 		check_global(&name[1], np);
2159673Slinton 	    }
21611104Slinton 	} else if (name[0] == '_') {
21711104Slinton 	    check_local(&name[1], np);
2189673Slinton 	} else if ((np->n_type&N_TEXT) == N_TEXT) {
2199673Slinton 	    check_filename(name);
2209673Slinton 	}
2219673Slinton     }
22214443Slinton     if (not afterlg) {
223*14653Slinton 	fatal("not linked for debugging, use \"cc -g ...\"");
22414443Slinton     }
2259673Slinton     dispose(namelist);
2269673Slinton }
2279673Slinton 
2289673Slinton /*
2299673Slinton  * Initialize symbol information.
2309673Slinton  */
2319673Slinton 
2329673Slinton private initsyms()
2339673Slinton {
2349673Slinton     curblock = nil;
2359673Slinton     curlevel = 0;
23614443Slinton     nesting = 0;
2379673Slinton     if (progname == nil) {
2389673Slinton 	progname = strdup(objname);
2399673Slinton 	if (rindex(progname, '/') != nil) {
2409673Slinton 	    progname = rindex(progname, '/') + 1;
2419673Slinton 	}
2429673Slinton 	if (index(progname, '.') != nil) {
2439673Slinton 	    *(index(progname, '.')) = '\0';
2449673Slinton 	}
2459673Slinton     }
2469673Slinton     program = insert(identname(progname, true));
2479673Slinton     program->class = PROG;
24811769Slinton     program->symvalue.funcv.beginaddr = 0;
24914443Slinton     program->symvalue.funcv.inline = false;
25014443Slinton     newfunc(program, codeloc(program));
25111769Slinton     findbeginning(program);
2529673Slinton     enterblock(program);
2539673Slinton     curmodule = program;
2549673Slinton }
2559673Slinton 
2569673Slinton /*
2579673Slinton  * Free all the object file information that's being stored.
2589673Slinton  */
2599673Slinton 
2609673Slinton public objfree()
2619673Slinton {
2629673Slinton     symbol_free();
2639673Slinton     keywords_free();
2649673Slinton     names_free();
2659673Slinton     dispose(stringtab);
2669673Slinton     clrfunctab();
2679673Slinton }
2689673Slinton 
2699673Slinton /*
2709673Slinton  * Enter a namelist entry.
2719673Slinton  */
2729673Slinton 
2739673Slinton private enter_nl(name, np)
2749673Slinton String name;
2759673Slinton register struct nlist *np;
2769673Slinton {
2779673Slinton     register Symbol s;
27811875Slinton     register Name n, nn;
27914443Slinton     char buf[100];
2809673Slinton 
2819673Slinton     s = nil;
2829673Slinton     if (name == nil) {
2839673Slinton 	n = nil;
2849673Slinton     } else {
2859673Slinton 	n = identname(name, true);
2869673Slinton     }
2879673Slinton     switch (np->n_type) {
28814443Slinton 	/*
28914443Slinton 	 * Build a symbol for the FORTRAN common area.  All GSYMS that follow
29014443Slinton 	 * will be chained in a list with the head kept in common.offset, and
29114443Slinton 	 * the tail in common.chain.
29214443Slinton 	 */
29313938Slinton 	case N_BCOMM:
29413938Slinton  	    if (curcomm) {
29513938Slinton 		curcomm->symvalue.common.chain = commchain;
29612542Scsvaf 	    }
29712542Scsvaf 	    curcomm = lookup(n);
29813938Slinton 	    if (curcomm == nil) {
29913938Slinton 		curcomm = insert(n);
30013938Slinton 		curcomm->class = COMMON;
30113938Slinton 		curcomm->block = curblock;
30213938Slinton 		curcomm->level = program->level;
30313938Slinton 		curcomm->symvalue.common.chain = nil;
30412542Scsvaf 	    }
30512542Scsvaf 	    commchain = curcomm->symvalue.common.chain;
30613938Slinton 	    break;
30712542Scsvaf 
30812542Scsvaf 	case N_ECOMM:
30913938Slinton 	    if (curcomm) {
31013938Slinton 		curcomm->symvalue.common.chain = commchain;
31113938Slinton 		curcomm = nil;
31212542Scsvaf 	    }
31312542Scsvaf 	    break;
31414443Slinton 
3159673Slinton 	case N_LBRAC:
31614443Slinton 	    ++nesting;
31714443Slinton 	    addrstk[nesting] = (linep - 1)->addr;
3189673Slinton 	    break;
3199673Slinton 
3209673Slinton 	case N_RBRAC:
32114443Slinton 	    if (addrstk[nesting] == NOADDR) {
32214443Slinton 		exitblock();
32314443Slinton 		newfunc(curblock, (linep - 1)->addr);
32414443Slinton 	    }
32514443Slinton 	    --nesting;
3269673Slinton 	    break;
3279673Slinton 
3289673Slinton 	case N_SLINE:
3299673Slinton 	    enterline((Lineno) np->n_desc, (Address) np->n_value);
3309673Slinton 	    break;
3319673Slinton 
3329673Slinton 	/*
33314443Slinton 	 * Source files.
3349673Slinton 	 */
3359673Slinton 	case N_SO:
33614443Slinton 	    enterSourceModule(n, (Address) np->n_value);
3379673Slinton 	    break;
3389673Slinton 
3399673Slinton 	/*
3409673Slinton 	 * Textually included files.
3419673Slinton 	 */
3429673Slinton 	case N_SOL:
3439673Slinton 	    enterfile(name, (Address) np->n_value);
3449673Slinton 	    break;
3459673Slinton 
3469673Slinton 	/*
3479673Slinton 	 * These symbols are assumed to have non-nil names.
3489673Slinton 	 */
3499673Slinton 	case N_GSYM:
3509673Slinton 	case N_FUN:
3519673Slinton 	case N_STSYM:
3529673Slinton 	case N_LCSYM:
3539673Slinton 	case N_RSYM:
3549673Slinton 	case N_PSYM:
3559673Slinton 	case N_LSYM:
3569673Slinton 	case N_SSYM:
35714443Slinton 	case N_LENG:
3589673Slinton 	    if (index(name, ':') == nil) {
3599673Slinton 		if (not warned) {
3609673Slinton 		    warned = true;
3619673Slinton 		    warning("old style symbol information found in \"%s\"",
3629673Slinton 			curfilename());
3639673Slinton 		}
3649673Slinton 	    } else {
3659673Slinton 		entersym(name, np);
3669673Slinton 	    }
3679673Slinton 	    break;
3689673Slinton 
3699673Slinton 	case N_PC:
3709673Slinton 	    break;
3719673Slinton 
37211558Slinton 	default:
37314443Slinton 	    printf("warning:  stab entry unrecognized: ");
3749673Slinton 	    if (name != nil) {
37514443Slinton 		printf("name %s,", name);
3769673Slinton 	    }
37714443Slinton 	    printf("ntype %2x, desc %x, value %x'\n",
3789673Slinton 		np->n_type, np->n_desc, np->n_value);
3799673Slinton 	    break;
3809673Slinton     }
3819673Slinton }
3829673Slinton 
3839673Slinton /*
3849673Slinton  * Check to see if a global _name is already in the symbol table,
3859673Slinton  * if not then insert it.
3869673Slinton  */
3879673Slinton 
3889673Slinton private check_global(name, np)
3899673Slinton String name;
3909673Slinton register struct nlist *np;
3919673Slinton {
3929673Slinton     register Name n;
39312542Scsvaf     register Symbol t, u;
3949673Slinton 
3959673Slinton     if (not streq(name, "end")) {
3969673Slinton 	n = identname(name, true);
3979673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
3989673Slinton 	    find(t, n) where
39914443Slinton 		t->level == program->level and
40014443Slinton 		(t->class == PROC or t->class == FUNC)
4019673Slinton 	    endfind(t);
4029673Slinton 	    if (t == nil) {
4039673Slinton 		t = insert(n);
4049673Slinton 		t->language = findlanguage(".s");
4059673Slinton 		t->class = FUNC;
4069673Slinton 		t->type = t_int;
4079673Slinton 		t->block = curblock;
4089673Slinton 		t->level = program->level;
40911875Slinton 		t->symvalue.funcv.src = false;
41014443Slinton 		t->symvalue.funcv.inline = false;
4119673Slinton 	    }
4129673Slinton 	    t->symvalue.funcv.beginaddr = np->n_value;
41314443Slinton 	    newfunc(t, codeloc(t));
4149673Slinton 	    findbeginning(t);
41513938Slinton 	} else if ((np->n_type&N_TYPE) == N_BSS) {
4169673Slinton 	    find(t, n) where
41713938Slinton 		t->class == COMMON
41812542Scsvaf 	    endfind(t);
41913938Slinton 	    if (t != nil) {
42013938Slinton 		u = (Symbol) t->symvalue.common.offset;
42113938Slinton 		while (u != nil) {
42213938Slinton 		    u->symvalue.offset = u->symvalue.common.offset+np->n_value;
42313938Slinton 		    u = u->symvalue.common.chain;
42413938Slinton 		}
42513938Slinton             } else {
42613938Slinton 		check_var(np, n);
4279673Slinton 	    }
42813938Slinton         } else {
42913938Slinton 	    check_var(np, n);
4309673Slinton 	}
4319673Slinton     }
4329673Slinton }
4339673Slinton 
4349673Slinton /*
43513938Slinton  * Check to see if a namelist entry refers to a variable.
43613938Slinton  * If not, create a variable for the entry.  In any case,
43713938Slinton  * set the offset of the variable according to the value field
43813938Slinton  * in the entry.
43913938Slinton  */
44013938Slinton 
44113938Slinton private check_var(np, n)
44213938Slinton struct nlist *np;
44313938Slinton register Name n;
44413938Slinton {
44513938Slinton     register Symbol t;
44613938Slinton 
44713938Slinton     find(t, n) where
44813938Slinton 	t->class == VAR and t->level == program->level
44913938Slinton     endfind(t);
45013938Slinton     if (t == nil) {
45113938Slinton 	t = insert(n);
45213938Slinton 	t->language = findlanguage(".s");
45313938Slinton 	t->class = VAR;
45413938Slinton 	t->type = t_int;
45513938Slinton 	t->level = program->level;
45613938Slinton     }
45713938Slinton     t->block = curblock;
45813938Slinton     t->symvalue.offset = np->n_value;
45913938Slinton }
46013938Slinton 
46113938Slinton /*
4629673Slinton  * Check to see if a local _name is known in the current scope.
4639673Slinton  * If not then enter it.
4649673Slinton  */
4659673Slinton 
4669673Slinton private check_local(name, np)
4679673Slinton String name;
4689673Slinton register struct nlist *np;
4699673Slinton {
4709673Slinton     register Name n;
4719673Slinton     register Symbol t, cur;
4729673Slinton 
4739673Slinton     n = identname(name, true);
4749673Slinton     cur = ((np->n_type&N_TYPE) == N_TEXT) ? curmodule : curblock;
4759673Slinton     find(t, n) where t->block == cur endfind(t);
4769673Slinton     if (t == nil) {
4779673Slinton 	t = insert(n);
4789673Slinton 	t->language = findlanguage(".s");
4799673Slinton 	t->type = t_int;
4809673Slinton 	t->block = cur;
4819673Slinton 	t->level = cur->level;
4829673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
4839673Slinton 	    t->class = FUNC;
48411875Slinton 	    t->symvalue.funcv.src = false;
48514443Slinton 	    t->symvalue.funcv.inline = false;
4869673Slinton 	    t->symvalue.funcv.beginaddr = np->n_value;
48714443Slinton 	    newfunc(t, codeloc(t));
4889673Slinton 	    findbeginning(t);
4899673Slinton 	} else {
4909673Slinton 	    t->class = VAR;
4919673Slinton 	    t->symvalue.offset = np->n_value;
4929673Slinton 	}
4939673Slinton     }
4949673Slinton }
4959673Slinton 
4969673Slinton /*
4979673Slinton  * Check to see if a symbol corresponds to a object file name.
4989673Slinton  * For some reason these are listed as in the text segment.
4999673Slinton  */
5009673Slinton 
5019673Slinton private check_filename(name)
5029673Slinton String name;
5039673Slinton {
5049673Slinton     register String mname;
5059673Slinton     register Integer i;
5069673Slinton     register Symbol s;
5079673Slinton 
5089673Slinton     mname = strdup(name);
5099673Slinton     i = strlen(mname) - 2;
5109673Slinton     if (i >= 0 and mname[i] == '.' and mname[i+1] == 'o') {
5119673Slinton 	mname[i] = '\0';
5129673Slinton 	--i;
5139673Slinton 	while (mname[i] != '/' and i >= 0) {
5149673Slinton 	    --i;
5159673Slinton 	}
5169673Slinton 	s = insert(identname(&mname[i+1], true));
5179673Slinton 	s->language = findlanguage(".s");
5189673Slinton 	s->class = MODULE;
51911769Slinton 	s->symvalue.funcv.beginaddr = 0;
52011769Slinton 	findbeginning(s);
5219673Slinton 	if (curblock->class != PROG) {
5229673Slinton 	    exitblock();
5239673Slinton 	    if (curblock->class != PROG) {
5249673Slinton 		exitblock();
5259673Slinton 	    }
5269673Slinton 	}
5279673Slinton 	enterblock(s);
5289673Slinton 	curmodule = s;
5299673Slinton     }
5309673Slinton }
5319673Slinton 
5329673Slinton /*
53314443Slinton  * Check to see if a symbol is about to be defined within an unnamed block.
53414443Slinton  * If this happens, we create a procedure for the unnamed block, make it
53514443Slinton  * "inline" so that tracebacks don't associate an activation record with it,
53614443Slinton  * and enter it into the function table so that it will be detected
53714443Slinton  * by "whatblock".
53814443Slinton  */
53914443Slinton 
54014443Slinton private unnamed_block()
54114443Slinton {
54214443Slinton     register Symbol s;
54314443Slinton     static int bnum = 0;
54414443Slinton     char buf[100];
54514443Slinton 
54614443Slinton     ++bnum;
54714443Slinton     sprintf(buf, "$b%d", bnum);
54814443Slinton     s = insert(identname(buf, false));
54914443Slinton     s->class = PROG;
55014443Slinton     s->symvalue.funcv.src = false;
55114443Slinton     s->symvalue.funcv.inline = true;
55214443Slinton     s->symvalue.funcv.beginaddr = addrstk[nesting];
55314443Slinton     enterblock(s);
55414443Slinton     newfunc(s, addrstk[nesting]);
55514443Slinton     addrstk[nesting] = NOADDR;
55614443Slinton }
55714443Slinton 
55814443Slinton /*
55914443Slinton  * Compilation unit.  C associates scope with filenames
56014443Slinton  * so we treat them as "modules".  The filename without
56114443Slinton  * the suffix is used for the module name.
56214443Slinton  *
56314443Slinton  * Because there is no explicit "end-of-block" mark in
56414443Slinton  * the object file, we must exit blocks for the current
56514443Slinton  * procedure and module.
56614443Slinton  */
56714443Slinton 
56814443Slinton private enterSourceModule(n, addr)
56914443Slinton Name n;
57014443Slinton Address addr;
57114443Slinton {
57214443Slinton     register Symbol s;
57314443Slinton     Name nn;
57414443Slinton     String mname, suffix;
57514443Slinton 
57614443Slinton     mname = strdup(ident(n));
57714443Slinton     if (rindex(mname, '/') != nil) {
57814443Slinton 	mname = rindex(mname, '/') + 1;
57914443Slinton     }
58014443Slinton     suffix = rindex(mname, '.');
58114443Slinton     curlang = findlanguage(suffix);
58214443Slinton     if (curlang == findlanguage(".f")) {
58314443Slinton 	strip_ = true;
58414443Slinton     }
58514443Slinton     if (suffix != nil) {
58614443Slinton 	*suffix = '\0';
58714443Slinton     }
58814443Slinton     if (curblock->class != PROG) {
58914443Slinton 	exitblock();
59014443Slinton 	if (curblock->class != PROG) {
59114443Slinton 	    exitblock();
59214443Slinton 	}
59314443Slinton     }
59414443Slinton     nn = identname(mname, true);
59514443Slinton     if (curmodule == nil or curmodule->name != nn) {
59614443Slinton 	s = insert(nn);
59714443Slinton 	s->class = MODULE;
59814443Slinton 	s->symvalue.funcv.beginaddr = 0;
59914443Slinton 	findbeginning(s);
60014443Slinton     } else {
60114443Slinton 	s = curmodule;
60214443Slinton     }
60314443Slinton     s->language = curlang;
60414443Slinton     enterblock(s);
60514443Slinton     curmodule = s;
60614443Slinton     if (program->language == nil) {
60714443Slinton 	program->language = curlang;
60814443Slinton     }
60914443Slinton     warned = false;
61014443Slinton     enterfile(ident(n), addr);
61114443Slinton     bzero(typetable, sizeof(typetable));
61214443Slinton }
61314443Slinton 
61414443Slinton /*
6159673Slinton  * Put an nlist into the symbol table.
6169673Slinton  * If it's already there just add the associated information.
6179673Slinton  *
6189673Slinton  * Type information is encoded in the name following a ":".
6199673Slinton  */
6209673Slinton 
6219673Slinton private Symbol constype();
6229673Slinton private Char *curchar;
6239673Slinton 
6249673Slinton #define skipchar(ptr, ch) { \
6259673Slinton     if (*ptr != ch) { \
6269673Slinton 	panic("expected char '%c', found char '%c'", ch, *ptr); \
6279673Slinton     } \
6289673Slinton     ++ptr; \
6299673Slinton }
6309673Slinton 
6319673Slinton private entersym(str, np)
6329673Slinton String str;
6339673Slinton struct nlist *np;
6349673Slinton {
6359673Slinton     register Symbol s;
6369673Slinton     register char *p;
6379673Slinton     register int c;
6389673Slinton     register Name n;
6399673Slinton     register Integer i;
6409673Slinton     Boolean knowtype, isnew;
6419673Slinton     Symclass class;
6429673Slinton     Integer level;
6439673Slinton 
6449673Slinton     p = index(str, ':');
6459673Slinton     *p = '\0';
6469673Slinton     c = *(p+1);
6479673Slinton     n = identname(str, true);
6489673Slinton     if (index("FfGV", c) != nil) {
6499673Slinton 	if (c == 'F' or c == 'f') {
6509673Slinton 	    class = FUNC;
6519673Slinton 	} else {
6529673Slinton 	    class = VAR;
6539673Slinton 	}
6549673Slinton 	level = (c == 'f' ? curmodule->level : program->level);
6559673Slinton 	find(s, n) where s->level == level and s->class == class endfind(s);
6569673Slinton 	if (s == nil) {
6579673Slinton 	    isnew = true;
6589673Slinton 	    s = insert(n);
6599673Slinton 	} else {
6609673Slinton 	    isnew = false;
6619673Slinton 	}
6629673Slinton     } else {
6639673Slinton 	isnew = true;
6649673Slinton 	s = insert(n);
6659673Slinton     }
6669673Slinton 
66714443Slinton     if (nesting > 0 and addrstk[nesting] != NOADDR) {
66814443Slinton 	unnamed_block();
66914443Slinton     }
67014443Slinton 
6719673Slinton     /*
6729673Slinton      * Default attributes.
6739673Slinton      */
6749673Slinton     s->language = curlang;
6759673Slinton     s->class = VAR;
6769673Slinton     s->block = curblock;
6779673Slinton     s->level = curlevel;
6789673Slinton     s->symvalue.offset = np->n_value;
6799673Slinton     curchar = p + 2;
6809673Slinton     knowtype = false;
6819673Slinton     switch (c) {
6829673Slinton 	case 't':	/* type name */
6839673Slinton 	    s->class = TYPE;
6849673Slinton 	    i = getint();
6859673Slinton 	    if (i == 0) {
6869673Slinton 		panic("bad input on type \"%s\" at \"%s\"", symname(s),
6879673Slinton 		    curchar);
6889673Slinton 	    } else if (i >= NTYPES) {
6899673Slinton 		panic("too many types in file \"%s\"", curfilename());
6909673Slinton 	    }
6919673Slinton 	    /*
6929673Slinton 	     * A hack for C typedefs that don't create new types,
6939673Slinton 	     * e.g. typedef unsigned int Hashvalue;
69411558Slinton 	     *  or  typedef struct blah BLAH;
6959673Slinton 	     */
6969673Slinton 	    if (*curchar == '\0') {
6979673Slinton 		s->type = typetable[i];
6989673Slinton 		if (s->type == nil) {
69911558Slinton 		    s->type = symbol_alloc();
70011558Slinton 		    typetable[i] = s->type;
7019673Slinton 		}
7029673Slinton 		knowtype = true;
7039673Slinton 	    } else {
7049673Slinton 		typetable[i] = s;
7059673Slinton 		skipchar(curchar, '=');
7069673Slinton 	    }
7079673Slinton 	    break;
7089673Slinton 
7099673Slinton 	case 'T':	/* tag */
7109673Slinton 	    s->class = TAG;
7119673Slinton 	    i = getint();
7129673Slinton 	    if (i == 0) {
7139673Slinton 		panic("bad input on tag \"%s\" at \"%s\"", symname(s),
7149673Slinton 		    curchar);
7159673Slinton 	    } else if (i >= NTYPES) {
7169673Slinton 		panic("too many types in file \"%s\"", curfilename());
7179673Slinton 	    }
7189673Slinton 	    if (typetable[i] != nil) {
7199673Slinton 		typetable[i]->language = curlang;
7209673Slinton 		typetable[i]->class = TYPE;
7219673Slinton 		typetable[i]->type = s;
7229673Slinton 	    } else {
7239673Slinton 		typetable[i] = s;
7249673Slinton 	    }
7259673Slinton 	    skipchar(curchar, '=');
7269673Slinton 	    break;
7279673Slinton 
7289673Slinton 	case 'F':	/* public function */
7299673Slinton 	case 'f':	/* private function */
7309673Slinton 	    s->class = FUNC;
7319673Slinton 	    if (curblock->class == FUNC or curblock->class == PROC) {
7329673Slinton 		exitblock();
7339673Slinton 	    }
7349673Slinton 	    enterblock(s);
7359673Slinton 	    if (c == 'F') {
7369673Slinton 		s->level = program->level;
7379673Slinton 		isnew = false;
7389673Slinton 	    }
7399673Slinton 	    curparam = s;
7409673Slinton 	    if (isnew) {
74111875Slinton 		s->symvalue.funcv.src = false;
74214443Slinton 		s->symvalue.funcv.inline = false;
7439673Slinton 		s->symvalue.funcv.beginaddr = np->n_value;
74414443Slinton 		newfunc(s, codeloc(s));
7459673Slinton 		findbeginning(s);
7469673Slinton 	    }
7479673Slinton 	    break;
7489673Slinton 
7499673Slinton 	case 'G':	/* public variable */
7509673Slinton 	    s->level = program->level;
7519673Slinton 	    break;
7529673Slinton 
7539673Slinton 	case 'S':	/* private variable */
7549673Slinton 	    s->level = curmodule->level;
7559673Slinton 	    s->block = curmodule;
7569673Slinton 	    break;
7579673Slinton 
75812542Scsvaf /*
75912542Scsvaf  *  keep global BSS variables chained so can resolve when get the start
76012542Scsvaf  *  of common; keep the list in order so f77 can display all vars in a COMMON
76112542Scsvaf */
7629673Slinton 	case 'V':	/* own variable */
7639673Slinton 	    s->level = 2;
76412542Scsvaf 	    if (curcomm) {
76512542Scsvaf 	      if (commchain != nil) {
76612542Scsvaf  		  commchain->symvalue.common.chain = s;
76712542Scsvaf 	      }
76812542Scsvaf 	      else {
76912542Scsvaf 		  curcomm->symvalue.common.offset = (int) s;
77012542Scsvaf 	      }
77112542Scsvaf               commchain = s;
77212542Scsvaf               s->symvalue.common.offset = np->n_value;
77312542Scsvaf               s->symvalue.common.chain = nil;
77412542Scsvaf 	    }
7759673Slinton 	    break;
7769673Slinton 
7779673Slinton 	case 'r':	/* register variable */
7789673Slinton 	    s->level = -(s->level);
7799673Slinton 	    break;
7809673Slinton 
7819673Slinton 	case 'p':	/* parameter variable */
7829673Slinton 	    curparam->chain = s;
7839673Slinton 	    curparam = s;
7849673Slinton 	    break;
7859673Slinton 
7869673Slinton 	case 'v':	/* varies parameter */
7879673Slinton 	    s->class = REF;
7889673Slinton 	    s->symvalue.offset = np->n_value;
7899673Slinton 	    curparam->chain = s;
7909673Slinton 	    curparam = s;
7919673Slinton 	    break;
7929673Slinton 
7939673Slinton 	default:	/* local variable */
7949673Slinton 	    --curchar;
7959673Slinton 	    break;
7969673Slinton     }
7979673Slinton     if (not knowtype) {
7989673Slinton 	s->type = constype(nil);
7999673Slinton 	if (s->class == TAG) {
8009673Slinton 	    addtag(s);
8019673Slinton 	}
8029673Slinton     }
8039673Slinton     if (tracesyms) {
8049673Slinton 	printdecl(s);
8059673Slinton 	fflush(stdout);
8069673Slinton     }
8079673Slinton }
8089673Slinton 
8099673Slinton /*
8109673Slinton  * Construct a type out of a string encoding.
8119673Slinton  *
8129673Slinton  * The forms of the string are
8139673Slinton  *
8149673Slinton  *	<number>
8159673Slinton  *	<number>=<type>
8169673Slinton  *	r<type>;<number>;<number>		$ subrange
8179673Slinton  *	a<type>;<type>				$ array[index] of element
8189673Slinton  *	s{<name>:<type>;<number>;<number>}	$ record
819*14653Slinton  *	S<type>					$ set
8209673Slinton  *	*<type>					$ pointer
8219673Slinton  */
8229673Slinton 
823*14653Slinton private Rangetype getrangetype();
824*14653Slinton 
8259673Slinton private Symbol constype(type)
8269673Slinton Symbol type;
8279673Slinton {
8289673Slinton     register Symbol t, u;
8299673Slinton     register Char *p, *cur;
8309673Slinton     register Integer n;
8319673Slinton     Integer b;
8329673Slinton     Name name;
8339673Slinton     Char class;
8349673Slinton 
8359673Slinton     b = curlevel;
8369673Slinton     if (isdigit(*curchar)) {
8379673Slinton 	n = getint();
8389673Slinton 	if (n == 0) {
8399673Slinton 	    panic("bad type number at \"%s\"", curchar);
8409673Slinton 	} else if (n >= NTYPES) {
8419673Slinton 	    panic("too many types in file \"%s\"", curfilename());
8429673Slinton 	}
8439673Slinton 	if (*curchar == '=') {
8449673Slinton 	    if (typetable[n] != nil) {
8459673Slinton 		t = typetable[n];
8469673Slinton 	    } else {
8479673Slinton 		t = symbol_alloc();
8489673Slinton 		typetable[n] = t;
8499673Slinton 	    }
8509673Slinton 	    ++curchar;
8519673Slinton 	    constype(t);
8529673Slinton 	} else {
8539673Slinton 	    t = typetable[n];
8549673Slinton 	    if (t == nil) {
8559673Slinton 		t = symbol_alloc();
8569673Slinton 		typetable[n] = t;
8579673Slinton 	    }
8589673Slinton 	}
8599673Slinton     } else {
8609673Slinton 	if (type == nil) {
8619673Slinton 	    t = symbol_alloc();
8629673Slinton 	} else {
8639673Slinton 	    t = type;
8649673Slinton 	}
8659673Slinton 	t->language = curlang;
8669673Slinton 	t->level = b;
86712542Scsvaf 	t->block = curblock;
8689673Slinton 	class = *curchar++;
8699673Slinton 	switch (class) {
8709673Slinton 	    case 'r':
8719673Slinton 		t->class = RANGE;
8729673Slinton 		t->type = constype(nil);
8739673Slinton 		skipchar(curchar, ';');
874*14653Slinton 		t->symvalue.rangev.lowertype = getrangetype();
87512542Scsvaf 	        t->symvalue.rangev.lower = getint();
876*14653Slinton 		t->symvalue.rangev.uppertype = getrangetype();
8779673Slinton 		t->symvalue.rangev.upper = getint();
8789673Slinton 		break;
8799673Slinton 
8809673Slinton 	    case 'a':
8819673Slinton 		t->class = ARRAY;
8829673Slinton 		t->chain = constype(nil);
8839673Slinton 		skipchar(curchar, ';');
8849673Slinton 		t->type = constype(nil);
8859673Slinton 		break;
8869673Slinton 
887*14653Slinton 	    case 'S':
888*14653Slinton 		t->class = SET;
889*14653Slinton 		t->type = constype(nil);
890*14653Slinton 		break;
891*14653Slinton 
8929673Slinton 	    case 's':
8939673Slinton 	    case 'u':
8949673Slinton 		t->class = (class == 's') ? RECORD : VARNT;
8959673Slinton 		t->symvalue.offset = getint();
8969673Slinton 		u = t;
8979673Slinton 		cur = curchar;
8989673Slinton 		while (*cur != ';' and *cur != '\0') {
8999673Slinton 		    p = index(cur, ':');
9009673Slinton 		    if (p == nil) {
9019673Slinton 			panic("index(\"%s\", ':') failed", curchar);
9029673Slinton 		    }
9039673Slinton 		    *p = '\0';
9049673Slinton 		    name = identname(cur, true);
9059673Slinton 		    u->chain = newSymbol(name, b, FIELD, nil, nil);
9069673Slinton 		    cur = p + 1;
9079673Slinton 		    u = u->chain;
9089673Slinton 		    u->language = curlang;
9099673Slinton 		    curchar = cur;
9109673Slinton 		    u->type = constype(nil);
9119673Slinton 		    skipchar(curchar, ',');
9129673Slinton 		    u->symvalue.field.offset = getint();
9139673Slinton 		    skipchar(curchar, ',');
9149673Slinton 		    u->symvalue.field.length = getint();
9159673Slinton 		    skipchar(curchar, ';');
9169673Slinton 		    cur = curchar;
9179673Slinton 		}
9189673Slinton 		if (*cur == ';') {
9199673Slinton 		    ++cur;
9209673Slinton 		}
9219673Slinton 		curchar = cur;
9229673Slinton 		break;
9239673Slinton 
9249673Slinton 	    case 'e':
9259673Slinton 		t->class = SCAL;
9269673Slinton 		u = t;
9279673Slinton 		while (*curchar != ';' and *curchar != '\0') {
9289673Slinton 		    p = index(curchar, ':');
9299673Slinton 		    assert(p != nil);
9309673Slinton 		    *p = '\0';
9319673Slinton 		    u->chain = insert(identname(curchar, true));
9329673Slinton 		    curchar = p + 1;
9339673Slinton 		    u = u->chain;
9349673Slinton 		    u->language = curlang;
9359673Slinton 		    u->class = CONST;
9369673Slinton 		    u->level = b;
9379673Slinton 		    u->block = curblock;
9389673Slinton 		    u->type = t;
9399673Slinton 		    u->symvalue.iconval = getint();
9409673Slinton 		    skipchar(curchar, ',');
9419673Slinton 		}
9429673Slinton 		break;
9439673Slinton 
9449673Slinton 	    case '*':
9459673Slinton 		t->class = PTR;
9469673Slinton 		t->type = constype(nil);
9479673Slinton 		break;
9489673Slinton 
9499673Slinton 	    case 'f':
9509673Slinton 		t->class = FUNC;
9519673Slinton 		t->type = constype(nil);
9529673Slinton 		break;
9539673Slinton 
9549673Slinton 	    default:
9559673Slinton 		badcaseval(class);
9569673Slinton 	}
9579673Slinton     }
9589673Slinton     return t;
9599673Slinton }
9609673Slinton 
9619673Slinton /*
962*14653Slinton  * Get a range type.
963*14653Slinton  *
964*14653Slinton  * Special letters indicate a dynamic bound, i.e. what follows
965*14653Slinton  * is the offset from the fp which contains the bound.
966*14653Slinton  * J is a special flag to handle fortran a(*) bounds.
967*14653Slinton  */
968*14653Slinton 
969*14653Slinton private Rangetype getrangetype()
970*14653Slinton {
971*14653Slinton     Rangetype t;
972*14653Slinton 
973*14653Slinton     switch (*curchar) {
974*14653Slinton 	case 'A':
975*14653Slinton 	    t = R_ARG;
976*14653Slinton 	    curchar++;
977*14653Slinton 	    break;
978*14653Slinton 
979*14653Slinton 	case 'T':
980*14653Slinton 	    t = R_TEMP;
981*14653Slinton 	    curchar++;
982*14653Slinton 	    break;
983*14653Slinton 
984*14653Slinton 	case 'J':
985*14653Slinton 	    t = R_ADJUST;
986*14653Slinton 	    curchar++;
987*14653Slinton 	    break;
988*14653Slinton 
989*14653Slinton 	default:
990*14653Slinton 	    t = R_CONST;
991*14653Slinton 	    break;
992*14653Slinton     }
993*14653Slinton     return t;
994*14653Slinton }
995*14653Slinton 
996*14653Slinton /*
9979673Slinton  * Read an integer from the current position in the type string.
9989673Slinton  */
9999673Slinton 
10009673Slinton private Integer getint()
10019673Slinton {
10029673Slinton     register Integer n;
10039673Slinton     register char *p;
10049673Slinton     register Boolean isneg;
10059673Slinton 
10069673Slinton     n = 0;
10079673Slinton     p = curchar;
10089673Slinton     if (*p == '-') {
10099673Slinton 	isneg = true;
10109673Slinton 	++p;
10119673Slinton     } else {
10129673Slinton 	isneg = false;
10139673Slinton     }
10149673Slinton     while (isdigit(*p)) {
10159673Slinton 	n = 10*n + (*p - '0');
10169673Slinton 	++p;
10179673Slinton     }
10189673Slinton     curchar = p;
10199673Slinton     return isneg ? (-n) : n;
10209673Slinton }
10219673Slinton 
10229673Slinton /*
10239673Slinton  * Add a tag name.  This is a kludge to be able to refer
10249673Slinton  * to tags that have the same name as some other symbol
10259673Slinton  * in the same block.
10269673Slinton  */
10279673Slinton 
10289673Slinton private addtag(s)
10299673Slinton register Symbol s;
10309673Slinton {
10319673Slinton     register Symbol t;
10329673Slinton     char buf[100];
10339673Slinton 
10349673Slinton     sprintf(buf, "$$%.90s", ident(s->name));
10359673Slinton     t = insert(identname(buf, false));
10369673Slinton     t->language = s->language;
10379673Slinton     t->class = TAG;
10389673Slinton     t->type = s->type;
10399673Slinton     t->block = s->block;
10409673Slinton }
10419673Slinton 
10429673Slinton /*
10439673Slinton  * Allocate file and line tables and initialize indices.
10449673Slinton  */
10459673Slinton 
10469673Slinton private allocmaps(nf, nl)
10479673Slinton Integer nf, nl;
10489673Slinton {
10499673Slinton     if (filetab != nil) {
10509673Slinton 	dispose(filetab);
10519673Slinton     }
10529673Slinton     if (linetab != nil) {
10539673Slinton 	dispose(linetab);
10549673Slinton     }
10559673Slinton     filetab = newarr(Filetab, nf);
10569673Slinton     linetab = newarr(Linetab, nl);
10579673Slinton     filep = filetab;
10589673Slinton     linep = linetab;
10599673Slinton }
10609673Slinton 
10619673Slinton /*
10629673Slinton  * Add a file to the file table.
106313938Slinton  *
106413938Slinton  * If the new address is the same as the previous file address
106513938Slinton  * this routine used to not enter the file, but this caused some
106613938Slinton  * problems so it has been removed.  It's not clear that this in
106713938Slinton  * turn may not also cause a problem.
10689673Slinton  */
10699673Slinton 
10709673Slinton private enterfile(filename, addr)
10719673Slinton String filename;
10729673Slinton Address addr;
10739673Slinton {
107413938Slinton     filep->addr = addr;
107513938Slinton     filep->filename = filename;
107613938Slinton     filep->lineindex = linep - linetab;
107713938Slinton     ++filep;
10789673Slinton }
10799673Slinton 
10809673Slinton /*
10819673Slinton  * Since we only estimated the number of lines (and it was a poor
10829673Slinton  * estimation) and since we need to know the exact number of lines
10839673Slinton  * to do a binary search, we set it when we're done.
10849673Slinton  */
10859673Slinton 
10869673Slinton private setnlines()
10879673Slinton {
10889673Slinton     nlhdr.nlines = linep - linetab;
10899673Slinton }
10909673Slinton 
10919673Slinton /*
10929673Slinton  * Similarly for nfiles ...
10939673Slinton  */
10949673Slinton 
10959673Slinton private setnfiles()
10969673Slinton {
10979673Slinton     nlhdr.nfiles = filep - filetab;
10989673Slinton     setsource(filetab[0].filename);
10999673Slinton }
1100