2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/nl.c

   1: /*
   2:  * Copyright (c) 1980 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[] = "@(#)nl.c	5.1 (Berkeley) 6/5/85";
   9: #endif not lint
  10: 
  11: 
  12: #include "whoami.h"
  13: #include "0.h"
  14: #ifdef PI
  15: #include "opcode.h"
  16: #include "objfmt.h"
  17: 
  18: /*
  19:  * NAMELIST SEGMENT DEFINITIONS
  20:  */
  21: struct nls {
  22:     struct nl *nls_low;
  23:     struct nl *nls_high;
  24: } ntab[MAXNL], *nlact;
  25: 
  26: struct  nl nl[INL];
  27: struct  nl *nlp = nl;
  28: struct  nls *nlact = ntab;
  29: 
  30:     /*
  31:      *	all these strings must be places where people can find them
  32:      *	since lookup only looks at the string pointer, not the chars.
  33:      *	see, for example, pTreeInit.
  34:      */
  35: 
  36:     /*
  37:      *	built in constants
  38:      */
  39: char    *in_consts[] = {
  40:         "true" ,
  41:         "false" ,
  42:         "TRUE",
  43:         "FALSE",
  44:         "minint" ,
  45:         "maxint" ,
  46:         "minchar" ,
  47:         "maxchar" ,
  48:         "bell" ,
  49:         "tab" ,
  50:         0
  51:     };
  52: 
  53:     /*
  54:      *	built in simple types
  55:      */
  56: char *in_types[] =
  57:     {
  58:     "boolean",
  59:     "char",
  60:     "integer",
  61:     "real",
  62:     "_nil",     /* dummy name */
  63:     0
  64:     };
  65: 
  66: int in_rclasses[] =
  67:     {
  68:     TINT ,
  69:     TINT ,
  70:     TINT ,
  71:     TCHAR ,
  72:     TBOOL ,
  73:     TDOUBLE ,
  74:     0
  75:     };
  76: 
  77: long in_ranges[] =
  78:     {
  79:     -128L    , 127L ,
  80:     -32768L  , 32767L ,
  81:     -2147483648L , 2147483647L ,
  82:     0L       , 127L ,
  83:     0L       , 1L ,
  84:     0L       , 0L       /* fake for reals */
  85:     };
  86: 
  87:     /*
  88:      *	built in constructed types
  89:      */
  90: char    *in_ctypes[] = {
  91:         "Boolean" ,
  92:         "intset" ,
  93:         "alfa" ,
  94:         "text" ,
  95:         0
  96:     };
  97: 
  98:     /*
  99:      *	built in variables
 100:      */
 101: char    *in_vars[] = {
 102:         "input" ,
 103:         "output" ,
 104:         0
 105:     };
 106: 
 107:     /*
 108:      *	built in functions
 109:      */
 110: char *in_funcs[] =
 111:     {
 112:     "abs" ,
 113:     "arctan" ,
 114:     "card" ,
 115:     "chr" ,
 116:     "clock" ,
 117:     "cos" ,
 118:     "eof" ,
 119:     "eoln" ,
 120:     "eos" ,
 121:     "exp" ,
 122:     "expo" ,
 123:     "ln" ,
 124:     "odd" ,
 125:     "ord" ,
 126:     "pred" ,
 127:     "round" ,
 128:     "sin" ,
 129:     "sqr" ,
 130:     "sqrt" ,
 131:     "succ" ,
 132:     "trunc" ,
 133:     "undefined" ,
 134:     /*
 135: 	 * Extensions
 136: 	 */
 137:     "argc" ,
 138:     "random" ,
 139:     "seed" ,
 140:     "wallclock" ,
 141:     "sysclock" ,
 142:     0
 143:     };
 144: 
 145:     /*
 146: 	 * Built-in procedures
 147: 	 */
 148: char *in_procs[] =
 149:     {
 150:     "assert",
 151:     "date" ,
 152:     "dispose" ,
 153:     "flush" ,
 154:     "get" ,
 155:     "getseg" ,
 156:     "halt" ,
 157:     "linelimit" ,
 158:     "message" ,
 159:     "new" ,
 160:     "pack" ,
 161:     "page" ,
 162:     "put" ,
 163:     "putseg" ,
 164:     "read" ,
 165:     "readln" ,
 166:     "remove" ,
 167:     "reset" ,
 168:     "rewrite" ,
 169:     "time" ,
 170:     "unpack" ,
 171:     "write" ,
 172:     "writeln" ,
 173:     /*
 174: 	 * Extensions
 175: 	 */
 176:     "argv" ,
 177:     "null" ,
 178:     "stlimit" ,
 179:     0
 180:     };
 181: 
 182: #ifndef PI0
 183:     /*
 184:      *	and their opcodes
 185:      */
 186: int in_fops[] =
 187:     {
 188:     O_ABS2,
 189:     O_ATAN,
 190:     O_CARD|NSTAND,
 191:     O_CHR2,
 192:     O_CLCK|NSTAND,
 193:     O_COS,
 194:     O_EOF,
 195:     O_EOLN,
 196:     0,
 197:     O_EXP,
 198:     O_EXPO|NSTAND,
 199:     O_LN,
 200:     O_ODD2,
 201:     O_ORD2,
 202:     O_PRED2,
 203:     O_ROUND,
 204:     O_SIN,
 205:     O_SQR2,
 206:     O_SQRT,
 207:     O_SUCC2,
 208:     O_TRUNC,
 209:     O_UNDEF|NSTAND,
 210:     /*
 211: 	 * Extensions
 212: 	 */
 213:     O_ARGC|NSTAND,
 214:     O_RANDOM|NSTAND,
 215:     O_SEED|NSTAND,
 216:     O_WCLCK|NSTAND,
 217:     O_SCLCK|NSTAND
 218:     };
 219: 
 220:     /*
 221:      * Built-in procedures
 222:      */
 223: int in_pops[] =
 224:     {
 225:     O_ASRT|NSTAND,
 226:     O_DATE|NSTAND,
 227:     O_DISPOSE,
 228:     O_FLUSH|NSTAND,
 229:     O_GET,
 230:     0,
 231:     O_HALT|NSTAND,
 232:     O_LLIMIT|NSTAND,
 233:     O_MESSAGE|NSTAND,
 234:     O_NEW,
 235:     O_PACK,
 236:     O_PAGE,
 237:     O_PUT,
 238:     0,
 239:     O_READ4,
 240:     O_READLN,
 241:     O_REMOVE|NSTAND,
 242:     O_RESET,
 243:     O_REWRITE,
 244:     O_TIME|NSTAND,
 245:     O_UNPACK,
 246:     O_WRITEF,
 247:     O_WRITLN,
 248:     /*
 249: 	 * Extensions
 250: 	 */
 251:     O_ARGV|NSTAND,
 252:     O_ABORT|NSTAND,
 253:     O_STLIM|NSTAND
 254:     };
 255: #endif
 256: 
 257: /*
 258:  * Initnl initializes the first namelist segment and then
 259:  * initializes the name list for block 0.
 260:  */
 261: initnl()
 262:     {
 263:     register char       **cp;
 264:     register struct nl  *np;
 265:     struct nl       *fp;
 266:     int         *ip;
 267:     long            *lp;
 268: 
 269: #ifdef  DEBUG
 270:     if ( hp21mx )
 271:         {
 272:         MININT = -32768.;
 273:         MAXINT = 32767.;
 274: #ifndef PI0
 275: #ifdef OBJ
 276:         genmx();
 277: #endif OBJ
 278: #endif
 279:         }
 280: #endif
 281:     ntab[0].nls_low = nl;
 282:     ntab[0].nls_high = &nl[INL];
 283:     (void) defnl ( (char *) 0 , 0 , NLNIL , 0 );
 284: 
 285:     /*
 286: 	 *	Types
 287: 	 */
 288:     for ( cp = in_types ; *cp != 0 ; cp ++ )
 289:         (void) hdefnl ( *cp , TYPE , nlp , 0 );
 290: 
 291:     /*
 292: 	 *	Ranges
 293: 	 */
 294:     lp = in_ranges;
 295:     for ( ip = in_rclasses ; *ip != 0 ; ip ++ )
 296:         {
 297:         np = defnl ( (char *) 0 , RANGE , nl+(*ip) , 0 );
 298:         nl[*ip].type = np;
 299:         np -> range[0] = *lp ++ ;
 300:         np -> range[1] = *lp ++ ;
 301: 
 302:         };
 303: 
 304:     /*
 305: 	 *	built in constructed types
 306: 	 */
 307: 
 308:     cp = in_ctypes;
 309:     /*
 310: 	 *	Boolean = boolean;
 311: 	 */
 312:     (void) hdefnl ( *cp++ , TYPE , (struct nl *) (nl+T1BOOL) , 0 );
 313: 
 314:     /*
 315: 	 *	intset = set of 0 .. 127;
 316: 	 */
 317:     intset = ((struct nl *) *cp++);
 318:     (void) hdefnl( (char *) intset , TYPE , nlp+1 , 0 );
 319:     (void) defnl ( (char *) 0 , SET , nlp+1 , 0 );
 320:     np = defnl ( (char *) 0 , RANGE , nl+TINT , 0 );
 321:     np -> range[0] = 0L;
 322:     np -> range[1] = 127L;
 323: 
 324:     /*
 325: 	 *	alfa = array [ 1 .. 10 ] of char;
 326: 	 */
 327:     np = defnl ( (char *) 0 , RANGE , nl+TINT , 0 );
 328:     np -> range[0] = 1L;
 329:     np -> range[1] = 10L;
 330:     defnl ( (char *) 0 , ARRAY , nl+T1CHAR , 1 ) -> chain = np;
 331:     (void) hdefnl ( *cp++ , TYPE , nlp-1 , 0 );
 332: 
 333:     /*
 334: 	 *	text = file of char;
 335: 	 */
 336:     (void) hdefnl ( *cp++ , TYPE , nlp+1 , 0 );
 337:     np = defnl ( (char *) 0 , FILET , nl+T1CHAR , 0 );
 338:     np -> nl_flags |= NFILES;
 339: 
 340:     /*
 341: 	 *	input,output : text;
 342: 	 */
 343:     cp = in_vars;
 344: #	ifndef    PI0
 345:         input = hdefnl ( *cp++ , VAR , np , INPUT_OFF );
 346:         output = hdefnl (  *cp++ , VAR , np , OUTPUT_OFF );
 347: #	else
 348:         input = hdefnl ( *cp++ , VAR , np , 0 );
 349:         output = hdefnl ( *cp++ , VAR , np , 0 );
 350: #	endif
 351: #	ifdef PC
 352:         input -> extra_flags |= NGLOBAL;
 353:         output -> extra_flags |= NGLOBAL;
 354: #	endif PC
 355: 
 356:     /*
 357: 	 *	built in constants
 358: 	 */
 359:     cp = in_consts;
 360:     np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
 361:     fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
 362:     (nl + TBOOL)->chain = fp;
 363:     fp->chain = np;
 364:     np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
 365:     fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
 366:     fp->chain = np;
 367:     if (opt('s'))
 368:         (nl + TBOOL)->chain = fp;
 369:     hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MININT;
 370:     hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MAXINT;
 371:     (void) hdefnl ( *cp++ , CONST , nl + T1CHAR , 0 );
 372:     (void) hdefnl ( *cp++ , CONST , nl + T1CHAR , 127 );
 373:     (void) hdefnl ( *cp++ , CONST , nl + T1CHAR , '\007' );
 374:     (void) hdefnl ( *cp++ , CONST , nl + T1CHAR , '\t' );
 375: 
 376:     /*
 377: 	 * Built-in functions and procedures
 378: 	 */
 379: #ifndef PI0
 380:     ip = in_fops;
 381:     for ( cp = in_funcs ; *cp != 0 ; cp ++ )
 382:         (void) hdefnl ( *cp , FUNC , NLNIL , * ip ++ );
 383:     ip = in_pops;
 384:     for ( cp = in_procs ; *cp != 0 ; cp ++ )
 385:         (void) hdefnl ( *cp , PROC , NLNIL , * ip ++ );
 386: #else
 387:     for ( cp = in_funcs ; *cp != 0 ; cp ++ )
 388:         (void) hdefnl ( *cp , FUNC , NLNIL , 0 );
 389:     for ( cp = in_procs ; *cp != 0 , cp ++ )
 390:         (void) hdefnl ( *cp , PROC , NLNIL , 0 );
 391: #endif
 392: #	ifdef PTREE
 393:         pTreeInit();
 394: #	endif
 395:     }
 396: 
 397: struct nl *
 398: hdefnl(sym, cls, typ, val)
 399:     char *sym;
 400:     int  cls;
 401:     struct nl *typ;
 402:     int val;
 403: {
 404:     register struct nl *p;
 405: 
 406: #ifndef PI1
 407:     if (sym)
 408:         (void) hash(sym, 0);
 409: #endif
 410:     p = defnl(sym, cls, typ, val);
 411:     if (sym)
 412:         (void) enter(p);
 413:     return (p);
 414: }
 415: 
 416: /*
 417:  * Free up the name list segments
 418:  * at the end of a statement/proc/func
 419:  * All segments are freed down to the one in which
 420:  * p points.
 421:  */
 422: nlfree(p)
 423:     struct nl *p;
 424: {
 425: 
 426:     nlp = p;
 427:     while (nlact->nls_low > nlp || nlact->nls_high < nlp) {
 428:         free((char *) nlact->nls_low);
 429:         nlact->nls_low = NIL;
 430:         nlact->nls_high = NIL;
 431:         --nlact;
 432:         if (nlact < &ntab[0])
 433:             panic("nlfree");
 434:     }
 435: }
 436: #endif PI
 437: 
 438: 
 439: #ifndef PC
 440: #ifndef OBJ
 441: char    *VARIABLE   = "variable";
 442: #endif PC
 443: #endif OBJ
 444: 
 445: char    *classes[ ] = {
 446:     "undefined",
 447:     "constant",
 448:     "type",
 449:     "variable", /*	VARIABLE	*/
 450:     "array",
 451:     "pointer or file",
 452:     "record",
 453:     "field",
 454:     "procedure",
 455:     "function",
 456:     "variable", /*	VARIABLE	*/
 457:     "variable", /*	VARIABLE	*/
 458:     "pointer",
 459:     "file",
 460:     "set",
 461:     "subrange",
 462:     "label",
 463:     "withptr",
 464:     "scalar",
 465:     "string",
 466:     "program",
 467:     "improper",
 468:     "variant",
 469:     "formal procedure",
 470:     "formal function"
 471: };
 472: 
 473: #ifndef PC
 474: #ifndef OBJ
 475: char    *snark  = "SNARK";
 476: #endif
 477: #endif
 478: 
 479: #ifdef PI
 480: #ifdef DEBUG
 481: char    *ctext[] =
 482: {
 483:     "BADUSE",
 484:     "CONST",
 485:     "TYPE",
 486:     "VAR",
 487:     "ARRAY",
 488:     "PTRFILE",
 489:     "RECORD",
 490:     "FIELD",
 491:     "PROC",
 492:     "FUNC",
 493:     "FVAR",
 494:     "REF",
 495:     "PTR",
 496:     "FILET",
 497:     "SET",
 498:     "RANGE",
 499:     "LABEL",
 500:     "WITHPTR",
 501:     "SCAL",
 502:     "STR",
 503:     "PROG",
 504:     "IMPROPER",
 505:     "VARNT",
 506:     "FPROC",
 507:     "FFUNC",
 508:     "CRANGE"
 509: };
 510: 
 511: char    *stars  = "\t***";
 512: 
 513: /*
 514:  * Dump the namelist from the
 515:  * current nlp down to 'to'.
 516:  * All the namelist is dumped if
 517:  * to is NIL.
 518:  */
 519: /*VARARGS*/
 520: dumpnl(to, rout)
 521:     struct nl *to;
 522: {
 523:     register struct nl *p;
 524:     struct nls *nlsp;
 525:     int v, head;
 526: 
 527:     if (opt('y') == 0)
 528:         return;
 529:     if (to != NIL)
 530:         printf("\n\"%s\" Block=%d\n", rout, cbn);
 531:     nlsp = nlact;
 532:     head = NIL;
 533:     for (p = nlp; p != to;) {
 534:         if (p == nlsp->nls_low) {
 535:             if (nlsp == &ntab[0])
 536:                 break;
 537:             nlsp--;
 538:             p = nlsp->nls_high;
 539:         }
 540:         p--;
 541:         if (head == NIL) {
 542:             printf("\tName\tClass  Bn+Flags\tType\tVal\tChn\n");
 543:             head++;
 544:         }
 545:         printf("%3d:", nloff(p));
 546:         if (p->symbol)
 547:             printf("\t%.7s", p->symbol);
 548:         else
 549:             printf(stars);
 550:         if (p->class)
 551:             printf("\t%s", ctext[p->class]);
 552:         else
 553:             printf(stars);
 554:         if (p->nl_flags) {
 555:             pchr('\t');
 556:             if (p->nl_flags & 037)
 557:                 printf("%d ", p->nl_flags & 037);
 558: #ifndef PI0
 559:             if (p->nl_flags & NMOD)
 560:                 pchr('M');
 561:             if (p->nl_flags & NUSED)
 562:                 pchr('U');
 563: #endif
 564:             if (p->nl_flags & NFILES)
 565:                 pchr('F');
 566:         } else
 567:             printf(stars);
 568:         if (p->type)
 569:             printf("\t[%d]", nloff(p->type));
 570:         else
 571:             printf(stars);
 572:         v = p->value[0];
 573:         switch (p->class) {
 574:             case TYPE:
 575:                 break;
 576:             case VARNT:
 577:                 goto con;
 578:             case CONST:
 579:                 switch (nloff(p->type)) {
 580:                     default:
 581:                         printf("\t%d", v);
 582:                         break;
 583:                     case TDOUBLE:
 584:                         printf("\t%f", p->real);
 585:                         break;
 586:                     case TINT:
 587:                     case T4INT:
 588: con:
 589:                         printf("\t%ld", p->range[0]);
 590:                         break;
 591:                     case TSTR:
 592:                         printf("\t'%s'", p->ptr[0]);
 593:                         break;
 594:                     }
 595:                 break;
 596:             case VAR:
 597:             case REF:
 598:             case WITHPTR:
 599:             case FFUNC:
 600:             case FPROC:
 601:                 printf("\t%d,%d", cbn, v);
 602:                 break;
 603:             case SCAL:
 604:             case RANGE:
 605:                 printf("\t%ld..%ld", p->range[0], p->range[1]);
 606:                 break;
 607:             case CRANGE:
 608:                 printf("\t%s..%s", p->nptr[0]->symbol,
 609:                     p->nptr[1]->symbol);
 610:                 break;
 611:             case RECORD:
 612:                 printf("\t%d", v);
 613:                 break;
 614:             case FIELD:
 615:                 printf("\t%d", v);
 616:                 break;
 617:             case STR:
 618:                 printf("\t|%d|", p->value[0]);
 619:                 break;
 620:             case FVAR:
 621:             case FUNC:
 622:             case PROC:
 623:             case PROG:
 624:                 if (cbn == 0) {
 625:                     printf("\t<%o>", p->value[0] & 0377);
 626: #ifndef PI0
 627:                     if (p->value[0] & NSTAND)
 628:                         printf("\tNSTAND");
 629: #endif
 630:                     break;
 631:                 }
 632:                 v = p->value[1];
 633:             default:
 634: 
 635:                 if (v)
 636:                     printf("\t<%d>", v);
 637:                 else
 638:                     printf(stars);
 639:         }
 640:         if (p->chain)
 641:             printf("\t[%d]", nloff(p->chain));
 642:         switch (p->class) {
 643:             case RECORD:
 644:                 printf("\tALIGN=%d", p->align_info);
 645:                 if (p->ptr[NL_FIELDLIST]) {
 646:                     printf(" FLIST=[%d]",
 647:                     nloff(p->ptr[NL_FIELDLIST]));
 648:                 } else {
 649:                     printf(" FLIST=[]");
 650:                 }
 651:                 if (p->ptr[NL_TAG]) {
 652:                     printf(" TAG=[%d]",
 653:                     nloff(p->ptr[NL_TAG]));
 654:                 } else {
 655:                     printf(" TAG=[]");
 656:                 }
 657:                 if (p->ptr[NL_VARNT]) {
 658:                     printf(" VARNT=[%d]",
 659:                     nloff(p->ptr[NL_VARNT]));
 660:                 } else {
 661:                     printf(" VARNT=[]");
 662:                 }
 663:                 break;
 664:             case FIELD:
 665:                 if (p->ptr[NL_FIELDLIST]) {
 666:                     printf("\tFLIST=[%d]",
 667:                     nloff(p->ptr[NL_FIELDLIST]));
 668:                 } else {
 669:                     printf("\tFLIST=[]");
 670:                 }
 671:                 break;
 672:             case VARNT:
 673:                 printf("\tVTOREC=[%d]",
 674:                     nloff(p->ptr[NL_VTOREC]));
 675:                 break;
 676:         }
 677: #		ifdef PC
 678:             if ( p -> extra_flags != 0 ) {
 679:             pchr( '\t' );
 680:             if ( p -> extra_flags & NEXTERN )
 681:                 printf( "NEXTERN " );
 682:             if ( p -> extra_flags & NLOCAL )
 683:                 printf( "NLOCAL " );
 684:             if ( p -> extra_flags & NPARAM )
 685:                 printf( "NPARAM " );
 686:             if ( p -> extra_flags & NGLOBAL )
 687:                 printf( "NGLOBAL " );
 688:             if ( p -> extra_flags & NREGVAR )
 689:                 printf( "NREGVAR " );
 690:             }
 691: #		endif PC
 692: #		ifdef PTREE
 693:             pchr( '\t' );
 694:             pPrintPointer( stdout , "%s" , p -> inTree );
 695: #		endif
 696:         pchr('\n');
 697:     }
 698:     if (head == 0)
 699:         printf("\tNo entries\n");
 700: }
 701: #endif
 702: 
 703: 
 704: /*
 705:  * Define a new name list entry
 706:  * with initial symbol, class, type
 707:  * and value[0] as given.  A new name
 708:  * list segment is allocated to hold
 709:  * the next name list slot if necessary.
 710:  */
 711: struct nl *
 712: defnl(sym, cls, typ, val)
 713:     char *sym;
 714:     int cls;
 715:     struct nl *typ;
 716:     int val;
 717: {
 718:     register struct nl *p;
 719:     register int *q, i;
 720:     char *cp;
 721: 
 722:     p = nlp;
 723: 
 724:     /*
 725: 	 * Zero out this entry
 726: 	 */
 727:     q = ((int *) p);
 728:     i = (sizeof *p)/(sizeof (int));
 729:     do
 730:         *q++ = 0;
 731:     while (--i);
 732: 
 733:     /*
 734: 	 * Insert the values
 735: 	 */
 736:     p->symbol = sym;
 737:     p->class = cls;
 738:     p->type = typ;
 739:     p->nl_block = cbn;
 740:     p->value[0] = val;
 741: 
 742:     /*
 743: 	 * Insure that the next namelist
 744: 	 * entry actually exists. This is
 745: 	 * really not needed here, it would
 746: 	 * suffice to do it at entry if we
 747: 	 * need the slot.  It is done this
 748: 	 * way because, historically, nlp
 749: 	 * always pointed at the next namelist
 750: 	 * slot.
 751: 	 */
 752:     nlp++;
 753:     if (nlp >= nlact->nls_high) {
 754:         i = NLINC;
 755:         cp = (char *) malloc(NLINC * sizeof *nlp);
 756:         if (cp == 0) {
 757:             i = NLINC / 2;
 758:             cp = (char *) malloc((NLINC / 2) * sizeof *nlp);
 759:         }
 760:         if (cp == 0) {
 761:             error("Ran out of memory (defnl)");
 762:             pexit(DIED);
 763:         }
 764:         nlact++;
 765:         if (nlact >= &ntab[MAXNL]) {
 766:             error("Ran out of name list tables");
 767:             pexit(DIED);
 768:         }
 769:         nlp = (struct nl *) cp;
 770:         nlact->nls_low = nlp;
 771:         nlact->nls_high = nlact->nls_low + i;
 772:     }
 773:     return (p);
 774: }
 775: 
 776: /*
 777:  * Make a duplicate of the argument
 778:  * namelist entry for, e.g., type
 779:  * declarations of the form 'type a = b'
 780:  * and array indicies.
 781:  */
 782: struct nl *
 783: nlcopy(p)
 784:     struct nl *p;
 785: {
 786:     register struct nl *p1, *p2;
 787: 
 788:     p1 = p;
 789:     p2 = defnl((char *) 0, 0, NLNIL, 0);
 790:     *p2 = *p1;
 791:     p2->chain = NLNIL;
 792:     return (p2);
 793: }
 794: 
 795: /*
 796:  * Compute a namelist offset
 797:  */
 798: nloff(p)
 799:     struct nl *p;
 800: {
 801: 
 802:     return (p - nl);
 803: }
 804: 
 805: /*
 806:  * Enter a symbol into the block
 807:  * symbol table.  Symbols are hashed
 808:  * 64 ways based on low 6 bits of the
 809:  * character pointer into the string
 810:  * table.
 811:  */
 812: struct nl *
 813: enter(np)
 814:     struct nl *np;
 815: {
 816:     register struct nl *rp, *hp;
 817:     register struct nl *p;
 818:     int i;
 819: 
 820:     rp = np;
 821:     if (rp == NIL)
 822:         return (NIL);
 823: #ifndef PI1
 824:     if (cbn > 0)
 825:         if (rp->symbol == input->symbol || rp->symbol == output->symbol)
 826:             error("Pre-defined files input and output must not be redefined");
 827: #endif
 828:     i = (int) rp->symbol;
 829:     i &= 077;
 830:     hp = disptab[i];
 831:     if (rp->class != BADUSE && rp->class != FIELD)
 832:     for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next)
 833:         if (p->symbol == rp->symbol && p->symbol != NIL &&
 834:             p->class != BADUSE && p->class != FIELD) {
 835: #ifndef PI1
 836:             error("%s is already defined in this block", rp->symbol);
 837: #endif
 838:             break;
 839: 
 840:         }
 841:     rp->nl_next = hp;
 842:     disptab[i] = rp;
 843:     return (rp);
 844: }
 845: #endif

Defined functions

Defined variables

Defined struct's