Return to nl.c CVS log

Up to [CSRG BSD Unix] / 42BSD / ucb / pascal / src

Annotation of 42BSD/ucb/pascal/src/nl.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.