Return to pcproc.c CVS log

Up to [CSRG BSD Unix] / 40BSD / cmd / pc0

Annotation of 40BSD/cmd/pc0/pcproc.c, revision 1.1

1.1     ! root        1: /* Copyright (c) 1979 Regents of the University of California */
        !             2: 
        !             3: static char sccsid[] = "@(#)pcproc.c 1.3 10/28/80";
        !             4: 
        !             5: #include "whoami.h"
        !             6: #ifdef PC
        !             7:     /*
        !             8:      * and to the end of the file
        !             9:      */
        !            10: #include "0.h"
        !            11: #include "tree.h"
        !            12: #include "opcode.h"
        !            13: #include       "pc.h"
        !            14: #include       "pcops.h"
        !            15: 
        !            16: /*
        !            17:  * The following array is used to determine which classes may be read
        !            18:  * from textfiles. It is indexed by the return value from classify.
        !            19:  */
        !            20: #define rdops(x) rdxxxx[(x)-(TFIRST)]
        !            21: 
        !            22: int rdxxxx[] = {
        !            23:        0,              /* -7 file types */
        !            24:        0,              /* -6 record types */
        !            25:        0,              /* -5 array types */
        !            26:        O_READE,        /* -4 scalar types */
        !            27:        0,              /* -3 pointer types */
        !            28:        0,              /* -2 set types */
        !            29:        0,              /* -1 string types */
        !            30:        0,              /*  0 nil, no type */
        !            31:        O_READE,        /*  1 boolean */
        !            32:        O_READC,        /*  2 character */
        !            33:        O_READ4,        /*  3 integer */
        !            34:        O_READ8         /*  4 real */
        !            35: };
        !            36: 
        !            37: /*
        !            38:  * Proc handles procedure calls.
        !            39:  * Non-builtin procedures are "buck-passed" to func (with a flag
        !            40:  * indicating that they are actually procedures.
        !            41:  * builtin procedures are handled here.
        !            42:  */
        !            43: pcproc(r)
        !            44:        int *r;
        !            45: {
        !            46:        register struct nl *p;
        !            47:        register int *alv, *al, op;
        !            48:        struct nl *filetype, *ap;
        !            49:        int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file;
        !            50:        char fmt, format[20], *strptr;
        !            51:        int prec, field, strnglen, fmtlen, fmtstart, pu;
        !            52:        int *pua, *pui, *puz;
        !            53:        int i, j, k;
        !            54:        int itemwidth;
        !            55:        char    *readname;
        !            56:        long    tempoff;
        !            57:        long    readtype;
        !            58: 
        !            59: #define        CONPREC 4
        !            60: #define        VARPREC 8
        !            61: #define        CONWIDTH 1
        !            62: #define        VARWIDTH 2
        !            63: #define SKIP 16
        !            64: 
        !            65:        /*
        !            66:         * Verify that the name is
        !            67:         * defined and is that of a
        !            68:         * procedure.
        !            69:         */
        !            70:        p = lookup(r[2]);
        !            71:        if (p == NIL) {
        !            72:                rvlist(r[3]);
        !            73:                return;
        !            74:        }
        !            75:        if (p->class != PROC && p->class != FPROC) {
        !            76:                error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
        !            77:                rvlist(r[3]);
        !            78:                return;
        !            79:        }
        !            80:        argv = r[3];
        !            81: 
        !            82:        /*
        !            83:         * Call handles user defined
        !            84:         * procedures and functions.
        !            85:         */
        !            86:        if (bn != 0) {
        !            87:                call(p, argv, PROC, bn);
        !            88:                return;
        !            89:        }
        !            90: 
        !            91:        /*
        !            92:         * Call to built-in procedure.
        !            93:         * Count the arguments.
        !            94:         */
        !            95:        argc = 0;
        !            96:        for (al = argv; al != NIL; al = al[2])
        !            97:                argc++;
        !            98: 
        !            99:        /*
        !           100:         * Switch on the operator
        !           101:         * associated with the built-in
        !           102:         * procedure in the namelist
        !           103:         */
        !           104:        op = p->value[0] &~ NSTAND;
        !           105:        if (opt('s') && (p->value[0] & NSTAND)) {
        !           106:                standard();
        !           107:                error("%s is a nonstandard procedure", p->symbol);
        !           108:        }
        !           109:        switch (op) {
        !           110: 
        !           111:        case O_ABORT:
        !           112:                if (argc != 0)
        !           113:                        error("null takes no arguments");
        !           114:                return;
        !           115: 
        !           116:        case O_FLUSH:
        !           117:                if (argc == 0) {
        !           118:                        putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
        !           119:                        putop( P2UNARY P2CALL , P2INT );
        !           120:                        putdot( filename , line );
        !           121:                        return;
        !           122:                }
        !           123:                if (argc != 1) {
        !           124:                        error("flush takes at most one argument");
        !           125:                        return;
        !           126:                }
        !           127:                putleaf( P2ICON , 0 , 0
        !           128:                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           129:                        , "_FLUSH" );
        !           130:                ap = stklval(argv[1], NOFLAGS);
        !           131:                if (ap == NIL)
        !           132:                        return;
        !           133:                if (ap->class != FILET) {
        !           134:                        error("flush's argument must be a file, not %s", nameof(ap));
        !           135:                        return;
        !           136:                }
        !           137:                putop( P2CALL , P2INT );
        !           138:                putdot( filename , line );
        !           139:                return;
        !           140: 
        !           141:        case O_MESSAGE:
        !           142:        case O_WRITEF:
        !           143:        case O_WRITLN:
        !           144:                /*
        !           145:                 * Set up default file "output"'s type
        !           146:                 */
        !           147:                file = NIL;
        !           148:                filetype = nl+T1CHAR;
        !           149:                /*
        !           150:                 * Determine the file implied
        !           151:                 * for the write and generate
        !           152:                 * code to make it the active file.
        !           153:                 */
        !           154:                if (op == O_MESSAGE) {
        !           155:                        /*
        !           156:                         * For message, all that matters
        !           157:                         * is that the filetype is
        !           158:                         * a character file.
        !           159:                         * Thus "output" will suit us fine.
        !           160:                         */
        !           161:                        putleaf( P2ICON , 0 , 0 , P2INT , "_PFLUSH" );
        !           162:                        putop( P2UNARY P2CALL , P2INT );
        !           163:                        putdot( filename , line );
        !           164:                        putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           165:                        putLV( "__err" , 0 , 0 , P2PTR|P2STRTY );
        !           166:                        putop( P2ASSIGN , P2PTR|P2STRTY );
        !           167:                        putdot( filename , line );
        !           168:                } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) {
        !           169:                        /*
        !           170:                         * If there is a first argument which has
        !           171:                         * no write widths, then it is potentially
        !           172:                         * a file name.
        !           173:                         */
        !           174:                        codeoff();
        !           175:                        ap = stkrval(argv[1], NIL , RREQ );
        !           176:                        codeon();
        !           177:                        if (ap == NIL)
        !           178:                                argv = argv[2];
        !           179:                        if (ap != NIL && ap->class == FILET) {
        !           180:                                /*
        !           181:                                 * Got "write(f, ...", make
        !           182:                                 * f the active file, and save
        !           183:                                 * it and its type for use in
        !           184:                                 * processing the rest of the
        !           185:                                 * arguments to write.
        !           186:                                 */
        !           187:                                putRV( 0 , cbn , CURFILEOFFSET
        !           188:                                        , P2PTR|P2STRTY );
        !           189:                                putleaf( P2ICON , 0 , 0
        !           190:                                    , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           191:                                    , "_UNIT" );
        !           192:                                file = argv[1];
        !           193:                                filetype = ap->type;
        !           194:                                stklval(argv[1], NOFLAGS);
        !           195:                                putop( P2CALL , P2INT );
        !           196:                                putop( P2ASSIGN , P2PTR|P2STRTY );
        !           197:                                putdot( filename , line );
        !           198:                                /*
        !           199:                                 * Skip over the first argument
        !           200:                                 */
        !           201:                                argv = argv[2];
        !           202:                                argc--;
        !           203:                        } else {
        !           204:                                /*
        !           205:                                 * Set up for writing on 
        !           206:                                 * standard output.
        !           207:                                 */
        !           208:                                putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           209:                                putLV( "_output" , 0 , 0 , P2PTR|P2STRTY );
        !           210:                                putop( P2ASSIGN , P2PTR|P2STRTY );
        !           211:                                putdot( filename , line );
        !           212:                        }
        !           213:                } else {
        !           214:                        putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           215:                        putLV( "_output" , 0 , 0 , P2PTR|P2STRTY );
        !           216:                        putop( P2ASSIGN , P2PTR|P2STRTY );
        !           217:                        putdot( filename , line );
        !           218:                }
        !           219:                /*
        !           220:                 * Loop and process each
        !           221:                 * of the arguments.
        !           222:                 */
        !           223:                for (; argv != NIL; argv = argv[2]) {
        !           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 longs 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[1];
        !           238:                        if (al == NIL)
        !           239:                                continue;
        !           240:                        if (al[0] == T_WEXP)
        !           241:                                alv = al[1];
        !           242:                        else
        !           243:                                alv = al;
        !           244:                        if (alv == NIL)
        !           245:                                continue;
        !           246:                        codeoff();
        !           247:                        ap = stkrval(alv, NIL , RREQ );
        !           248:                        codeon();
        !           249:                        if (ap == NIL)
        !           250:                                continue;
        !           251:                        typ = classify(ap);
        !           252:                        if (al[0] == 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[3] == OCT)
        !           264:                                        fmt = 'O';
        !           265:                                else if (al[3] == HEX)
        !           266:                                        fmt = 'X';
        !           267:                                else if (al[3] != NIL) {
        !           268:                                        /*
        !           269:                                         * Evaluate second format spec
        !           270:                                         */
        !           271:                                        if ( constval(al[3])
        !           272:                                            && isa( con.ctype , "i" ) ) {
        !           273:                                                fmtspec += CONPREC;
        !           274:                                                prec = con.crval;
        !           275:                                        } else {
        !           276:                                                fmtspec += VARPREC;
        !           277:                                        }
        !           278:                                        fmt = 'f';
        !           279:                                        switch ( typ ) {
        !           280:                                        case TINT:
        !           281:                                                if ( opt( 's' ) ) {
        !           282:                                                    standard();
        !           283:                                                    error("Writing %ss with two write widths is non-standard", clnames[typ]);
        !           284:                                                }
        !           285:                                                /* and fall through */
        !           286:                                        case TDOUBLE:
        !           287:                                                break;
        !           288:                                        default:
        !           289:                                                error("Cannot write %ss with two write widths", clnames[typ]);
        !           290:                                                continue;
        !           291:                                        }
        !           292:                                }
        !           293:                                /*
        !           294:                                 * Evaluate first format spec
        !           295:                                 */
        !           296:                                if (al[2] != NIL) {
        !           297:                                        if ( constval(al[2])
        !           298:                                            && isa( con.ctype , "i" ) ) {
        !           299:                                                fmtspec += CONWIDTH;
        !           300:                                                field = con.crval;
        !           301:                                        } else {
        !           302:                                                fmtspec += VARWIDTH;
        !           303:                                        }
        !           304:                                }
        !           305:                                if ((fmtspec & CONPREC) && prec < 0 ||
        !           306:                                    (fmtspec & CONWIDTH) && field < 0) {
        !           307:                                        error("Negative widths are not allowed");
        !           308:                                        continue;
        !           309:                                }
        !           310:                        }
        !           311:                        if (filetype != nl+T1CHAR) {
        !           312:                                if (fmt == 'O' || fmt == 'X') {
        !           313:                                        error("Oct/hex allowed only on text files");
        !           314:                                        continue;
        !           315:                                }
        !           316:                                if (fmtspec) {
        !           317:                                        error("Write widths allowed only on text files");
        !           318:                                        continue;
        !           319:                                }
        !           320:                                /*
        !           321:                                 * Generalized write, i.e.
        !           322:                                 * to a non-textfile.
        !           323:                                 */
        !           324:                                putleaf( P2ICON , 0 , 0
        !           325:                                    , ADDTYPE(
        !           326:                                        ADDTYPE(
        !           327:                                            ADDTYPE( p2type( filetype )
        !           328:                                                    , P2PTR )
        !           329:                                            , P2FTN )
        !           330:                                        , P2PTR )
        !           331:                                    , "_FNIL" );
        !           332:                                stklval(file, NOFLAGS);
        !           333:                                putop( P2CALL
        !           334:                                    , ADDTYPE( p2type( filetype ) , P2PTR ) );
        !           335:                                putop( P2UNARY P2MUL , p2type( filetype ) );
        !           336:                                /*
        !           337:                                 * file^ := ...
        !           338:                                 */
        !           339:                                switch ( classify( filetype ) ) {
        !           340:                                    case TBOOL:
        !           341:                                    case TCHAR:
        !           342:                                    case TINT:
        !           343:                                    case TSCAL:
        !           344:                                        precheck( filetype , "_RANG4"  , "_RSGN4" );
        !           345:                                            /* and fall through */
        !           346:                                    case TDOUBLE:
        !           347:                                    case TPTR:
        !           348:                                        ap = rvalue( argv[1] , filetype , RREQ );
        !           349:                                        break;
        !           350:                                    default:
        !           351:                                        ap = rvalue( argv[1] , filetype , LREQ );
        !           352:                                        break;
        !           353:                                }
        !           354:                                if (ap == NIL)
        !           355:                                        continue;
        !           356:                                if (incompat(ap, filetype, argv[1])) {
        !           357:                                        cerror("Type mismatch in write to non-text file");
        !           358:                                        continue;
        !           359:                                }
        !           360:                                switch ( classify( filetype ) ) {
        !           361:                                    case TBOOL:
        !           362:                                    case TCHAR:
        !           363:                                    case TINT:
        !           364:                                    case TSCAL:
        !           365:                                            postcheck( filetype );
        !           366:                                                /* and fall through */
        !           367:                                    case TDOUBLE:
        !           368:                                    case TPTR:
        !           369:                                            putop( P2ASSIGN , p2type( filetype ) );
        !           370:                                            putdot( filename , line );
        !           371:                                            break;
        !           372:                                    default:
        !           373:                                            putstrop( P2STASG
        !           374:                                                        , p2type( filetype )
        !           375:                                                        , lwidth( filetype )
        !           376:                                                        , align( filetype ) );
        !           377:                                            putdot( filename , line );
        !           378:                                            break;
        !           379:                                }
        !           380:                                /*
        !           381:                                 * put(file)
        !           382:                                 */
        !           383:                                putleaf( P2ICON , 0 , 0
        !           384:                                    , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           385:                                    , "_PUT" );
        !           386:                                putRV( 0 , cbn , CURFILEOFFSET
        !           387:                                        , P2PTR|P2STRTY );
        !           388:                                putop( P2CALL , P2INT );
        !           389:                                putdot( filename , line );
        !           390:                                continue;
        !           391:                        }
        !           392:                        /*
        !           393:                         * Write to a textfile
        !           394:                         *
        !           395:                         * Evaluate the expression
        !           396:                         * to be written.
        !           397:                         */
        !           398:                        if (fmt == 'O' || fmt == 'X') {
        !           399:                                if (opt('s')) {
        !           400:                                        standard();
        !           401:                                        error("Oct and hex are non-standard");
        !           402:                                }
        !           403:                                if (typ == TSTR || typ == TDOUBLE) {
        !           404:                                        error("Can't write %ss with oct/hex", clnames[typ]);
        !           405:                                        continue;
        !           406:                                }
        !           407:                                if (typ == TCHAR || typ == TBOOL)
        !           408:                                        typ = TINT;
        !           409:                        }
        !           410:                        /*
        !           411:                         * If there is no format specified by the programmer,
        !           412:                         * implement the default.
        !           413:                         */
        !           414:                        switch (typ) {
        !           415:                        case TINT:
        !           416:                                if (fmt == 'f') {
        !           417:                                        typ = TDOUBLE;
        !           418:                                        goto tdouble;
        !           419:                                }
        !           420:                                if (fmtspec == NIL) {
        !           421:                                        if (fmt == 'D')
        !           422:                                                field = 10;
        !           423:                                        else if (fmt == 'X')
        !           424:                                                field = 8;
        !           425:                                        else if (fmt == 'O')
        !           426:                                                field = 11;
        !           427:                                        else
        !           428:                                                panic("fmt1");
        !           429:                                        fmtspec = CONWIDTH;
        !           430:                                }
        !           431:                                break;
        !           432:                        case TCHAR:
        !           433:                             tchar:
        !           434:                                fmt = 'c';
        !           435:                                break;
        !           436:                        case TSCAL:
        !           437:                                warning();
        !           438:                                if (opt('s')) {
        !           439:                                        standard();
        !           440:                                }
        !           441:                                error("Writing scalars to text files is non-standard");
        !           442:                        case TBOOL:
        !           443:                                fmt = 's';
        !           444:                                break;
        !           445:                        case TDOUBLE:
        !           446:                             tdouble:
        !           447:                                switch (fmtspec) {
        !           448:                                case NIL:
        !           449:                                        field = 21;
        !           450:                                        prec = 14;
        !           451:                                        fmt = 'E';
        !           452:                                        fmtspec = CONWIDTH + CONPREC;
        !           453:                                        break;
        !           454:                                case CONWIDTH:
        !           455:                                        if (--field < 1)
        !           456:                                                field = 1;
        !           457:                                        prec = field - 7;
        !           458:                                        if (prec < 1)
        !           459:                                                prec = 1;
        !           460:                                        fmtspec += CONPREC;
        !           461:                                        fmt = 'E';
        !           462:                                        break;
        !           463:                                case VARWIDTH:
        !           464:                                        fmtspec += VARPREC;
        !           465:                                        fmt = 'E';
        !           466:                                        break;
        !           467:                                case CONWIDTH + CONPREC:
        !           468:                                case CONWIDTH + VARPREC:
        !           469:                                        if (--field < 1)
        !           470:                                                field = 1;
        !           471:                                }
        !           472:                                format[0] = ' ';
        !           473:                                fmtstart = 0;
        !           474:                                break;
        !           475:                        case TSTR:
        !           476:                                constval( alv );
        !           477:                                switch ( classify( con.ctype ) ) {
        !           478:                                    case TCHAR:
        !           479:                                        typ = TCHAR;
        !           480:                                        goto tchar;
        !           481:                                    case TSTR:
        !           482:                                        strptr = con.cpval;
        !           483:                                        for (strnglen = 0;  *strptr++;  strnglen++) /* void */;
        !           484:                                        strptr = con.cpval;
        !           485:                                        break;
        !           486:                                    default:
        !           487:                                        strnglen = width(ap);
        !           488:                                        break;
        !           489:                                }
        !           490:                                fmt = 's';
        !           491:                                strfmt = fmtspec;
        !           492:                                if (fmtspec == NIL) {
        !           493:                                        fmtspec = SKIP;
        !           494:                                        break;
        !           495:                                }
        !           496:                                if (fmtspec & CONWIDTH) {
        !           497:                                        if (field <= strnglen)
        !           498:                                                fmtspec = SKIP;
        !           499:                                        else
        !           500:                                                field -= strnglen;
        !           501:                                }
        !           502:                                break;
        !           503:                        default:
        !           504:                                error("Can't write %ss to a text file", clnames[typ]);
        !           505:                                continue;
        !           506:                        }
        !           507:                        /*
        !           508:                         * Generate the format string
        !           509:                         */
        !           510:                        switch (fmtspec) {
        !           511:                        default:
        !           512:                                panic("fmt2");
        !           513:                        case NIL:
        !           514:                                if (fmt == 'c') {
        !           515:                                        if ( opt( 't' ) ) {
        !           516:                                            putleaf( P2ICON , 0 , 0
        !           517:                                                , ADDTYPE( P2FTN|P2INT , P2PTR )
        !           518:                                                , "_WRITEC" );
        !           519:                                            putRV( 0 , cbn , CURFILEOFFSET
        !           520:                                                    , P2PTR|P2STRTY );
        !           521:                                            stkrval( alv , NIL , RREQ );
        !           522:                                            putop( P2LISTOP , P2INT );
        !           523:                                        } else {
        !           524:                                            putleaf( P2ICON , 0 , 0
        !           525:                                                , ADDTYPE( P2FTN|P2INT , P2PTR )
        !           526:                                                , "_fputc" );
        !           527:                                            stkrval( alv , NIL , RREQ );
        !           528:                                        }
        !           529:                                        putleaf( P2ICON , 0 , 0
        !           530:                                            , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           531:                                            , "_ACTFILE" );
        !           532:                                        putRV( 0, cbn , CURFILEOFFSET
        !           533:                                                , P2PTR|P2STRTY );
        !           534:                                        putop( P2CALL , P2INT );
        !           535:                                        putop( P2LISTOP , P2INT );
        !           536:                                        putop( P2CALL , P2INT );
        !           537:                                        putdot( filename , line );
        !           538:                                } else  {
        !           539:                                        sprintf(&format[1], "%%%c", fmt);
        !           540:                                        goto fmtgen;
        !           541:                                }
        !           542:                        case SKIP:
        !           543:                                break;
        !           544:                        case CONWIDTH:
        !           545:                                sprintf(&format[1], "%%%1D%c", field, fmt);
        !           546:                                goto fmtgen;
        !           547:                        case VARWIDTH:
        !           548:                                sprintf(&format[1], "%%*%c", fmt);
        !           549:                                goto fmtgen;
        !           550:                        case CONWIDTH + CONPREC:
        !           551:                                sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt);
        !           552:                                goto fmtgen;
        !           553:                        case CONWIDTH + VARPREC:
        !           554:                                sprintf(&format[1], "%%%1D.*%c", field, fmt);
        !           555:                                goto fmtgen;
        !           556:                        case VARWIDTH + CONPREC:
        !           557:                                sprintf(&format[1], "%%*.%1D%c", prec, fmt);
        !           558:                                goto fmtgen;
        !           559:                        case VARWIDTH + VARPREC:
        !           560:                                sprintf(&format[1], "%%*.*%c", fmt);
        !           561:                        fmtgen:
        !           562:                                if ( opt( 't' ) ) {
        !           563:                                    putleaf( P2ICON , 0 , 0
        !           564:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           565:                                        , "_WRITEF" );
        !           566:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           567:                                            , P2PTR|P2STRTY );
        !           568:                                    putleaf( P2ICON , 0 , 0
        !           569:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           570:                                        , "_ACTFILE" );
        !           571:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           572:                                            , P2PTR|P2STRTY );
        !           573:                                    putop( P2CALL , P2INT );
        !           574:                                    putop( P2LISTOP , P2INT );
        !           575:                                } else {
        !           576:                                    putleaf( P2ICON , 0 , 0
        !           577:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           578:                                        , "_fprintf" );
        !           579:                                    putleaf( P2ICON , 0 , 0
        !           580:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           581:                                        , "_ACTFILE" );
        !           582:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           583:                                            , P2PTR|P2STRTY );
        !           584:                                    putop( P2CALL , P2INT );
        !           585:                                }
        !           586:                                putCONG( &format[ fmtstart ]
        !           587:                                        , strlen( &format[ fmtstart ] )
        !           588:                                        , LREQ );
        !           589:                                putop( P2LISTOP , P2INT );
        !           590:                                if ( fmtspec & VARWIDTH ) {
        !           591:                                        /*
        !           592:                                         * either
        !           593:                                         *      ,(temp=width,MAX(temp,...)),
        !           594:                                         * or
        !           595:                                         *      , MAX( width , ... ) ,
        !           596:                                         */
        !           597:                                    if ( ( typ == TDOUBLE && al[3] == NIL )
        !           598:                                        || typ == TSTR ) {
        !           599:                                        sizes[ cbn ].om_off -= sizeof( int );
        !           600:                                        tempoff = sizes[ cbn ].om_off;
        !           601:                                        putlbracket( ftnno , -tempoff );
        !           602:                                        if ( tempoff < sizes[ cbn ].om_max ) {
        !           603:                                            sizes[ cbn ].om_max = tempoff;
        !           604:                                        }
        !           605:                                        putRV( 0 , cbn , tempoff , P2INT );
        !           606:                                        ap = stkrval( al[2] , NIL , RREQ );
        !           607:                                        putop( P2ASSIGN , P2INT );
        !           608:                                        putleaf( P2ICON , 0 , 0
        !           609:                                            , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           610:                                            , "_MAX" );
        !           611:                                        putRV( 0 , cbn , tempoff , P2INT );
        !           612:                                    } else {
        !           613:                                        if (opt('t')
        !           614:                                            || typ == TSTR || typ == TDOUBLE) {
        !           615:                                            putleaf( P2ICON , 0 , 0
        !           616:                                                ,ADDTYPE( P2FTN | P2INT, P2PTR )
        !           617:                                                ,"_MAX" );
        !           618:                                        }
        !           619:                                        ap = stkrval( al[2] , NIL , RREQ );
        !           620:                                    }
        !           621:                                    if (ap == NIL)
        !           622:                                            continue;
        !           623:                                    if (isnta(ap,"i")) {
        !           624:                                            error("First write width must be integer, not %s", nameof(ap));
        !           625:                                            continue;
        !           626:                                    }
        !           627:                                    switch ( typ ) {
        !           628:                                    case TDOUBLE:
        !           629:                                        putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           630:                                        putop( P2LISTOP , P2INT );
        !           631:                                        putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           632:                                        putop( P2LISTOP , P2INT );
        !           633:                                        putop( P2CALL , P2INT );
        !           634:                                        if ( al[3] == NIL ) {
        !           635:                                                /*
        !           636:                                                 * finish up the comma op
        !           637:                                                 */
        !           638:                                            putop( P2COMOP , P2INT );
        !           639:                                            fmtspec &= ~VARPREC;
        !           640:                                            putop( P2LISTOP , P2INT );
        !           641:                                            putleaf( P2ICON , 0 , 0
        !           642:                                                , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           643:                                                , "_MAX" );
        !           644:                                            putRV( 0 , cbn , tempoff , P2INT );
        !           645:                                            sizes[ cbn ].om_off += sizeof( int );
        !           646:                                            putleaf( P2ICON , 8 , 0 , P2INT , 0 );
        !           647:                                            putop( P2LISTOP , P2INT );
        !           648:                                            putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           649:                                            putop( P2LISTOP , P2INT );
        !           650:                                            putop( P2CALL , P2INT );
        !           651:                                        }
        !           652:                                        putop( P2LISTOP , P2INT );
        !           653:                                        break;
        !           654:                                    case TSTR:
        !           655:                                        putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
        !           656:                                        putop( P2LISTOP , P2INT );
        !           657:                                        putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !           658:                                        putop( P2LISTOP , P2INT );
        !           659:                                        putop( P2CALL , P2INT );
        !           660:                                        putop( P2COMOP , P2INT );
        !           661:                                        putop( P2LISTOP , P2INT );
        !           662:                                        break;
        !           663:                                    default:
        !           664:                                        if (opt('t')) {
        !           665:                                            putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !           666:                                            putop( P2LISTOP , P2INT );
        !           667:                                            putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !           668:                                            putop( P2LISTOP , P2INT );
        !           669:                                            putop( P2CALL , P2INT );
        !           670:                                        }
        !           671:                                        putop( P2LISTOP , P2INT );
        !           672:                                        break;
        !           673:                                    }
        !           674:                                }
        !           675:                                /*
        !           676:                                 * If there is a variable precision,
        !           677:                                 * evaluate it 
        !           678:                                 */
        !           679:                                if (fmtspec & VARPREC) {
        !           680:                                        if (opt('t')) {
        !           681:                                        putleaf( P2ICON , 0 , 0
        !           682:                                            , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           683:                                            , "_MAX" );
        !           684:                                        }
        !           685:                                        ap = stkrval( al[3] , NIL , RREQ );
        !           686:                                        if (ap == NIL)
        !           687:                                                continue;
        !           688:                                        if (isnta(ap,"i")) {
        !           689:                                                error("Second write width must be integer, not %s", nameof(ap));
        !           690:                                                continue;
        !           691:                                        }
        !           692:                                        if (opt('t')) {
        !           693:                                            putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !           694:                                            putop( P2LISTOP , P2INT );
        !           695:                                            putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !           696:                                            putop( P2LISTOP , P2INT );
        !           697:                                            putop( P2CALL , P2INT );
        !           698:                                        }
        !           699:                                        putop( P2LISTOP , P2INT );
        !           700:                                }
        !           701:                                /*
        !           702:                                 * evaluate the thing we want printed.
        !           703:                                 */
        !           704:                                switch ( typ ) {
        !           705:                                case TCHAR:
        !           706:                                case TINT:
        !           707:                                    stkrval( alv , NIL , RREQ );
        !           708:                                    putop( P2LISTOP , P2INT );
        !           709:                                    break;
        !           710:                                case TDOUBLE:
        !           711:                                    ap = stkrval( alv , NIL , RREQ );
        !           712:                                    if ( isnta( ap , "d" ) ) {
        !           713:                                        putop( P2SCONV , P2DOUBLE );
        !           714:                                    }
        !           715:                                    putop( P2LISTOP , P2INT );
        !           716:                                    break;
        !           717:                                case TSCAL:
        !           718:                                case TBOOL:
        !           719:                                    putleaf( P2ICON , 0 , 0
        !           720:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           721:                                        , "_NAM" );
        !           722:                                    ap = stkrval( alv , NIL , RREQ );
        !           723:                                    sprintf( format , PREFIXFORMAT , LABELPREFIX
        !           724:                                            , listnames( ap ) );
        !           725:                                    putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
        !           726:                                            , format );
        !           727:                                    putop( P2LISTOP , P2INT );
        !           728:                                    putop( P2CALL , P2INT );
        !           729:                                    putop( P2LISTOP , P2INT );
        !           730:                                    break;
        !           731:                                case TSTR:
        !           732:                                    putCONG( "" , 0 , LREQ );
        !           733:                                    putop( P2LISTOP , P2INT );
        !           734:                                    break;
        !           735:                                }
        !           736:                                putop( P2CALL , P2INT );
        !           737:                                putdot( filename , line );
        !           738:                        }
        !           739:                        /*
        !           740:                         * Write the string after its blank padding
        !           741:                         */
        !           742:                        if (typ == TSTR ) {
        !           743:                                if ( opt( 't' ) ) {
        !           744:                                    putleaf( P2ICON , 0 , 0
        !           745:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           746:                                        , "_WRITES" );
        !           747:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           748:                                            , P2PTR|P2STRTY );
        !           749:                                    ap = stkrval(alv, NIL , RREQ );
        !           750:                                    putop( P2LISTOP , P2INT );
        !           751:                                } else {
        !           752:                                    putleaf( P2ICON , 0 , 0
        !           753:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           754:                                        , "_fwrite" );
        !           755:                                    ap = stkrval(alv, NIL , RREQ );
        !           756:                                }
        !           757:                                if (strfmt & VARWIDTH) {
        !           758:                                            /*
        !           759:                                             *  min, inline expanded as
        !           760:                                             *  temp < len ? temp : len
        !           761:                                             */
        !           762:                                        putRV( 0 , cbn , tempoff , P2INT );
        !           763:                                        putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
        !           764:                                        putop( P2LT , P2INT );
        !           765:                                        putRV( 0 , cbn , tempoff , P2INT );
        !           766:                                        putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
        !           767:                                        putop( P2COLON , P2INT );
        !           768:                                        putop( P2QUEST , P2INT );
        !           769:                                } else {
        !           770:                                        if (   ( fmtspec & SKIP )
        !           771:                                            && ( strfmt & CONWIDTH ) ) {
        !           772:                                                strnglen = field;
        !           773:                                        }
        !           774:                                        putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
        !           775:                                }
        !           776:                                putop( P2LISTOP , P2INT );
        !           777:                                putleaf( P2ICON , 1 , 0 , P2INT , 0 );
        !           778:                                putop( P2LISTOP , P2INT );
        !           779:                                putleaf( P2ICON , 0 , 0
        !           780:                                    , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           781:                                    , "_ACTFILE" );
        !           782:                                putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           783:                                putop( P2CALL , P2INT );
        !           784:                                putop( P2LISTOP , P2INT );
        !           785:                                putop( P2CALL , P2INT );
        !           786:                                putdot( filename , line );
        !           787:                        }
        !           788:                }
        !           789:                /*
        !           790:                 * Done with arguments.
        !           791:                 * Handle writeln and
        !           792:                 * insufficent number of args.
        !           793:                 */
        !           794:                switch (p->value[0] &~ NSTAND) {
        !           795:                        case O_WRITEF:
        !           796:                                if (argc == 0)
        !           797:                                        error("Write requires an argument");
        !           798:                                break;
        !           799:                        case O_MESSAGE:
        !           800:                                if (argc == 0)
        !           801:                                        error("Message requires an argument");
        !           802:                        case O_WRITLN:
        !           803:                                if (filetype != nl+T1CHAR)
        !           804:                                        error("Can't 'writeln' a non text file");
        !           805:                                if ( opt( 't' ) ) {
        !           806:                                    putleaf( P2ICON , 0 , 0
        !           807:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           808:                                        , "_WRITLN" );
        !           809:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           810:                                            , P2PTR|P2STRTY );
        !           811:                                } else {
        !           812:                                    putleaf( P2ICON , 0 , 0
        !           813:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           814:                                        , "_fputc" );
        !           815:                                    putleaf( P2ICON , '\n' , 0 , P2CHAR , 0 );
        !           816:                                    putleaf( P2ICON , 0 , 0
        !           817:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           818:                                        , "_ACTFILE" );
        !           819:                                    putRV( 0 , cbn , CURFILEOFFSET
        !           820:                                            , P2PTR|P2STRTY );
        !           821:                                    putop( P2CALL , P2INT );
        !           822:                                    putop( P2LISTOP , P2INT );
        !           823:                                }
        !           824:                                putop( P2CALL , P2INT );
        !           825:                                putdot( filename , line );
        !           826:                                break;
        !           827:                }
        !           828:                return;
        !           829: 
        !           830:        case O_READ4:
        !           831:        case O_READLN:
        !           832:                /*
        !           833:                 * Set up default
        !           834:                 * file "input".
        !           835:                 */
        !           836:                file = NIL;
        !           837:                filetype = nl+T1CHAR;
        !           838:                /*
        !           839:                 * Determine the file implied
        !           840:                 * for the read and generate
        !           841:                 * code to make it the active file.
        !           842:                 */
        !           843:                if (argv != NIL) {
        !           844:                        codeoff();
        !           845:                        ap = stkrval(argv[1], NIL , RREQ );
        !           846:                        codeon();
        !           847:                        if (ap == NIL)
        !           848:                                argv = argv[2];
        !           849:                        if (ap != NIL && ap->class == FILET) {
        !           850:                                /*
        !           851:                                 * Got "read(f, ...", make
        !           852:                                 * f the active file, and save
        !           853:                                 * it and its type for use in
        !           854:                                 * processing the rest of the
        !           855:                                 * arguments to read.
        !           856:                                 */
        !           857:                                file = argv[1];
        !           858:                                filetype = ap->type;
        !           859:                                putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           860:                                putleaf( P2ICON , 0 , 0 
        !           861:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           862:                                        , "_UNIT" );
        !           863:                                stklval(argv[1], NOFLAGS);
        !           864:                                putop( P2CALL , P2INT );
        !           865:                                putop( P2ASSIGN , P2PTR|P2STRTY );
        !           866:                                putdot( filename , line );
        !           867:                                argv = argv[2];
        !           868:                                argc--;
        !           869:                        } else {
        !           870:                                /*
        !           871:                                 * Default is read from
        !           872:                                 * standard input.
        !           873:                                 */
        !           874:                                putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           875:                                putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
        !           876:                                putop( P2ASSIGN , P2PTR|P2STRTY );
        !           877:                                putdot( filename , line );
        !           878:                                input->nl_flags |= NUSED;
        !           879:                        }
        !           880:                } else {
        !           881:                        putRV( 0, cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !           882:                        putLV( "_input" , 0 , 0 , P2PTR|P2STRTY );
        !           883:                        putop( P2ASSIGN , P2PTR|P2STRTY );
        !           884:                        putdot( filename , line );
        !           885:                        input->nl_flags |= NUSED;
        !           886:                }
        !           887:                /*
        !           888:                 * Loop and process each
        !           889:                 * of the arguments.
        !           890:                 */
        !           891:                for (; argv != NIL; argv = argv[2]) {
        !           892:                        /*
        !           893:                         * Get the address of the target
        !           894:                         * on the stack.
        !           895:                         */
        !           896:                        al = argv[1];
        !           897:                        if (al == NIL)
        !           898:                                continue;
        !           899:                        if (al[0] != T_VAR) {
        !           900:                                error("Arguments to %s must be variables, not expressions", p->symbol);
        !           901:                                continue;
        !           902:                        }
        !           903:                        codeoff();
        !           904:                        ap = stklval(al, MOD|ASGN|NOUSE);
        !           905:                        codeon();
        !           906:                        if (ap == NIL)
        !           907:                                continue;
        !           908:                        if (filetype != nl+T1CHAR) {
        !           909:                                /*
        !           910:                                 * Generalized read, i.e.
        !           911:                                 * from a non-textfile.
        !           912:                                 */
        !           913:                                if (incompat(filetype, ap, argv[1] )) {
        !           914:                                        error("Type mismatch in read from non-text file");
        !           915:                                        continue;
        !           916:                                }
        !           917:                                /*
        !           918:                                 * var := file ^;
        !           919:                                 */
        !           920:                                ap = lvalue( al , MOD | ASGN | NOUSE , RREQ );
        !           921:                                if ( isa( ap , "bsci" ) ) {
        !           922:                                        precheck( ap , "_RANG4" , "_RSNG4" );
        !           923:                                }
        !           924:                                putleaf( P2ICON , 0 , 0
        !           925:                                    , ADDTYPE(
        !           926:                                        ADDTYPE(
        !           927:                                            ADDTYPE(
        !           928:                                                p2type( filetype ) , P2PTR )
        !           929:                                            , P2FTN )
        !           930:                                        , P2PTR )
        !           931:                                    , "_FNIL" );
        !           932:                                if (file != NIL)
        !           933:                                        stklval(file, NOFLAGS);
        !           934:                                else /* Magic */
        !           935:                                        putRV( "_input" , 0 , 0
        !           936:                                                , P2PTR | P2STRTY );
        !           937:                                putop( P2CALL , P2INT );
        !           938:                                switch ( classify( filetype ) ) {
        !           939:                                    case TBOOL:
        !           940:                                    case TCHAR:
        !           941:                                    case TINT:
        !           942:                                    case TSCAL:
        !           943:                                    case TDOUBLE:
        !           944:                                    case TPTR:
        !           945:                                        putop( P2UNARY P2MUL
        !           946:                                                , p2type( filetype ) );
        !           947:                                }
        !           948:                                switch ( classify( filetype ) ) {
        !           949:                                    case TBOOL:
        !           950:                                    case TCHAR:
        !           951:                                    case TINT:
        !           952:                                    case TSCAL:
        !           953:                                            postcheck( ap );
        !           954:                                                /* and fall through */
        !           955:                                    case TDOUBLE:
        !           956:                                    case TPTR:
        !           957:                                            putop( P2ASSIGN , p2type( ap ) );
        !           958:                                            putdot( filename , line );
        !           959:                                            break;
        !           960:                                    default:
        !           961:                                            putstrop( P2STASG
        !           962:                                                        , p2type( ap )
        !           963:                                                        , lwidth( ap )
        !           964:                                                        , align( ap ) );
        !           965:                                            putdot( filename , line );
        !           966:                                            break;
        !           967:                                }
        !           968:                                /*
        !           969:                                 * get(file);
        !           970:                                 */
        !           971:                                putleaf( P2ICON , 0 , 0 
        !           972:                                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !           973:                                        , "_GET" );
        !           974:                                putRV( 0 , cbn , CURFILEOFFSET 
        !           975:                                        , P2PTR|P2STRTY );
        !           976:                                putop( P2CALL , P2INT );
        !           977:                                putdot( filename , line );
        !           978:                                continue;
        !           979:                        }
        !           980:                            /*
        !           981:                             *  if you get to here, you are reading from
        !           982:                             *  a text file.  only possiblities are:
        !           983:                             *  character, integer, real, or scalar.
        !           984:                             *  read( f , foo , ... ) is done as
        !           985:                             *  foo := read( f ) with rangechecking
        !           986:                             *  if appropriate.
        !           987:                             */
        !           988:                        typ = classify(ap);
        !           989:                        op = rdops(typ);
        !           990:                        if (op == NIL) {
        !           991:                                error("Can't read %ss from a text file", clnames[typ]);
        !           992:                                continue;
        !           993:                        }
        !           994:                            /*
        !           995:                             *  left hand side of foo := read( f )
        !           996:                             */
        !           997:                        ap = lvalue( al , MOD|ASGN|NOUSE , RREQ );
        !           998:                        if ( isa( ap , "bsci" ) ) {
        !           999:                            precheck( ap , "_RANG4" , "_RSNG4" );
        !          1000:                        }
        !          1001:                        switch ( op ) {
        !          1002:                            case O_READC:
        !          1003:                                readname = "_READC";
        !          1004:                                readtype = P2INT;
        !          1005:                                break;
        !          1006:                            case O_READ4:
        !          1007:                                readname = "_READ4";
        !          1008:                                readtype = P2INT;
        !          1009:                                break;
        !          1010:                            case O_READ8:
        !          1011:                                readname = "_READ8";
        !          1012:                                readtype = P2DOUBLE;
        !          1013:                                break;
        !          1014:                            case O_READE:
        !          1015:                                readname = "_READE";
        !          1016:                                readtype = P2INT;
        !          1017:                                break;
        !          1018:                        }
        !          1019:                        putleaf( P2ICON , 0 , 0
        !          1020:                                , ADDTYPE( P2FTN | readtype , P2PTR )
        !          1021:                                , readname );
        !          1022:                        putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !          1023:                        if ( op == O_READE ) {
        !          1024:                                sprintf( format , PREFIXFORMAT , LABELPREFIX
        !          1025:                                        , listnames( ap ) );
        !          1026:                                putleaf( P2ICON , 0 , 0 , P2PTR | P2CHAR
        !          1027:                                        , format );
        !          1028:                                putop( P2LISTOP , P2INT );
        !          1029:                                warning();
        !          1030:                                if (opt('s')) {
        !          1031:                                        standard();
        !          1032:                                }
        !          1033:                                error("Reading scalars from text files is non-standard");
        !          1034:                        }
        !          1035:                        putop( P2CALL , readtype );
        !          1036:                        if ( isa( ap , "bcsi" ) ) {
        !          1037:                            postcheck( ap );
        !          1038:                        }
        !          1039:                        putop( P2ASSIGN , p2type( ap ) );
        !          1040:                        putdot( filename , line );
        !          1041:                }
        !          1042:                /*
        !          1043:                 * Done with arguments.
        !          1044:                 * Handle readln and
        !          1045:                 * insufficient number of args.
        !          1046:                 */
        !          1047:                if (p->value[0] == O_READLN) {
        !          1048:                        if (filetype != nl+T1CHAR)
        !          1049:                                error("Can't 'readln' a non text file");
        !          1050:                        putleaf( P2ICON , 0 , 0 
        !          1051:                                , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1052:                                , "_READLN" );
        !          1053:                        putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !          1054:                        putop( P2CALL , P2INT );
        !          1055:                        putdot( filename , line );
        !          1056:                } else if (argc == 0)
        !          1057:                        error("read requires an argument");
        !          1058:                return;
        !          1059: 
        !          1060:        case O_GET:
        !          1061:        case O_PUT:
        !          1062:                if (argc != 1) {
        !          1063:                        error("%s expects one argument", p->symbol);
        !          1064:                        return;
        !          1065:                }
        !          1066:                putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !          1067:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1068:                        , "_UNIT" );
        !          1069:                ap = stklval(argv[1], NOFLAGS);
        !          1070:                if (ap == NIL)
        !          1071:                        return;
        !          1072:                if (ap->class != FILET) {
        !          1073:                        error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
        !          1074:                        return;
        !          1075:                }
        !          1076:                putop( P2CALL , P2INT );
        !          1077:                putop( P2ASSIGN , P2PTR|P2STRTY );
        !          1078:                putdot( filename , line );
        !          1079:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1080:                        , op == O_GET ? "_GET" : "_PUT" );
        !          1081:                putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !          1082:                putop( P2CALL , P2INT );
        !          1083:                putdot( filename , line );
        !          1084:                return;
        !          1085: 
        !          1086:        case O_RESET:
        !          1087:        case O_REWRITE:
        !          1088:                if (argc == 0 || argc > 2) {
        !          1089:                        error("%s expects one or two arguments", p->symbol);
        !          1090:                        return;
        !          1091:                }
        !          1092:                if (opt('s') && argc == 2) {
        !          1093:                        standard();
        !          1094:                        error("Two argument forms of reset and rewrite are non-standard");
        !          1095:                }
        !          1096:                putleaf( P2ICON , 0 , 0 , P2INT
        !          1097:                        , op == O_RESET ? "_RESET" : "_REWRITE" );
        !          1098:                ap = stklval(argv[1], MOD|NOUSE);
        !          1099:                if (ap == NIL)
        !          1100:                        return;
        !          1101:                if (ap->class != FILET) {
        !          1102:                        error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
        !          1103:                        return;
        !          1104:                }
        !          1105:                if (argc == 2) {
        !          1106:                        /*
        !          1107:                         * Optional second argument
        !          1108:                         * is a string name of a
        !          1109:                         * UNIX (R) file to be associated.
        !          1110:                         */
        !          1111:                        al = argv[2];
        !          1112:                        al = stkrval(al[1], NOFLAGS , RREQ );
        !          1113:                        if (al == NIL)
        !          1114:                                return;
        !          1115:                        if (classify(al) != TSTR) {
        !          1116:                                error("Second argument to %s must be a string, not %s", p->symbol, nameof(al));
        !          1117:                                return;
        !          1118:                        }
        !          1119:                        strnglen = width(al);
        !          1120:                } else {
        !          1121:                        putleaf( P2ICON , 0 , 0 , P2INT , 0 );
        !          1122:                        strnglen = 0;
        !          1123:                }
        !          1124:                putop( P2LISTOP , P2INT );
        !          1125:                putleaf( P2ICON , strnglen , 0 , P2INT , 0 );
        !          1126:                putop( P2LISTOP , P2INT );
        !          1127:                putleaf( P2ICON , text(ap) ? 0: width(ap->type) , 0 , P2INT , 0 );
        !          1128:                putop( P2LISTOP , P2INT );
        !          1129:                putop( P2CALL , P2INT );
        !          1130:                putdot( filename , line );
        !          1131:                return;
        !          1132: 
        !          1133:        case O_NEW:
        !          1134:        case O_DISPOSE:
        !          1135:                if (argc == 0) {
        !          1136:                        error("%s expects at least one argument", p->symbol);
        !          1137:                        return;
        !          1138:                }
        !          1139:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1140:                        , op == O_DISPOSE ? "_DISPOSE" :
        !          1141:                                opt('t') ? "_NEWZ" : "_NEW" );
        !          1142:                ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD );
        !          1143:                if (ap == NIL)
        !          1144:                        return;
        !          1145:                if (ap->class != PTR) {
        !          1146:                        error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
        !          1147:                        return;
        !          1148:                }
        !          1149:                ap = ap->type;
        !          1150:                if (ap == NIL)
        !          1151:                        return;
        !          1152:                argv = argv[2];
        !          1153:                if (argv != NIL) {
        !          1154:                        if (ap->class != RECORD) {
        !          1155:                                error("Record required when specifying variant tags");
        !          1156:                                return;
        !          1157:                        }
        !          1158:                        for (; argv != NIL; argv = argv[2]) {
        !          1159:                                if (ap->ptr[NL_VARNT] == NIL) {
        !          1160:                                        error("Too many tag fields");
        !          1161:                                        return;
        !          1162:                                }
        !          1163:                                if (!isconst(argv[1])) {
        !          1164:                                        error("Second and successive arguments to %s must be constants", p->symbol);
        !          1165:                                        return;
        !          1166:                                }
        !          1167:                                gconst(argv[1]);
        !          1168:                                if (con.ctype == NIL)
        !          1169:                                        return;
        !          1170:                                if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) {
        !          1171:                                        cerror("Specified tag constant type clashed with variant case selector type");
        !          1172:                                        return;
        !          1173:                                }
        !          1174:                                for (ap = ap->ptr[NL_VARNT]; ap != NIL; ap = ap->chain)
        !          1175:                                        if (ap->range[0] == con.crval)
        !          1176:                                                break;
        !          1177:                                if (ap == NIL) {
        !          1178:                                        error("No variant case label value equals specified constant value");
        !          1179:                                        return;
        !          1180:                                }
        !          1181:                                ap = ap->ptr[NL_VTOREC];
        !          1182:                        }
        !          1183:                }
        !          1184:                putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
        !          1185:                putop( P2LISTOP , P2INT );
        !          1186:                putop( P2CALL , P2INT );
        !          1187:                putdot( filename , line );
        !          1188:                return;
        !          1189: 
        !          1190:        case O_DATE:
        !          1191:        case O_TIME:
        !          1192:                if (argc != 1) {
        !          1193:                        error("%s expects one argument", p->symbol);
        !          1194:                        return;
        !          1195:                }
        !          1196:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1197:                        , op == O_DATE ? "_DATE" : "_TIME" );
        !          1198:                ap = stklval(argv[1], MOD|NOUSE);
        !          1199:                if (ap == NIL)
        !          1200:                        return;
        !          1201:                if (classify(ap) != TSTR || width(ap) != 10) {
        !          1202:                        error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
        !          1203:                        return;
        !          1204:                }
        !          1205:                putop( P2CALL , P2INT );
        !          1206:                putdot( filename , line );
        !          1207:                return;
        !          1208: 
        !          1209:        case O_HALT:
        !          1210:                if (argc != 0) {
        !          1211:                        error("halt takes no arguments");
        !          1212:                        return;
        !          1213:                }
        !          1214:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1215:                        , "_HALT" );
        !          1216: 
        !          1217:                putop( P2UNARY P2CALL , P2INT );
        !          1218:                putdot( filename , line );
        !          1219:                noreach = 1;
        !          1220:                return;
        !          1221: 
        !          1222:        case O_ARGV:
        !          1223:                if (argc != 2) {
        !          1224:                        error("argv takes two arguments");
        !          1225:                        return;
        !          1226:                }
        !          1227:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1228:                        , "_ARGV" );
        !          1229:                ap = stkrval(argv[1], NIL , RREQ );
        !          1230:                if (ap == NIL)
        !          1231:                        return;
        !          1232:                if (isnta(ap, "i")) {
        !          1233:                        error("argv's first argument must be an integer, not %s", nameof(ap));
        !          1234:                        return;
        !          1235:                }
        !          1236:                al = argv[2];
        !          1237:                ap = stklval(al[1], MOD|NOUSE);
        !          1238:                if (ap == NIL)
        !          1239:                        return;
        !          1240:                if (classify(ap) != TSTR) {
        !          1241:                        error("argv's second argument must be a string, not %s", nameof(ap));
        !          1242:                        return;
        !          1243:                }
        !          1244:                putop( P2LISTOP , P2INT );
        !          1245:                putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
        !          1246:                putop( P2LISTOP , P2INT );
        !          1247:                putop( P2CALL , P2INT );
        !          1248:                putdot( filename , line );
        !          1249:                return;
        !          1250: 
        !          1251:        case O_STLIM:
        !          1252:                if (argc != 1) {
        !          1253:                        error("stlimit requires one argument");
        !          1254:                        return;
        !          1255:                }
        !          1256:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1257:                        , "_STLIM" );
        !          1258:                ap = stkrval(argv[1], NIL , RREQ );
        !          1259:                if (ap == NIL)
        !          1260:                        return;
        !          1261:                if (isnta(ap, "i")) {
        !          1262:                        error("stlimit's argument must be an integer, not %s", nameof(ap));
        !          1263:                        return;
        !          1264:                }
        !          1265:                putop( P2CALL , P2INT );
        !          1266:                putdot( filename , line );
        !          1267:                return;
        !          1268: 
        !          1269:        case O_REMOVE:
        !          1270:                if (argc != 1) {
        !          1271:                        error("remove expects one argument");
        !          1272:                        return;
        !          1273:                }
        !          1274:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1275:                        , "_REMOVE" );
        !          1276:                ap = stkrval(argv[1], NOFLAGS , RREQ );
        !          1277:                if (ap == NIL)
        !          1278:                        return;
        !          1279:                if (classify(ap) != TSTR) {
        !          1280:                        error("remove's argument must be a string, not %s", nameof(ap));
        !          1281:                        return;
        !          1282:                }
        !          1283:                putleaf( P2ICON , width( ap ) , 0 , P2INT , 0 );
        !          1284:                putop( P2LISTOP , P2INT );
        !          1285:                putop( P2CALL , P2INT );
        !          1286:                putdot( filename , line );
        !          1287:                return;
        !          1288: 
        !          1289:        case O_LLIMIT:
        !          1290:                if (argc != 2) {
        !          1291:                        error("linelimit expects two arguments");
        !          1292:                        return;
        !          1293:                }
        !          1294:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1295:                        , "_LLIMIT" );
        !          1296:                ap = stklval(argv[1], NOFLAGS|NOUSE);
        !          1297:                if (ap == NIL)
        !          1298:                        return;
        !          1299:                if (!text(ap)) {
        !          1300:                        error("linelimit's first argument must be a text file, not %s", nameof(ap));
        !          1301:                        return;
        !          1302:                }
        !          1303:                al = argv[2];
        !          1304:                ap = stkrval(al[1], NIL , RREQ );
        !          1305:                if (ap == NIL)
        !          1306:                        return;
        !          1307:                if (isnta(ap, "i")) {
        !          1308:                        error("linelimit's second argument must be an integer, not %s", nameof(ap));
        !          1309:                        return;
        !          1310:                }
        !          1311:                putop( P2LISTOP , P2INT );
        !          1312:                putop( P2CALL , P2INT );
        !          1313:                putdot( filename , line );
        !          1314:                return;
        !          1315:        case O_PAGE:
        !          1316:                if (argc != 1) {
        !          1317:                        error("page expects one argument");
        !          1318:                        return;
        !          1319:                }
        !          1320:                putRV( 0 , cbn , CURFILEOFFSET , P2PTR|P2STRTY );
        !          1321:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1322:                        , "_UNIT" );
        !          1323:                ap = stklval(argv[1], NOFLAGS);
        !          1324:                if (ap == NIL)
        !          1325:                        return;
        !          1326:                if (!text(ap)) {
        !          1327:                        error("Argument to page must be a text file, not %s", nameof(ap));
        !          1328:                        return;
        !          1329:                }
        !          1330:                putop( P2CALL , P2INT );
        !          1331:                putop( P2ASSIGN , P2PTR|P2STRTY );
        !          1332:                putdot( filename , line );
        !          1333:                if ( opt( 't' ) ) {
        !          1334:                    putleaf( P2ICON , 0 , 0
        !          1335:                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1336:                        , "_PAGE" );
        !          1337:                    putRV( 0 , cbn , CURFILEOFFSET
        !          1338:                            , P2PTR|P2STRTY );
        !          1339:                } else {
        !          1340:                    putleaf( P2ICON , 0 , 0
        !          1341:                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1342:                        , "_fputc" );
        !          1343:                    putleaf( P2ICON , '\f' , 0 , P2CHAR , 0 );
        !          1344:                    putleaf( P2ICON , 0 , 0
        !          1345:                        , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1346:                        , "_ACTFILE" );
        !          1347:                    putRV( 0 , cbn , CURFILEOFFSET
        !          1348:                            , P2PTR|P2STRTY );
        !          1349:                    putop( P2CALL , P2INT );
        !          1350:                    putop( P2LISTOP , P2INT );
        !          1351:                }
        !          1352:                putop( P2CALL , P2INT );
        !          1353:                putdot( filename , line );
        !          1354:                return;
        !          1355: 
        !          1356:        case O_PACK:
        !          1357:                if (argc != 3) {
        !          1358:                        error("pack expects three arguments");
        !          1359:                        return;
        !          1360:                }
        !          1361:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1362:                        , "_PACK" );
        !          1363:                pu = "pack(a,i,z)";
        !          1364:                pua = (al = argv)[1];
        !          1365:                pui = (al = al[2])[1];
        !          1366:                puz = (al = al[2])[1];
        !          1367:                goto packunp;
        !          1368:        case O_UNPACK:
        !          1369:                if (argc != 3) {
        !          1370:                        error("unpack expects three arguments");
        !          1371:                        return;
        !          1372:                }
        !          1373:                putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
        !          1374:                        , "_UNPACK" );
        !          1375:                pu = "unpack(z,a,i)";
        !          1376:                puz = (al = argv)[1];
        !          1377:                pua = (al = al[2])[1];
        !          1378:                pui = (al = al[2])[1];
        !          1379: packunp:
        !          1380:                ap = stkrval((int *) pui, NLNIL , RREQ );
        !          1381:                if (ap == NIL)
        !          1382:                        return;
        !          1383:                ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
        !          1384:                if (ap == NIL)
        !          1385:                        return;
        !          1386:                if (ap->class != ARRAY) {
        !          1387:                        error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
        !          1388:                        return;
        !          1389:                }
        !          1390:                putop( P2LISTOP , P2INT );
        !          1391:                al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
        !          1392:                if (al->class != ARRAY) {
        !          1393:                        error("%s requires z to be a packed array, not %s", pu, nameof(ap));
        !          1394:                        return;
        !          1395:                }
        !          1396:                if (al->type == NIL || ap->type == NIL)
        !          1397:                        return;
        !          1398:                if (al->type != ap->type) {
        !          1399:                        error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
        !          1400:                        return;
        !          1401:                }
        !          1402:                putop( P2LISTOP , P2INT );
        !          1403:                k = width(al);
        !          1404:                itemwidth = width(ap->type);
        !          1405:                ap = ap->chain;
        !          1406:                al = al->chain;
        !          1407:                if (ap->chain != NIL || al->chain != NIL) {
        !          1408:                        error("%s requires a and z to be single dimension arrays", pu);
        !          1409:                        return;
        !          1410:                }
        !          1411:                if (ap == NIL || al == NIL)
        !          1412:                        return;
        !          1413:                /*
        !          1414:                 * al is the range for z i.e. u..v
        !          1415:                 * ap is the range for a i.e. m..n
        !          1416:                 * i will be n-m+1
        !          1417:                 * j will be v-u+1
        !          1418:                 */
        !          1419:                i = ap->range[1] - ap->range[0] + 1;
        !          1420:                j = al->range[1] - al->range[0] + 1;
        !          1421:                if (i < j) {
        !          1422:                        error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i);
        !          1423:                        return;
        !          1424:                }
        !          1425:                /*
        !          1426:                 * get n-m-(v-u) and m for the interpreter
        !          1427:                 */
        !          1428:                i -= j;
        !          1429:                j = ap->range[0];
        !          1430:                putleaf( P2ICON , itemwidth , 0 , P2INT , 0 );
        !          1431:                putop( P2LISTOP , P2INT );
        !          1432:                putleaf( P2ICON , j , 0 , P2INT , 0 );
        !          1433:                putop( P2LISTOP , P2INT );
        !          1434:                putleaf( P2ICON , i , 0 , P2INT , 0 );
        !          1435:                putop( P2LISTOP , P2INT );
        !          1436:                putleaf( P2ICON , k , 0 , P2INT , 0 );
        !          1437:                putop( P2LISTOP , P2INT );
        !          1438:                putop( P2CALL , P2INT );
        !          1439:                putdot( filename , line );
        !          1440:                return;
        !          1441:        case 0:
        !          1442:                error("%s is an unimplemented 6400 extension", p->symbol);
        !          1443:                return;
        !          1444: 
        !          1445:        default:
        !          1446:                panic("proc case");
        !          1447:        }
        !          1448: }
        !          1449: #endif PC

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