Return to nl.c CVS log

Up to [CSRG BSD Unix] / 41BSD / cmd / pi

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

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