Return to nl.c CVS log

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

Annotation of 3BSD/cmd/pi/nl.c, revision 1.1

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

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