xref: /csrg-svn/old/dbx/object.c (revision 15274)
1 /* Copyright (c) 1982 Regents of the University of California */
2 
3 static char sccsid[] = "@(#)object.c 1.14 10/22/83";
4 
5 /*
6  * Object code interface, mainly for extraction of symbolic information.
7  */
8 
9 #include "defs.h"
10 #include "object.h"
11 #include "main.h"
12 #include "symbols.h"
13 #include "names.h"
14 #include "languages.h"
15 #include "mappings.h"
16 #include "lists.h"
17 #include <a.out.h>
18 #include <stab.h>
19 #include <ctype.h>
20 
21 #ifndef public
22 
23 struct {
24     unsigned int stringsize;	/* size of the dumped string table */
25     unsigned int nsyms;		/* number of symbols */
26     unsigned int nfiles;	/* number of files */
27     unsigned int nlines;	/* number of lines */
28 } nlhdr;
29 
30 #endif
31 
32 public String objname = "a.out";
33 public Integer objsize;
34 public char *stringtab;
35 
36 private String progname = nil;
37 private Language curlang;
38 private Symbol curmodule;
39 private Symbol curparam;
40 private Boolean warned;
41 private Symbol curcomm;
42 private Symbol commchain;
43 private Boolean strip_ = false;
44 
45 private Filetab *filep;
46 private Linetab *linep, *prevlinep;
47 
48 #define curfilename() (filep-1)->filename
49 
50 /*
51  * Blocks are figured out on the fly while reading the symbol table.
52  */
53 
54 #define MAXBLKDEPTH 25
55 
56 private Symbol curblock;
57 private Symbol blkstack[MAXBLKDEPTH];
58 private Integer curlevel;
59 private Integer bnum, nesting;
60 private Address addrstk[MAXBLKDEPTH];
61 
62 #define enterblock(b) { \
63     blkstack[curlevel] = curblock; \
64     ++curlevel; \
65     b->level = curlevel; \
66     b->block = curblock; \
67     curblock = b; \
68 }
69 
70 #define exitblock() { \
71     if (curblock->class == FUNC or curblock->class == PROC) { \
72 	if (prevlinep != linep) { \
73 	    curblock->symvalue.funcv.src = true; \
74 	} \
75     } \
76     --curlevel; \
77     curblock = blkstack[curlevel]; \
78 }
79 
80 /*
81  * Enter a source line or file name reference into the appropriate table.
82  * Expanded inline to reduce procedure calls.
83  *
84  * private enterline(linenumber, address)
85  * Lineno linenumber;
86  * Address address;
87  *  ...
88  */
89 
90 #define enterline(linenumber, address) \
91 { \
92     register Linetab *lp; \
93  \
94     lp = linep - 1; \
95     if (linenumber != lp->line) { \
96 	if (address != lp->addr) { \
97 	    ++lp; \
98 	} \
99 	lp->line = linenumber; \
100 	lp->addr = address; \
101 	linep = lp + 1; \
102     } \
103 }
104 
105 #define NTYPES 1000
106 
107 private Symbol typetable[NTYPES];
108 
109 /*
110  * Read in the namelist from the obj file.
111  *
112  * Reads and seeks are used instead of fread's and fseek's
113  * for efficiency sake; there's a lot of data being read here.
114  */
115 
116 public readobj(file)
117 String file;
118 {
119     Fileid f;
120     struct exec hdr;
121     struct nlist nlist;
122 
123     f = open(file, 0);
124     if (f < 0) {
125 	fatal("can't open %s", file);
126     }
127     read(f, &hdr, sizeof(hdr));
128     objsize = hdr.a_text;
129     nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
130     nlhdr.nfiles = nlhdr.nsyms;
131     nlhdr.nlines = nlhdr.nsyms;
132     if (nlhdr.nsyms > 0) {
133 	lseek(f, (long) N_STROFF(hdr), 0);
134 	read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
135 	nlhdr.stringsize -= 4;
136 	stringtab = newarr(char, nlhdr.stringsize);
137 	read(f, stringtab, nlhdr.stringsize);
138 	allocmaps(nlhdr.nfiles, nlhdr.nlines);
139 	lseek(f, (long) N_SYMOFF(hdr), 0);
140 	readsyms(f);
141 	ordfunctab();
142 	setnlines();
143 	setnfiles();
144     }
145     close(f);
146 }
147 
148 /*
149  * Read in symbols from object file.
150  */
151 
152 private readsyms(f)
153 Fileid f;
154 {
155     struct nlist *namelist;
156     register struct nlist *np, *ub;
157     register int index;
158     register String name;
159     register Boolean afterlg;
160 
161     initsyms();
162     namelist = newarr(struct nlist, nlhdr.nsyms);
163     read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
164     afterlg = false;
165     ub = &namelist[nlhdr.nsyms];
166     for (np = &namelist[0]; np < ub; np++) {
167 	index = np->n_un.n_strx;
168 	if (index != 0) {
169 	    name = &stringtab[index - 4];
170 	    /*
171              *  if the program contains any .f files a trailing _ is stripped
172        	     *  from the name on the assumption it was added by the compiler.
173 	     *  This only affects names that follow the sdb N_SO entry with
174              *  the .f name.
175              */
176             if (strip_ and name[0] != '\0' ) {
177 		register char *p;
178 
179 		p = name;
180 		while (*p != '\0') {
181 		    ++p;
182 		}
183 		--p;
184 		if (*p == '_') {
185 		    *p = '\0';
186 		}
187             }
188 
189 	} else {
190 	    name = nil;
191 	}
192 	/*
193 	 * assumptions:
194 	 *	not an N_STAB	==> name != nil
195 	 *	name[0] == '-'	==> name == "-lg"
196 	 *	name[0] != '_'	==> filename or invisible
197 	 *
198 	 * The "-lg" signals the beginning of global loader symbols.
199          *
200 	 */
201 	if ((np->n_type&N_STAB) != 0) {
202 	    enter_nl(name, np);
203 	} else if (name[0] == '-') {
204 	    afterlg = true;
205 	    if (curblock->class != PROG) {
206 		exitblock();
207 		if (curblock->class != PROG) {
208 		    exitblock();
209 		}
210 	    }
211 	    enterline(0, (linep-1)->addr + 1);
212 	} else if (afterlg) {
213 	    if (name[0] == '_') {
214 		check_global(&name[1], np);
215 	    }
216 	} else if (name[0] == '_') {
217 	    check_local(&name[1], np);
218 	} else if ((np->n_type&N_TEXT) == N_TEXT) {
219 	    check_filename(name);
220 	}
221     }
222     if (not afterlg) {
223 	fatal("not linked for debugging, use \"cc -g ...\"");
224     }
225     dispose(namelist);
226 }
227 
228 /*
229  * Initialize symbol information.
230  */
231 
232 private initsyms()
233 {
234     curblock = nil;
235     curlevel = 0;
236     nesting = 0;
237     if (progname == nil) {
238 	progname = strdup(objname);
239 	if (rindex(progname, '/') != nil) {
240 	    progname = rindex(progname, '/') + 1;
241 	}
242 	if (index(progname, '.') != nil) {
243 	    *(index(progname, '.')) = '\0';
244 	}
245     }
246     program = insert(identname(progname, true));
247     program->class = PROG;
248     program->symvalue.funcv.beginaddr = 0;
249     program->symvalue.funcv.inline = false;
250     newfunc(program, codeloc(program));
251     findbeginning(program);
252     enterblock(program);
253     curmodule = program;
254 }
255 
256 /*
257  * Free all the object file information that's being stored.
258  */
259 
260 public objfree()
261 {
262     symbol_free();
263     keywords_free();
264     names_free();
265     dispose(stringtab);
266     clrfunctab();
267 }
268 
269 /*
270  * Enter a namelist entry.
271  */
272 
273 private enter_nl(name, np)
274 String name;
275 register struct nlist *np;
276 {
277     register Symbol s;
278     register Name n, nn;
279     char buf[100];
280 
281     s = nil;
282     if (name == nil) {
283 	n = nil;
284     } else {
285 	n = identname(name, true);
286     }
287     switch (np->n_type) {
288 	/*
289 	 * Build a symbol for the FORTRAN common area.  All GSYMS that follow
290 	 * will be chained in a list with the head kept in common.offset, and
291 	 * the tail in common.chain.
292 	 */
293 	case N_BCOMM:
294  	    if (curcomm) {
295 		curcomm->symvalue.common.chain = commchain;
296 	    }
297 	    curcomm = lookup(n);
298 	    if (curcomm == nil) {
299 		curcomm = insert(n);
300 		curcomm->class = COMMON;
301 		curcomm->block = curblock;
302 		curcomm->level = program->level;
303 		curcomm->symvalue.common.chain = nil;
304 	    }
305 	    commchain = curcomm->symvalue.common.chain;
306 	    break;
307 
308 	case N_ECOMM:
309 	    if (curcomm) {
310 		curcomm->symvalue.common.chain = commchain;
311 		curcomm = nil;
312 	    }
313 	    break;
314 
315 	case N_LBRAC:
316 	    ++nesting;
317 	    addrstk[nesting] = (linep - 1)->addr;
318 	    break;
319 
320 	case N_RBRAC:
321 	    if (addrstk[nesting] == NOADDR) {
322 		exitblock();
323 		newfunc(curblock, (linep - 1)->addr);
324 	    }
325 	    --nesting;
326 	    break;
327 
328 	case N_SLINE:
329 	    enterline((Lineno) np->n_desc, (Address) np->n_value);
330 	    break;
331 
332 	/*
333 	 * Source files.
334 	 */
335 	case N_SO:
336 	    enterSourceModule(n, (Address) np->n_value);
337 	    break;
338 
339 	/*
340 	 * Textually included files.
341 	 */
342 	case N_SOL:
343 	    enterfile(name, (Address) np->n_value);
344 	    break;
345 
346 	/*
347 	 * These symbols are assumed to have non-nil names.
348 	 */
349 	case N_GSYM:
350 	case N_FUN:
351 	case N_STSYM:
352 	case N_LCSYM:
353 	case N_RSYM:
354 	case N_PSYM:
355 	case N_LSYM:
356 	case N_SSYM:
357 	case N_LENG:
358 	    if (index(name, ':') == nil) {
359 		if (not warned) {
360 		    warned = true;
361 		    warning("old style symbol information found in \"%s\"",
362 			curfilename());
363 		}
364 	    } else {
365 		entersym(name, np);
366 	    }
367 	    break;
368 
369 	case N_PC:
370 	    break;
371 
372 	default:
373 	    printf("warning:  stab entry unrecognized: ");
374 	    if (name != nil) {
375 		printf("name %s,", name);
376 	    }
377 	    printf("ntype %2x, desc %x, value %x'\n",
378 		np->n_type, np->n_desc, np->n_value);
379 	    break;
380     }
381 }
382 
383 /*
384  * Check to see if a global _name is already in the symbol table,
385  * if not then insert it.
386  */
387 
388 private check_global(name, np)
389 String name;
390 register struct nlist *np;
391 {
392     register Name n;
393     register Symbol t, u;
394 
395     if (not streq(name, "end")) {
396 	n = identname(name, true);
397 	if ((np->n_type&N_TYPE) == N_TEXT) {
398 	    find(t, n) where
399 		t->level == program->level and
400 		(t->class == PROC or t->class == FUNC)
401 	    endfind(t);
402 	    if (t == nil) {
403 		t = insert(n);
404 		t->language = findlanguage(".s");
405 		t->class = FUNC;
406 		t->type = t_int;
407 		t->block = curblock;
408 		t->level = program->level;
409 		t->symvalue.funcv.src = false;
410 		t->symvalue.funcv.inline = false;
411 	    }
412 	    t->symvalue.funcv.beginaddr = np->n_value;
413 	    newfunc(t, codeloc(t));
414 	    findbeginning(t);
415 	} else if ((np->n_type&N_TYPE) == N_BSS) {
416 	    find(t, n) where
417 		t->class == COMMON
418 	    endfind(t);
419 	    if (t != nil) {
420 		u = (Symbol) t->symvalue.common.offset;
421 		while (u != nil) {
422 		    u->symvalue.offset = u->symvalue.common.offset+np->n_value;
423 		    u = u->symvalue.common.chain;
424 		}
425             } else {
426 		check_var(np, n);
427 	    }
428         } else {
429 	    check_var(np, n);
430 	}
431     }
432 }
433 
434 /*
435  * Check to see if a namelist entry refers to a variable.
436  * If not, create a variable for the entry.  In any case,
437  * set the offset of the variable according to the value field
438  * in the entry.
439  */
440 
441 private check_var(np, n)
442 struct nlist *np;
443 register Name n;
444 {
445     register Symbol t;
446 
447     find(t, n) where
448 	t->class == VAR and t->level == program->level
449     endfind(t);
450     if (t == nil) {
451 	t = insert(n);
452 	t->language = findlanguage(".s");
453 	t->class = VAR;
454 	t->type = t_int;
455 	t->level = program->level;
456     }
457     t->block = curblock;
458     t->symvalue.offset = np->n_value;
459 }
460 
461 /*
462  * Check to see if a local _name is known in the current scope.
463  * If not then enter it.
464  */
465 
466 private check_local(name, np)
467 String name;
468 register struct nlist *np;
469 {
470     register Name n;
471     register Symbol t, cur;
472 
473     n = identname(name, true);
474     cur = ((np->n_type&N_TYPE) == N_TEXT) ? curmodule : curblock;
475     find(t, n) where t->block == cur endfind(t);
476     if (t == nil) {
477 	t = insert(n);
478 	t->language = findlanguage(".s");
479 	t->type = t_int;
480 	t->block = cur;
481 	t->level = cur->level;
482 	if ((np->n_type&N_TYPE) == N_TEXT) {
483 	    t->class = FUNC;
484 	    t->symvalue.funcv.src = false;
485 	    t->symvalue.funcv.inline = false;
486 	    t->symvalue.funcv.beginaddr = np->n_value;
487 	    newfunc(t, codeloc(t));
488 	    findbeginning(t);
489 	} else {
490 	    t->class = VAR;
491 	    t->symvalue.offset = np->n_value;
492 	}
493     }
494 }
495 
496 /*
497  * Check to see if a symbol corresponds to a object file name.
498  * For some reason these are listed as in the text segment.
499  */
500 
501 private check_filename(name)
502 String name;
503 {
504     register String mname;
505     register Integer i;
506     register Symbol s;
507 
508     mname = strdup(name);
509     i = strlen(mname) - 2;
510     if (i >= 0 and mname[i] == '.' and mname[i+1] == 'o') {
511 	mname[i] = '\0';
512 	--i;
513 	while (mname[i] != '/' and i >= 0) {
514 	    --i;
515 	}
516 	s = insert(identname(&mname[i+1], true));
517 	s->language = findlanguage(".s");
518 	s->class = MODULE;
519 	s->symvalue.funcv.beginaddr = 0;
520 	findbeginning(s);
521 	if (curblock->class != PROG) {
522 	    exitblock();
523 	    if (curblock->class != PROG) {
524 		exitblock();
525 	    }
526 	}
527 	enterblock(s);
528 	curmodule = s;
529     }
530 }
531 
532 /*
533  * Check to see if a symbol is about to be defined within an unnamed block.
534  * If this happens, we create a procedure for the unnamed block, make it
535  * "inline" so that tracebacks don't associate an activation record with it,
536  * and enter it into the function table so that it will be detected
537  * by "whatblock".
538  */
539 
540 private unnamed_block()
541 {
542     register Symbol s;
543     static int bnum = 0;
544     char buf[100];
545 
546     ++bnum;
547     sprintf(buf, "$b%d", bnum);
548     s = insert(identname(buf, false));
549     s->class = PROG;
550     s->symvalue.funcv.src = false;
551     s->symvalue.funcv.inline = true;
552     s->symvalue.funcv.beginaddr = addrstk[nesting];
553     enterblock(s);
554     newfunc(s, addrstk[nesting]);
555     addrstk[nesting] = NOADDR;
556 }
557 
558 /*
559  * Compilation unit.  C associates scope with filenames
560  * so we treat them as "modules".  The filename without
561  * the suffix is used for the module name.
562  *
563  * Because there is no explicit "end-of-block" mark in
564  * the object file, we must exit blocks for the current
565  * procedure and module.
566  */
567 
568 private enterSourceModule(n, addr)
569 Name n;
570 Address addr;
571 {
572     register Symbol s;
573     Name nn;
574     String mname, suffix;
575 
576     mname = strdup(ident(n));
577     if (rindex(mname, '/') != nil) {
578 	mname = rindex(mname, '/') + 1;
579     }
580     suffix = rindex(mname, '.');
581     curlang = findlanguage(suffix);
582     if (curlang == findlanguage(".f")) {
583 	strip_ = true;
584     }
585     if (suffix != nil) {
586 	*suffix = '\0';
587     }
588     if (curblock->class != PROG) {
589 	exitblock();
590 	if (curblock->class != PROG) {
591 	    exitblock();
592 	}
593     }
594     nn = identname(mname, true);
595     if (curmodule == nil or curmodule->name != nn) {
596 	s = insert(nn);
597 	s->class = MODULE;
598 	s->symvalue.funcv.beginaddr = 0;
599 	findbeginning(s);
600     } else {
601 	s = curmodule;
602     }
603     s->language = curlang;
604     enterblock(s);
605     curmodule = s;
606     if (program->language == nil) {
607 	program->language = curlang;
608     }
609     warned = false;
610     enterfile(ident(n), addr);
611     bzero(typetable, sizeof(typetable));
612 }
613 
614 /*
615  * Put an nlist into the symbol table.
616  * If it's already there just add the associated information.
617  *
618  * Type information is encoded in the name following a ":".
619  */
620 
621 private Symbol constype();
622 private Char *curchar;
623 
624 #define skipchar(ptr, ch) { \
625     if (*ptr != ch) { \
626 	panic("expected char '%c', found char '%c'", ch, *ptr); \
627     } \
628     ++ptr; \
629 }
630 
631 private entersym(str, np)
632 String str;
633 struct nlist *np;
634 {
635     register Symbol s;
636     register char *p;
637     register int c;
638     register Name n;
639     register Integer i;
640     Boolean knowtype, isnew;
641     Symclass class;
642     Integer level;
643 
644     p = index(str, ':');
645     *p = '\0';
646     c = *(p+1);
647     n = identname(str, true);
648     if (index("FfGV", c) != nil) {
649 	if (c == 'F' or c == 'f') {
650 	    class = FUNC;
651 	} else {
652 	    class = VAR;
653 	}
654 	level = (c == 'f' ? curmodule->level : program->level);
655 	find(s, n) where s->level == level and s->class == class endfind(s);
656 	if (s == nil) {
657 	    isnew = true;
658 	    s = insert(n);
659 	} else {
660 	    isnew = false;
661 	}
662     } else {
663 	isnew = true;
664 	s = insert(n);
665     }
666 
667     if (nesting > 0 and addrstk[nesting] != NOADDR) {
668 	unnamed_block();
669     }
670 
671     /*
672      * Default attributes.
673      */
674     s->language = curlang;
675     s->class = VAR;
676     s->block = curblock;
677     s->level = curlevel;
678     s->symvalue.offset = np->n_value;
679     curchar = p + 2;
680     knowtype = false;
681     switch (c) {
682 	case 't':	/* type name */
683 	    s->class = TYPE;
684 	    i = getint();
685 	    if (i == 0) {
686 		panic("bad input on type \"%s\" at \"%s\"", symname(s),
687 		    curchar);
688 	    } else if (i >= NTYPES) {
689 		panic("too many types in file \"%s\"", curfilename());
690 	    }
691 	    /*
692 	     * A hack for C typedefs that don't create new types,
693 	     * e.g. typedef unsigned int Hashvalue;
694 	     *  or  typedef struct blah BLAH;
695 	     */
696 	    if (*curchar == '\0') {
697 		s->type = typetable[i];
698 		if (s->type == nil) {
699 		    s->type = symbol_alloc();
700 		    typetable[i] = s->type;
701 		}
702 		knowtype = true;
703 	    } else {
704 		typetable[i] = s;
705 		skipchar(curchar, '=');
706 	    }
707 	    break;
708 
709 	case 'T':	/* tag */
710 	    s->class = TAG;
711 	    i = getint();
712 	    if (i == 0) {
713 		panic("bad input on tag \"%s\" at \"%s\"", symname(s),
714 		    curchar);
715 	    } else if (i >= NTYPES) {
716 		panic("too many types in file \"%s\"", curfilename());
717 	    }
718 	    if (typetable[i] != nil) {
719 		typetable[i]->language = curlang;
720 		typetable[i]->class = TYPE;
721 		typetable[i]->type = s;
722 	    } else {
723 		typetable[i] = s;
724 	    }
725 	    skipchar(curchar, '=');
726 	    break;
727 
728 	case 'F':	/* public function */
729 	case 'f':	/* private function */
730 	    s->class = FUNC;
731 	    if (curblock->class == FUNC or curblock->class == PROC) {
732 		exitblock();
733 	    }
734 	    enterblock(s);
735 	    if (c == 'F') {
736 		s->level = program->level;
737 		isnew = false;
738 	    }
739 	    curparam = s;
740 	    if (isnew) {
741 		s->symvalue.funcv.src = false;
742 		s->symvalue.funcv.inline = false;
743 		s->symvalue.funcv.beginaddr = np->n_value;
744 		newfunc(s, codeloc(s));
745 		findbeginning(s);
746 	    }
747 	    break;
748 
749 	case 'G':	/* public variable */
750 	    s->level = program->level;
751 	    break;
752 
753 	case 'S':	/* private variable */
754 	    s->level = curmodule->level;
755 	    s->block = curmodule;
756 	    break;
757 
758 /*
759  *  keep global BSS variables chained so can resolve when get the start
760  *  of common; keep the list in order so f77 can display all vars in a COMMON
761 */
762 	case 'V':	/* own variable */
763 	    s->level = 2;
764 	    if (curcomm) {
765 	      if (commchain != nil) {
766  		  commchain->symvalue.common.chain = s;
767 	      }
768 	      else {
769 		  curcomm->symvalue.common.offset = (int) s;
770 	      }
771               commchain = s;
772               s->symvalue.common.offset = np->n_value;
773               s->symvalue.common.chain = nil;
774 	    }
775 	    break;
776 
777 	case 'r':	/* register variable */
778 	    s->level = -(s->level);
779 	    break;
780 
781 	case 'p':	/* parameter variable */
782 	    curparam->chain = s;
783 	    curparam = s;
784 	    break;
785 
786 	case 'v':	/* varies parameter */
787 	    s->class = REF;
788 	    s->symvalue.offset = np->n_value;
789 	    curparam->chain = s;
790 	    curparam = s;
791 	    break;
792 
793 	default:	/* local variable */
794 	    --curchar;
795 	    break;
796     }
797     if (not knowtype) {
798 	s->type = constype(nil);
799 	if (s->class == TAG) {
800 	    addtag(s);
801 	}
802     }
803     if (tracesyms) {
804 	printdecl(s);
805 	fflush(stdout);
806     }
807 }
808 
809 /*
810  * Construct a type out of a string encoding.
811  *
812  * The forms of the string are
813  *
814  *	<number>
815  *	<number>=<type>
816  *	r<type>;<number>;<number>		$ subrange
817  *	a<type>;<type>				$ array[index] of element
818  *	s{<name>:<type>;<number>;<number>}	$ record
819  *	S<type>					$ set
820  *	*<type>					$ pointer
821  */
822 
823 private Rangetype getrangetype();
824 
825 private Symbol constype(type)
826 Symbol type;
827 {
828     register Symbol t, u;
829     register Char *p, *cur;
830     register Integer n;
831     Integer b;
832     Name name;
833     Char class;
834 
835     b = curlevel;
836     if (isdigit(*curchar)) {
837 	n = getint();
838 	if (n == 0) {
839 	    panic("bad type number at \"%s\"", curchar);
840 	} else if (n >= NTYPES) {
841 	    panic("too many types in file \"%s\"", curfilename());
842 	}
843 	if (*curchar == '=') {
844 	    if (typetable[n] != nil) {
845 		t = typetable[n];
846 	    } else {
847 		t = symbol_alloc();
848 		typetable[n] = t;
849 	    }
850 	    ++curchar;
851 	    constype(t);
852 	} else {
853 	    t = typetable[n];
854 	    if (t == nil) {
855 		t = symbol_alloc();
856 		typetable[n] = t;
857 	    }
858 	}
859     } else {
860 	if (type == nil) {
861 	    t = symbol_alloc();
862 	} else {
863 	    t = type;
864 	}
865 	t->language = curlang;
866 	t->level = b;
867 	t->block = curblock;
868 	class = *curchar++;
869 	switch (class) {
870 	    case 'r':
871 		t->class = RANGE;
872 		t->type = constype(nil);
873 		skipchar(curchar, ';');
874 		t->symvalue.rangev.lowertype = getrangetype();
875 	        t->symvalue.rangev.lower = getint();
876 		skipchar(curchar, ';');
877 		t->symvalue.rangev.uppertype = getrangetype();
878 		t->symvalue.rangev.upper = getint();
879 		break;
880 
881 	    case 'a':
882 		t->class = ARRAY;
883 		t->chain = constype(nil);
884 		skipchar(curchar, ';');
885 		t->type = constype(nil);
886 		break;
887 
888 	    case 'S':
889 		t->class = SET;
890 		t->type = constype(nil);
891 		break;
892 
893 	    case 's':
894 	    case 'u':
895 		t->class = (class == 's') ? RECORD : VARNT;
896 		t->symvalue.offset = getint();
897 		u = t;
898 		cur = curchar;
899 		while (*cur != ';' and *cur != '\0') {
900 		    p = index(cur, ':');
901 		    if (p == nil) {
902 			panic("index(\"%s\", ':') failed", curchar);
903 		    }
904 		    *p = '\0';
905 		    name = identname(cur, true);
906 		    u->chain = newSymbol(name, b, FIELD, nil, nil);
907 		    cur = p + 1;
908 		    u = u->chain;
909 		    u->language = curlang;
910 		    curchar = cur;
911 		    u->type = constype(nil);
912 		    skipchar(curchar, ',');
913 		    u->symvalue.field.offset = getint();
914 		    skipchar(curchar, ',');
915 		    u->symvalue.field.length = getint();
916 		    skipchar(curchar, ';');
917 		    cur = curchar;
918 		}
919 		if (*cur == ';') {
920 		    ++cur;
921 		}
922 		curchar = cur;
923 		break;
924 
925 	    case 'e':
926 		t->class = SCAL;
927 		u = t;
928 		while (*curchar != ';' and *curchar != '\0') {
929 		    p = index(curchar, ':');
930 		    assert(p != nil);
931 		    *p = '\0';
932 		    u->chain = insert(identname(curchar, true));
933 		    curchar = p + 1;
934 		    u = u->chain;
935 		    u->language = curlang;
936 		    u->class = CONST;
937 		    u->level = b;
938 		    u->block = curblock;
939 		    u->type = t;
940 		    u->symvalue.iconval = getint();
941 		    skipchar(curchar, ',');
942 		}
943 		if (*curchar == ';')
944 			curchar++;
945 		break;
946 
947 	    case '*':
948 		t->class = PTR;
949 		t->type = constype(nil);
950 		break;
951 
952 	    case 'f':
953 		t->class = FUNC;
954 		t->type = constype(nil);
955 		break;
956 
957 	    default:
958 		badcaseval(class);
959 	}
960     }
961     return t;
962 }
963 
964 /*
965  * Get a range type.
966  *
967  * Special letters indicate a dynamic bound, i.e. what follows
968  * is the offset from the fp which contains the bound.
969  * J is a special flag to handle fortran a(*) bounds.
970  */
971 
972 private Rangetype getrangetype()
973 {
974     Rangetype t;
975 
976     switch (*curchar) {
977 	case 'A':
978 	    t = R_ARG;
979 	    curchar++;
980 	    break;
981 
982 	case 'T':
983 	    t = R_TEMP;
984 	    curchar++;
985 	    break;
986 
987 	case 'J':
988 	    t = R_ADJUST;
989 	    curchar++;
990 	    break;
991 
992 	default:
993 	    t = R_CONST;
994 	    break;
995     }
996     return t;
997 }
998 
999 /*
1000  * Read an integer from the current position in the type string.
1001  */
1002 
1003 private Integer getint()
1004 {
1005     register Integer n;
1006     register char *p;
1007     register Boolean isneg;
1008 
1009     n = 0;
1010     p = curchar;
1011     if (*p == '-') {
1012 	isneg = true;
1013 	++p;
1014     } else {
1015 	isneg = false;
1016     }
1017     while (isdigit(*p)) {
1018 	n = 10*n + (*p - '0');
1019 	++p;
1020     }
1021     curchar = p;
1022     return isneg ? (-n) : n;
1023 }
1024 
1025 /*
1026  * Add a tag name.  This is a kludge to be able to refer
1027  * to tags that have the same name as some other symbol
1028  * in the same block.
1029  */
1030 
1031 private addtag(s)
1032 register Symbol s;
1033 {
1034     register Symbol t;
1035     char buf[100];
1036 
1037     sprintf(buf, "$$%.90s", ident(s->name));
1038     t = insert(identname(buf, false));
1039     t->language = s->language;
1040     t->class = TAG;
1041     t->type = s->type;
1042     t->block = s->block;
1043 }
1044 
1045 /*
1046  * Allocate file and line tables and initialize indices.
1047  */
1048 
1049 private allocmaps(nf, nl)
1050 Integer nf, nl;
1051 {
1052     if (filetab != nil) {
1053 	dispose(filetab);
1054     }
1055     if (linetab != nil) {
1056 	dispose(linetab);
1057     }
1058     filetab = newarr(Filetab, nf);
1059     linetab = newarr(Linetab, nl);
1060     filep = filetab;
1061     linep = linetab;
1062 }
1063 
1064 /*
1065  * Add a file to the file table.
1066  *
1067  * If the new address is the same as the previous file address
1068  * this routine used to not enter the file, but this caused some
1069  * problems so it has been removed.  It's not clear that this in
1070  * turn may not also cause a problem.
1071  */
1072 
1073 private enterfile(filename, addr)
1074 String filename;
1075 Address addr;
1076 {
1077     filep->addr = addr;
1078     filep->filename = filename;
1079     filep->lineindex = linep - linetab;
1080     ++filep;
1081 }
1082 
1083 /*
1084  * Since we only estimated the number of lines (and it was a poor
1085  * estimation) and since we need to know the exact number of lines
1086  * to do a binary search, we set it when we're done.
1087  */
1088 
1089 private setnlines()
1090 {
1091     nlhdr.nlines = linep - linetab;
1092 }
1093 
1094 /*
1095  * Similarly for nfiles ...
1096  */
1097 
1098 private setnfiles()
1099 {
1100     nlhdr.nfiles = filep - filetab;
1101     setsource(filetab[0].filename);
1102 }
1103