Commit | Line | Data |
---|---|---|
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 | */ | |
0022c355 | 6 | |
21e15a40 | 7 | #ifndef lint |
2a24676e DF |
8 | static char sccsid[] = "@(#)stabstring.c 5.1 (Berkeley) %G%"; |
9 | #endif not lint | |
21e15a40 | 10 | |
0022c355 ML |
11 | static char rcsid[] = "$Header: stabstring.c,v 1.6 84/12/26 10:42:17 linton Exp $"; |
12 | ||
21e15a40 SL |
13 | /* |
14 | * String information interpretation | |
15 | * | |
16 | * The string part of a stab entry is broken up into name and type information. | |
17 | */ | |
18 | ||
19 | #include "defs.h" | |
20 | #include "stabstring.h" | |
21 | #include "object.h" | |
22 | #include "main.h" | |
23 | #include "symbols.h" | |
24 | #include "names.h" | |
25 | #include "languages.h" | |
0022c355 | 26 | #include "tree.h" |
21e15a40 SL |
27 | #include <a.out.h> |
28 | #include <ctype.h> | |
29 | ||
30 | #ifndef public | |
31 | #endif | |
32 | ||
33 | /* | |
34 | * Special characters in symbol table information. | |
35 | */ | |
36 | ||
0022c355 | 37 | #define CONSTNAME 'c' |
21e15a40 SL |
38 | #define TYPENAME 't' |
39 | #define TAGNAME 'T' | |
40 | #define MODULEBEGIN 'm' | |
41 | #define EXTPROCEDURE 'P' | |
42 | #define PRIVPROCEDURE 'Q' | |
43 | #define INTPROCEDURE 'I' | |
44 | #define EXTFUNCTION 'F' | |
45 | #define PRIVFUNCTION 'f' | |
46 | #define INTFUNCTION 'J' | |
47 | #define EXTVAR 'G' | |
48 | #define MODULEVAR 'S' | |
49 | #define OWNVAR 'V' | |
50 | #define REGVAR 'r' | |
51 | #define VALUEPARAM 'p' | |
52 | #define VARIABLEPARAM 'v' | |
53 | #define LOCALVAR /* default */ | |
54 | ||
55 | /* | |
56 | * Type information special characters. | |
57 | */ | |
58 | ||
59 | #define T_SUBRANGE 'r' | |
60 | #define T_ARRAY 'a' | |
0022c355 ML |
61 | #define T_OLDOPENARRAY 'A' |
62 | #define T_OPENARRAY 'O' | |
63 | #define T_DYNARRAY 'D' | |
64 | #define T_SUBARRAY 'E' | |
21e15a40 SL |
65 | #define T_RECORD 's' |
66 | #define T_UNION 'u' | |
67 | #define T_ENUM 'e' | |
68 | #define T_PTR '*' | |
69 | #define T_FUNCVAR 'f' | |
70 | #define T_PROCVAR 'p' | |
71 | #define T_IMPORTED 'i' | |
72 | #define T_SET 'S' | |
73 | #define T_OPAQUE 'o' | |
0022c355 | 74 | #define T_FILE 'd' |
21e15a40 SL |
75 | |
76 | /* | |
77 | * Table of types indexed by per-file unique identification number. | |
78 | */ | |
79 | ||
80 | #define NTYPES 1000 | |
81 | ||
82 | private Symbol typetable[NTYPES]; | |
83 | ||
84 | public initTypeTable () | |
85 | { | |
86 | bzero(typetable, sizeof(typetable)); | |
87 | (*language_op(curlang, L_MODINIT))(typetable); | |
88 | } | |
89 | ||
90 | /* | |
91 | * Put an nlist entry into the symbol table. | |
92 | * If it's already there just add the associated information. | |
93 | * | |
94 | * Type information is encoded in the name following a ":". | |
95 | */ | |
96 | ||
97 | private Symbol constype(); | |
98 | private Char *curchar; | |
99 | ||
100 | #define skipchar(ptr, ch) \ | |
101 | { \ | |
102 | if (*ptr != ch) { \ | |
103 | panic("expected char '%c', found '%s'", ch, ptr); \ | |
104 | } \ | |
105 | ++ptr; \ | |
106 | } | |
107 | ||
108 | #define optchar(ptr, ch) \ | |
109 | { \ | |
110 | if (*ptr == ch) { \ | |
111 | ++ptr; \ | |
112 | } \ | |
113 | } | |
114 | ||
115 | #define chkcont(ptr) \ | |
116 | { \ | |
117 | if (*ptr == '?') { \ | |
118 | ptr = getcont(); \ | |
119 | } \ | |
120 | } | |
121 | ||
122 | #define newSym(s, n) \ | |
123 | { \ | |
124 | s = insert(n); \ | |
125 | s->level = curblock->level + 1; \ | |
126 | s->language = curlang; \ | |
127 | s->block = curblock; \ | |
128 | } | |
129 | ||
130 | #define makeVariable(s, n, off) \ | |
131 | { \ | |
132 | newSym(s, n); \ | |
133 | s->class = VAR; \ | |
134 | s->symvalue.offset = off; \ | |
135 | getType(s); \ | |
136 | } | |
137 | ||
138 | #define makeParameter(s, n, cl, off) \ | |
139 | { \ | |
140 | newSym(s, n); \ | |
141 | s->class = cl; \ | |
142 | s->symvalue.offset = off; \ | |
143 | curparam->chain = s; \ | |
144 | curparam = s; \ | |
145 | getType(s); \ | |
146 | } | |
147 | ||
148 | public entersym (name, np) | |
149 | String name; | |
150 | struct nlist *np; | |
151 | { | |
0022c355 | 152 | Symbol s, t; |
21e15a40 SL |
153 | char *p; |
154 | register Name n; | |
155 | char c; | |
156 | ||
157 | p = index(name, ':'); | |
158 | *p = '\0'; | |
159 | c = *(p+1); | |
160 | n = identname(name, true); | |
161 | chkUnnamedBlock(); | |
162 | curchar = p + 2; | |
163 | switch (c) { | |
0022c355 ML |
164 | case CONSTNAME: |
165 | newSym(s, n); | |
166 | constName(s); | |
167 | break; | |
168 | ||
21e15a40 SL |
169 | case TYPENAME: |
170 | newSym(s, n); | |
171 | typeName(s); | |
172 | break; | |
173 | ||
174 | case TAGNAME: | |
0022c355 ML |
175 | s = symbol_alloc(); |
176 | s->name = n; | |
177 | s->level = curblock->level + 1; | |
178 | s->language = curlang; | |
179 | s->block = curblock; | |
21e15a40 SL |
180 | tagName(s); |
181 | break; | |
182 | ||
183 | case MODULEBEGIN: | |
0022c355 | 184 | publicRoutine(&s, n, MODULE, np->n_value, false); |
21e15a40 SL |
185 | curmodule = s; |
186 | break; | |
187 | ||
188 | case EXTPROCEDURE: | |
0022c355 | 189 | publicRoutine(&s, n, PROC, np->n_value, false); |
21e15a40 SL |
190 | break; |
191 | ||
192 | case PRIVPROCEDURE: | |
193 | privateRoutine(&s, n, PROC, np->n_value); | |
194 | break; | |
195 | ||
196 | case INTPROCEDURE: | |
0022c355 | 197 | publicRoutine(&s, n, PROC, np->n_value, true); |
21e15a40 SL |
198 | break; |
199 | ||
200 | case EXTFUNCTION: | |
0022c355 | 201 | publicRoutine(&s, n, FUNC, np->n_value, false); |
21e15a40 SL |
202 | break; |
203 | ||
204 | case PRIVFUNCTION: | |
205 | privateRoutine(&s, n, FUNC, np->n_value); | |
206 | break; | |
207 | ||
208 | case INTFUNCTION: | |
0022c355 | 209 | publicRoutine(&s, n, FUNC, np->n_value, true); |
21e15a40 SL |
210 | break; |
211 | ||
212 | case EXTVAR: | |
0022c355 | 213 | extVar(&s, n, np->n_value); |
21e15a40 SL |
214 | break; |
215 | ||
216 | case MODULEVAR: | |
217 | if (curblock->class != MODULE) { | |
218 | exitblock(); | |
219 | } | |
220 | makeVariable(s, n, np->n_value); | |
221 | s->level = program->level; | |
222 | s->block = curmodule; | |
223 | getExtRef(s); | |
224 | break; | |
225 | ||
226 | case OWNVAR: | |
227 | makeVariable(s, n, np->n_value); | |
228 | ownVariable(s, np->n_value); | |
229 | getExtRef(s); | |
230 | break; | |
231 | ||
232 | case REGVAR: | |
233 | makeVariable(s, n, np->n_value); | |
234 | s->level = -(s->level); | |
235 | break; | |
236 | ||
237 | case VALUEPARAM: | |
238 | makeParameter(s, n, VAR, np->n_value); | |
239 | break; | |
240 | ||
241 | case VARIABLEPARAM: | |
242 | makeParameter(s, n, REF, np->n_value); | |
243 | break; | |
244 | ||
245 | default: /* local variable */ | |
246 | --curchar; | |
247 | makeVariable(s, n, np->n_value); | |
248 | break; | |
249 | } | |
250 | if (tracesyms) { | |
251 | printdecl(s); | |
252 | fflush(stdout); | |
253 | } | |
254 | } | |
255 | ||
0022c355 ML |
256 | /* |
257 | * Enter a named constant. | |
258 | */ | |
259 | ||
260 | private constName (s) | |
261 | Symbol s; | |
262 | { | |
263 | integer i; | |
264 | double d; | |
265 | char *p, buf[1000]; | |
266 | ||
267 | s->class = CONST; | |
268 | skipchar(curchar, '='); | |
269 | p = curchar; | |
270 | ++curchar; | |
271 | switch (*p) { | |
272 | case 'b': | |
273 | s->type = t_boolean; | |
274 | s->symvalue.constval = build(O_LCON, getint()); | |
275 | break; | |
276 | ||
277 | case 'c': | |
278 | s->type = t_char; | |
279 | s->symvalue.constval = build(O_LCON, getint()); | |
280 | break; | |
281 | ||
282 | case 'i': | |
283 | s->type = t_int; | |
284 | s->symvalue.constval = build(O_LCON, getint()); | |
285 | break; | |
286 | ||
287 | case 'r': | |
288 | sscanf(curchar, "%lf", &d); | |
289 | while (*curchar != '\0' and *curchar != ';') { | |
290 | ++curchar; | |
291 | } | |
292 | --curchar; | |
293 | s->type = t_real; | |
294 | s->symvalue.constval = build(O_FCON, d); | |
295 | break; | |
296 | ||
297 | case 's': | |
298 | p = &buf[0]; | |
299 | skipchar(curchar, '\''); | |
300 | while (*curchar != '\'') { | |
301 | *p = *curchar; | |
302 | ++p; | |
303 | ++curchar; | |
304 | } | |
305 | *p = '\0'; | |
306 | s->symvalue.constval = build(O_SCON, strdup(buf)); | |
307 | s->type = s->symvalue.constval->nodetype; | |
308 | break; | |
309 | ||
310 | case 'e': | |
311 | getType(s); | |
312 | skipchar(curchar, ','); | |
313 | s->symvalue.constval = build(O_LCON, getint()); | |
314 | break; | |
315 | ||
316 | case 'S': | |
317 | getType(s); | |
318 | skipchar(curchar, ','); | |
319 | i = getint(); /* set size */ | |
320 | skipchar(curchar, ','); | |
321 | i = getint(); /* number of bits in constant */ | |
322 | s->symvalue.constval = build(O_LCON, 0); | |
323 | break; | |
324 | ||
325 | default: | |
326 | s->type = t_int; | |
327 | s->symvalue.constval = build(O_LCON, 0); | |
328 | printf("[internal error: unknown constant type '%c']", *p); | |
329 | break; | |
330 | } | |
331 | s->symvalue.constval->nodetype = s->type; | |
332 | } | |
333 | ||
21e15a40 SL |
334 | /* |
335 | * Enter a type name. | |
336 | */ | |
337 | ||
338 | private typeName (s) | |
339 | Symbol s; | |
340 | { | |
341 | register integer i; | |
342 | ||
343 | s->class = TYPE; | |
344 | s->language = curlang; | |
345 | s->block = curblock; | |
346 | s->level = curblock->level + 1; | |
347 | i = getint(); | |
348 | if (i == 0) { | |
349 | panic("bad input on type \"%s\" at \"%s\"", symname(s), curchar); | |
350 | } else if (i >= NTYPES) { | |
351 | panic("too many types in file \"%s\"", curfilename()); | |
352 | } | |
353 | /* | |
354 | * A hack for C typedefs that don't create new types, | |
355 | * e.g. typedef unsigned int Hashvalue; | |
356 | * or typedef struct blah BLAH; | |
357 | */ | |
358 | if (*curchar != '=') { | |
359 | s->type = typetable[i]; | |
360 | if (s->type == nil) { | |
361 | s->type = symbol_alloc(); | |
362 | typetable[i] = s->type; | |
363 | } | |
364 | } else { | |
365 | if (typetable[i] != nil) { | |
366 | typetable[i]->language = curlang; | |
367 | typetable[i]->class = TYPE; | |
368 | typetable[i]->type = s; | |
369 | } else { | |
370 | typetable[i] = s; | |
371 | } | |
372 | skipchar(curchar, '='); | |
373 | getType(s); | |
374 | } | |
375 | } | |
376 | ||
377 | /* | |
378 | * Enter a tag name. | |
379 | */ | |
380 | ||
381 | private tagName (s) | |
382 | Symbol s; | |
383 | { | |
384 | register integer i; | |
385 | ||
386 | s->class = TAG; | |
387 | i = getint(); | |
388 | if (i == 0) { | |
389 | panic("bad input on tag \"%s\" at \"%s\"", symname(s), curchar); | |
390 | } else if (i >= NTYPES) { | |
391 | panic("too many types in file \"%s\"", curfilename()); | |
392 | } | |
393 | if (typetable[i] != nil) { | |
394 | typetable[i]->language = curlang; | |
395 | typetable[i]->class = TYPE; | |
396 | typetable[i]->type = s; | |
397 | } else { | |
398 | typetable[i] = s; | |
399 | } | |
400 | skipchar(curchar, '='); | |
401 | getType(s); | |
402 | } | |
403 | ||
404 | /* | |
405 | * Setup a symbol entry for a public procedure or function. | |
0022c355 ML |
406 | * |
407 | * If it contains nested procedures, then it may already be defined | |
408 | * in the current block as a MODULE. | |
21e15a40 SL |
409 | */ |
410 | ||
0022c355 ML |
411 | private publicRoutine (s, n, class, addr, isinternal) |
412 | Symbol *s; | |
413 | Name n; | |
21e15a40 SL |
414 | Symclass class; |
415 | Address addr; | |
0022c355 | 416 | boolean isinternal; |
21e15a40 | 417 | { |
0022c355 ML |
418 | Symbol nt, t; |
419 | ||
420 | newSym(nt, n); | |
421 | if (isinternal) { | |
422 | markInternal(nt); | |
423 | } | |
424 | enterRoutine(nt, class); | |
425 | find(t, n) where | |
426 | t != nt and t->class == MODULE and t->block == nt->block | |
427 | endfind(t); | |
428 | if (t == nil) { | |
429 | t = nt; | |
430 | } else { | |
431 | t->language = nt->language; | |
432 | t->class = nt->class; | |
433 | t->type = nt->type; | |
434 | t->chain = nt->chain; | |
435 | t->symvalue = nt->symvalue; | |
436 | nt->class = EXTREF; | |
437 | nt->symvalue.extref = t; | |
438 | delete(nt); | |
439 | curparam = t; | |
440 | changeBlock(t); | |
441 | } | |
442 | if (t->block == program) { | |
443 | t->level = program->level; | |
444 | } else if (t->class == MODULE) { | |
445 | t->level = t->block->level; | |
446 | } else if (t->block->class == MODULE) { | |
447 | t->level = t->block->block->level; | |
448 | } else { | |
449 | t->level = t->block->level + 1; | |
450 | } | |
451 | *s = t; | |
21e15a40 SL |
452 | } |
453 | ||
454 | /* | |
455 | * Setup a symbol entry for a private procedure or function. | |
456 | */ | |
457 | ||
458 | private privateRoutine (s, n, class, addr) | |
459 | Symbol *s; | |
460 | Name n; | |
461 | Symclass class; | |
462 | Address addr; | |
463 | { | |
464 | Symbol t; | |
465 | boolean isnew; | |
466 | ||
467 | find(t, n) where | |
468 | t->level == curmodule->level and t->class == class | |
469 | endfind(t); | |
470 | if (t == nil) { | |
471 | isnew = true; | |
472 | t = insert(n); | |
473 | } else { | |
474 | isnew = false; | |
475 | } | |
476 | t->language = curlang; | |
477 | enterRoutine(t, class); | |
478 | if (isnew) { | |
479 | t->symvalue.funcv.src = false; | |
480 | t->symvalue.funcv.inline = false; | |
481 | t->symvalue.funcv.beginaddr = addr; | |
482 | newfunc(t, codeloc(t)); | |
483 | findbeginning(t); | |
484 | } | |
485 | *s = t; | |
486 | } | |
487 | ||
488 | /* | |
489 | * Set up for beginning a new procedure, function, or module. | |
490 | * If it's a function, then read the type. | |
491 | * | |
492 | * If the next character is a ",", then read the name of the enclosing block. | |
493 | * Otherwise assume the previous function, if any, is over, and the current | |
494 | * routine is at the same level. | |
495 | */ | |
496 | ||
497 | private enterRoutine (s, class) | |
498 | Symbol s; | |
499 | Symclass class; | |
500 | { | |
501 | s->class = class; | |
502 | if (class == FUNC) { | |
503 | getType(s); | |
504 | } | |
505 | if (s->class != MODULE) { | |
506 | getExtRef(s); | |
507 | } else if (*curchar == ',') { | |
508 | ++curchar; | |
509 | } | |
510 | if (*curchar != '\0') { | |
511 | exitblock(); | |
512 | enterNestedBlock(s); | |
513 | } else { | |
514 | if (curblock->class == FUNC or curblock->class == PROC) { | |
515 | exitblock(); | |
516 | } | |
517 | if (class == MODULE) { | |
518 | exitblock(); | |
519 | } | |
520 | enterblock(s); | |
521 | } | |
522 | curparam = s; | |
523 | } | |
524 | ||
0022c355 ML |
525 | /* |
526 | * Handling an external variable is tricky, since we might already | |
527 | * know it but need to define it's type for other type information | |
528 | * in the file. So just in case we read the type information anyway. | |
529 | */ | |
530 | ||
531 | private extVar (symp, n, off) | |
532 | Symbol *symp; | |
533 | Name n; | |
534 | integer off; | |
535 | { | |
536 | Symbol s, t; | |
537 | ||
538 | find(s, n) where | |
539 | s->level == program->level and s->class == VAR | |
540 | endfind(s); | |
541 | if (s == nil) { | |
542 | makeVariable(s, n, off); | |
543 | s->level = program->level; | |
544 | s->block = curmodule; | |
545 | getExtRef(s); | |
546 | } else { | |
547 | t = constype(nil); | |
548 | } | |
549 | *symp = s; | |
550 | } | |
551 | ||
21e15a40 SL |
552 | /* |
553 | * Check to see if the stab string contains the name of the external | |
554 | * reference. If so, we create a symbol with that name and class EXTREF, and | |
555 | * connect it to the given symbol. This link is created so that when | |
556 | * we see the linker symbol we can resolve it to the given symbol. | |
557 | */ | |
558 | ||
559 | private getExtRef (s) | |
560 | Symbol s; | |
561 | { | |
562 | char *p; | |
563 | Name n; | |
564 | Symbol t; | |
565 | ||
566 | if (*curchar == ',' and *(curchar + 1) != '\0') { | |
567 | p = index(curchar + 1, ','); | |
568 | *curchar = '\0'; | |
569 | if (p != nil) { | |
570 | *p = '\0'; | |
571 | n = identname(curchar + 1, false); | |
572 | curchar = p + 1; | |
573 | } else { | |
574 | n = identname(curchar + 1, true); | |
575 | } | |
576 | t = insert(n); | |
577 | t->language = s->language; | |
578 | t->class = EXTREF; | |
579 | t->block = program; | |
580 | t->level = program->level; | |
581 | t->symvalue.extref = s; | |
582 | } | |
583 | } | |
584 | ||
585 | /* | |
586 | * Find a block with the given identifier in the given outer block. | |
587 | * If not there, then create it. | |
588 | */ | |
589 | ||
590 | private Symbol findBlock (id, m) | |
591 | String id; | |
592 | Symbol m; | |
593 | { | |
594 | Name n; | |
595 | Symbol s; | |
596 | ||
597 | n = identname(id, true); | |
598 | find(s, n) where s->block == m and isblock(s) endfind(s); | |
599 | if (s == nil) { | |
600 | s = insert(n); | |
601 | s->block = m; | |
602 | s->language = curlang; | |
603 | s->class = MODULE; | |
604 | s->level = m->level + 1; | |
605 | } | |
606 | return s; | |
607 | } | |
608 | ||
609 | /* | |
610 | * Enter a nested block. | |
611 | * The block within which it is nested is described | |
612 | * by "module{:module}[:proc]". | |
613 | */ | |
614 | ||
615 | private enterNestedBlock (b) | |
616 | Symbol b; | |
617 | { | |
618 | register char *p, *q; | |
619 | Symbol m, s; | |
620 | Name n; | |
621 | ||
622 | q = curchar; | |
623 | p = index(q, ':'); | |
624 | m = program; | |
625 | while (p != nil) { | |
626 | *p = '\0'; | |
627 | m = findBlock(q, m); | |
628 | q = p + 1; | |
629 | p = index(q, ':'); | |
630 | } | |
631 | if (*q != '\0') { | |
632 | m = findBlock(q, m); | |
633 | } | |
634 | b->level = m->level + 1; | |
635 | b->block = m; | |
636 | pushBlock(b); | |
637 | } | |
638 | ||
639 | /* | |
640 | * Enter a statically-allocated variable defined within a routine. | |
641 | * | |
642 | * Global BSS variables are chained together so we can resolve them | |
643 | * when the start of common is determined. The list is kept in order | |
644 | * so that f77 can display all vars in a COMMON. | |
645 | */ | |
646 | ||
647 | private ownVariable (s, addr) | |
648 | Symbol s; | |
649 | Address addr; | |
650 | { | |
651 | s->level = 1; | |
652 | if (curcomm) { | |
653 | if (commchain != nil) { | |
654 | commchain->symvalue.common.chain = s; | |
655 | } else { | |
656 | curcomm->symvalue.common.offset = (integer) s; | |
657 | } | |
658 | commchain = s; | |
659 | s->symvalue.common.offset = addr; | |
660 | s->symvalue.common.chain = nil; | |
661 | } | |
662 | } | |
663 | ||
664 | /* | |
665 | * Get a type from the current stab string for the given symbol. | |
666 | */ | |
667 | ||
668 | private getType (s) | |
669 | Symbol s; | |
670 | { | |
671 | s->type = constype(nil); | |
672 | if (s->class == TAG) { | |
673 | addtag(s); | |
674 | } | |
675 | } | |
676 | ||
677 | /* | |
678 | * Construct a type out of a string encoding. | |
21e15a40 SL |
679 | */ |
680 | ||
681 | private Rangetype getRangeBoundType(); | |
682 | ||
683 | private Symbol constype (type) | |
684 | Symbol type; | |
685 | { | |
686 | register Symbol t; | |
687 | register integer n; | |
688 | char class; | |
0022c355 | 689 | char *p; |
21e15a40 | 690 | |
0022c355 ML |
691 | while (*curchar == '@') { |
692 | p = index(curchar, ';'); | |
693 | if (p == nil) { | |
694 | fflush(stdout); | |
695 | fprintf(stderr, "missing ';' after type attributes"); | |
696 | } else { | |
697 | curchar = p + 1; | |
698 | } | |
699 | } | |
21e15a40 SL |
700 | if (isdigit(*curchar)) { |
701 | n = getint(); | |
702 | if (n >= NTYPES) { | |
703 | panic("too many types in file \"%s\"", curfilename()); | |
704 | } | |
705 | if (*curchar == '=') { | |
706 | if (typetable[n] != nil) { | |
707 | t = typetable[n]; | |
708 | } else { | |
709 | t = symbol_alloc(); | |
710 | typetable[n] = t; | |
711 | } | |
712 | ++curchar; | |
713 | constype(t); | |
714 | } else { | |
715 | t = typetable[n]; | |
716 | if (t == nil) { | |
717 | t = symbol_alloc(); | |
718 | typetable[n] = t; | |
719 | } | |
720 | } | |
721 | } else { | |
722 | if (type == nil) { | |
723 | t = symbol_alloc(); | |
724 | } else { | |
725 | t = type; | |
726 | } | |
727 | t->language = curlang; | |
728 | t->level = curblock->level + 1; | |
729 | t->block = curblock; | |
730 | class = *curchar++; | |
731 | switch (class) { | |
732 | case T_SUBRANGE: | |
733 | consSubrange(t); | |
734 | break; | |
735 | ||
736 | case T_ARRAY: | |
737 | t->class = ARRAY; | |
738 | t->chain = constype(nil); | |
739 | skipchar(curchar, ';'); | |
740 | chkcont(curchar); | |
741 | t->type = constype(nil); | |
742 | break; | |
743 | ||
0022c355 ML |
744 | case T_OLDOPENARRAY: |
745 | t->class = DYNARRAY; | |
746 | t->symvalue.ndims = 1; | |
747 | t->type = constype(nil); | |
748 | t->chain = t_int; | |
749 | break; | |
750 | ||
21e15a40 | 751 | case T_OPENARRAY: |
0022c355 ML |
752 | case T_DYNARRAY: |
753 | consDynarray(t); | |
754 | break; | |
755 | ||
756 | case T_SUBARRAY: | |
757 | t->class = SUBARRAY; | |
758 | t->symvalue.ndims = getint(); | |
759 | skipchar(curchar, ','); | |
21e15a40 | 760 | t->type = constype(nil); |
0022c355 | 761 | t->chain = t_int; |
21e15a40 SL |
762 | break; |
763 | ||
764 | case T_RECORD: | |
765 | consRecord(t, RECORD); | |
766 | break; | |
767 | ||
768 | case T_UNION: | |
769 | consRecord(t, VARNT); | |
770 | break; | |
771 | ||
772 | case T_ENUM: | |
773 | consEnum(t); | |
774 | break; | |
775 | ||
776 | case T_PTR: | |
777 | t->class = PTR; | |
778 | t->type = constype(nil); | |
779 | break; | |
780 | ||
781 | /* | |
782 | * C function variables are different from Modula-2's. | |
783 | */ | |
784 | case T_FUNCVAR: | |
785 | t->class = FFUNC; | |
786 | t->type = constype(nil); | |
787 | if (not streq(language_name(curlang), "c")) { | |
788 | skipchar(curchar, ','); | |
789 | consParamlist(t); | |
790 | } | |
791 | break; | |
792 | ||
793 | case T_PROCVAR: | |
794 | t->class = FPROC; | |
795 | consParamlist(t); | |
796 | break; | |
797 | ||
798 | case T_IMPORTED: | |
799 | consImpType(t); | |
800 | break; | |
801 | ||
802 | case T_SET: | |
803 | t->class = SET; | |
804 | t->type = constype(nil); | |
805 | break; | |
806 | ||
807 | case T_OPAQUE: | |
808 | consOpaqType(t); | |
809 | break; | |
810 | ||
0022c355 ML |
811 | case T_FILE: |
812 | t->class = FILET; | |
813 | t->type = constype(nil); | |
814 | break; | |
815 | ||
21e15a40 SL |
816 | default: |
817 | badcaseval(class); | |
818 | } | |
819 | } | |
820 | return t; | |
821 | } | |
822 | ||
823 | /* | |
824 | * Construct a subrange type. | |
825 | */ | |
826 | ||
827 | private consSubrange (t) | |
828 | Symbol t; | |
829 | { | |
830 | t->class = RANGE; | |
831 | t->type = constype(nil); | |
832 | skipchar(curchar, ';'); | |
833 | chkcont(curchar); | |
834 | t->symvalue.rangev.lowertype = getRangeBoundType(); | |
835 | t->symvalue.rangev.lower = getint(); | |
836 | skipchar(curchar, ';'); | |
837 | chkcont(curchar); | |
838 | t->symvalue.rangev.uppertype = getRangeBoundType(); | |
839 | t->symvalue.rangev.upper = getint(); | |
840 | } | |
841 | ||
842 | /* | |
843 | * Figure out the bound type of a range. | |
844 | * | |
845 | * Some letters indicate a dynamic bound, ie what follows | |
846 | * is the offset from the fp which contains the bound; this will | |
847 | * need a different encoding when pc a['A'..'Z'] is | |
848 | * added; J is a special flag to handle fortran a(*) bounds | |
849 | */ | |
850 | ||
851 | private Rangetype getRangeBoundType () | |
852 | { | |
853 | Rangetype r; | |
854 | ||
855 | switch (*curchar) { | |
856 | case 'A': | |
857 | r = R_ARG; | |
858 | curchar++; | |
859 | break; | |
860 | ||
861 | case 'T': | |
862 | r = R_TEMP; | |
863 | curchar++; | |
864 | break; | |
865 | ||
866 | case 'J': | |
867 | r = R_ADJUST; | |
868 | curchar++; | |
869 | break; | |
870 | ||
871 | default: | |
872 | r = R_CONST; | |
873 | break; | |
874 | } | |
875 | return r; | |
876 | } | |
877 | ||
0022c355 ML |
878 | /* |
879 | * Construct a dynamic array descriptor. | |
880 | */ | |
881 | ||
882 | private consDynarray (t) | |
883 | register Symbol t; | |
884 | { | |
885 | t->class = DYNARRAY; | |
886 | t->symvalue.ndims = getint(); | |
887 | skipchar(curchar, ','); | |
888 | t->type = constype(nil); | |
889 | t->chain = t_int; | |
890 | } | |
891 | ||
21e15a40 SL |
892 | /* |
893 | * Construct a record or union type. | |
894 | */ | |
895 | ||
896 | private consRecord (t, class) | |
897 | Symbol t; | |
898 | Symclass class; | |
899 | { | |
900 | register Symbol u; | |
901 | register char *cur, *p; | |
902 | Name name; | |
903 | integer d; | |
904 | ||
905 | t->class = class; | |
906 | t->symvalue.offset = getint(); | |
907 | d = curblock->level + 1; | |
908 | u = t; | |
909 | cur = curchar; | |
910 | while (*cur != ';' and *cur != '\0') { | |
911 | p = index(cur, ':'); | |
912 | if (p == nil) { | |
913 | panic("index(\"%s\", ':') failed", curchar); | |
914 | } | |
915 | *p = '\0'; | |
916 | name = identname(cur, true); | |
917 | u->chain = newSymbol(name, d, FIELD, nil, nil); | |
918 | cur = p + 1; | |
919 | u = u->chain; | |
920 | u->language = curlang; | |
921 | curchar = cur; | |
922 | u->type = constype(nil); | |
923 | skipchar(curchar, ','); | |
924 | u->symvalue.field.offset = getint(); | |
925 | skipchar(curchar, ','); | |
926 | u->symvalue.field.length = getint(); | |
927 | skipchar(curchar, ';'); | |
928 | chkcont(curchar); | |
929 | cur = curchar; | |
930 | } | |
931 | if (*cur == ';') { | |
932 | ++cur; | |
933 | } | |
934 | curchar = cur; | |
935 | } | |
936 | ||
937 | /* | |
938 | * Construct an enumeration type. | |
939 | */ | |
940 | ||
941 | private consEnum (t) | |
942 | Symbol t; | |
943 | { | |
944 | register Symbol u; | |
945 | register char *p; | |
946 | register integer count; | |
947 | ||
948 | t->class = SCAL; | |
949 | count = 0; | |
950 | u = t; | |
951 | while (*curchar != ';' and *curchar != '\0') { | |
952 | p = index(curchar, ':'); | |
953 | assert(p != nil); | |
954 | *p = '\0'; | |
955 | u->chain = insert(identname(curchar, true)); | |
956 | curchar = p + 1; | |
957 | u = u->chain; | |
958 | u->language = curlang; | |
959 | u->class = CONST; | |
960 | u->level = curblock->level + 1; | |
961 | u->block = curblock; | |
962 | u->type = t; | |
0022c355 | 963 | u->symvalue.constval = build(O_LCON, (long) getint()); |
21e15a40 SL |
964 | ++count; |
965 | skipchar(curchar, ','); | |
966 | chkcont(curchar); | |
967 | } | |
968 | if (*curchar == ';') { | |
969 | ++curchar; | |
970 | } | |
971 | t->symvalue.iconval = count; | |
972 | } | |
973 | ||
974 | /* | |
975 | * Construct a parameter list for a function or procedure variable. | |
976 | */ | |
977 | ||
978 | private consParamlist (t) | |
979 | Symbol t; | |
980 | { | |
981 | Symbol p; | |
982 | integer i, d, n, paramclass; | |
983 | ||
984 | n = getint(); | |
985 | skipchar(curchar, ';'); | |
986 | p = t; | |
987 | d = curblock->level + 1; | |
988 | for (i = 0; i < n; i++) { | |
989 | p->chain = newSymbol(nil, d, VAR, nil, nil); | |
990 | p = p->chain; | |
991 | p->type = constype(nil); | |
992 | skipchar(curchar, ','); | |
993 | paramclass = getint(); | |
994 | if (paramclass == 0) { | |
995 | p->class = REF; | |
996 | } | |
997 | skipchar(curchar, ';'); | |
998 | chkcont(curchar); | |
999 | } | |
1000 | } | |
1001 | ||
1002 | /* | |
1003 | * Construct an imported type. | |
1004 | * Add it to a list of symbols to get fixed up. | |
1005 | */ | |
1006 | ||
1007 | private consImpType (t) | |
1008 | Symbol t; | |
1009 | { | |
1010 | register char *p; | |
1011 | Symbol tmp; | |
1012 | ||
1013 | p = curchar; | |
1014 | while (*p != ',' and *p != ';' and *p != '\0') { | |
1015 | ++p; | |
1016 | } | |
1017 | if (*p == '\0') { | |
1018 | panic("bad import symbol entry '%s'", curchar); | |
1019 | } | |
1020 | t->class = TYPEREF; | |
1021 | t->symvalue.typeref = curchar; | |
21e15a40 SL |
1022 | if (*p == ',') { |
1023 | curchar = p + 1; | |
1024 | tmp = constype(nil); | |
0022c355 ML |
1025 | } else { |
1026 | curchar = p; | |
21e15a40 SL |
1027 | } |
1028 | skipchar(curchar, ';'); | |
1029 | *p = '\0'; | |
1030 | } | |
1031 | ||
1032 | /* | |
1033 | * Construct an opaque type entry. | |
1034 | */ | |
1035 | ||
1036 | private consOpaqType (t) | |
1037 | Symbol t; | |
1038 | { | |
1039 | register char *p; | |
1040 | register Symbol s; | |
1041 | register Name n; | |
1042 | boolean def; | |
1043 | ||
1044 | p = curchar; | |
1045 | while (*p != ';' and *p != ',') { | |
1046 | if (*p == '\0') { | |
1047 | panic("bad opaque symbol entry '%s'", curchar); | |
1048 | } | |
1049 | ++p; | |
1050 | } | |
1051 | def = (Boolean) (*p == ','); | |
1052 | *p = '\0'; | |
1053 | n = identname(curchar, true); | |
1054 | find(s, n) where s->class == TYPEREF endfind(s); | |
1055 | if (s == nil) { | |
1056 | s = insert(n); | |
1057 | s->class = TYPEREF; | |
1058 | s->type = nil; | |
1059 | } | |
1060 | curchar = p + 1; | |
1061 | if (def) { | |
1062 | s->type = constype(nil); | |
1063 | skipchar(curchar, ';'); | |
1064 | } | |
1065 | t->class = TYPE; | |
1066 | t->type = s; | |
1067 | } | |
1068 | ||
1069 | /* | |
1070 | * Read an integer from the current position in the type string. | |
1071 | */ | |
1072 | ||
1073 | private integer getint () | |
1074 | { | |
1075 | register integer n; | |
1076 | register char *p; | |
1077 | register Boolean isneg; | |
1078 | ||
1079 | n = 0; | |
1080 | p = curchar; | |
1081 | if (*p == '-') { | |
1082 | isneg = true; | |
1083 | ++p; | |
1084 | } else { | |
1085 | isneg = false; | |
1086 | } | |
1087 | while (isdigit(*p)) { | |
1088 | n = 10*n + (*p - '0'); | |
1089 | ++p; | |
1090 | } | |
1091 | curchar = p; | |
1092 | return isneg ? (-n) : n; | |
1093 | } | |
1094 | ||
1095 | /* | |
1096 | * Add a tag name. This is a kludge to be able to refer | |
1097 | * to tags that have the same name as some other symbol | |
1098 | * in the same block. | |
1099 | */ | |
1100 | ||
1101 | private addtag (s) | |
1102 | register Symbol s; | |
1103 | { | |
1104 | register Symbol t; | |
1105 | char buf[100]; | |
1106 | ||
1107 | sprintf(buf, "$$%.90s", ident(s->name)); | |
1108 | t = insert(identname(buf, false)); | |
1109 | t->language = s->language; | |
1110 | t->class = TAG; | |
1111 | t->type = s->type; | |
1112 | t->block = s->block; | |
1113 | } |