Return to proc.c CVS log

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

Annotation of 43BSDTahoe/ucb/pascal/src/proc.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[] = "@(#)proc.c     5.1 (Berkeley) 6/5/85";
        !             9: #endif not lint
        !            10: 
        !            11: #include "whoami.h"
        !            12: #ifdef OBJ
        !            13:     /*
        !            14:      * and the rest of the file
        !            15:      */
        !            16: #include "0.h"
        !            17: #include "tree.h"
        !            18: #include "opcode.h"
        !            19: #include "objfmt.h"
        !            20: #include "tmps.h"
        !            21: #include "tree_ty.h"
        !            22: 
        !            23: /*
        !            24:  * The constant EXPOSIZE specifies the number of digits in the exponent
        !            25:  * of real numbers.
        !            26:  *
        !            27:  * The constant REALSPC defines the amount of forced padding preceeding
        !            28:  * real numbers when they are printed. If REALSPC == 0, then no padding
        !            29:  * is added, REALSPC == 1 adds one extra blank irregardless of the width
        !            30:  * specified by the user.
        !            31:  *
        !            32:  * N.B. - Values greater than one require program mods.
        !            33:  */
        !            34: #define EXPOSIZE       2
        !            35: #define        REALSPC         0
        !            36: 
        !            37: /*
        !            38:  * The following array is used to determine which classes may be read
        !            39:  * from textfiles. It is indexed by the return value from classify.
        !            40:  */
        !            41: #define rdops(x) rdxxxx[(x)-(TFIRST)]
        !            42: 
        !            43: int rdxxxx[] = {
        !            44:        0,              /* -7 file types */
        !            45:        0,              /* -6 record types */
        !            46:        0,              /* -5 array types */
        !            47:        O_READE,        /* -4 scalar types */
        !            48:        0,              /* -3 pointer types */
        !            49:        0,              /* -2 set types */
        !            50:        0,              /* -1 string types */
        !            51:        0,              /*  0 nil, no type */
        !            52:        O_READE,        /*  1 boolean */
        !            53:        O_READC,        /*  2 character */
        !            54:        O_READ4,        /*  3 integer */
        !            55:        O_READ8         /*  4 real */
        !            56: };
        !            57: 
        !            58: /*
        !            59:  * Proc handles procedure calls.
        !            60:  * Non-builtin procedures are "buck-passed" to func (with a flag
        !            61:  * indicating that they are actually procedures.
        !            62:  * builtin procedures are handled here.
        !            63:  */
        !            64: proc(r)
        !            65:        struct tnode *r;
        !            66: {
        !            67:        register struct nl *p;
        !            68:        register struct tnode *alv, *al;
        !            69:        register int op;
        !            70:        struct nl *filetype, *ap, *al1;
        !            71:        int argc, typ, fmtspec, strfmt, stkcnt;
        !            72:        struct tnode *argv; 
        !            73:        char fmt, format[20], *strptr, *pu;
        !            74:        int prec, field, strnglen, fmtlen, fmtstart;
        !            75:        struct tnode *pua, *pui, *puz, *file;
        !            76:        int i, j, k;
        !            77:        int itemwidth;
        !            78:        struct tmps soffset;
        !            79:        struct nl       *tempnlp;
        !            80: 
        !            81: #define        CONPREC 4
        !            82: #define        VARPREC 8
        !            83: #define        CONWIDTH 1
        !            84: #define        VARWIDTH 2
        !            85: #define SKIP 16
        !            86: 
        !            87:        /*
        !            88:         * Verify that the name is
        !            89:         * defined and is that of a
        !            90:         * procedure.
        !            91:         */
        !            92:        p = lookup(r->pcall_node.proc_id);
        !            93:        if (p == NIL) {
        !            94:                rvlist(r->pcall_node.arg);
        !            95:                return;
        !            96:        }
        !            97:        if (p->class != PROC && p->class != FPROC) {
        !            98:                error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
        !            99:                rvlist(r->pcall_node.arg);
        !           100:                return;
        !           101:        }
        !           102:        argv = r->pcall_node.arg;
        !           103: 
        !           104:        /*
        !           105:         * Call handles user defined
        !           106:         * procedures and functions.
        !           107:         */
        !           108:        if (bn != 0) {
        !           109:                (void) call(p, argv, PROC, bn);
        !           110:                return;
        !           111:        }
        !           112: 
        !           113:        /*
        !           114:         * Call to built-in procedure.
        !           115:         * Count the arguments.
        !           116:         */
        !           117:        argc = 0;
        !           118:        for (al = argv; al != TR_NIL; al = al->list_node.next)
        !           119:                argc++;
        !           120: 
        !           121:        /*
        !           122:         * Switch on the operator
        !           123:         * associated with the built-in
        !           124:         * procedure in the namelist
        !           125:         */
        !           126:        op = p->value[0] &~ NSTAND;
        !           127:        if (opt('s') && (p->value[0] & NSTAND)) {
        !           128:                standard();
        !           129:                error("%s is a nonstandard procedure", p->symbol);
        !           130:        }
        !           131:        switch (op) {
        !           132: 
        !           133:        case O_ABORT:
        !           134:                if (argc != 0)
        !           135:                        error("null takes no arguments");
        !           136:                return;
        !           137: 
        !           138:        case O_FLUSH:
        !           139:                if (argc == 0) {
        !           140:                        (void) put(1, O_MESSAGE);
        !           141:                        return;
        !           142:                }
        !           143:                if (argc != 1) {
        !           144:                        error("flush takes at most one argument");
        !           145:                        return;
        !           146:                }
        !           147:                ap = stklval(argv->list_node.list, NIL );
        !           148:                if (ap == NLNIL)
        !           149:                        return;
        !           150:                if (ap->class != FILET) {
        !           151:                        error("flush's argument must be a file, not %s", nameof(ap));
        !           152:                        return;
        !           153:                }
        !           154:                (void) put(1, op);
        !           155:                return;
        !           156: 
        !           157:        case O_MESSAGE:
        !           158:        case O_WRITEF:
        !           159:        case O_WRITLN:
        !           160:                /*
        !           161:                 * Set up default file "output"'s type
        !           162:                 */
        !           163:                file = NIL;
        !           164:                filetype = nl+T1CHAR;
        !           165:                /*
        !           166:                 * Determine the file implied
        !           167:                 * for the write and generate
        !           168:                 * code to make it the active file.
        !           169:                 */
        !           170:                if (op == O_MESSAGE) {
        !           171:                        /*
        !           172:                         * For message, all that matters
        !           173:                         * is that the filetype is
        !           174:                         * a character file.
        !           175:                         * Thus "output" will suit us fine.
        !           176:                         */
        !           177:                        (void) put(1, O_MESSAGE);
        !           178:                } else if (argv != TR_NIL && (al = argv->list_node.list)->tag !=
        !           179:                                        T_WEXP) {
        !           180:                        /*
        !           181:                         * If there is a first argument which has
        !           182:                         * no write widths, then it is potentially
        !           183:                         * a file name.
        !           184:                         */
        !           185:                        codeoff();
        !           186:                        ap = stkrval(argv->list_node.list, NLNIL, (long) RREQ );
        !           187:                        codeon();
        !           188:                        if (ap == NLNIL)
        !           189:                                argv = argv->list_node.next;
        !           190:                        if (ap != NLNIL && ap->class == FILET) {
        !           191:                                /*
        !           192:                                 * Got "write(f, ...", make
        !           193:                                 * f the active file, and save
        !           194:                                 * it and its type for use in
        !           195:                                 * processing the rest of the
        !           196:                                 * arguments to write.
        !           197:                                 */
        !           198:                                file = argv->list_node.list;
        !           199:                                filetype = ap->type;
        !           200:                                (void) stklval(argv->list_node.list, NIL );
        !           201:                                (void) put(1, O_UNIT);
        !           202:                                /*
        !           203:                                 * Skip over the first argument
        !           204:                                 */
        !           205:                                argv = argv->list_node.next;
        !           206:                                argc--;
        !           207:                        } else {
        !           208:                                /*
        !           209:                                 * Set up for writing on 
        !           210:                                 * standard output.
        !           211:                                 */
        !           212:                                (void) put(1, O_UNITOUT);
        !           213:                                output->nl_flags |= NUSED;
        !           214:                        }
        !           215:                } else {
        !           216:                        (void) put(1, O_UNITOUT);
        !           217:                        output->nl_flags |= NUSED;
        !           218:                }
        !           219:                /*
        !           220:                 * Loop and process each
        !           221:                 * of the arguments.
        !           222:                 */
        !           223:                for (; argv != TR_NIL; argv = argv->list_node.next) {
        !           224:                        /*
        !           225:                         * fmtspec indicates the type (CONstant or VARiable)
        !           226:                         *      and number (none, WIDTH, and/or PRECision)
        !           227:                         *      of the fields in the printf format for this
        !           228:                         *      output variable.
        !           229:                         * stkcnt is the number of bytes pushed on the stack
        !           230:                         * fmt is the format output indicator (D, E, F, O, X, S)
        !           231:                         * fmtstart = 0 for leading blank; = 1 for no blank
        !           232:                         */
        !           233:                        fmtspec = NIL;
        !           234:                        stkcnt = 0;
        !           235:                        fmt = 'D';
        !           236:                        fmtstart = 1;
        !           237:                        al = argv->list_node.list;
        !           238:                        if (al == TR_NIL)
        !           239:                                continue;
        !           240:                        if (al->tag == T_WEXP)
        !           241:                                alv = al->wexpr_node.expr1;
        !           242:                        else
        !           243:                                alv = al;
        !           244:                        if (alv == TR_NIL)
        !           245:                                continue;
        !           246:                        codeoff();
        !           247:                        ap = stkrval(alv, NLNIL , (long) RREQ );
        !           248:                        codeon();
        !           249:                        if (ap == NLNIL)
        !           250:                                continue;
        !           251:                        typ = classify(ap);
        !           252:                        if (al->tag == T_WEXP) {
        !           253:                                /*
        !           254:                                 * Handle width expressions.
        !           255:                                 * The basic game here is that width
        !           256:                                 * expressions get evaluated. If they
        !           257:                                 * are constant, the value is placed
        !           258:                                 * directly in the format string.
        !           259:                                 * Otherwise the value is pushed onto
        !           260:                                 * the stack and an indirection is
        !           261:                                 * put into the format string.
        !           262:                                 */
        !           263:                                if (al->wexpr_node.expr3 == 
        !           264:                                                (struct tnode *) OCT)
        !           265:                                        fmt = 'O';
        !           266:                                else if (al->wexpr_node.expr3 == 
        !           267:                                                (struct tnode *) HEX)
        !           268:                                        fmt = 'X';
        !           269:                                else if (al->wexpr_node.expr3 != TR_NIL) {
        !           270:                                        /*
        !           271:                                         * Evaluate second format spec
        !           272:                                         */
        !           273:                                        if ( constval(al->wexpr_node.expr3)
        !           274:                                            && isa( con.ctype , "i" ) ) {
        !           275:                                                fmtspec += CONPREC;
        !           276:                                                prec = con.crval;
        !           277:                                        } else {
        !           278:                                                fmtspec += VARPREC;
        !           279:                                        }
        !           280:                                        fmt = 'f';
        !           281:                                        switch ( typ ) {
        !           282:                                        case TINT:
        !           283:                                                if ( opt( 's' ) ) {
        !           284:                                                    standard();
        !           285:                                                    error("Writing %ss with two write widths is non-standard", clnames[typ]);
        !           286:                                                }
        !           287:                                                /* and fall through */
        !           288:                                        case TDOUBLE:
        !           289:                                                break;
        !           290:                                        default:
        !           291:                                                error("Cannot write %ss with two write widths", clnames[typ]);
        !           292:                                                continue;
        !           293:                                        }
        !           294:                                }
        !           295:                                /*
        !           296:                                 * Evaluate first format spec
        !           297:                                 */
        !           298:                                if (al->wexpr_node.expr2 != TR_NIL) {
        !           299:                                        if ( constval(al->wexpr_node.expr2)
        !           300:                                            && isa( con.ctype , "i" ) ) {
        !           301:                                                fmtspec += CONWIDTH;
        !           302:                                                field = con.crval;
        !           303:                                        } else {
        !           304:                                                fmtspec += VARWIDTH;
        !           305:                                        }
        !           306:                                }
        !           307:                                if ((fmtspec & CONPREC) && prec < 0 ||
        !           308:                                    (fmtspec & CONWIDTH) && field < 0) {
        !           309:                                        error("Negative widths are not allowed");
        !           310:                                        continue;
        !           311:                                }
        !           312:                                if ( opt('s') &&
        !           313:                                    ((fmtspec & CONPREC) && prec == 0 ||
        !           314:                                    (fmtspec & CONWIDTH) && field == 0)) {
        !           315:                                        standard();
        !           316:                                        error("Zero widths are non-standard");
        !           317:                                }
        !           318:                        }
        !           319:                        if (filetype != nl+T1CHAR) {
        !           320:                                if (fmt == 'O' || fmt == 'X') {
        !           321:                                        error("Oct/hex allowed only on text files");
        !           322:                                        continue;
        !           323:                                }
        !           324:                                if (fmtspec) {
        !           325:                                        error("Write widths allowed only on text files");
        !           326:                                        continue;
        !           327:                                }
        !           328:                                /*
        !           329:                                 * Generalized write, i.e.
        !           330:                                 * to a non-textfile.
        !           331:                                 */
        !           332:                                (void) stklval(file, NIL );
        !           333:                                (void) put(1, O_FNIL);
        !           334:                                /*
        !           335:                                 * file^ := ...
        !           336:                                 */
        !           337:                                ap = rvalue(argv->list_node.list, NLNIL, LREQ);
        !           338:                                if (ap == NLNIL)
        !           339:                                        continue;
        !           340:                                if (incompat(ap, filetype,
        !           341:                                                argv->list_node.list)) {
        !           342:                                        cerror("Type mismatch in write to non-text file");
        !           343:                                        continue;
        !           344:                                }
        !           345:                                convert(ap, filetype);
        !           346:                                (void) put(2, O_AS, width(filetype));
        !           347:                                /*
        !           348:                                 * put(file)
        !           349:                                 */
        !           350:                                (void) put(1, O_PUT);
        !           351:                                continue;
        !           352:                        }
        !           353:                        /*
        !           354:                         * Write to a textfile
        !           355:                         *
        !           356:                         * Evaluate the expression
        !           357:                         * to be written.
        !           358:                         */
        !           359:                        if (fmt == 'O' || fmt == 'X') {
        !           360:                                if (opt('s')) {
        !           361:                                        standard();
        !           362:                                        error("Oct and hex are non-standard");
        !           363:                                }
        !           364:                                if (typ == TSTR || typ == TDOUBLE) {
        !           365:                                        error("Can't write %ss with oct/hex", clnames[typ]);
        !           366:                                        continue;
        !           367:                                }
        !           368:                                if (typ == TCHAR || typ == TBOOL)
        !           369:                                        typ = TINT;
        !           370:                        }
        !           371:                        /*
        !           372:                         * Place the arguement on the stack. If there is
        !           373:                         * no format specified by the programmer, implement
        !           374:                         * the default.
        !           375:                         */
        !           376:                        switch (typ) {
        !           377:                        case TPTR:
        !           378:                                warning();
        !           379:                                if (opt('s')) {
        !           380:                                        standard();
        !           381:                                }
        !           382:                                error("Writing %ss to text files is non-standard",
        !           383:                                    clnames[typ]);
        !           384:                                /* and fall through */
        !           385:                        case TINT:
        !           386:                                if (fmt != 'f') {
        !           387:                                        ap = stkrval(alv, NLNIL, (long) RREQ );
        !           388:                                        stkcnt += sizeof(long);
        !           389:                                } else {
        !           390:                                        ap = stkrval(alv, NLNIL, (long) RREQ );
        !           391:                                        (void) put(1, O_ITOD);
        !           392:                                        stkcnt += sizeof(double);
        !           393:                                        typ = TDOUBLE;
        !           394:                                        goto tdouble;
        !           395:                                }
        !           396:                                if (fmtspec == NIL) {
        !           397:                                        if (fmt == 'D')
        !           398:                                                field = 10;
        !           399:                                        else if (fmt == 'X')
        !           400:                                                field = 8;
        !           401:                                        else if (fmt == 'O')
        !           402:                                                field = 11;
        !           403:                                        else
        !           404:                                                panic("fmt1");
        !           405:                                        fmtspec = CONWIDTH;
        !           406:                                }
        !           407:                                break;
        !           408:                        case TCHAR:
        !           409:                             tchar:
        !           410:                                if (fmtspec == NIL) {
        !           411:                                        (void) put(1, O_FILE);
        !           412:                                        ap = stkrval(alv, NLNIL, (long) RREQ );
        !           413:                                        convert(nl + T4INT, INT_TYP);
        !           414:                                        (void) put(2, O_WRITEC,
        !           415:                                                sizeof(char *) + sizeof(int));
        !           416:                                        fmtspec = SKIP;
        !           417:                                        break;
        !           418:                                }
        !           419:                                ap = stkrval(alv, NLNIL , (long) RREQ );
        !           420:                                convert(nl + T4INT, INT_TYP);
        !           421:                                stkcnt += sizeof(int);
        !           422:                                fmt = 'c';
        !           423:                                break;
        !           424:                        case TSCAL:
        !           425:                                warning();
        !           426:                                if (opt('s')) {
        !           427:                                        standard();
        !           428:                                }
        !           429:                                error("Writing %ss to text files is non-standard",
        !           430:                                    clnames[typ]);
        !           431:                                /* and fall through */
        !           432:                        case TBOOL:
        !           433:                                (void) stkrval(alv, NLNIL , (long) RREQ );
        !           434:                                (void) put(2, O_NAM, (long)listnames(ap));
        !           435:                                stkcnt += sizeof(char *);
        !           436:                                fmt = 's';
        !           437:                                break;
        !           438:                        case TDOUBLE:
        !           439:                                ap = stkrval(alv, (struct nl *) TDOUBLE , (long) RREQ );
        !           440:                                stkcnt += sizeof(double);
        !           441:                             tdouble:
        !           442:                                switch (fmtspec) {
        !           443:                                case NIL:
        !           444:                                        field = 14 + (5 + EXPOSIZE);
        !           445:                                        prec = field - (5 + EXPOSIZE);
        !           446:                                        fmt = 'e';
        !           447:                                        fmtspec = CONWIDTH + CONPREC;
        !           448:                                        break;
        !           449:                                case CONWIDTH:
        !           450:                                        field -= REALSPC;
        !           451:                                        if (field < 1)
        !           452:                                                field = 1;
        !           453:                                        prec = field - (5 + EXPOSIZE);
        !           454:                                        if (prec < 1)
        !           455:                                                prec = 1;
        !           456:                                        fmtspec += CONPREC;
        !           457:                                        fmt = 'e';
        !           458:                                        break;
        !           459:                                case CONWIDTH + CONPREC:
        !           460:                                case CONWIDTH + VARPREC:
        !           461:                                        field -= REALSPC;
        !           462:                                        if (field < 1)
        !           463:                                                field = 1;
        !           464:                                }
        !           465:                                format[0] = ' ';
        !           466:                                fmtstart = 1 - REALSPC;
        !           467:                                break;
        !           468:                        case TSTR:
        !           469:                                (void) constval( alv );
        !           470:                                switch ( classify( con.ctype ) ) {
        !           471:                                    case TCHAR:
        !           472:                                        typ = TCHAR;
        !           473:                                        goto tchar;
        !           474:                                    case TSTR:
        !           475:                                        strptr = con.cpval;
        !           476:                                        for (strnglen = 0;  *strptr++;  strnglen++) /* void */;
        !           477:                                        strptr = con.cpval;
        !           478:                                        break;
        !           479:                                    default:
        !           480:                                        strnglen = width(ap);
        !           481:                                        break;
        !           482:                                }
        !           483:                                fmt = 's';
        !           484:                                strfmt = fmtspec;
        !           485:                                if (fmtspec == NIL) {
        !           486:                                        fmtspec = SKIP;
        !           487:                                        break;
        !           488:                                }
        !           489:                                if (fmtspec & CONWIDTH) {
        !           490:                                        if (field <= strnglen) {
        !           491:                                                fmtspec = SKIP;
        !           492:                                                break;
        !           493:                                        } else
        !           494:                                                field -= strnglen;
        !           495:                                }
        !           496:                                /*
        !           497:                                 * push string to implement leading blank padding
        !           498:                                 */
        !           499:                                (void) put(2, O_LVCON, 2);
        !           500:                                putstr("", 0);
        !           501:                                stkcnt += sizeof(char *);
        !           502:                                break;
        !           503:                        default:
        !           504:                                error("Can't write %ss to a text file", clnames[typ]);
        !           505:                                continue;
        !           506:                        }
        !           507:                        /*
        !           508:                         * If there is a variable precision, evaluate it onto
        !           509:                         * the stack
        !           510:                         */
        !           511:                        if (fmtspec & VARPREC) {
        !           512:                                ap = stkrval(al->wexpr_node.expr3, NLNIL ,
        !           513:                                                (long) RREQ );
        !           514:                                if (ap == NIL)
        !           515:                                        continue;
        !           516:                                if (isnta(ap,"i")) {
        !           517:                                        error("Second write width must be integer, not %s", nameof(ap));
        !           518:                                        continue;
        !           519:                                }
        !           520:                                if ( opt( 't' ) ) {
        !           521:                                    (void) put(3, O_MAX, 0, 0);
        !           522:                                }
        !           523:                                convert(nl+T4INT, INT_TYP);
        !           524:                                stkcnt += sizeof(int);
        !           525:                        }
        !           526:                        /*
        !           527:                         * If there is a variable width, evaluate it onto
        !           528:                         * the stack
        !           529:                         */
        !           530:                        if (fmtspec & VARWIDTH) {
        !           531:                                if ( ( typ == TDOUBLE && fmtspec == VARWIDTH )
        !           532:                                    || typ == TSTR ) {
        !           533:                                        soffset = sizes[cbn].curtmps;
        !           534:                                        tempnlp = tmpalloc((long) (sizeof(long)),
        !           535:                                                nl+T4INT, REGOK);
        !           536:                                        (void) put(2, O_LV | cbn << 8 + INDX, 
        !           537:                                            tempnlp -> value[ NL_OFFS ] );
        !           538:                                }
        !           539:                                ap = stkrval(al->wexpr_node.expr2, NLNIL, (long) RREQ );
        !           540:                                if (ap == NIL)
        !           541:                                        continue;
        !           542:                                if (isnta(ap,"i")) {
        !           543:                                        error("First write width must be integer, not %s", nameof(ap));
        !           544:                                        continue;
        !           545:                                }
        !           546:                                /*
        !           547:                                 * Perform special processing on widths based
        !           548:                                 * on data type 
        !           549:                                 */
        !           550:                                switch (typ) {
        !           551:                                case TDOUBLE:
        !           552:                                        if (fmtspec == VARWIDTH) {
        !           553:                                                fmt = 'e';
        !           554:                                                (void) put(1, O_AS4);
        !           555:                                                (void) put(2, O_RV4 | cbn << 8 + INDX,
        !           556:                                                    tempnlp -> value[NL_OFFS] );
        !           557:                                                (void) put(3, O_MAX,
        !           558:                                                    5 + EXPOSIZE + REALSPC, 1);
        !           559:                                                convert(nl+T4INT, INT_TYP);
        !           560:                                                stkcnt += sizeof(int);
        !           561:                                                (void) put(2, O_RV4 | cbn << 8 + INDX, 
        !           562:                                                    tempnlp->value[NL_OFFS] );
        !           563:                                                fmtspec += VARPREC;
        !           564:                                                tmpfree(&soffset);
        !           565:                                        }
        !           566:                                        (void) put(3, O_MAX, REALSPC, 1);
        !           567:                                        break;
        !           568:                                case TSTR:
        !           569:                                        (void) put(1, O_AS4);
        !           570:                                        (void) put(2, O_RV4 | cbn << 8 + INDX, 
        !           571:                                            tempnlp -> value[ NL_OFFS ] );
        !           572:                                        (void) put(3, O_MAX, strnglen, 0);
        !           573:                                        break;
        !           574:                                default:
        !           575:                                        if ( opt( 't' ) ) {
        !           576:                                            (void) put(3, O_MAX, 0, 0);
        !           577:                                        }
        !           578:                                        break;
        !           579:                                }
        !           580:                                convert(nl+T4INT, INT_TYP);
        !           581:                                stkcnt += sizeof(int);
        !           582:                        }
        !           583:                        /*
        !           584:                         * Generate the format string
        !           585:                         */
        !           586:                        switch (fmtspec) {
        !           587:                        default:
        !           588:                                panic("fmt2");
        !           589:                        case SKIP:
        !           590:                                break;
        !           591:                        case NIL:
        !           592:                                sprintf(&format[1], "%%%c", fmt);
        !           593:                                goto fmtgen;
        !           594:                        case CONWIDTH:
        !           595:                                sprintf(&format[1], "%%%d%c", field, fmt);
        !           596:                                goto fmtgen;
        !           597:                        case VARWIDTH:
        !           598:                                sprintf(&format[1], "%%*%c", fmt);
        !           599:                                goto fmtgen;
        !           600:                        case CONWIDTH + CONPREC:
        !           601:                                sprintf(&format[1], "%%%d.%d%c", field, prec, fmt);
        !           602:                                goto fmtgen;
        !           603:                        case CONWIDTH + VARPREC:
        !           604:                                sprintf(&format[1], "%%%d.*%c", field, fmt);
        !           605:                                goto fmtgen;
        !           606:                        case VARWIDTH + CONPREC:
        !           607:                                sprintf(&format[1], "%%*.%d%c", prec, fmt);
        !           608:                                goto fmtgen;
        !           609:                        case VARWIDTH + VARPREC:
        !           610:                                sprintf(&format[1], "%%*.*%c", fmt);
        !           611:                        fmtgen:
        !           612:                                fmtlen = lenstr(&format[fmtstart], 0);
        !           613:                                (void) put(2, O_LVCON, fmtlen);
        !           614:                                putstr(&format[fmtstart], 0);
        !           615:                                (void) put(1, O_FILE);
        !           616:                                stkcnt += 2 * sizeof(char *);
        !           617:                                (void) put(2, O_WRITEF, stkcnt);
        !           618:                        }
        !           619:                        /*
        !           620:                         * Write the string after its blank padding
        !           621:                         */
        !           622:                        if (typ == TSTR) {
        !           623:                                (void) put(1, O_FILE);
        !           624:                                (void) put(2, CON_INT, 1);
        !           625:                                if (strfmt & VARWIDTH) {
        !           626:                                        (void) put(2, O_RV4 | cbn << 8 + INDX , 
        !           627:                                            tempnlp -> value[ NL_OFFS ] );
        !           628:                                        (void) put(2, O_MIN, strnglen);
        !           629:                                        convert(nl+T4INT, INT_TYP);
        !           630:                                        tmpfree(&soffset);
        !           631:                                } else {
        !           632:                                        if ((fmtspec & SKIP) &&
        !           633:                                           (strfmt & CONWIDTH)) {
        !           634:                                                strnglen = field;
        !           635:                                        }
        !           636:                                        (void) put(2, CON_INT, strnglen);
        !           637:                                }
        !           638:                                ap = stkrval(alv, NLNIL , (long) RREQ );
        !           639:                                (void) put(2, O_WRITES,
        !           640:                                        2 * sizeof(char *) + 2 * sizeof(int));
        !           641:                        }
        !           642:                }
        !           643:                /*
        !           644:                 * Done with arguments.
        !           645:                 * Handle writeln and
        !           646:                 * insufficent number of args.
        !           647:                 */
        !           648:                switch (p->value[0] &~ NSTAND) {
        !           649:                        case O_WRITEF:
        !           650:                                if (argc == 0)
        !           651:                                        error("Write requires an argument");
        !           652:                                break;
        !           653:                        case O_MESSAGE:
        !           654:                                if (argc == 0)
        !           655:                                        error("Message requires an argument");
        !           656:                        case O_WRITLN:
        !           657:                                if (filetype != nl+T1CHAR)
        !           658:                                        error("Can't 'writeln' a non text file");
        !           659:                                (void) put(1, O_WRITLN);
        !           660:                                break;
        !           661:                }
        !           662:                return;
        !           663: 
        !           664:        case O_READ4:
        !           665:        case O_READLN:
        !           666:                /*
        !           667:                 * Set up default
        !           668:                 * file "input".
        !           669:                 */
        !           670:                file = NIL;
        !           671:                filetype = nl+T1CHAR;
        !           672:                /*
        !           673:                 * Determine the file implied
        !           674:                 * for the read and generate
        !           675:                 * code to make it the active file.
        !           676:                 */
        !           677:                if (argv != TR_NIL) {
        !           678:                        codeoff();
        !           679:                        ap = stkrval(argv->list_node.list, NLNIL, (long) RREQ );
        !           680:                        codeon();
        !           681:                        if (ap == NLNIL)
        !           682:                                argv = argv->list_node.next;
        !           683:                        if (ap != NLNIL && ap->class == FILET) {
        !           684:                                /*
        !           685:                                 * Got "read(f, ...", make
        !           686:                                 * f the active file, and save
        !           687:                                 * it and its type for use in
        !           688:                                 * processing the rest of the
        !           689:                                 * arguments to read.
        !           690:                                 */
        !           691:                                file = argv->list_node.list;
        !           692:                                filetype = ap->type;
        !           693:                                (void) stklval(argv->list_node.list, NIL );
        !           694:                                (void) put(1, O_UNIT);
        !           695:                                argv = argv->list_node.next;
        !           696:                                argc--;
        !           697:                        } else {
        !           698:                                /*
        !           699:                                 * Default is read from
        !           700:                                 * standard input.
        !           701:                                 */
        !           702:                                (void) put(1, O_UNITINP);
        !           703:                                input->nl_flags |= NUSED;
        !           704:                        }
        !           705:                } else {
        !           706:                        (void) put(1, O_UNITINP);
        !           707:                        input->nl_flags |= NUSED;
        !           708:                }
        !           709:                /*
        !           710:                 * Loop and process each
        !           711:                 * of the arguments.
        !           712:                 */
        !           713:                for (; argv != TR_NIL; argv = argv->list_node.next) {
        !           714:                        /*
        !           715:                         * Get the address of the target
        !           716:                         * on the stack.
        !           717:                         */
        !           718:                        al = argv->list_node.list;
        !           719:                        if (al == TR_NIL)
        !           720:                                continue;
        !           721:                        if (al->tag != T_VAR) {
        !           722:                                error("Arguments to %s must be variables, not expressions", p->symbol);
        !           723:                                continue;
        !           724:                        }
        !           725:                        ap = stklval(al, MOD|ASGN|NOUSE);
        !           726:                        if (ap == NLNIL)
        !           727:                                continue;
        !           728:                        if (filetype != nl+T1CHAR) {
        !           729:                                /*
        !           730:                                 * Generalized read, i.e.
        !           731:                                 * from a non-textfile.
        !           732:                                 */
        !           733:                                if (incompat(filetype, ap,
        !           734:                                        argv->list_node.list )) {
        !           735:                                        error("Type mismatch in read from non-text file");
        !           736:                                        continue;
        !           737:                                }
        !           738:                                /*
        !           739:                                 * var := file ^;
        !           740:                                 */
        !           741:                                if (file != NIL)
        !           742:                                    (void) stklval(file, NIL);
        !           743:                                else /* Magic */
        !           744:                                    (void) put(2, PTR_RV, (int)input->value[0]);
        !           745:                                (void) put(1, O_FNIL);
        !           746:                                if (isa(filetype, "bcsi")) {
        !           747:                                    int filewidth = width(filetype);
        !           748: 
        !           749:                                    switch (filewidth) {
        !           750:                                        case 4:
        !           751:                                            (void) put(1, O_IND4);
        !           752:                                            break;
        !           753:                                        case 2:
        !           754:                                            (void) put(1, O_IND2);
        !           755:                                            break;
        !           756:                                        case 1:
        !           757:                                            (void) put(1, O_IND1);
        !           758:                                            break;
        !           759:                                        default:
        !           760:                                            (void) put(2, O_IND, filewidth);
        !           761:                                    }
        !           762:                                    convert(filetype, ap);
        !           763:                                    rangechk(ap, ap);
        !           764:                                    (void) gen(O_AS2, O_AS2,
        !           765:                                            filewidth, width(ap));
        !           766:                                } else {
        !           767:                                    (void) put(2, O_IND, width(filetype));
        !           768:                                    convert(filetype, ap);
        !           769:                                    (void) put(2, O_AS, width(ap));
        !           770:                                }
        !           771:                                /*
        !           772:                                 * get(file);
        !           773:                                 */
        !           774:                                (void) put(1, O_GET);
        !           775:                                continue;
        !           776:                        }
        !           777:                        typ = classify(ap);
        !           778:                        op = rdops(typ);
        !           779:                        if (op == NIL) {
        !           780:                                error("Can't read %ss from a text file", clnames[typ]);
        !           781:                                continue;
        !           782:                        }
        !           783:                        if (op != O_READE)
        !           784:                                (void) put(1, op);
        !           785:                        else {
        !           786:                                (void) put(2, op, (long)listnames(ap));
        !           787:                                warning();
        !           788:                                if (opt('s')) {
        !           789:                                        standard();
        !           790:                                }
        !           791:                                error("Reading scalars from text files is non-standard");
        !           792:                        }
        !           793:                        /*
        !           794:                         * Data read is on the stack.
        !           795:                         * Assign it.
        !           796:                         */
        !           797:                        if (op != O_READ8 && op != O_READE)
        !           798:                                rangechk(ap, op == O_READC ? ap : nl+T4INT);
        !           799:                        (void) gen(O_AS2, O_AS2, width(ap),
        !           800:                                op == O_READ8 ? 8 : op == O_READ4 ? 4 : 2);
        !           801:                }
        !           802:                /*
        !           803:                 * Done with arguments.
        !           804:                 * Handle readln and
        !           805:                 * insufficient number of args.
        !           806:                 */
        !           807:                if (p->value[0] == O_READLN) {
        !           808:                        if (filetype != nl+T1CHAR)
        !           809:                                error("Can't 'readln' a non text file");
        !           810:                        (void) put(1, O_READLN);
        !           811:                }
        !           812:                else if (argc == 0)
        !           813:                        error("read requires an argument");
        !           814:                return;
        !           815: 
        !           816:        case O_GET:
        !           817:        case O_PUT:
        !           818:                if (argc != 1) {
        !           819:                        error("%s expects one argument", p->symbol);
        !           820:                        return;
        !           821:                }
        !           822:                ap = stklval(argv->list_node.list, NIL );
        !           823:                if (ap == NLNIL)
        !           824:                        return;
        !           825:                if (ap->class != FILET) {
        !           826:                        error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
        !           827:                        return;
        !           828:                }
        !           829:                (void) put(1, O_UNIT);
        !           830:                (void) put(1, op);
        !           831:                return;
        !           832: 
        !           833:        case O_RESET:
        !           834:        case O_REWRITE:
        !           835:                if (argc == 0 || argc > 2) {
        !           836:                        error("%s expects one or two arguments", p->symbol);
        !           837:                        return;
        !           838:                }
        !           839:                if (opt('s') && argc == 2) {
        !           840:                        standard();
        !           841:                        error("Two argument forms of reset and rewrite are non-standard");
        !           842:                }
        !           843:                codeoff();
        !           844:                ap = stklval(argv->list_node.list, MOD|NOUSE);
        !           845:                codeon();
        !           846:                if (ap == NLNIL)
        !           847:                        return;
        !           848:                if (ap->class != FILET) {
        !           849:                        error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
        !           850:                        return;
        !           851:                }
        !           852:                (void) put(2, O_CON24, text(ap) ? 0: width(ap->type));
        !           853:                if (argc == 2) {
        !           854:                        /*
        !           855:                         * Optional second argument
        !           856:                         * is a string name of a
        !           857:                         * UNIX (R) file to be associated.
        !           858:                         */
        !           859:                        al = argv->list_node.next;
        !           860:                        codeoff();
        !           861:                        al = (struct tnode *) stkrval(al->list_node.list,
        !           862:                                        (struct nl *) NOFLAGS , (long) RREQ );
        !           863:                        codeon();
        !           864:                        if (al == TR_NIL)
        !           865:                                return;
        !           866:                        if (classify((struct nl *) al) != TSTR) {
        !           867:                                error("Second argument to %s must be a string, not %s", p->symbol, nameof((struct nl *) al));
        !           868:                                return;
        !           869:                        }
        !           870:                        (void) put(2, O_CON24, width((struct nl *) al));
        !           871:                        al = argv->list_node.next;
        !           872:                        al = (struct tnode *) stkrval(al->list_node.list,
        !           873:                                        (struct nl *) NOFLAGS , (long) RREQ );
        !           874:                } else {
        !           875:                        (void) put(2, O_CON24, 0);
        !           876:                        (void) put(2, PTR_CON, NIL);
        !           877:                }
        !           878:                ap = stklval(argv->list_node.list, MOD|NOUSE);
        !           879:                (void) put(1, op);
        !           880:                return;
        !           881: 
        !           882:        case O_NEW:
        !           883:        case O_DISPOSE:
        !           884:                if (argc == 0) {
        !           885:                        error("%s expects at least one argument", p->symbol);
        !           886:                        return;
        !           887:                }
        !           888:                ap = stklval(argv->list_node.list,
        !           889:                                op == O_NEW ? ( MOD | NOUSE ) : MOD );
        !           890:                if (ap == NLNIL)
        !           891:                        return;
        !           892:                if (ap->class != PTR) {
        !           893:                        error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
        !           894:                        return;
        !           895:                }
        !           896:                ap = ap->type;
        !           897:                if (ap == NIL)
        !           898:                        return;
        !           899:                if ((ap->nl_flags & NFILES) && op == O_DISPOSE)
        !           900:                        op = O_DFDISP;
        !           901:                argv = argv->list_node.next;
        !           902:                if (argv != TR_NIL) {
        !           903:                        if (ap->class != RECORD) {
        !           904:                                error("Record required when specifying variant tags");
        !           905:                                return;
        !           906:                        }
        !           907:                        for (; argv != TR_NIL; argv = argv->list_node.next) {
        !           908:                                if (ap->ptr[NL_VARNT] == NIL) {
        !           909:                                        error("Too many tag fields");
        !           910:                                        return;
        !           911:                                }
        !           912:                                if (!isconst(argv->list_node.list)) {
        !           913:                                        error("Second and successive arguments to %s must be constants", p->symbol);
        !           914:                                        return;
        !           915:                                }
        !           916:                                gconst(argv->list_node.list);
        !           917:                                if (con.ctype == NIL)
        !           918:                                        return;
        !           919:                                if (incompat(con.ctype, (
        !           920:                                        ap->ptr[NL_TAG])->type , TR_NIL )) {
        !           921:                                        cerror("Specified tag constant type clashed with variant case selector type");
        !           922:                                        return;
        !           923:                                }
        !           924:                                for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain)
        !           925:                                        if (ap->range[0] == con.crval)
        !           926:                                                break;
        !           927:                                if (ap == NIL) {
        !           928:                                        error("No variant case label value equals specified constant value");
        !           929:                                        return;
        !           930:                                }
        !           931:                                ap = ap->ptr[NL_VTOREC];
        !           932:                        }
        !           933:                }
        !           934:                (void) put(2, op, width(ap));
        !           935:                return;
        !           936: 
        !           937:        case O_DATE:
        !           938:        case O_TIME:
        !           939:                if (argc != 1) {
        !           940:                        error("%s expects one argument", p->symbol);
        !           941:                        return;
        !           942:                }
        !           943:                ap = stklval(argv->list_node.list, MOD|NOUSE);
        !           944:                if (ap == NLNIL)
        !           945:                        return;
        !           946:                if (classify(ap) != TSTR || width(ap) != 10) {
        !           947:                        error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
        !           948:                        return;
        !           949:                }
        !           950:                (void) put(1, op);
        !           951:                return;
        !           952: 
        !           953:        case O_HALT:
        !           954:                if (argc != 0) {
        !           955:                        error("halt takes no arguments");
        !           956:                        return;
        !           957:                }
        !           958:                (void) put(1, op);
        !           959:                noreach = TRUE; /* used to be 1 */
        !           960:                return;
        !           961: 
        !           962:        case O_ARGV:
        !           963:                if (argc != 2) {
        !           964:                        error("argv takes two arguments");
        !           965:                        return;
        !           966:                }
        !           967:                ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
        !           968:                if (ap == NLNIL)
        !           969:                        return;
        !           970:                if (isnta(ap, "i")) {
        !           971:                        error("argv's first argument must be an integer, not %s", nameof(ap));
        !           972:                        return;
        !           973:                }
        !           974:                al = argv->list_node.next;
        !           975:                ap = stklval(al->list_node.list, MOD|NOUSE);
        !           976:                if (ap == NLNIL)
        !           977:                        return;
        !           978:                if (classify(ap) != TSTR) {
        !           979:                        error("argv's second argument must be a string, not %s", nameof(ap));
        !           980:                        return;
        !           981:                }
        !           982:                (void) put(2, op, width(ap));
        !           983:                return;
        !           984: 
        !           985:        case O_STLIM:
        !           986:                if (argc != 1) {
        !           987:                        error("stlimit requires one argument");
        !           988:                        return;
        !           989:                }
        !           990:                ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
        !           991:                if (ap == NLNIL)
        !           992:                        return;
        !           993:                if (isnta(ap, "i")) {
        !           994:                        error("stlimit's argument must be an integer, not %s", nameof(ap));
        !           995:                        return;
        !           996:                }
        !           997:                if (width(ap) != 4)
        !           998:                        (void) put(1, O_STOI);
        !           999:                (void) put(1, op);
        !          1000:                return;
        !          1001: 
        !          1002:        case O_REMOVE:
        !          1003:                if (argc != 1) {
        !          1004:                        error("remove expects one argument");
        !          1005:                        return;
        !          1006:                }
        !          1007:                codeoff();
        !          1008:                ap = stkrval(argv->list_node.list, (struct nl *) NOFLAGS,
        !          1009:                                (long) RREQ );
        !          1010:                codeon();
        !          1011:                if (ap == NLNIL)
        !          1012:                        return;
        !          1013:                if (classify(ap) != TSTR) {
        !          1014:                        error("remove's argument must be a string, not %s", nameof(ap));
        !          1015:                        return;
        !          1016:                }
        !          1017:                (void) put(2, O_CON24, width(ap));
        !          1018:                ap = stkrval(argv->list_node.list, (struct nl *) NOFLAGS,
        !          1019:                                (long) RREQ );
        !          1020:                (void) put(1, op);
        !          1021:                return;
        !          1022: 
        !          1023:        case O_LLIMIT:
        !          1024:                if (argc != 2) {
        !          1025:                        error("linelimit expects two arguments");
        !          1026:                        return;
        !          1027:                }
        !          1028:                al = argv->list_node.next;
        !          1029:                ap = stkrval(al->list_node.list, NLNIL , (long) RREQ );
        !          1030:                if (ap == NIL)
        !          1031:                        return;
        !          1032:                if (isnta(ap, "i")) {
        !          1033:                        error("linelimit's second argument must be an integer, not %s", nameof(ap));
        !          1034:                        return;
        !          1035:                }
        !          1036:                ap = stklval(argv->list_node.list, NOFLAGS|NOUSE);
        !          1037:                if (ap == NLNIL)
        !          1038:                        return;
        !          1039:                if (!text(ap)) {
        !          1040:                        error("linelimit's first argument must be a text file, not %s", nameof(ap));
        !          1041:                        return;
        !          1042:                }
        !          1043:                (void) put(1, op);
        !          1044:                return;
        !          1045:        case O_PAGE:
        !          1046:                if (argc != 1) {
        !          1047:                        error("page expects one argument");
        !          1048:                        return;
        !          1049:                }
        !          1050:                ap = stklval(argv->list_node.list, NIL );
        !          1051:                if (ap == NLNIL)
        !          1052:                        return;
        !          1053:                if (!text(ap)) {
        !          1054:                        error("Argument to page must be a text file, not %s", nameof(ap));
        !          1055:                        return;
        !          1056:                }
        !          1057:                (void) put(1, O_UNIT);
        !          1058:                (void) put(1, op);
        !          1059:                return;
        !          1060: 
        !          1061:        case O_ASRT:
        !          1062:                if (!opt('t'))
        !          1063:                        return;
        !          1064:                if (argc == 0 || argc > 2) {
        !          1065:                        error("Assert expects one or two arguments");
        !          1066:                        return;
        !          1067:                }
        !          1068:                if (argc == 2) {
        !          1069:                        /*
        !          1070:                         * Optional second argument is a string specifying
        !          1071:                         * why the assertion failed.
        !          1072:                         */
        !          1073:                        al = argv->list_node.next;
        !          1074:                        al1 =  stkrval(al->list_node.list, NLNIL , (long) RREQ );
        !          1075:                        if (al1 == NIL)
        !          1076:                                return;
        !          1077:                        if (classify(al1) != TSTR) {
        !          1078:                                error("Second argument to assert must be a string, not %s", nameof(al1));
        !          1079:                                return;
        !          1080:                        }
        !          1081:                } else {
        !          1082:                        (void) put(2, PTR_CON, NIL);
        !          1083:                }
        !          1084:                ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
        !          1085:                if (ap == NIL)
        !          1086:                        return;
        !          1087:                if (isnta(ap, "b"))
        !          1088:                        error("Assert expression must be Boolean, not %ss", nameof(ap));
        !          1089:                (void) put(1, O_ASRT);
        !          1090:                return;
        !          1091: 
        !          1092:        case O_PACK:
        !          1093:                if (argc != 3) {
        !          1094:                        error("pack expects three arguments");
        !          1095:                        return;
        !          1096:                }
        !          1097:                pu = "pack(a,i,z)";
        !          1098:                pua = argv->list_node.list;
        !          1099:                al = argv->list_node.next;
        !          1100:                pui = al->list_node.list;
        !          1101:                alv = al->list_node.next;
        !          1102:                puz = alv->list_node.list;
        !          1103:                goto packunp;
        !          1104:        case O_UNPACK:
        !          1105:                if (argc != 3) {
        !          1106:                        error("unpack expects three arguments");
        !          1107:                        return;
        !          1108:                }
        !          1109:                pu = "unpack(z,a,i)";
        !          1110:                puz = argv->list_node.list;
        !          1111:                al = argv->list_node.next;
        !          1112:                pua = al->list_node.list;
        !          1113:                alv = al->list_node.next;
        !          1114:                pui = alv->list_node.list;
        !          1115: packunp:
        !          1116:                codeoff();
        !          1117:                ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
        !          1118:                al1 = stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
        !          1119:                codeon();
        !          1120:                if (ap == NIL)
        !          1121:                        return;
        !          1122:                if (ap->class != ARRAY) {
        !          1123:                        error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
        !          1124:                        return;
        !          1125:                }
        !          1126:                if (al1->class != ARRAY) {
        !          1127:                        error("%s requires z to be a packed array, not %s", pu, nameof(ap));
        !          1128:                        return;
        !          1129:                }
        !          1130:                if (al1->type == NIL || ap->type == NIL)
        !          1131:                        return;
        !          1132:                if (al1->type != ap->type) {
        !          1133:                        error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
        !          1134:                        return;
        !          1135:                }
        !          1136:                k = width(al1);
        !          1137:                itemwidth = width(ap->type);
        !          1138:                ap = ap->chain;
        !          1139:                al1 = al1->chain;
        !          1140:                if (ap->chain != NIL || al1->chain != NIL) {
        !          1141:                        error("%s requires a and z to be single dimension arrays", pu);
        !          1142:                        return;
        !          1143:                }
        !          1144:                if (ap == NIL || al1 == NIL)
        !          1145:                        return;
        !          1146:                /*
        !          1147:                 * al1 is the range for z i.e. u..v
        !          1148:                 * ap is the range for a i.e. m..n
        !          1149:                 * i will be n-m+1
        !          1150:                 * j will be v-u+1
        !          1151:                 */
        !          1152:                i = ap->range[1] - ap->range[0] + 1;
        !          1153:                j = al1->range[1] - al1->range[0] + 1;
        !          1154:                if (i < j) {
        !          1155:                        error("%s cannot have more elements in a (%d) than in z (%d)", pu, (char *) j, (char *) i);
        !          1156:                        return;
        !          1157:                }
        !          1158:                /*
        !          1159:                 * get n-m-(v-u) and m for the interpreter
        !          1160:                 */
        !          1161:                i -= j;
        !          1162:                j = ap->range[0];
        !          1163:                (void) put(2, O_CON24, k);
        !          1164:                (void) put(2, O_CON24, i);
        !          1165:                (void) put(2, O_CON24, j);
        !          1166:                (void) put(2, O_CON24, itemwidth);
        !          1167:                al1 = stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
        !          1168:                ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
        !          1169:                ap = stkrval(pui, NLNIL , (long) RREQ );
        !          1170:                if (ap == NIL)
        !          1171:                        return;
        !          1172:                (void) put(1, op);
        !          1173:                return;
        !          1174:        case 0:
        !          1175:                error("%s is an unimplemented extension", p->symbol);
        !          1176:                return;
        !          1177: 
        !          1178:        default:
        !          1179:                panic("proc case");
        !          1180:        }
        !          1181: }
        !          1182: #endif OBJ

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