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

##### Functions

    alloc             X
    defnl             X
    dumpnl            X
    enter             X
    hdefnl            X
    initnl            X
    nlcopy            X
    nlfree            X
    nloff             X

##### Variables

    MAXINT            X
    MININT            X
    VARIABLE          X
    biltins           X
    classes           X
    ctext             X
    nl                X
    nlact             X
    nlp               X
    ntab              X
    snark             X
    stars             X

##### struct's

    nls               X

       1: #
       2: /*
       3:  * pi - Pascal interpreter code translator
       4:  *
       5:  * Charles Haley, Bill Joy UCB
       6:  * Version 1.2 January 1979
       7:  */
       8:
       9: #include "0.h"
      10: #include "opcode.h"
      11:
      12: #ifdef PI
      13: /*
      14:  * Array of information about pre-defined, block 0 symbols.
      15:  */
      16: int *biltins[] {
      17:
      18:     /*
      19: 	 * Types
      20: 	 */
      21:     "boolean",
      22:     "char",
      23:     "integer",
      24:     "real",
      25:     "_nil",     /* dummy name */
      26:     0,
      27:
      28:     /*
      29: 	 * Ranges
      30: 	 */
      31:     TINT,       0177777, 0177600, 0, 0177,
      32:     TINT,       0177777, 0100000, 0, 077777,
      33:     TINT,       0100000, 0, 077777, 0177777,
      34:     TCHAR,      0, 0, 0, 127,
      35:     TBOOL,      0, 0, 0, 1,
      36:     TDOUBLE,    0, 0, 0, 0,     /* fake for reals */
      37:     0,
      38:
      39:     /*
      40: 	 * Built-in composite types
      41: 	 */
      42:     "Boolean",
      43:     "intset",
      44:     "alfa",
      45:     "text",
      46:     "input",
      47:     "output",
      48:
      49:     /*
      50: 	 * Built-in constants
      51: 	 */
      52:     "true",     TBOOL,  1, 0,
      53:     "false",    TBOOL,  0, 0,
      54:     "minchar",  T1CHAR, 0, 0,
      55:     "maxchar",  T1CHAR, 0177, 0,
      56:     "bell",     T1CHAR, 07, 0,
      57:     "tab",      T1CHAR, 011, 0,
      58:     "minint",   T4INT,  0100000, 0,     /* Must be last 2! */
      59:     "maxint",   T4INT,  077777, 0177777,
      60:     0,
      61:
      62:     /*
      63: 	 * Built-in functions
      64: 	 */
      65: #ifndef PI0
      66:     "abs",      O_ABS2,
      67:     "arctan",   O_ATAN,
      68:     "card",     O_CARD|NSTAND,
      69:     "chr",      O_CHR2,
      70:     "clock",    O_CLCK|NSTAND,
      71:     "cos",      O_COS,
      72:     "eof",      O_EOF,
      73:     "eoln",     O_EOLN,
      74:     "eos",      0,
      75:     "exp",      O_EXP,
      76:     "expo",     O_EXPO|NSTAND,
      77:     "ln",       O_LN,
      78:     "odd",      O_ODD2,
      79:     "ord",      O_ORD2,
      80:     "pred",     O_PRED2,
      81:     "round",    O_ROUND,
      82:     "sin",      O_SIN,
      83:     "sqr",      O_SQR2,
      84:     "sqrt",     O_SQRT,
      85:     "succ",     O_SUCC2,
      86:     "trunc",    O_TRUNC,
      87:     "undefined",    O_UNDEF|NSTAND,
      88:     /*
      89: 	 * Extensions
      90: 	 */
      91:     "argc",     O_ARGC|NSTAND,
      92:     "random",   O_RANDOM|NSTAND,
      93:     "seed",     O_SEED|NSTAND,
      94:     "wallclock",    O_WCLCK|NSTAND,
      95:     "sysclock", O_SCLCK|NSTAND,
      96:     0,
      97:
      98:     /*
      99: 	 * Built-in procedures
     100: 	 */
     101:     "date",     O_DATE|NSTAND,
     102:     "flush",    O_FLUSH|NSTAND,
     103:     "get",      O_GET,
     104:     "getseg",   0,
     105:     "halt",     O_HALT|NSTAND,
     106:     "linelimit",    O_LLIMIT|NSTAND,
     107:     "message",  O_MESSAGE|NSTAND,
     108:     "new",      O_NEW,
     109:     "pack",     O_PACK,
     110:     "page",     O_PAGE,
     111:     "put",      O_PUT,
     112:     "putseg",   0,
     113:     "read",     O_READ4,
     114:     "readln",   O_READLN,
     115:     "remove",   O_REMOVE|NSTAND,
     116:     "reset",    O_RESET,
     117:     "rewrite",  O_REWRITE,
     118:     "time",     O_TIME|NSTAND,
     119:     "unpack",   O_UNPACK,
     120:     "write",    O_WRIT2,
     121:     "writeln",  O_WRITLN,
     122:     /*
     123: 	 * Extensions
     124: 	 */
     125:     "argv",     O_ARGV|NSTAND,
     126:     "null",     O_NULL|NSTAND,
     127:     "stlimit",  O_STLIM|NSTAND,
     128:     0,
     129: #else
     130:     "abs",
     131:     "arctan",
     132:     "card",
     133:     "chr",
     134:     "clock",
     135:     "cos",
     136:     "eof",
     137:     "eoln",
     138:     "eos",
     139:     "exp",
     140:     "expo",
     141:     "ln",
     142:     "odd",
     143:     "ord",
     144:     "pred",
     145:     "round",
     146:     "sin",
     147:     "sqr",
     148:     "sqrt",
     149:     "succ",
     150:     "trunc",
     151:     "undefined",
     152:     /*
     153: 	 * Extensions
     154: 	 */
     155:     "argc",
     156:     "random",
     157:     "seed",
     158:     "wallclock",
     159:     "sysclock",
     160:     0,
     161:
     162:     /*
     163: 	 * Built-in procedures
     164: 	 */
     165:     "date",
     166:     "flush",
     167:     "get",
     168:     "getseg",
     169:     "halt",
     170:     "linelimit",
     171:     "message",
     172:     "new",
     173:     "pack",
     174:     "page",
     175:     "put",
     176:     "putseg",
     177:     "read",
     178:     "readln",
     179:     "remove",
     180:     "reset",
     181:     "rewrite",
     182:     "time",
     183:     "unpack",
     184:     "write",
     185:     "writeln",
     186:     /*
     187: 	 * Extensions
     188: 	 */
     189:     "argv",
     190:     "null",
     191:     "stlimit",
     192:     0,
     193: #endif
     194: };
     195:
     196: /*
     197:  * NAMELIST SEGMENT DEFINITIONS
     198:  */
     199: struct nls {
     200:     struct nl *nls_low;
     201:     struct nl *nls_high;
     202: } ntab[MAXNL], *nlact;
     203:
     204: struct  nl nl[INL];
     205: struct  nl *nlp nl;
     206: struct  nls *nlact ntab;
     207: /*
     208:  * Initnl initializes the first namelist segment and then
     209:  * uses the array biltins to initialize the name list for
     210:  * block 0.
     211:  */
     212: initnl()
     213: {
     214:     register int *q;
     215:     register struct nl *p;
     216:     register int i;
     217:
     218: #ifdef DEBUG
     219:     if (hp21mx) {
     220:         MININT = -32768.;
     221:         MAXINT = 32767.;
     222: #ifndef PI0
     223:         genmx();
     224: #endif
     225:     }
     226: #endif
     227:     ntab[0].nls_low = nl;
     228:     ntab[0].nls_high = &nl[INL];
     229:     defnl(0, 0, 0, 0);
     230:     /*
     231: 	 * Fundamental types
     232: 	 */
     233:     for (q = biltins; *q != 0; q++)
     234:         hdefnl(*q, TYPE, nlp, 0);
     235:     q++;
     236:
     237:     /*
     238: 	 * Ranges
     239: 	 */
     240:     while (*q) {
     241:         p = defnl(0, RANGE, nl+*q, 0);
     242:         nl[*q++].type = p;
     243:         for (i = 0; i < 4; i++)
     244:             p->value[i] = *q++;
     245:     }
     246:     q++;
     247:
     248: #ifdef DEBUG
     249:     if (hp21mx) {
     250:         nl[T4INT].range[0] = MININT;
     251:         nl[T4INT].range[1] = MAXINT;
     252:     }
     253: #endif
     254:
     255:     /*
     256: 	 * Pre-defined composite types
     257: 	 */
     258:     hdefnl(*q++, TYPE, nl+T1BOOL, 0);
     259:     enter(defnl((intset = *q++), TYPE, nlp+1, 0));
     260:     defnl(0, SET, nlp+1, 0);
     261:     defnl(0, RANGE, nl+TINT, 0)->value[3] = 127;
     262:      p= defnl(0, RANGE, nl+TINT, 0);
     263:     p->value[1] = 1;
     264:     p->value[3] = 10;
     265:     defnl(0, ARRAY, nl+T1CHAR, 1)->chain = p;
     266:     hdefnl(*q++, TYPE, nlp-1, 0);   /* "alfa" */
     267:     hdefnl(*q++, TYPE, nlp+1, 0);   /* "text" */
     268:      p= defnl(0, FILE, nl+T1CHAR, 0);
     269:     p->nl_flags |= NFILES;
     270: #ifndef PI0
     271:     input = hdefnl(*q++, VAR, p, -2);   /* "input" */
     272:     output = hdefnl(*q++, VAR, p, -4);  /* "output" */
     273: #else
     274:     input = hdefnl(*q++, VAR, p, 0);    /* "input" */
     275:     output = hdefnl(*q++, VAR, p, 0);   /* "output" */
     276: #endif
     277:
     278:     /*
     279: 	 * Pre-defined constants
     280: 	 */
     281:     for (; *q; q += 4)
     282:         hdefnl(q[0], CONST, nl+q[1], q[2])->value[1] = q[3];
     283:
     284: #ifdef DEBUG
     285:     if (hp21mx) {
     286:         nlp[-2].range[0] = MININT;
     287:         nlp[-1].range[0] = MAXINT;
     288:     }
     289: #endif
     290:
     291:     /*
     292: 	 * Built-in procedures and functions
     293: 	 */
     294: #ifndef PI0
     295:     for (q++; *q; q += 2)
     296:         hdefnl(q[0], FUNC, 0, q[1]);
     297:     for (q++; *q; q += 2)
     298:         hdefnl(q[0], PROC, 0, q[1]);
     299: #else
     300:     for (q++; *q;)
     301:         hdefnl(*q++, FUNC, 0, 0);
     302:     for (q++; *q;)
     303:         hdefnl(*q++, PROC, 0, 0);
     304: #endif
     305: }
     306:
     307: hdefnl(sym, cls, typ, val)
     308: {
     309:     register struct nl *p;
     310:
     311: #ifndef PI1
     312:     if (sym)
     313:         hash(sym, 0);
     314: #endif
     315:     p = defnl(sym, cls, typ, val);
     316:     if (sym)
     317:         enter(p);
     318:     return (p);
     319: }
     320:
     321: /*
     322:  * Free up the name list segments
     323:  * at the end of a statement/proc/func
     324:  * All segments are freed down to the one in which
     325:  * p points.
     326:  */
     327: nlfree(p)
     328:     struct nl *p;
     329: {
     330:
     331:     nlp = p;
     332:     while (nlact->nls_low > nlp || nlact->nls_high < nlp) {
     333:         free(nlact->nls_low);
     334:         nlact->nls_low = NIL;
     335:         nlact->nls_high = NIL;
     336:         --nlact;
     337:         if (nlact < &ntab[0])
     338:             panic("nlfree");
     339:     }
     340: }
     341: #endif
     342:
     343: char    VARIABLE[]  = "variable";
     344:
     345: char    *classes[] = {
     346:     "undefined",
     347:     "constant",
     348:     "type",
     349:     VARIABLE,
     350:     "array",
     351:     "pointer or file",
     352:     "record",
     353:     "field",
     354:     "procedure",
     355:     "function",
     356:     VARIABLE,
     357:     VARIABLE,
     358:     "pointer",
     359:     "file",
     360:     "set",
     361:     "subrange",
     362:     "label",
     363:     "withptr",
     364:     "scalar",
     365:     "string",
     366:     "program",
     367:     "improper",
     368: #ifdef DEBUG
     369:     "variant",
     370: #endif
     371: };
     372:
     373: char    snark[] = "SNARK";
     374:
     375: #ifdef PI
     376: #ifdef DEBUG
     377: char    *ctext[]
     378: {
     379:     "BADUSE",
     380:     "CONST",
     381:     "TYPE",
     382:     "VAR",
     383:     "ARRAY",
     384:     "PTRFILE",
     385:     "RECORD",
     386:     "FIELD",
     387:     "PROC",
     388:     "FUNC",
     389:     "FVAR",
     390:     "REF",
     391:     "PTR",
     392:     "FILE",
     393:     "SET",
     394:     "RANGE",
     395:     "LABEL",
     396:     "WITHPTR",
     397:     "SCAL",
     398:     "STR",
     399:     "PROG",
     400:     "IMPROPER",
     401:     "VARNT"
     402: };
     403:
     404: char    *stars  "\t***";
     405:
     406: /*
     407:  * Dump the namelist from the
     408:  * current nlp down to 'to'.
     409:  * All the namelist is dumped if
     410:  * to is NIL.
     411:  */
     412: dumpnl(to, rout)
     413:     struct nl *to;
     414: {
     415:     register struct nl *p;
     416:     register int j;
     417:     struct nls *nlsp;
     418:     int i, v, head;
     419:
     420:     if (opt('y') == 0)
     421:         return;
     422:     if (to != NIL)
     423:         printf("\n\"%s\" Block=%d\n", rout, cbn);
     424:     nlsp = nlact;
     425:     head = NIL;
     426:     for (p = nlp; p != to;) {
     427:         if (p == nlsp->nls_low) {
     428:             if (nlsp == &ntab[0])
     429:                 break;
     430:             nlsp--;
     431:             p = nlsp->nls_high;
     432:         }
     433:         p--;
     434:         if (head == NIL) {
     435:             printf("\tName\tClass  Bn+Flags\tType\tVal\tChn\n");
     436:             head++;
     437:         }
     438:         printf("%3d:", nloff(p));
     439:         if (p->symbol)
     440:             printf("\t%.7s", p->symbol);
     441:         else
     442:             printf(stars);
     443:         if (p->class)
     444:             printf("\t%s", ctext[p->class]);
     445:         else
     446:             printf(stars);
     447:         if (p->nl_flags) {
     448:             putchar('\t');
     449:             if (p->nl_flags & 037)
     450:                 printf("%d ", p->nl_flags & 037);
     451: #ifndef PI0
     452:             if (p->nl_flags & NMOD)
     453:                 putchar('M');
     454:             if (p->nl_flags & NUSED)
     455:                 putchar('U');
     456: #endif
     457:             if (p->nl_flags & NFILES)
     458:                 putchar('F');
     459:         } else
     460:             printf(stars);
     461:         if (p->type)
     462:             printf("\t[%d]", nloff(p->type));
     463:         else
     464:             printf(stars);
     465:         v = p->value[0];
     466:         switch (p->class) {
     467:             case TYPE:
     468:                 break;
     469:             case VARNT:
     470:                 goto con;
     471:             case CONST:
     472:                 switch (nloff(p->type)) {
     473:                     default:
     474:                         printf("\t%d", v);
     475:                         break;
     476:                     case TDOUBLE:
     477:                         printf("\t%f", p->real);
     478:                         break;
     479:                     case TINT:
     480: con:
     481:                         printf("\t%ld", p->range[0]);
     482:                         break;
     483:                     case TSTR:
     484:                         printf("\t'%s'", v);
     485:                         break;
     486:                     }
     487:                 break;
     488:             case VAR:
     489:             case REF:
     490:             case WITHPTR:
     491:                 printf("\t%d,%d", cbn, v);
     492:                 break;
     493:             case SCAL:
     494:             case RANGE:
     495:                 printf("\t%ld..%ld", p->range[0], p->range[1]);
     496:                 break;
     497:             case RECORD:
     498:                 printf("\t%d(%d)", v, p->value[NL_FLDSZ]);
     499:                 break;
     500:             case FIELD:
     501:                 printf("\t%d", v);
     502:                 break;
     503:             case STR:
     504:                 printf("\t\"%s\"", p->value[1]);
     505:                 goto casedef;
     506:             case FVAR:
     507:             case FUNC:
     508:             case PROC:
     509:             case PROG:
     510:                 if (cbn == 0) {
     511:                     printf("\t<%o>", p->value[0] & 0377);
     512: #ifndef PI0
     513:                     if (p->value[0] & NSTAND)
     514:                         printf("\tNSTAND");
     515: #endif
     516:                     break;
     517:                 }
     518:                 v = p->value[1];
     519:             default:
     520: casedef:
     521:                 if (v)
     522:                     printf("\t<%d>", v);
     523:                 else
     524:                     printf(stars);
     525:         }
     526:         if (p->chain)
     527:             printf("\t[%d]", nloff(p->chain));
     528:         switch (p->class) {
     529:             case RECORD:
     530:                 if (p->value[NL_VARNT])
     531:                     printf("\tVARNT=[%d]", nloff(p->value[NL_VARNT]));
     532:                 if (p->value[NL_TAG])
     533:                     printf(" TAG=[%d]", nloff(p->value[NL_TAG]));
     534:                 break;
     535:             case VARNT:
     536:                 printf("\tVTOREC=[%d]", nloff(p->value[NL_VTOREC]));
     537:                 break;
     538:         }
     539:         putchar('\n');
     540:     }
     541:     if (head == 0)
     542:         printf("\tNo entries\n");
     543: }
     544: #endif
     545:
     546:
     547: /*
     548:  * Define a new name list entry
     549:  * with initial symbol, class, type
     550:  * and value[0] as given.  A new name
     551:  * list segment is allocated to hold
     552:  * the next name list slot if necessary.
     553:  */
     554: defnl(sym, cls, typ, val)
     555:     char *sym;
     556:     int cls;
     557:     struct nl *typ;
     558:     int val;
     559: {
     560:     register struct nl *p;
     561:     register int *q, i;
     562:     char *cp;
     563:
     564:     p = nlp;
     565:
     566:     /*
     567: 	 * Zero out this entry
     568: 	 */
     569:     q = p;
     570:     i = (sizeof *p)/2;
     571:     do
     572:         *q++ = 0;
     573:     while (--i);
     574:
     575:     /*
     576: 	 * Insert the values
     577: 	 */
     578:     p->symbol = sym;
     579:     p->class = cls;
     580:     p->type = typ;
     581:     p->nl_block = cbn;
     582:     p->value[0] = val;
     583:
     584:     /*
     585: 	 * Insure that the next namelist
     586: 	 * entry actually exists. This is
     587: 	 * really not needed here, it would
     588: 	 * suffice to do it at entry if we
     589: 	 * need the slot.  It is done this
     590: 	 * way because, historically, nlp
     591: 	 * always pointed at the next namelist
     592: 	 * slot.
     593: 	 */
     594:     nlp++;
     595:     if (nlp >= nlact->nls_high) {
     596:         i = NLINC;
     597:         cp = alloc(NLINC * sizeof *nlp);
     598:         if (cp == -1) {
     599:             i = NLINC / 2;
     600:             cp = alloc((NLINC / 2) * sizeof *nlp);
     601:         }
     602:         if (cp == -1) {
     603:             error("Ran out of memory (defnl)");
     604:             pexit(DIED);
     605:         }
     606:         nlact++;
     607:         if (nlact >= &ntab[MAXNL]) {
     608:             error("Ran out of name list tables");
     609:             pexit(DIED);
     610:         }
     611:         nlp = cp;
     612:         nlact->nls_low = nlp;
     613:         nlact->nls_high = nlact->nls_low + i;
     614:     }
     615:     return (p);
     616: }
     617:
     618: /*
     619:  * Make a duplicate of the argument
     620:  * namelist entry for, e.g., type
     621:  * declarations of the form 'type a = b'
     622:  * and array indicies.
     623:  */
     624: nlcopy(p)
     625:     struct nl *p;
     626: {
     627:     register int *p1, *p2, i;
     628:
     629:     p1 = p;
     630:     p = p2 = defnl(0, 0, 0, 0);
     631:     i = (sizeof *p)/2;
     632:     do
     633:         *p2++ = *p1++;
     634:     while (--i);
     635:     return (p);
     636: }
     637:
     638: /*
     639:  * Compute a namelist offset
     640:  */
     641: nloff(p)
     642:     struct nl *p;
     643: {
     644:
     645:     return (p - nl);
     646: }
     647:
     648: /*
     649:  * Enter a symbol into the block
     650:  * symbol table.  Symbols are hashed
     651:  * 64 ways based on low 6 bits of the
     652:  * character pointer into the string
     653:  * table.
     654:  */
     655: enter(np)
     656:     struct nl *np;
     657: {
     658:     register struct nl *rp, *hp;
     659:     register struct nl *p;
     660:     int i;
     661:
     662:     rp = np;
     663:     if (rp == NIL)
     664:         return (NIL);
     665: #ifndef PI1
     666:     if (cbn > 0)
     667:         if (rp->symbol == input->symbol || rp->symbol == output->symbol)
     668:             error("Pre-defined files input and output must not be redefined");
     669: #endif
     670:     i = rp->symbol;
     671:     i &= 077;
     672:     hp = disptab[i];
     673:     if (rp->class != BADUSE && rp->class != FIELD)
     674:     for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next)
     675:         if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) {
     676: #ifndef PI1
     677:             error("%s is already defined in this block", rp->symbol);
     678: #endif
     679:             break;
     680:
     681:         }
     682:     rp->nl_next = hp;
     683:     disptab[i] = rp;
     684:     return (rp);
     685: }
     686: #endif
     687:
     688: double  MININT      = -2147483648.;
     689: double  MAXINT      = 2147483647.;
     690:
     691: char *
     692: alloc(i)
     693: {
     694: char *cp = malloc(i);
     695: return (cp == 0 ? -1 : cp);
     696: }

#### Defined functions

alloc defined in line 691; used 9 times

- in line 597-600(2)
- in /usr/src/ucb/pascal/pxp/0.h line 221
- in /usr/src/ucb/pascal/pxp/pmon.c line 168-171(2)
- in /usr/src/ucb/pascal/pxp/string.c line 40
- in /usr/src/ucb/pascal/pxp/subr.c line 126
- in /usr/src/ucb/pascal/pxp/tree.c line 117
- in /usr/src/ucb/pascal/pxp/yyget.c line 239

defnl defined in line 554; used 11 times

- in line 229, 241, 259-268(6), 315, 630
- in /usr/src/ucb/pascal/pxp/yyid.c line 89

dumpnl defined in line 412; used 1 times

- in /usr/src/ucb/pascal/pxp/yymain.c line 68

enter defined in line 655; used 3 times

- in line 259, 317
- in /usr/src/ucb/pascal/pxp/yyid.c line 89

hdefnl defined in line 307; used 13 times

- in line 234, 258, 266-275(6), 282, 296-303(4)

initnl defined in line 212; used 1 times

- in /usr/src/ucb/pascal/pxp/yymain.c line 58

nlcopy defined in line 624; never used
nlfree defined in line 327; never used
nloff defined in line 641; used 7 times

- in line 438, 462, 472, 527-536(4)

#### Defined variables

MAXINT defined in line 689; used 3 times

- in line 221, 251, 287

MININT defined in line 688; used 3 times

- in line 220, 250, 286

VARIABLE defined in line 343; used 3 times

- in line 349, 356-357(2)

biltins defined in line 16; used 1 times

- in line 233

classes defined in line 345; never used
ctext defined in line 377; used 1 times

- in line 444

nl defined in line 205; used 13 times

- in line 227-228(2), 241-242(2), 250-251(2), 258-268(5), 282, 645

nlact defined in line 206; used 14 times

- in line 332-337(7), 424, 595, 606-613(5)

nlp defined in line 205; used 18 times

- in line 234, 259-260(2), 266-267(2), 286-287(2), 331-332(3), 426, 564, 594-600(4), 611-612(2)

ntab defined in line 206; used 5 times

- in line 227-228(2), 337, 428, 607

snark defined in line 373; never used
stars defined in line 404; used 5 times

- in line 442-446(2), 460-464(2), 524

#### Defined struct's

nls defined in line 199; used 4 times

- in line 206(2), 417(2)

Last modified: 1986-06-01 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 969 |