xref: /csrg-svn/old/dbx/object.c (revision 16613)
19673Slinton /* Copyright (c) 1982 Regents of the University of California */
29673Slinton 
315274Ssam static char sccsid[] = "@(#)object.c 1.14 10/22/83";
49673Slinton 
5*16613Ssam static char rcsid[] = "$Header: object.c,v 1.4 84/03/27 10:22:25 linton Exp $";
6*16613Ssam 
79673Slinton /*
89673Slinton  * Object code interface, mainly for extraction of symbolic information.
99673Slinton  */
109673Slinton 
119673Slinton #include "defs.h"
129673Slinton #include "object.h"
13*16613Ssam #include "stabstring.h"
149673Slinton #include "main.h"
159673Slinton #include "symbols.h"
169673Slinton #include "names.h"
179673Slinton #include "languages.h"
189673Slinton #include "mappings.h"
199673Slinton #include "lists.h"
209673Slinton #include <a.out.h>
219673Slinton #include <stab.h>
229673Slinton #include <ctype.h>
239673Slinton 
249673Slinton #ifndef public
259673Slinton 
269673Slinton struct {
279673Slinton     unsigned int stringsize;	/* size of the dumped string table */
289673Slinton     unsigned int nsyms;		/* number of symbols */
299673Slinton     unsigned int nfiles;	/* number of files */
309673Slinton     unsigned int nlines;	/* number of lines */
319673Slinton } nlhdr;
329673Slinton 
33*16613Ssam #include "languages.h"
34*16613Ssam #include "symbols.h"
35*16613Ssam 
369673Slinton #endif
379673Slinton 
38*16613Ssam #ifndef N_MOD2
39*16613Ssam #    define N_MOD2 0x50
40*16613Ssam #endif
41*16613Ssam 
429673Slinton public String objname = "a.out";
43*16613Ssam public integer objsize;
449673Slinton 
45*16613Ssam public Language curlang;
46*16613Ssam public Symbol curmodule;
47*16613Ssam public Symbol curparam;
48*16613Ssam public Symbol curcomm;
49*16613Ssam public Symbol commchain;
50*16613Ssam 
51*16613Ssam private char *stringtab;
52*16613Ssam private struct nlist *curnp;
539673Slinton private Boolean warned;
5412542Scsvaf private Boolean strip_ = false;
559673Slinton 
569673Slinton private Filetab *filep;
5711875Slinton private Linetab *linep, *prevlinep;
589673Slinton 
59*16613Ssam public String curfilename ()
60*16613Ssam {
61*16613Ssam     return ((filep-1)->filename);
62*16613Ssam }
639673Slinton 
649673Slinton /*
659673Slinton  * Blocks are figured out on the fly while reading the symbol table.
669673Slinton  */
679673Slinton 
689673Slinton #define MAXBLKDEPTH 25
699673Slinton 
70*16613Ssam public Symbol curblock;
71*16613Ssam 
729673Slinton private Symbol blkstack[MAXBLKDEPTH];
73*16613Ssam private integer curlevel;
74*16613Ssam private integer bnum, nesting;
7514443Slinton private Address addrstk[MAXBLKDEPTH];
769673Slinton 
77*16613Ssam public pushBlock (b)
78*16613Ssam Symbol b;
79*16613Ssam {
80*16613Ssam     if (curlevel >= MAXBLKDEPTH) {
81*16613Ssam 	fatal("nesting depth too large (%d)", curlevel);
82*16613Ssam     }
83*16613Ssam     blkstack[curlevel] = curblock;
84*16613Ssam     ++curlevel;
85*16613Ssam     curblock = b;
86*16613Ssam     if (traceblocks) {
87*16613Ssam 	printf("entering block %s\n", symname(b));
88*16613Ssam     }
899673Slinton }
909673Slinton 
91*16613Ssam public enterblock (b)
92*16613Ssam Symbol b;
93*16613Ssam {
94*16613Ssam     if (curblock == nil) {
95*16613Ssam 	b->level = 1;
96*16613Ssam     } else {
97*16613Ssam 	b->level = curblock->level + 1;
98*16613Ssam     }
99*16613Ssam     b->block = curblock;
100*16613Ssam     pushBlock(b);
1019673Slinton }
1029673Slinton 
103*16613Ssam public exitblock ()
104*16613Ssam {
105*16613Ssam     if (curblock->class == FUNC or curblock->class == PROC) {
106*16613Ssam 	if (prevlinep != linep) {
107*16613Ssam 	    curblock->symvalue.funcv.src = true;
108*16613Ssam 	}
109*16613Ssam     }
110*16613Ssam     if (curlevel <= 0) {
111*16613Ssam 	panic("nesting depth underflow (%d)", curlevel);
112*16613Ssam     }
113*16613Ssam     --curlevel;
114*16613Ssam     if (traceblocks) {
115*16613Ssam 	printf("exiting block %s\n", symname(curblock));
116*16613Ssam     }
117*16613Ssam     curblock = blkstack[curlevel];
118*16613Ssam }
119*16613Ssam 
1209673Slinton /*
1219673Slinton  * Enter a source line or file name reference into the appropriate table.
1229673Slinton  * Expanded inline to reduce procedure calls.
1239673Slinton  *
124*16613Ssam  * private enterline (linenumber, address)
1259673Slinton  * Lineno linenumber;
1269673Slinton  * Address address;
1279673Slinton  *  ...
1289673Slinton  */
1299673Slinton 
1309673Slinton #define enterline(linenumber, address) \
1319673Slinton { \
1329673Slinton     register Linetab *lp; \
1339673Slinton  \
1349673Slinton     lp = linep - 1; \
1359673Slinton     if (linenumber != lp->line) { \
1369673Slinton 	if (address != lp->addr) { \
1379673Slinton 	    ++lp; \
1389673Slinton 	} \
1399673Slinton 	lp->line = linenumber; \
1409673Slinton 	lp->addr = address; \
1419673Slinton 	linep = lp + 1; \
1429673Slinton     } \
1439673Slinton }
1449673Slinton 
1459673Slinton /*
1469673Slinton  * Read in the namelist from the obj file.
1479673Slinton  *
1489673Slinton  * Reads and seeks are used instead of fread's and fseek's
1499673Slinton  * for efficiency sake; there's a lot of data being read here.
1509673Slinton  */
1519673Slinton 
152*16613Ssam public readobj (file)
1539673Slinton String file;
1549673Slinton {
1559673Slinton     Fileid f;
1569673Slinton     struct exec hdr;
1579673Slinton     struct nlist nlist;
1589673Slinton 
1599673Slinton     f = open(file, 0);
1609673Slinton     if (f < 0) {
1619673Slinton 	fatal("can't open %s", file);
1629673Slinton     }
1639673Slinton     read(f, &hdr, sizeof(hdr));
1649673Slinton     objsize = hdr.a_text;
1659673Slinton     nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
1669673Slinton     nlhdr.nfiles = nlhdr.nsyms;
1679673Slinton     nlhdr.nlines = nlhdr.nsyms;
16814443Slinton     if (nlhdr.nsyms > 0) {
16914443Slinton 	lseek(f, (long) N_STROFF(hdr), 0);
17014443Slinton 	read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
17114443Slinton 	nlhdr.stringsize -= 4;
17214443Slinton 	stringtab = newarr(char, nlhdr.stringsize);
17314443Slinton 	read(f, stringtab, nlhdr.stringsize);
17414443Slinton 	allocmaps(nlhdr.nfiles, nlhdr.nlines);
17514443Slinton 	lseek(f, (long) N_SYMOFF(hdr), 0);
17614443Slinton 	readsyms(f);
17714443Slinton 	ordfunctab();
17814443Slinton 	setnlines();
17914443Slinton 	setnfiles();
18014443Slinton     }
1819673Slinton     close(f);
1829673Slinton }
1839673Slinton 
1849673Slinton /*
1859673Slinton  * Read in symbols from object file.
1869673Slinton  */
1879673Slinton 
188*16613Ssam private readsyms (f)
1899673Slinton Fileid f;
1909673Slinton {
1919673Slinton     struct nlist *namelist;
1929673Slinton     register struct nlist *np, *ub;
1939673Slinton     register String name;
1949673Slinton     register Boolean afterlg;
195*16613Ssam     integer index;
196*16613Ssam     char *lastchar;
1979673Slinton 
1989673Slinton     initsyms();
1999673Slinton     namelist = newarr(struct nlist, nlhdr.nsyms);
2009673Slinton     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
2019673Slinton     afterlg = false;
2029673Slinton     ub = &namelist[nlhdr.nsyms];
203*16613Ssam     curnp = &namelist[0];
204*16613Ssam     np = curnp;
205*16613Ssam     while (np < ub) {
2069673Slinton 	index = np->n_un.n_strx;
2079673Slinton 	if (index != 0) {
2089673Slinton 	    name = &stringtab[index - 4];
20912542Scsvaf 	    /*
210*16613Ssam              *  If the program contains any .f files a trailing _ is stripped
21112542Scsvaf        	     *  from the name on the assumption it was added by the compiler.
21212542Scsvaf 	     *  This only affects names that follow the sdb N_SO entry with
21312542Scsvaf              *  the .f name.
21412542Scsvaf              */
21514443Slinton             if (strip_ and name[0] != '\0' ) {
216*16613Ssam 		lastchar = &name[strlen(name) - 1];
217*16613Ssam 		if (*lastchar == '_') {
218*16613Ssam 		    *lastchar = '\0';
21914443Slinton 		}
22012542Scsvaf             }
2219673Slinton 	} else {
2229673Slinton 	    name = nil;
22312542Scsvaf 	}
224*16613Ssam 
2259673Slinton 	/*
226*16613Ssam 	 * Assumptions:
2279673Slinton 	 *	not an N_STAB	==> name != nil
2289673Slinton 	 *	name[0] == '-'	==> name == "-lg"
2299673Slinton 	 *	name[0] != '_'	==> filename or invisible
2309673Slinton 	 *
2319673Slinton 	 * The "-lg" signals the beginning of global loader symbols.
23212542Scsvaf          *
2339673Slinton 	 */
2349673Slinton 	if ((np->n_type&N_STAB) != 0) {
2359673Slinton 	    enter_nl(name, np);
2369673Slinton 	} else if (name[0] == '-') {
2379673Slinton 	    afterlg = true;
2389673Slinton 	    if (curblock->class != PROG) {
2399673Slinton 		exitblock();
2409673Slinton 		if (curblock->class != PROG) {
2419673Slinton 		    exitblock();
2429673Slinton 		}
2439673Slinton 	    }
2449673Slinton 	    enterline(0, (linep-1)->addr + 1);
24511104Slinton 	} else if (afterlg) {
24611104Slinton 	    if (name[0] == '_') {
2479673Slinton 		check_global(&name[1], np);
2489673Slinton 	    }
24911104Slinton 	} else if (name[0] == '_') {
25011104Slinton 	    check_local(&name[1], np);
2519673Slinton 	} else if ((np->n_type&N_TEXT) == N_TEXT) {
2529673Slinton 	    check_filename(name);
2539673Slinton 	}
254*16613Ssam 	++curnp;
255*16613Ssam 	np = curnp;
2569673Slinton     }
25714443Slinton     if (not afterlg) {
25814653Slinton 	fatal("not linked for debugging, use \"cc -g ...\"");
25914443Slinton     }
2609673Slinton     dispose(namelist);
2619673Slinton }
2629673Slinton 
2639673Slinton /*
264*16613Ssam  * Get a continuation entry from the name list.
265*16613Ssam  * Return the beginning of the name.
266*16613Ssam  */
267*16613Ssam 
268*16613Ssam public String getcont ()
269*16613Ssam {
270*16613Ssam     register integer index;
271*16613Ssam     register String name;
272*16613Ssam 
273*16613Ssam     ++curnp;
274*16613Ssam     index = curnp->n_un.n_strx;
275*16613Ssam     if (index == 0) {
276*16613Ssam 	panic("continuation followed by empty stab");
277*16613Ssam     }
278*16613Ssam     name = &stringtab[index - 4];
279*16613Ssam     return name;
280*16613Ssam }
281*16613Ssam 
282*16613Ssam /*
2839673Slinton  * Initialize symbol information.
2849673Slinton  */
2859673Slinton 
286*16613Ssam private initsyms ()
2879673Slinton {
2889673Slinton     curblock = nil;
2899673Slinton     curlevel = 0;
29014443Slinton     nesting = 0;
291*16613Ssam     program = insert(identname("", true));
2929673Slinton     program->class = PROG;
29311769Slinton     program->symvalue.funcv.beginaddr = 0;
29414443Slinton     program->symvalue.funcv.inline = false;
29514443Slinton     newfunc(program, codeloc(program));
29611769Slinton     findbeginning(program);
2979673Slinton     enterblock(program);
2989673Slinton     curmodule = program;
299*16613Ssam     t_boolean = maketype("$boolean", 0L, 1L);
300*16613Ssam     t_int = maketype("$integer", 0x80000000L, 0x7fffffffL);
301*16613Ssam     t_char = maketype("$char", 0L, 255L);
302*16613Ssam     t_real = maketype("$real", 8L, 0L);
303*16613Ssam     t_nil = maketype("$nil", 0L, 0L);
304*16613Ssam     t_open = maketype("integer", 0L, -1L);
3059673Slinton }
3069673Slinton 
3079673Slinton /*
3089673Slinton  * Free all the object file information that's being stored.
3099673Slinton  */
3109673Slinton 
311*16613Ssam public objfree ()
3129673Slinton {
3139673Slinton     symbol_free();
3149673Slinton     keywords_free();
3159673Slinton     names_free();
3169673Slinton     dispose(stringtab);
3179673Slinton     clrfunctab();
3189673Slinton }
3199673Slinton 
3209673Slinton /*
3219673Slinton  * Enter a namelist entry.
3229673Slinton  */
3239673Slinton 
324*16613Ssam private enter_nl (name, np)
3259673Slinton String name;
3269673Slinton register struct nlist *np;
3279673Slinton {
3289673Slinton     register Symbol s;
329*16613Ssam     register Name n;
3309673Slinton 
3319673Slinton     s = nil;
3329673Slinton     switch (np->n_type) {
33314443Slinton 	/*
33414443Slinton 	 * Build a symbol for the FORTRAN common area.  All GSYMS that follow
33514443Slinton 	 * will be chained in a list with the head kept in common.offset, and
33614443Slinton 	 * the tail in common.chain.
33714443Slinton 	 */
33813938Slinton 	case N_BCOMM:
33913938Slinton  	    if (curcomm) {
34013938Slinton 		curcomm->symvalue.common.chain = commchain;
34112542Scsvaf 	    }
342*16613Ssam 	    n = identname(name, true);
34312542Scsvaf 	    curcomm = lookup(n);
34413938Slinton 	    if (curcomm == nil) {
34513938Slinton 		curcomm = insert(n);
34613938Slinton 		curcomm->class = COMMON;
34713938Slinton 		curcomm->block = curblock;
34813938Slinton 		curcomm->level = program->level;
34913938Slinton 		curcomm->symvalue.common.chain = nil;
35012542Scsvaf 	    }
35112542Scsvaf 	    commchain = curcomm->symvalue.common.chain;
35213938Slinton 	    break;
35312542Scsvaf 
35412542Scsvaf 	case N_ECOMM:
35513938Slinton 	    if (curcomm) {
35613938Slinton 		curcomm->symvalue.common.chain = commchain;
35713938Slinton 		curcomm = nil;
35812542Scsvaf 	    }
35912542Scsvaf 	    break;
36014443Slinton 
3619673Slinton 	case N_LBRAC:
36214443Slinton 	    ++nesting;
36314443Slinton 	    addrstk[nesting] = (linep - 1)->addr;
3649673Slinton 	    break;
3659673Slinton 
3669673Slinton 	case N_RBRAC:
367*16613Ssam 	    --nesting;
36814443Slinton 	    if (addrstk[nesting] == NOADDR) {
36914443Slinton 		exitblock();
37014443Slinton 		newfunc(curblock, (linep - 1)->addr);
371*16613Ssam 		addrstk[nesting] = (linep - 1)->addr;
37214443Slinton 	    }
3739673Slinton 	    break;
3749673Slinton 
3759673Slinton 	case N_SLINE:
3769673Slinton 	    enterline((Lineno) np->n_desc, (Address) np->n_value);
3779673Slinton 	    break;
3789673Slinton 
3799673Slinton 	/*
38014443Slinton 	 * Source files.
3819673Slinton 	 */
3829673Slinton 	case N_SO:
383*16613Ssam 	    n = identname(name, true);
38414443Slinton 	    enterSourceModule(n, (Address) np->n_value);
3859673Slinton 	    break;
3869673Slinton 
3879673Slinton 	/*
3889673Slinton 	 * Textually included files.
3899673Slinton 	 */
3909673Slinton 	case N_SOL:
3919673Slinton 	    enterfile(name, (Address) np->n_value);
3929673Slinton 	    break;
3939673Slinton 
3949673Slinton 	/*
3959673Slinton 	 * These symbols are assumed to have non-nil names.
3969673Slinton 	 */
3979673Slinton 	case N_GSYM:
3989673Slinton 	case N_FUN:
3999673Slinton 	case N_STSYM:
4009673Slinton 	case N_LCSYM:
4019673Slinton 	case N_RSYM:
4029673Slinton 	case N_PSYM:
4039673Slinton 	case N_LSYM:
4049673Slinton 	case N_SSYM:
40514443Slinton 	case N_LENG:
4069673Slinton 	    if (index(name, ':') == nil) {
4079673Slinton 		if (not warned) {
4089673Slinton 		    warned = true;
4099673Slinton 		    warning("old style symbol information found in \"%s\"",
4109673Slinton 			curfilename());
4119673Slinton 		}
4129673Slinton 	    } else {
4139673Slinton 		entersym(name, np);
4149673Slinton 	    }
4159673Slinton 	    break;
4169673Slinton 
4179673Slinton 	case N_PC:
418*16613Ssam 	case N_MOD2:
4199673Slinton 	    break;
4209673Slinton 
42111558Slinton 	default:
42214443Slinton 	    printf("warning:  stab entry unrecognized: ");
4239673Slinton 	    if (name != nil) {
42414443Slinton 		printf("name %s,", name);
4259673Slinton 	    }
42614443Slinton 	    printf("ntype %2x, desc %x, value %x'\n",
4279673Slinton 		np->n_type, np->n_desc, np->n_value);
4289673Slinton 	    break;
4299673Slinton     }
4309673Slinton }
4319673Slinton 
4329673Slinton /*
433*16613Ssam  * Try to find the symbol that is referred to by the given name.
434*16613Ssam  * Since it's an external, we may want to follow a level of indirection.
435*16613Ssam  */
436*16613Ssam 
437*16613Ssam private Symbol findsym (n)
438*16613Ssam Name n;
439*16613Ssam {
440*16613Ssam     register Symbol r, s;
441*16613Ssam 
442*16613Ssam     find(s, n) where
443*16613Ssam 	s->level == program->level and
444*16613Ssam 	    (s->class == EXTREF or s->class == VAR or
445*16613Ssam 	     s->class == PROC or s->class == FUNC)
446*16613Ssam     endfind(s);
447*16613Ssam     if (s != nil and s->class == EXTREF) {
448*16613Ssam 	r = s->symvalue.extref;
449*16613Ssam 	delete(s);
450*16613Ssam     } else {
451*16613Ssam 	r = s;
452*16613Ssam     }
453*16613Ssam     return r;
454*16613Ssam }
455*16613Ssam 
456*16613Ssam /*
4579673Slinton  * Check to see if a global _name is already in the symbol table,
4589673Slinton  * if not then insert it.
4599673Slinton  */
4609673Slinton 
461*16613Ssam private check_global (name, np)
4629673Slinton String name;
4639673Slinton register struct nlist *np;
4649673Slinton {
4659673Slinton     register Name n;
46612542Scsvaf     register Symbol t, u;
4679673Slinton 
4689673Slinton     if (not streq(name, "end")) {
4699673Slinton 	n = identname(name, true);
4709673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
471*16613Ssam 	    t = findsym(n);
4729673Slinton 	    if (t == nil) {
4739673Slinton 		t = insert(n);
4749673Slinton 		t->language = findlanguage(".s");
4759673Slinton 		t->class = FUNC;
4769673Slinton 		t->type = t_int;
4779673Slinton 		t->block = curblock;
4789673Slinton 		t->level = program->level;
47911875Slinton 		t->symvalue.funcv.src = false;
48014443Slinton 		t->symvalue.funcv.inline = false;
4819673Slinton 	    }
482*16613Ssam 	    if (t->class == VAR) {
483*16613Ssam 		t->symvalue.offset = np->n_value;
484*16613Ssam 	    } else {
485*16613Ssam 		t->symvalue.funcv.beginaddr = np->n_value;
486*16613Ssam 		newfunc(t, codeloc(t));
487*16613Ssam 		findbeginning(t);
488*16613Ssam 	    }
48913938Slinton 	} else if ((np->n_type&N_TYPE) == N_BSS) {
4909673Slinton 	    find(t, n) where
49113938Slinton 		t->class == COMMON
49212542Scsvaf 	    endfind(t);
49313938Slinton 	    if (t != nil) {
49413938Slinton 		u = (Symbol) t->symvalue.common.offset;
49513938Slinton 		while (u != nil) {
49613938Slinton 		    u->symvalue.offset = u->symvalue.common.offset+np->n_value;
49713938Slinton 		    u = u->symvalue.common.chain;
49813938Slinton 		}
49913938Slinton             } else {
50013938Slinton 		check_var(np, n);
5019673Slinton 	    }
50213938Slinton         } else {
50313938Slinton 	    check_var(np, n);
5049673Slinton 	}
5059673Slinton     }
5069673Slinton }
5079673Slinton 
5089673Slinton /*
50913938Slinton  * Check to see if a namelist entry refers to a variable.
51013938Slinton  * If not, create a variable for the entry.  In any case,
51113938Slinton  * set the offset of the variable according to the value field
51213938Slinton  * in the entry.
51313938Slinton  */
51413938Slinton 
515*16613Ssam private check_var (np, n)
51613938Slinton struct nlist *np;
51713938Slinton register Name n;
51813938Slinton {
51913938Slinton     register Symbol t;
52013938Slinton 
521*16613Ssam     t = findsym(n);
52213938Slinton     if (t == nil) {
52313938Slinton 	t = insert(n);
52413938Slinton 	t->language = findlanguage(".s");
52513938Slinton 	t->class = VAR;
52613938Slinton 	t->type = t_int;
52713938Slinton 	t->level = program->level;
528*16613Ssam 	t->block = curblock;
52913938Slinton     }
53013938Slinton     t->symvalue.offset = np->n_value;
53113938Slinton }
53213938Slinton 
53313938Slinton /*
5349673Slinton  * Check to see if a local _name is known in the current scope.
5359673Slinton  * If not then enter it.
5369673Slinton  */
5379673Slinton 
538*16613Ssam private check_local (name, np)
5399673Slinton String name;
5409673Slinton register struct nlist *np;
5419673Slinton {
5429673Slinton     register Name n;
5439673Slinton     register Symbol t, cur;
5449673Slinton 
5459673Slinton     n = identname(name, true);
5469673Slinton     cur = ((np->n_type&N_TYPE) == N_TEXT) ? curmodule : curblock;
5479673Slinton     find(t, n) where t->block == cur endfind(t);
5489673Slinton     if (t == nil) {
5499673Slinton 	t = insert(n);
5509673Slinton 	t->language = findlanguage(".s");
5519673Slinton 	t->type = t_int;
5529673Slinton 	t->block = cur;
5539673Slinton 	t->level = cur->level;
5549673Slinton 	if ((np->n_type&N_TYPE) == N_TEXT) {
5559673Slinton 	    t->class = FUNC;
55611875Slinton 	    t->symvalue.funcv.src = false;
55714443Slinton 	    t->symvalue.funcv.inline = false;
5589673Slinton 	    t->symvalue.funcv.beginaddr = np->n_value;
55914443Slinton 	    newfunc(t, codeloc(t));
5609673Slinton 	    findbeginning(t);
5619673Slinton 	} else {
5629673Slinton 	    t->class = VAR;
5639673Slinton 	    t->symvalue.offset = np->n_value;
5649673Slinton 	}
5659673Slinton     }
5669673Slinton }
5679673Slinton 
5689673Slinton /*
5699673Slinton  * Check to see if a symbol corresponds to a object file name.
5709673Slinton  * For some reason these are listed as in the text segment.
5719673Slinton  */
5729673Slinton 
573*16613Ssam private check_filename (name)
5749673Slinton String name;
5759673Slinton {
5769673Slinton     register String mname;
577*16613Ssam     register integer i;
5789673Slinton     register Symbol s;
5799673Slinton 
5809673Slinton     mname = strdup(name);
5819673Slinton     i = strlen(mname) - 2;
5829673Slinton     if (i >= 0 and mname[i] == '.' and mname[i+1] == 'o') {
5839673Slinton 	mname[i] = '\0';
5849673Slinton 	--i;
5859673Slinton 	while (mname[i] != '/' and i >= 0) {
5869673Slinton 	    --i;
5879673Slinton 	}
5889673Slinton 	s = insert(identname(&mname[i+1], true));
5899673Slinton 	s->language = findlanguage(".s");
5909673Slinton 	s->class = MODULE;
59111769Slinton 	s->symvalue.funcv.beginaddr = 0;
59211769Slinton 	findbeginning(s);
5939673Slinton 	if (curblock->class != PROG) {
5949673Slinton 	    exitblock();
5959673Slinton 	    if (curblock->class != PROG) {
5969673Slinton 		exitblock();
5979673Slinton 	    }
5989673Slinton 	}
5999673Slinton 	enterblock(s);
6009673Slinton 	curmodule = s;
6019673Slinton     }
6029673Slinton }
6039673Slinton 
6049673Slinton /*
60514443Slinton  * Check to see if a symbol is about to be defined within an unnamed block.
60614443Slinton  * If this happens, we create a procedure for the unnamed block, make it
60714443Slinton  * "inline" so that tracebacks don't associate an activation record with it,
60814443Slinton  * and enter it into the function table so that it will be detected
60914443Slinton  * by "whatblock".
61014443Slinton  */
61114443Slinton 
612*16613Ssam public chkUnnamedBlock ()
61314443Slinton {
61414443Slinton     register Symbol s;
61514443Slinton     static int bnum = 0;
61614443Slinton     char buf[100];
617*16613Ssam     Address startaddr;
61814443Slinton 
619*16613Ssam     if (nesting > 0 and addrstk[nesting] != NOADDR) {
620*16613Ssam 	startaddr = (linep - 1)->addr;
621*16613Ssam 	++bnum;
622*16613Ssam 	sprintf(buf, "$b%d", bnum);
623*16613Ssam 	s = insert(identname(buf, false));
624*16613Ssam 	s->language = curlang;
625*16613Ssam 	s->class = PROC;
626*16613Ssam 	s->symvalue.funcv.src = false;
627*16613Ssam 	s->symvalue.funcv.inline = true;
628*16613Ssam 	s->symvalue.funcv.beginaddr = startaddr;
629*16613Ssam 	enterblock(s);
630*16613Ssam 	newfunc(s, startaddr);
631*16613Ssam 	addrstk[nesting] = NOADDR;
632*16613Ssam     }
63314443Slinton }
63414443Slinton 
63514443Slinton /*
63614443Slinton  * Compilation unit.  C associates scope with filenames
63714443Slinton  * so we treat them as "modules".  The filename without
63814443Slinton  * the suffix is used for the module name.
63914443Slinton  *
64014443Slinton  * Because there is no explicit "end-of-block" mark in
64114443Slinton  * the object file, we must exit blocks for the current
64214443Slinton  * procedure and module.
64314443Slinton  */
64414443Slinton 
645*16613Ssam private enterSourceModule (n, addr)
64614443Slinton Name n;
64714443Slinton Address addr;
64814443Slinton {
64914443Slinton     register Symbol s;
65014443Slinton     Name nn;
65114443Slinton     String mname, suffix;
65214443Slinton 
65314443Slinton     mname = strdup(ident(n));
65414443Slinton     if (rindex(mname, '/') != nil) {
65514443Slinton 	mname = rindex(mname, '/') + 1;
65614443Slinton     }
65714443Slinton     suffix = rindex(mname, '.');
65814443Slinton     curlang = findlanguage(suffix);
65914443Slinton     if (curlang == findlanguage(".f")) {
66014443Slinton 	strip_ = true;
66114443Slinton     }
66214443Slinton     if (suffix != nil) {
66314443Slinton 	*suffix = '\0';
66414443Slinton     }
665*16613Ssam     if (not (*language_op(curlang, L_HASMODULES))()) {
66614443Slinton 	if (curblock->class != PROG) {
66714443Slinton 	    exitblock();
668*16613Ssam 	    if (curblock->class != PROG) {
669*16613Ssam 		exitblock();
670*16613Ssam 	    }
67114443Slinton 	}
672*16613Ssam 	nn = identname(mname, true);
673*16613Ssam 	if (curmodule == nil or curmodule->name != nn) {
674*16613Ssam 	    s = insert(nn);
675*16613Ssam 	    s->class = MODULE;
676*16613Ssam 	    s->symvalue.funcv.beginaddr = 0;
677*16613Ssam 	    findbeginning(s);
678*16613Ssam 	} else {
679*16613Ssam 	    s = curmodule;
680*16613Ssam 	}
681*16613Ssam 	s->language = curlang;
682*16613Ssam 	enterblock(s);
683*16613Ssam 	curmodule = s;
68414443Slinton     }
68514443Slinton     if (program->language == nil) {
68614443Slinton 	program->language = curlang;
68714443Slinton     }
68814443Slinton     warned = false;
68914443Slinton     enterfile(ident(n), addr);
690*16613Ssam     initTypeTable();
69114443Slinton }
69214443Slinton 
69314443Slinton /*
6949673Slinton  * Allocate file and line tables and initialize indices.
6959673Slinton  */
6969673Slinton 
697*16613Ssam private allocmaps (nf, nl)
698*16613Ssam integer nf, nl;
6999673Slinton {
7009673Slinton     if (filetab != nil) {
7019673Slinton 	dispose(filetab);
7029673Slinton     }
7039673Slinton     if (linetab != nil) {
7049673Slinton 	dispose(linetab);
7059673Slinton     }
7069673Slinton     filetab = newarr(Filetab, nf);
7079673Slinton     linetab = newarr(Linetab, nl);
7089673Slinton     filep = filetab;
7099673Slinton     linep = linetab;
7109673Slinton }
7119673Slinton 
7129673Slinton /*
7139673Slinton  * Add a file to the file table.
71413938Slinton  *
71513938Slinton  * If the new address is the same as the previous file address
71613938Slinton  * this routine used to not enter the file, but this caused some
71713938Slinton  * problems so it has been removed.  It's not clear that this in
71813938Slinton  * turn may not also cause a problem.
7199673Slinton  */
7209673Slinton 
721*16613Ssam private enterfile (filename, addr)
7229673Slinton String filename;
7239673Slinton Address addr;
7249673Slinton {
72513938Slinton     filep->addr = addr;
72613938Slinton     filep->filename = filename;
72713938Slinton     filep->lineindex = linep - linetab;
72813938Slinton     ++filep;
7299673Slinton }
7309673Slinton 
7319673Slinton /*
7329673Slinton  * Since we only estimated the number of lines (and it was a poor
7339673Slinton  * estimation) and since we need to know the exact number of lines
7349673Slinton  * to do a binary search, we set it when we're done.
7359673Slinton  */
7369673Slinton 
737*16613Ssam private setnlines ()
7389673Slinton {
7399673Slinton     nlhdr.nlines = linep - linetab;
7409673Slinton }
7419673Slinton 
7429673Slinton /*
7439673Slinton  * Similarly for nfiles ...
7449673Slinton  */
7459673Slinton 
746*16613Ssam private setnfiles ()
7479673Slinton {
7489673Slinton     nlhdr.nfiles = filep - filetab;
7499673Slinton     setsource(filetab[0].filename);
7509673Slinton }
751