Return to nl.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / ucb / pascal / src

Annotation of 43BSDTahoe/ucb/pascal/src/nl.c, revision 1.1

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

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