Return to nl.c CVS log

Up to [Research Unix] / researchv10dc / cmd / pascal / pc0

Annotation of researchv10dc/cmd/pascal/pc0/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.5 6/1/81";
        !             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|NSTAND,
        !           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(); where is this? */
        !           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 = (struct nl*)*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: #      ifdef PC
        !           340:            input -> extra_flags |= NGLOBAL;
        !           341:            output -> extra_flags |= NGLOBAL;
        !           342: #      endif PC
        !           343: 
        !           344:        /*
        !           345:         *      built in constants
        !           346:         */
        !           347:        cp = in_consts;
        !           348:        np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
        !           349:        fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
        !           350:        (nl + TBOOL)->chain = fp;
        !           351:        fp->chain = np;
        !           352:        np = hdefnl ( *cp++ , CONST , nl + TBOOL , 1 );
        !           353:        fp = hdefnl ( *cp++ , CONST , nl + TBOOL , 0 );
        !           354:        fp->chain = np;
        !           355:        if (opt('s'))
        !           356:                (nl + TBOOL)->chain = fp;
        !           357:        hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MININT;
        !           358:        hdefnl ( *cp++ , CONST , nl + T4INT , 0 ) -> range[0] = MAXINT;
        !           359:        hdefnl ( *cp++ , CONST , nl + T1CHAR , 0 );
        !           360:        hdefnl ( *cp++ , CONST , nl + T1CHAR , 127 );
        !           361:        hdefnl ( *cp++ , CONST , nl + T1CHAR , '\007' );
        !           362:        hdefnl ( *cp++ , CONST , nl + T1CHAR , '\t' );
        !           363: 
        !           364:        /*
        !           365:         * Built-in functions and procedures
        !           366:         */
        !           367: #ifndef PI0
        !           368:        ip = in_fops;
        !           369:        for ( cp = in_funcs ; *cp != 0 ; cp ++ )
        !           370:            hdefnl ( *cp , FUNC , 0 , * ip ++ );
        !           371:        ip = in_pops;
        !           372:        for ( cp = in_procs ; *cp != 0 ; cp ++ )
        !           373:            hdefnl ( *cp , PROC , 0 , * ip ++ );
        !           374: #else
        !           375:        for ( cp = in_funcs ; *cp != 0 ; cp ++ )
        !           376:            hdefnl ( *cp , FUNC , 0 , 0 );
        !           377:        for ( cp = in_procs ; *cp != 0 , cp ++ )
        !           378:            hdefnl ( *cp , PROC , 0 , 0 );
        !           379: #endif
        !           380: #      ifdef PTREE
        !           381:            pTreeInit();
        !           382: #      endif
        !           383:     }
        !           384: 
        !           385: struct nl *
        !           386: hdefnl(sym, cls, typ, val)
        !           387: {
        !           388:        register struct nl *p;
        !           389: 
        !           390: #ifndef PI1
        !           391:        if (sym)
        !           392:                hash(sym, 0);
        !           393: #endif
        !           394:        p = defnl(sym, cls, typ, val);
        !           395:        if (sym)
        !           396:                enter(p);
        !           397:        return (p);
        !           398: }
        !           399: 
        !           400: /*
        !           401:  * Free up the name list segments
        !           402:  * at the end of a statement/proc/func
        !           403:  * All segments are freed down to the one in which
        !           404:  * p points.
        !           405:  */
        !           406: nlfree(p)
        !           407:        struct nl *p;
        !           408: {
        !           409: 
        !           410:        nlp = p;
        !           411:        while (nlact->nls_low > nlp || nlact->nls_high < nlp) {
        !           412:                free(nlact->nls_low);
        !           413:                nlact->nls_low = NIL;
        !           414:                nlact->nls_high = NIL;
        !           415:                --nlact;
        !           416:                if (nlact < &ntab[0])
        !           417:                        panic("nlfree");
        !           418:        }
        !           419: }
        !           420: 
        !           421: 
        !           422: char   *VARIABLE       = "variable";
        !           423: 
        !           424: char   *classes[ ] = {
        !           425:        "undefined",
        !           426:        "constant",
        !           427:        "type",
        !           428:        "variable",     /*      VARIABLE        */
        !           429:        "array",
        !           430:        "pointer or file",
        !           431:        "record",
        !           432:        "field",
        !           433:        "procedure",
        !           434:        "function",
        !           435:        "variable",     /*      VARIABLE        */
        !           436:        "variable",     /*      VARIABLE        */
        !           437:        "pointer",
        !           438:        "file",
        !           439:        "set",
        !           440:        "subrange",
        !           441:        "label",
        !           442:        "withptr",
        !           443:        "scalar",
        !           444:        "string",
        !           445:        "program",
        !           446:        "improper",
        !           447:        "variant",
        !           448:        "formal procedure",
        !           449:        "formal function"
        !           450: };
        !           451: 
        !           452: char   *snark  = "SNARK";
        !           453: 
        !           454: #ifdef PI
        !           455: #ifdef DEBUG
        !           456: char   *ctext[] =
        !           457: {
        !           458:        "BADUSE",
        !           459:        "CONST",
        !           460:        "TYPE",
        !           461:        "VAR",
        !           462:        "ARRAY",
        !           463:        "PTRFILE",
        !           464:        "RECORD",
        !           465:        "FIELD",
        !           466:        "PROC",
        !           467:        "FUNC",
        !           468:        "FVAR",
        !           469:        "REF",
        !           470:        "PTR",
        !           471:        "FILET",
        !           472:        "SET",
        !           473:        "RANGE",
        !           474:        "LABEL",
        !           475:        "WITHPTR",
        !           476:        "SCAL",
        !           477:        "STR",
        !           478:        "PROG",
        !           479:        "IMPROPER",
        !           480:        "VARNT",
        !           481:        "FPROC",
        !           482:        "FFUNC"
        !           483: };
        !           484: 
        !           485: char   *stars  = "\t***";
        !           486: 
        !           487: /*
        !           488:  * Dump the namelist from the
        !           489:  * current nlp down to 'to'.
        !           490:  * All the namelist is dumped if
        !           491:  * to is NIL.
        !           492:  */
        !           493: dumpnl(to, rout)
        !           494:        struct nl *to;
        !           495: {
        !           496:        register struct nl *p;
        !           497:        register int j;
        !           498:        struct nls *nlsp;
        !           499:        int i, v, head;
        !           500: 
        !           501:        if (opt('y') == 0)
        !           502:                return;
        !           503:        if (to != NIL)
        !           504:                printf("\n\"%s\" Block=%d\n", rout, cbn);
        !           505:        nlsp = nlact;
        !           506:        head = NIL;
        !           507:        for (p = nlp; p != to;) {
        !           508:                if (p == nlsp->nls_low) {
        !           509:                        if (nlsp == &ntab[0])
        !           510:                                break;
        !           511:                        nlsp--;
        !           512:                        p = nlsp->nls_high;
        !           513:                }
        !           514:                p--;
        !           515:                if (head == NIL) {
        !           516:                        printf("\tName\tClass  Bn+Flags\tType\tVal\tChn\n");
        !           517:                        head++;
        !           518:                }
        !           519:                printf("%3d:", nloff(p));
        !           520:                if (p->symbol)
        !           521:                        printf("\t%.7s", p->symbol);
        !           522:                else
        !           523:                        printf(stars);
        !           524:                if (p->class)
        !           525:                        printf("\t%s", ctext[p->class]);
        !           526:                else
        !           527:                        printf(stars);
        !           528:                if (p->nl_flags) {
        !           529:                        pchr('\t');
        !           530:                        if (p->nl_flags & 037)
        !           531:                                printf("%d ", p->nl_flags & 037);
        !           532: #ifndef PI0
        !           533:                        if (p->nl_flags & NMOD)
        !           534:                                pchr('M');
        !           535:                        if (p->nl_flags & NUSED)
        !           536:                                pchr('U');
        !           537: #endif
        !           538:                        if (p->nl_flags & NFILES)
        !           539:                                pchr('F');
        !           540:                } else
        !           541:                        printf(stars);
        !           542:                if (p->type)
        !           543:                        printf("\t[%d]", nloff(p->type));
        !           544:                else
        !           545:                        printf(stars);
        !           546:                v = p->value[0];
        !           547:                switch (p->class) {
        !           548:                        case TYPE:
        !           549:                                break;
        !           550:                        case VARNT:
        !           551:                                goto con;
        !           552:                        case CONST:
        !           553:                                switch (nloff(p->type)) {
        !           554:                                        default:
        !           555:                                                printf("\t%d", v);
        !           556:                                                break;
        !           557:                                        case TDOUBLE:
        !           558:                                                printf("\t%f", p->real);
        !           559:                                                break;
        !           560:                                        case TINT:
        !           561:                                        case T4INT:
        !           562: con:
        !           563:                                                printf("\t%ld", p->range[0]);
        !           564:                                                break;
        !           565:                                        case TSTR:
        !           566:                                                printf("\t'%s'", p->ptr[0]);
        !           567:                                                break;
        !           568:                                        }
        !           569:                                break;
        !           570:                        case VAR:
        !           571:                        case REF:
        !           572:                        case WITHPTR:
        !           573:                        case FFUNC:
        !           574:                        case FPROC:
        !           575:                                printf("\t%d,%d", cbn, v);
        !           576:                                break;
        !           577:                        case SCAL:
        !           578:                        case RANGE:
        !           579:                                printf("\t%ld..%ld", p->range[0], p->range[1]);
        !           580:                                break;
        !           581:                        case RECORD:
        !           582:                                printf("\t%d(%d)", v, p->value[NL_FLDSZ]);
        !           583:                                break;
        !           584:                        case FIELD:
        !           585:                                printf("\t%d", v);
        !           586:                                break;
        !           587:                        case STR:
        !           588:                                printf("\t|%d|", p->value[0]);
        !           589:                                break;
        !           590:                        case FVAR:
        !           591:                        case FUNC:
        !           592:                        case PROC:
        !           593:                        case PROG:
        !           594:                                if (cbn == 0) {
        !           595:                                        printf("\t<%o>", p->value[0] & 0377);
        !           596: #ifndef PI0
        !           597:                                        if (p->value[0] & NSTAND)
        !           598:                                                printf("\tNSTAND");
        !           599: #endif
        !           600:                                        break;
        !           601:                                }
        !           602:                                v = p->value[1];
        !           603:                        default:
        !           604: casedef:
        !           605:                                if (v)
        !           606:                                        printf("\t<%d>", v);
        !           607:                                else
        !           608:                                        printf(stars);
        !           609:                }
        !           610:                if (p->chain)
        !           611:                        printf("\t[%d]", nloff(p->chain));
        !           612:                switch (p->class) {
        !           613:                        case RECORD:
        !           614:                                if (p->ptr[NL_VARNT])
        !           615:                                        printf("\tVARNT=[%d]", nloff(p->ptr[NL_VARNT]));
        !           616:                                if (p->ptr[NL_TAG])
        !           617:                                        printf(" TAG=[%d]", nloff(p->ptr[NL_TAG]));
        !           618:                                break;
        !           619:                        case VARNT:
        !           620:                                printf("\tVTOREC=[%d]", nloff(p->ptr[NL_VTOREC]));
        !           621:                                break;
        !           622:                }
        !           623: #              ifdef PC
        !           624:                    if ( p -> extra_flags != 0 ) {
        !           625:                        pchr( '\t' );
        !           626:                        if ( p -> extra_flags & NEXTERN )
        !           627:                            printf( "NEXTERN " );
        !           628:                        if ( p -> extra_flags & NLOCAL )
        !           629:                            printf( "NLOCAL " );
        !           630:                        if ( p -> extra_flags & NPARAM )
        !           631:                            printf( "NPARAM " );
        !           632:                        if ( p -> extra_flags & NGLOBAL )
        !           633:                            printf( "NGLOBAL " );
        !           634:                        if ( p -> extra_flags & NREGVAR )
        !           635:                            printf( "NREGVAR " );
        !           636:                    }
        !           637: #              endif PC
        !           638: #              ifdef PTREE
        !           639:                    pchr( '\t' );
        !           640:                    pPrintPointer( stdout , "%s" , p -> inTree );
        !           641: #              endif
        !           642:                pchr('\n');
        !           643:        }
        !           644:        if (head == 0)
        !           645:                printf("\tNo entries\n");
        !           646: }
        !           647: #endif
        !           648: 
        !           649: 
        !           650: /*
        !           651:  * Define a new name list entry
        !           652:  * with initial symbol, class, type
        !           653:  * and value[0] as given.  A new name
        !           654:  * list segment is allocated to hold
        !           655:  * the next name list slot if necessary.
        !           656:  */
        !           657: struct nl *
        !           658: defnl(sym, cls, typ, val)
        !           659:        char *sym;
        !           660:        int cls;
        !           661:        struct nl *typ;
        !           662:        int val;
        !           663: {
        !           664:        register struct nl *p;
        !           665:        register int *q, i;
        !           666:        char *cp;
        !           667: 
        !           668:        p = nlp;
        !           669: 
        !           670:        /*
        !           671:         * Zero out this entry
        !           672:         */
        !           673:        q = (int*)p;
        !           674:        i = (sizeof *p)/(sizeof (int));
        !           675:        do
        !           676:                *q++ = 0;
        !           677:        while (--i);
        !           678: 
        !           679:        /*
        !           680:         * Insert the values
        !           681:         */
        !           682:        p->symbol = sym;
        !           683:        p->class = cls;
        !           684:        p->type = typ;
        !           685:        p->nl_block = cbn;
        !           686:        p->value[0] = val;
        !           687: 
        !           688:        /*
        !           689:         * Insure that the next namelist
        !           690:         * entry actually exists. This is
        !           691:         * really not needed here, it would
        !           692:         * suffice to do it at entry if we
        !           693:         * need the slot.  It is done this
        !           694:         * way because, historically, nlp
        !           695:         * always pointed at the next namelist
        !           696:         * slot.
        !           697:         */
        !           698:        nlp++;
        !           699:        if (nlp >= nlact->nls_high) {
        !           700:                i = NLINC;
        !           701:                cp = (char*)malloc(NLINC * sizeof *nlp);
        !           702:                if (cp == 0) {
        !           703:                        i = NLINC / 2;
        !           704:                        cp = (char*)malloc((NLINC / 2) * sizeof *nlp);
        !           705:                }
        !           706:                if (cp == 0) {
        !           707:                        error("Ran out of memory (defnl)");
        !           708:                        pexit(DIED);
        !           709:                }
        !           710:                nlact++;
        !           711:                if (nlact >= &ntab[MAXNL]) {
        !           712:                        error("Ran out of name list tables");
        !           713:                        pexit(DIED);
        !           714:                }
        !           715:                nlp = (struct nl*)cp;
        !           716:                nlact->nls_low = nlp;
        !           717:                nlact->nls_high = nlact->nls_low + i;
        !           718:        }
        !           719:        return (p);
        !           720: }
        !           721: 
        !           722: /*
        !           723:  * Make a duplicate of the argument
        !           724:  * namelist entry for, e.g., type
        !           725:  * declarations of the form 'type a = b'
        !           726:  * and array indicies.
        !           727:  */
        !           728: struct nl *
        !           729: nlcopy(p)
        !           730:        struct nl *p;
        !           731: {
        !           732:        register int *p1, *p2, i;
        !           733: 
        !           734:        p1 = (int*)p;
        !           735:        p = (struct nl*) (p2 = (int*)defnl(0, 0, 0, 0));
        !           736:        i = (sizeof *p)/(sizeof (int));
        !           737:        do
        !           738:                *p2++ = *p1++;
        !           739:        while (--i);
        !           740:        p->chain = NIL;
        !           741:        return (p);
        !           742: }
        !           743: 
        !           744: /*
        !           745:  * Compute a namelist offset
        !           746:  */
        !           747: nloff(p)
        !           748:        struct nl *p;
        !           749: {
        !           750: 
        !           751:        return (p - nl);
        !           752: }
        !           753: 
        !           754: /*
        !           755:  * Enter a symbol into the block
        !           756:  * symbol table.  Symbols are hashed
        !           757:  * 64 ways based on low 6 bits of the
        !           758:  * character pointer into the string
        !           759:  * table.
        !           760:  */
        !           761: struct nl *
        !           762: enter(np)
        !           763:        struct nl *np;
        !           764: {
        !           765:        register struct nl *rp, *hp;
        !           766:        register struct nl *p;
        !           767:        int i;
        !           768: 
        !           769:        rp = np;
        !           770:        if (rp == NIL)
        !           771:                return (NIL);
        !           772: #ifndef PI1
        !           773:        if (cbn > 0)
        !           774:                if (rp->symbol == input->symbol || rp->symbol == output->symbol)
        !           775:                        error("Pre-defined files input and output must not be redefined");
        !           776: #endif
        !           777:        i = (int)rp->symbol;
        !           778:        i &= 077;
        !           779:        hp = disptab[i];
        !           780:        if (rp->class != BADUSE && rp->class != FIELD)
        !           781:        for (p = hp; p != NIL && (p->nl_block & 037) == cbn; p = p->nl_next)
        !           782:                if (p->symbol == rp->symbol && p->class != BADUSE && p->class != FIELD) {
        !           783: #ifndef PI1
        !           784:                        error("%s is already defined in this block", rp->symbol);
        !           785: #endif
        !           786:                        break;
        !           787: 
        !           788:                }
        !           789:        rp->nl_next = hp;
        !           790:        disptab[i] = rp;
        !           791:        return (rp);
        !           792: }
        !           793: #endif

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