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