file reorg, pathnames.h, paths.h
[unix-history] / usr / src / old / dbx / object.c
CommitLineData
2a24676e
DF
1/*
2 * Copyright (c) 1983 Regents of the University of California.
3 * All rights reserved. The Berkeley software License Agreement
4 * specifies the terms and conditions for redistribution.
5 */
2c3a9a86 6
2a24676e 7#ifndef lint
9606e7b9 8static char sccsid[] = "@(#)object.c 5.2 (Berkeley) %G%";
2a24676e 9#endif not lint
0022c355 10
9606e7b9 11static char rcsid[] = "$Header: object.c,v 1.5 87/03/26 20:24:58 donn Exp $";
2c3a9a86
ML
12
13/*
14 * Object code interface, mainly for extraction of symbolic information.
15 */
16
17#include "defs.h"
18#include "object.h"
2fd0f574 19#include "stabstring.h"
2c3a9a86
ML
20#include "main.h"
21#include "symbols.h"
22#include "names.h"
23#include "languages.h"
24#include "mappings.h"
25#include "lists.h"
26#include <a.out.h>
27#include <stab.h>
28#include <ctype.h>
29
30#ifndef public
31
32struct {
33 unsigned int stringsize; /* size of the dumped string table */
34 unsigned int nsyms; /* number of symbols */
35 unsigned int nfiles; /* number of files */
36 unsigned int nlines; /* number of lines */
37} nlhdr;
38
2fd0f574
SL
39#include "languages.h"
40#include "symbols.h"
41
42#endif
43
44#ifndef N_MOD2
45# define N_MOD2 0x50
2c3a9a86
ML
46#endif
47
48public String objname = "a.out";
2fd0f574
SL
49public integer objsize;
50
51public Language curlang;
52public Symbol curmodule;
53public Symbol curparam;
54public Symbol curcomm;
55public Symbol commchain;
2c3a9a86 56
2fd0f574
SL
57private char *stringtab;
58private struct nlist *curnp;
2c3a9a86 59private Boolean warned;
d5eceaed 60private Boolean strip_ = false;
2c3a9a86
ML
61
62private Filetab *filep;
cc4262e8 63private Linetab *linep, *prevlinep;
2c3a9a86 64
2fd0f574
SL
65public String curfilename ()
66{
67 return ((filep-1)->filename);
68}
2c3a9a86
ML
69
70/*
71 * Blocks are figured out on the fly while reading the symbol table.
72 */
73
74#define MAXBLKDEPTH 25
75
2fd0f574
SL
76public Symbol curblock;
77
2c3a9a86 78private Symbol blkstack[MAXBLKDEPTH];
2fd0f574
SL
79private integer curlevel;
80private integer bnum, nesting;
7005bb75 81private Address addrstk[MAXBLKDEPTH];
2c3a9a86 82
2fd0f574
SL
83public pushBlock (b)
84Symbol b;
85{
86 if (curlevel >= MAXBLKDEPTH) {
87 fatal("nesting depth too large (%d)", curlevel);
88 }
89 blkstack[curlevel] = curblock;
90 ++curlevel;
91 curblock = b;
92 if (traceblocks) {
93 printf("entering block %s\n", symname(b));
94 }
2c3a9a86
ML
95}
96
0022c355
ML
97/*
98 * Change the current block with saving the previous one,
99 * since it is assumed that the symbol for the current one is to be deleted.
100 */
101
102public changeBlock (b)
103Symbol b;
104{
105 curblock = b;
106}
107
2fd0f574
SL
108public enterblock (b)
109Symbol b;
110{
111 if (curblock == nil) {
112 b->level = 1;
113 } else {
114 b->level = curblock->level + 1;
115 }
116 b->block = curblock;
117 pushBlock(b);
118}
119
120public exitblock ()
121{
122 if (curblock->class == FUNC or curblock->class == PROC) {
123 if (prevlinep != linep) {
124 curblock->symvalue.funcv.src = true;
125 }
126 }
127 if (curlevel <= 0) {
128 panic("nesting depth underflow (%d)", curlevel);
129 }
130 --curlevel;
131 if (traceblocks) {
132 printf("exiting block %s\n", symname(curblock));
133 }
134 curblock = blkstack[curlevel];
2c3a9a86
ML
135}
136
137/*
138 * Enter a source line or file name reference into the appropriate table.
139 * Expanded inline to reduce procedure calls.
140 *
2fd0f574 141 * private enterline (linenumber, address)
2c3a9a86
ML
142 * Lineno linenumber;
143 * Address address;
144 * ...
145 */
146
147#define enterline(linenumber, address) \
148{ \
149 register Linetab *lp; \
150 \
151 lp = linep - 1; \
152 if (linenumber != lp->line) { \
153 if (address != lp->addr) { \
154 ++lp; \
155 } \
156 lp->line = linenumber; \
157 lp->addr = address; \
158 linep = lp + 1; \
159 } \
160}
161
2c3a9a86
ML
162/*
163 * Read in the namelist from the obj file.
164 *
165 * Reads and seeks are used instead of fread's and fseek's
166 * for efficiency sake; there's a lot of data being read here.
167 */
168
2fd0f574 169public readobj (file)
2c3a9a86
ML
170String file;
171{
172 Fileid f;
173 struct exec hdr;
174 struct nlist nlist;
175
176 f = open(file, 0);
177 if (f < 0) {
178 fatal("can't open %s", file);
179 }
180 read(f, &hdr, sizeof(hdr));
0022c355
ML
181 if (N_BADMAG(hdr)) {
182 objsize = 0;
183 nlhdr.nsyms = 0;
184 nlhdr.nfiles = 0;
185 nlhdr.nlines = 0;
186 } else {
187 objsize = hdr.a_text;
188 nlhdr.nsyms = hdr.a_syms / sizeof(nlist);
189 nlhdr.nfiles = nlhdr.nsyms;
190 nlhdr.nlines = nlhdr.nsyms;
191 }
7005bb75
ML
192 if (nlhdr.nsyms > 0) {
193 lseek(f, (long) N_STROFF(hdr), 0);
194 read(f, &(nlhdr.stringsize), sizeof(nlhdr.stringsize));
195 nlhdr.stringsize -= 4;
196 stringtab = newarr(char, nlhdr.stringsize);
197 read(f, stringtab, nlhdr.stringsize);
198 allocmaps(nlhdr.nfiles, nlhdr.nlines);
199 lseek(f, (long) N_SYMOFF(hdr), 0);
200 readsyms(f);
201 ordfunctab();
202 setnlines();
203 setnfiles();
0022c355
ML
204 } else {
205 initsyms();
7005bb75 206 }
2c3a9a86
ML
207 close(f);
208}
209
0022c355
ML
210/*
211 * Found the beginning of the externals in the object file
212 * (signified by the "-lg" or find an external), close the
213 * block for the last procedure.
214 */
215
216private foundglobals ()
217{
218 if (curblock->class != PROG) {
219 exitblock();
220 if (curblock->class != PROG) {
221 exitblock();
222 }
223 }
224 enterline(0, (linep-1)->addr + 1);
225}
226
2c3a9a86
ML
227/*
228 * Read in symbols from object file.
229 */
230
2fd0f574 231private readsyms (f)
2c3a9a86
ML
232Fileid f;
233{
234 struct nlist *namelist;
235 register struct nlist *np, *ub;
2c3a9a86 236 register String name;
9606e7b9 237 boolean afterlg, foundstab;
2fd0f574
SL
238 integer index;
239 char *lastchar;
2c3a9a86
ML
240
241 initsyms();
242 namelist = newarr(struct nlist, nlhdr.nsyms);
243 read(f, namelist, nlhdr.nsyms * sizeof(struct nlist));
244 afterlg = false;
9606e7b9 245 foundstab = false;
2c3a9a86 246 ub = &namelist[nlhdr.nsyms];
2fd0f574
SL
247 curnp = &namelist[0];
248 np = curnp;
249 while (np < ub) {
2c3a9a86
ML
250 index = np->n_un.n_strx;
251 if (index != 0) {
252 name = &stringtab[index - 4];
d5eceaed 253 /*
2fd0f574 254 * If the program contains any .f files a trailing _ is stripped
d5eceaed
AF
255 * from the name on the assumption it was added by the compiler.
256 * This only affects names that follow the sdb N_SO entry with
257 * the .f name.
258 */
7005bb75 259 if (strip_ and name[0] != '\0' ) {
2fd0f574
SL
260 lastchar = &name[strlen(name) - 1];
261 if (*lastchar == '_') {
262 *lastchar = '\0';
7005bb75 263 }
d5eceaed 264 }
2c3a9a86
ML
265 } else {
266 name = nil;
d5eceaed 267 }
2fd0f574 268
2c3a9a86 269 /*
2fd0f574 270 * Assumptions:
2c3a9a86
ML
271 * not an N_STAB ==> name != nil
272 * name[0] == '-' ==> name == "-lg"
273 * name[0] != '_' ==> filename or invisible
274 *
275 * The "-lg" signals the beginning of global loader symbols.
d5eceaed 276 *
2c3a9a86
ML
277 */
278 if ((np->n_type&N_STAB) != 0) {
9606e7b9 279 foundstab = true;
2c3a9a86
ML
280 enter_nl(name, np);
281 } else if (name[0] == '-') {
282 afterlg = true;
0022c355 283 foundglobals();
2d99de0e 284 } else if (afterlg) {
0022c355
ML
285 check_global(name, np);
286 } else if ((np->n_type&N_EXT) == N_EXT) {
287 afterlg = true;
288 foundglobals();
289 check_global(name, np);
2d99de0e
ML
290 } else if (name[0] == '_') {
291 check_local(&name[1], np);
2c3a9a86
ML
292 } else if ((np->n_type&N_TEXT) == N_TEXT) {
293 check_filename(name);
294 }
2fd0f574
SL
295 ++curnp;
296 np = curnp;
2c3a9a86 297 }
9606e7b9
DS
298 if (not foundstab) {
299 warning("no source compiled with -g");
300 }
2c3a9a86
ML
301 dispose(namelist);
302}
303
2fd0f574
SL
304/*
305 * Get a continuation entry from the name list.
306 * Return the beginning of the name.
307 */
308
309public String getcont ()
310{
311 register integer index;
312 register String name;
313
314 ++curnp;
315 index = curnp->n_un.n_strx;
316 if (index == 0) {
9606e7b9
DS
317 name = "";
318 } else {
319 name = &stringtab[index - 4];
2fd0f574 320 }
2fd0f574
SL
321 return name;
322}
323
2c3a9a86
ML
324/*
325 * Initialize symbol information.
326 */
327
2fd0f574 328private initsyms ()
2c3a9a86
ML
329{
330 curblock = nil;
331 curlevel = 0;
7005bb75 332 nesting = 0;
2fd0f574 333 program = insert(identname("", true));
2c3a9a86 334 program->class = PROG;
9606e7b9
DS
335 program->language = primlang;
336 program->symvalue.funcv.beginaddr = CODESTART;
7005bb75
ML
337 program->symvalue.funcv.inline = false;
338 newfunc(program, codeloc(program));
2c3a9a86
ML
339 findbeginning(program);
340 enterblock(program);
341 curmodule = program;
2c3a9a86
ML
342}
343
344/*
345 * Free all the object file information that's being stored.
346 */
347
2fd0f574 348public objfree ()
2c3a9a86
ML
349{
350 symbol_free();
0022c355
ML
351 /* keywords_free(); */
352 /* names_free(); */
353 /* dispose(stringtab); */
2c3a9a86
ML
354 clrfunctab();
355}
356
357/*
358 * Enter a namelist entry.
359 */
360
2fd0f574 361private enter_nl (name, np)
2c3a9a86
ML
362String name;
363register struct nlist *np;
364{
365 register Symbol s;
2fd0f574 366 register Name n;
2c3a9a86
ML
367
368 s = nil;
2c3a9a86 369 switch (np->n_type) {
7005bb75
ML
370 /*
371 * Build a symbol for the FORTRAN common area. All GSYMS that follow
372 * will be chained in a list with the head kept in common.offset, and
373 * the tail in common.chain.
374 */
214731a7
ML
375 case N_BCOMM:
376 if (curcomm) {
377 curcomm->symvalue.common.chain = commchain;
d5eceaed 378 }
2fd0f574 379 n = identname(name, true);
d5eceaed 380 curcomm = lookup(n);
214731a7
ML
381 if (curcomm == nil) {
382 curcomm = insert(n);
383 curcomm->class = COMMON;
384 curcomm->block = curblock;
385 curcomm->level = program->level;
386 curcomm->symvalue.common.chain = nil;
d5eceaed
AF
387 }
388 commchain = curcomm->symvalue.common.chain;
214731a7 389 break;
d5eceaed
AF
390
391 case N_ECOMM:
214731a7
ML
392 if (curcomm) {
393 curcomm->symvalue.common.chain = commchain;
394 curcomm = nil;
d5eceaed
AF
395 }
396 break;
7005bb75 397
2c3a9a86 398 case N_LBRAC:
7005bb75
ML
399 ++nesting;
400 addrstk[nesting] = (linep - 1)->addr;
2c3a9a86
ML
401 break;
402
403 case N_RBRAC:
2fd0f574 404 --nesting;
7005bb75
ML
405 if (addrstk[nesting] == NOADDR) {
406 exitblock();
407 newfunc(curblock, (linep - 1)->addr);
2fd0f574 408 addrstk[nesting] = (linep - 1)->addr;
7005bb75 409 }
2c3a9a86
ML
410 break;
411
412 case N_SLINE:
413 enterline((Lineno) np->n_desc, (Address) np->n_value);
414 break;
415
416 /*
7005bb75 417 * Source files.
2c3a9a86
ML
418 */
419 case N_SO:
2fd0f574 420 n = identname(name, true);
7005bb75 421 enterSourceModule(n, (Address) np->n_value);
2c3a9a86
ML
422 break;
423
424 /*
425 * Textually included files.
426 */
427 case N_SOL:
428 enterfile(name, (Address) np->n_value);
429 break;
430
431 /*
432 * These symbols are assumed to have non-nil names.
433 */
434 case N_GSYM:
435 case N_FUN:
436 case N_STSYM:
437 case N_LCSYM:
438 case N_RSYM:
439 case N_PSYM:
440 case N_LSYM:
441 case N_SSYM:
7005bb75 442 case N_LENG:
2c3a9a86
ML
443 if (index(name, ':') == nil) {
444 if (not warned) {
445 warned = true;
9606e7b9
DS
446 printf("warning: old style symbol information ");
447 printf("found in \"%s\"\n", curfilename());
2c3a9a86
ML
448 }
449 } else {
450 entersym(name, np);
451 }
452 break;
453
454 case N_PC:
2fd0f574 455 case N_MOD2:
2c3a9a86
ML
456 break;
457
438b5736 458 default:
7005bb75 459 printf("warning: stab entry unrecognized: ");
2c3a9a86 460 if (name != nil) {
7005bb75 461 printf("name %s,", name);
2c3a9a86 462 }
7005bb75 463 printf("ntype %2x, desc %x, value %x'\n",
2c3a9a86
ML
464 np->n_type, np->n_desc, np->n_value);
465 break;
466 }
467}
468
2fd0f574 469/*
0022c355
ML
470 * Try to find the symbol that is referred to by the given name. Since it's
471 * an external, we need to follow a level or two of indirection.
2fd0f574
SL
472 */
473
0022c355 474private Symbol findsym (n, var_isextref)
2fd0f574 475Name n;
0022c355 476boolean *var_isextref;
2fd0f574
SL
477{
478 register Symbol r, s;
479
0022c355 480 *var_isextref = false;
2fd0f574 481 find(s, n) where
0022c355
ML
482 (
483 s->level == program->level and (
484 s->class == EXTREF or s->class == VAR or
485 s->class == PROC or s->class == FUNC
486 )
487 ) or (
488 s->block == program and s->class == MODULE
489 )
2fd0f574 490 endfind(s);
0022c355
ML
491 if (s == nil) {
492 r = nil;
493 } else if (s->class == EXTREF) {
494 *var_isextref = true;
2fd0f574
SL
495 r = s->symvalue.extref;
496 delete(s);
0022c355
ML
497
498 /*
499 * Now check for another level of indirection that could come from
500 * a forward reference in procedure nesting information. In this case
501 * the symbol has already been deleted.
502 */
503 if (r != nil and r->class == EXTREF) {
504 r = r->symvalue.extref;
505 }
506/*
507 } else if (s->class == MODULE) {
508 s->class = FUNC;
509 s->level = program->level;
510 r = s;
511 */
2fd0f574
SL
512 } else {
513 r = s;
514 }
515 return r;
516}
517
0022c355
ML
518/*
519 * Create a symbol for a text symbol with no source information.
520 * We treat it as an assembly language function.
521 */
522
523private Symbol deffunc (n)
524Name n;
525{
526 Symbol f;
527
528 f = insert(n);
529 f->language = findlanguage(".s");
530 f->class = FUNC;
531 f->type = t_int;
532 f->block = curblock;
533 f->level = program->level;
534 f->symvalue.funcv.src = false;
535 f->symvalue.funcv.inline = false;
9606e7b9
DS
536 if (f->chain != nil) {
537 panic("chain not nil in deffunc");
538 }
0022c355
ML
539 return f;
540}
541
542/*
543 * Create a symbol for a data or bss symbol with no source information.
544 * We treat it as an assembly language variable.
545 */
546
547private Symbol defvar (n)
548Name n;
549{
550 Symbol v;
551
552 v = insert(n);
553 v->language = findlanguage(".s");
9606e7b9 554 v->storage = EXT;
0022c355
ML
555 v->class = VAR;
556 v->type = t_int;
557 v->level = program->level;
558 v->block = curblock;
559 return v;
560}
561
562/*
563 * Update a symbol entry with a text address.
564 */
565
566private updateTextSym (s, name, addr)
567Symbol s;
568char *name;
569Address addr;
570{
571 if (s->class == VAR) {
572 s->symvalue.offset = addr;
573 } else {
574 s->symvalue.funcv.beginaddr = addr;
575 if (name[0] == '_') {
576 newfunc(s, codeloc(s));
577 findbeginning(s);
578 }
579 }
580}
581
9606e7b9
DS
582/*
583 * Avoid seeing Pascal labels as text symbols.
584 */
585
586private boolean PascalLabel (n)
587Name n;
588{
589 boolean b;
590 register char *p;
591
592 b = false;
593 if (curlang == findlanguage(".p")) {
594 p = ident(n);
595 while (*p != '\0') {
596 if (*p == '_' and *(p+1) == '$') {
597 b = true;
598 break;
599 }
600 ++p;
601 }
602 }
603 return b;
604}
605
2c3a9a86
ML
606/*
607 * Check to see if a global _name is already in the symbol table,
608 * if not then insert it.
609 */
610
2fd0f574 611private check_global (name, np)
2c3a9a86
ML
612String name;
613register struct nlist *np;
614{
615 register Name n;
d5eceaed 616 register Symbol t, u;
0022c355
ML
617 char buf[4096];
618 boolean isextref;
619 integer count;
2c3a9a86 620
0022c355
ML
621 if (not streq(name, "_end")) {
622 if (name[0] == '_') {
623 n = identname(&name[1], true);
624 } else {
625 n = identname(name, true);
626 if (lookup(n) != nil) {
627 sprintf(buf, "$%s", name);
628 n = identname(buf, false);
629 }
630 }
2c3a9a86 631 if ((np->n_type&N_TYPE) == N_TEXT) {
0022c355
ML
632 count = 0;
633 t = findsym(n, &isextref);
634 while (isextref) {
635 ++count;
636 updateTextSym(t, name, np->n_value);
637 t = findsym(n, &isextref);
2c3a9a86 638 }
0022c355
ML
639 if (count == 0) {
640 if (t == nil) {
9606e7b9
DS
641 if (not PascalLabel(n)) {
642 t = deffunc(n);
643 updateTextSym(t, name, np->n_value);
644 if (tracesyms) {
645 printdecl(t);
646 }
0022c355
ML
647 }
648 } else {
649 if (t->class == MODULE) {
650 u = t;
651 t = deffunc(n);
652 t->block = u;
653 if (tracesyms) {
654 printdecl(t);
655 }
656 }
657 updateTextSym(t, name, np->n_value);
658 }
2fd0f574 659 }
9606e7b9 660 } else if ((np->n_type&N_TYPE) == N_BSS or (np->n_type&N_TYPE) == N_DATA) {
2c3a9a86 661 find(t, n) where
214731a7 662 t->class == COMMON
2c3a9a86 663 endfind(t);
214731a7
ML
664 if (t != nil) {
665 u = (Symbol) t->symvalue.common.offset;
666 while (u != nil) {
667 u->symvalue.offset = u->symvalue.common.offset+np->n_value;
668 u = u->symvalue.common.chain;
669 }
670 } else {
671 check_var(np, n);
2c3a9a86 672 }
214731a7
ML
673 } else {
674 check_var(np, n);
2c3a9a86
ML
675 }
676 }
677}
678
214731a7
ML
679/*
680 * Check to see if a namelist entry refers to a variable.
681 * If not, create a variable for the entry. In any case,
682 * set the offset of the variable according to the value field
683 * in the entry.
0022c355
ML
684 *
685 * If the external name has been referred to by several other symbols,
686 * we must update each of them.
214731a7
ML
687 */
688
2fd0f574 689private check_var (np, n)
214731a7
ML
690struct nlist *np;
691register Name n;
692{
0022c355
ML
693 register Symbol t, u, next;
694 Symbol conflict;
214731a7 695
0022c355 696 t = lookup(n);
214731a7 697 if (t == nil) {
0022c355
ML
698 t = defvar(n);
699 t->symvalue.offset = np->n_value;
700 if (tracesyms) {
701 printdecl(t);
702 }
703 } else {
704 conflict = nil;
705 do {
706 next = t->next_sym;
707 if (t->name == n) {
708 if (t->class == MODULE and t->block == program) {
709 conflict = t;
710 } else if (t->class == EXTREF and t->level == program->level) {
711 u = t->symvalue.extref;
712 while (u != nil and u->class == EXTREF) {
713 u = u->symvalue.extref;
714 }
715 u->symvalue.offset = np->n_value;
716 delete(t);
717 } else if (t->level == program->level and
718 (t->class == VAR or t->class == PROC or t->class == FUNC)
719 ) {
720 conflict = nil;
721 t->symvalue.offset = np->n_value;
722 }
723 }
724 t = next;
725 } while (t != nil);
726 if (conflict != nil) {
727 u = defvar(n);
728 u->block = conflict;
729 u->symvalue.offset = np->n_value;
730 }
214731a7 731 }
214731a7
ML
732}
733
2c3a9a86
ML
734/*
735 * Check to see if a local _name is known in the current scope.
736 * If not then enter it.
737 */
738
2fd0f574 739private check_local (name, np)
2c3a9a86
ML
740String name;
741register struct nlist *np;
742{
743 register Name n;
744 register Symbol t, cur;
745
746 n = identname(name, true);
747 cur = ((np->n_type&N_TYPE) == N_TEXT) ? curmodule : curblock;
748 find(t, n) where t->block == cur endfind(t);
749 if (t == nil) {
750 t = insert(n);
751 t->language = findlanguage(".s");
752 t->type = t_int;
753 t->block = cur;
9606e7b9 754 t->storage = EXT;
2c3a9a86
ML
755 t->level = cur->level;
756 if ((np->n_type&N_TYPE) == N_TEXT) {
757 t->class = FUNC;
cc4262e8 758 t->symvalue.funcv.src = false;
7005bb75 759 t->symvalue.funcv.inline = false;
2c3a9a86 760 t->symvalue.funcv.beginaddr = np->n_value;
7005bb75 761 newfunc(t, codeloc(t));
2c3a9a86
ML
762 findbeginning(t);
763 } else {
764 t->class = VAR;
765 t->symvalue.offset = np->n_value;
766 }
767 }
768}
769
770/*
771 * Check to see if a symbol corresponds to a object file name.
772 * For some reason these are listed as in the text segment.
773 */
774
2fd0f574 775private check_filename (name)
2c3a9a86
ML
776String name;
777{
778 register String mname;
2fd0f574 779 register integer i;
0022c355
ML
780 Name n;
781 Symbol s;
2c3a9a86
ML
782
783 mname = strdup(name);
784 i = strlen(mname) - 2;
785 if (i >= 0 and mname[i] == '.' and mname[i+1] == 'o') {
786 mname[i] = '\0';
787 --i;
788 while (mname[i] != '/' and i >= 0) {
789 --i;
790 }
0022c355
ML
791 n = identname(&mname[i+1], true);
792 find(s, n) where s->block == program and s->class == MODULE endfind(s);
793 if (s == nil) {
794 s = insert(n);
795 s->language = findlanguage(".s");
796 s->class = MODULE;
797 s->symvalue.funcv.beginaddr = 0;
798 findbeginning(s);
799 }
2c3a9a86
ML
800 if (curblock->class != PROG) {
801 exitblock();
802 if (curblock->class != PROG) {
803 exitblock();
804 }
805 }
806 enterblock(s);
807 curmodule = s;
808 }
809}
810
7005bb75
ML
811/*
812 * Check to see if a symbol is about to be defined within an unnamed block.
813 * If this happens, we create a procedure for the unnamed block, make it
814 * "inline" so that tracebacks don't associate an activation record with it,
815 * and enter it into the function table so that it will be detected
816 * by "whatblock".
817 */
818
2fd0f574 819public chkUnnamedBlock ()
7005bb75
ML
820{
821 register Symbol s;
822 static int bnum = 0;
823 char buf[100];
2fd0f574 824 Address startaddr;
7005bb75 825
2fd0f574
SL
826 if (nesting > 0 and addrstk[nesting] != NOADDR) {
827 startaddr = (linep - 1)->addr;
828 ++bnum;
829 sprintf(buf, "$b%d", bnum);
830 s = insert(identname(buf, false));
831 s->language = curlang;
832 s->class = PROC;
833 s->symvalue.funcv.src = false;
834 s->symvalue.funcv.inline = true;
835 s->symvalue.funcv.beginaddr = startaddr;
836 enterblock(s);
837 newfunc(s, startaddr);
838 addrstk[nesting] = NOADDR;
839 }
7005bb75
ML
840}
841
842/*
843 * Compilation unit. C associates scope with filenames
844 * so we treat them as "modules". The filename without
845 * the suffix is used for the module name.
846 *
847 * Because there is no explicit "end-of-block" mark in
848 * the object file, we must exit blocks for the current
849 * procedure and module.
850 */
851
2fd0f574 852private enterSourceModule (n, addr)
7005bb75
ML
853Name n;
854Address addr;
855{
856 register Symbol s;
857 Name nn;
858 String mname, suffix;
859
860 mname = strdup(ident(n));
861 if (rindex(mname, '/') != nil) {
862 mname = rindex(mname, '/') + 1;
863 }
864 suffix = rindex(mname, '.');
9606e7b9
DS
865 if (suffix > mname && *(suffix-1) == '.') {
866 /* special hack for C++ */
867 --suffix;
868 }
7005bb75
ML
869 curlang = findlanguage(suffix);
870 if (curlang == findlanguage(".f")) {
871 strip_ = true;
872 }
873 if (suffix != nil) {
874 *suffix = '\0';
875 }
2fd0f574 876 if (not (*language_op(curlang, L_HASMODULES))()) {
7005bb75
ML
877 if (curblock->class != PROG) {
878 exitblock();
2fd0f574 879 if (curblock->class != PROG) {
2c3a9a86
ML
880 exitblock();
881 }
2c3a9a86 882 }
2fd0f574
SL
883 nn = identname(mname, true);
884 if (curmodule == nil or curmodule->name != nn) {
885 s = insert(nn);
886 s->class = MODULE;
887 s->symvalue.funcv.beginaddr = 0;
888 findbeginning(s);
2c3a9a86 889 } else {
2fd0f574 890 s = curmodule;
2c3a9a86 891 }
2fd0f574
SL
892 s->language = curlang;
893 enterblock(s);
894 curmodule = s;
2c3a9a86 895 }
2fd0f574
SL
896 if (program->language == nil) {
897 program->language = curlang;
2c3a9a86 898 }
2fd0f574
SL
899 warned = false;
900 enterfile(ident(n), addr);
901 initTypeTable();
2c3a9a86
ML
902}
903
904/*
905 * Allocate file and line tables and initialize indices.
906 */
907
2fd0f574
SL
908private allocmaps (nf, nl)
909integer nf, nl;
2c3a9a86
ML
910{
911 if (filetab != nil) {
912 dispose(filetab);
913 }
914 if (linetab != nil) {
915 dispose(linetab);
916 }
917 filetab = newarr(Filetab, nf);
918 linetab = newarr(Linetab, nl);
919 filep = filetab;
920 linep = linetab;
921}
922
923/*
924 * Add a file to the file table.
214731a7
ML
925 *
926 * If the new address is the same as the previous file address
927 * this routine used to not enter the file, but this caused some
928 * problems so it has been removed. It's not clear that this in
929 * turn may not also cause a problem.
2c3a9a86
ML
930 */
931
2fd0f574 932private enterfile (filename, addr)
2c3a9a86
ML
933String filename;
934Address addr;
935{
214731a7
ML
936 filep->addr = addr;
937 filep->filename = filename;
938 filep->lineindex = linep - linetab;
939 ++filep;
2c3a9a86
ML
940}
941
942/*
943 * Since we only estimated the number of lines (and it was a poor
944 * estimation) and since we need to know the exact number of lines
945 * to do a binary search, we set it when we're done.
946 */
947
2fd0f574 948private setnlines ()
2c3a9a86
ML
949{
950 nlhdr.nlines = linep - linetab;
951}
952
953/*
954 * Similarly for nfiles ...
955 */
956
2fd0f574 957private setnfiles ()
2c3a9a86
ML
958{
959 nlhdr.nfiles = filep - filetab;
960 setsource(filetab[0].filename);
961}