4.3BSD - /usr/src/ucb/dbx/stabstring.c

   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:  */
   6: 
   7: #ifndef lint
   8: static char sccsid[] = "@(#)stabstring.c	5.1 (Berkeley) 5/31/85";
   9: #endif not lint
  10: 
  11: static char rcsid[] = "$Header: stabstring.c,v 1.6 84/12/26 10:42:17 linton Exp $";
  12: 
  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"
  26: #include "tree.h"
  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: 
  37: #define CONSTNAME 'c'
  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'
  61: #define T_OLDOPENARRAY 'A'
  62: #define T_OPENARRAY 'O'
  63: #define T_DYNARRAY 'D'
  64: #define T_SUBARRAY 'E'
  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'
  74: #define T_FILE 'd'
  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: {
 152:     Symbol s, t;
 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) {
 164:     case CONSTNAME:
 165:         newSym(s, n);
 166:         constName(s);
 167:         break;
 168: 
 169:     case TYPENAME:
 170:         newSym(s, n);
 171:         typeName(s);
 172:         break;
 173: 
 174:     case TAGNAME:
 175:         s = symbol_alloc();
 176:         s->name = n;
 177:         s->level = curblock->level + 1;
 178:         s->language = curlang;
 179:         s->block = curblock;
 180:         tagName(s);
 181:         break;
 182: 
 183:     case MODULEBEGIN:
 184:         publicRoutine(&s, n, MODULE, np->n_value, false);
 185:         curmodule = s;
 186:         break;
 187: 
 188:     case EXTPROCEDURE:
 189:         publicRoutine(&s, n, PROC, np->n_value, false);
 190:         break;
 191: 
 192:     case PRIVPROCEDURE:
 193:         privateRoutine(&s, n, PROC, np->n_value);
 194:         break;
 195: 
 196:     case INTPROCEDURE:
 197:         publicRoutine(&s, n, PROC, np->n_value, true);
 198:         break;
 199: 
 200:     case EXTFUNCTION:
 201:         publicRoutine(&s, n, FUNC, np->n_value, false);
 202:         break;
 203: 
 204:     case PRIVFUNCTION:
 205:         privateRoutine(&s, n, FUNC, np->n_value);
 206:         break;
 207: 
 208:     case INTFUNCTION:
 209:         publicRoutine(&s, n, FUNC, np->n_value, true);
 210:         break;
 211: 
 212:     case EXTVAR:
 213:         extVar(&s, n, np->n_value);
 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: 
 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: 
 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.
 406:  *
 407:  * If it contains nested procedures, then it may already be defined
 408:  * in the current block as a MODULE.
 409:  */
 410: 
 411: private publicRoutine (s, n, class, addr, isinternal)
 412: Symbol *s;
 413: Name n;
 414: Symclass class;
 415: Address addr;
 416: boolean isinternal;
 417: {
 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;
 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: 
 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: 
 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.
 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;
 689:     char *p;
 690: 
 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:     }
 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: 
 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: 
 751:         case T_OPENARRAY:
 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, ',');
 760:         t->type = constype(nil);
 761:         t->chain = t_int;
 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: 
 811:         case T_FILE:
 812:         t->class = FILET;
 813:         t->type = constype(nil);
 814:         break;
 815: 
 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: 
 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: 
 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;
 963:     u->symvalue.constval = build(O_LCON, (long) getint());
 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;
1022:     if (*p == ',') {
1023:     curchar = p + 1;
1024:     tmp = constype(nil);
1025:     } else {
1026:     curchar = p;
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: }

Defined functions

Defined variables

Defined macros