BSD 4_4 release

[unix-history] / usr / src / usr.bin / pascal / src / proc.c

diff --git a/usr/src/usr.bin/pascal/src/proc.c b/usr/src/usr.bin/pascal/src/proc.c
index 61180fe..2cb28b4 100644 (file)
--- a/usr/src/usr.bin/pascal/src/proc.c
+++ b/usr/src/usr.bin/pascal/src/proc.c
@@ -1,6 +1,39 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*-
+ * Copyright (c) 1980, 1993
+ *     The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *     This product includes software developed by the University of
+ *     California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */

 
 

-static char sccsid[] = "@(#)proc.c 1.2 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)proc.c     8.1 (Berkeley) 6/6/93";
+#endif /* not lint */

 
 #include "whoami.h"
 #ifdef OBJ
 
 #include "whoami.h"
 #ifdef OBJ


@@ -11,6 +44,22 @@ static       char sccsid[] = "@(#)proc.c 1.2 %G%";
 #include "tree.h"
 #include "opcode.h"
 #include "objfmt.h"
 #include "tree.h"
 #include "opcode.h"
 #include "objfmt.h"

+#include "tmps.h"
+#include "tree_ty.h"
+
+/*
+ * The constant EXPOSIZE specifies the number of digits in the exponent
+ * of real numbers.
+ *
+ * The constant REALSPC defines the amount of forced padding preceeding
+ * real numbers when they are printed. If REALSPC == 0, then no padding
+ * is added, REALSPC == 1 adds one extra blank irregardless of the width
+ * specified by the user.
+ *
+ * N.B. - Values greater than one require program mods.
+ */
+#define EXPOSIZE       2
+#define        REALSPC         0

 
 /*
  * The following array is used to determine which classes may be read
 
 /*
  * The following array is used to determine which classes may be read


@@ -40,17 +89,21 @@ int rdxxxx[] = {
  * builtin procedures are handled here.
  */
 proc(r)
  * builtin procedures are handled here.
  */
 proc(r)

-       int *r;
+       struct tnode *r;

 {
        register struct nl *p;
 {
        register struct nl *p;

-       register int *alv, *al, op;
-       struct nl *filetype, *ap;
-       int argc, *argv, typ, fmtspec, strfmt, stkcnt, *file;
-       char fmt, format[20], *strptr;
-       int prec, field, strnglen, fmtlen, fmtstart, pu;
-       int *pua, *pui, *puz;
+       register struct tnode *alv, *al;
+       register int op;
+       struct nl *filetype, *ap, *al1;
+       int argc, typ, fmtspec, strfmt, stkcnt;
+       struct tnode *argv; 
+       char fmt, format[20], *strptr, *pu;
+       int prec, field, strnglen, fmtlen, fmtstart;
+       struct tnode *pua, *pui, *puz, *file;

        int i, j, k;
        int itemwidth;
        int i, j, k;
        int itemwidth;

+       struct tmps soffset;
+       struct nl       *tempnlp;

 
 #define        CONPREC 4
 #define        VARPREC 8
 
 #define        CONPREC 4
 #define        VARPREC 8


@@ -63,24 +116,24 @@ proc(r)
         * defined and is that of a
         * procedure.
         */
         * defined and is that of a
         * procedure.
         */

-       p = lookup(r[2]);
+       p = lookup(r->pcall_node.proc_id);

        if (p == NIL) {
        if (p == NIL) {

-               rvlist(r[3]);
+               rvlist(r->pcall_node.arg);

                return;
        }
        if (p->class != PROC && p->class != FPROC) {
                error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);
                return;
        }
        if (p->class != PROC && p->class != FPROC) {
                error("Can't call %s, its %s not a procedure", p->symbol, classes[p->class]);

-               rvlist(r[3]);
+               rvlist(r->pcall_node.arg);

                return;
        }
                return;
        }

-       argv = r[3];
+       argv = r->pcall_node.arg;

 
        /*
         * Call handles user defined
         * procedures and functions.
         */
        if (bn != 0) {
 
        /*
         * Call handles user defined
         * procedures and functions.
         */
        if (bn != 0) {

-               call(p, argv, PROC, bn);
+               (void) call(p, argv, PROC, bn);

                return;
        }
 
                return;
        }
 


@@ -89,7 +142,7 @@ proc(r)
         * Count the arguments.
         */
        argc = 0;
         * Count the arguments.
         */
        argc = 0;

-       for (al = argv; al != NIL; al = al[2])
+       for (al = argv; al != TR_NIL; al = al->list_node.next)

                argc++;
 
        /*
                argc++;
 
        /*


@@ -111,21 +164,21 @@ proc(r)
 
        case O_FLUSH:
                if (argc == 0) {
 
        case O_FLUSH:
                if (argc == 0) {

-                       put(1, O_MESSAGE);
+                       (void) put(1, O_MESSAGE);

                        return;
                }
                if (argc != 1) {
                        error("flush takes at most one argument");
                        return;
                }
                        return;
                }
                if (argc != 1) {
                        error("flush takes at most one argument");
                        return;
                }

-               ap = stkrval(argv[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list, NIL );
+               if (ap == NLNIL)

                        return;
                if (ap->class != FILET) {
                        error("flush's argument must be a file, not %s", nameof(ap));
                        return;
                }
                        return;
                if (ap->class != FILET) {
                        error("flush's argument must be a file, not %s", nameof(ap));
                        return;
                }

-               put(1, op);
+               (void) put(1, op);

                return;
 
        case O_MESSAGE:
                return;
 
        case O_MESSAGE:


@@ -148,19 +201,20 @@ proc(r)
                         * a character file.
                         * Thus "output" will suit us fine.
                         */
                         * a character file.
                         * Thus "output" will suit us fine.
                         */

-                       put(1, O_MESSAGE);
-               } else if (argv != NIL && (al = argv[1])[0] != T_WEXP) {
+                       (void) put(1, O_MESSAGE);
+               } else if (argv != TR_NIL && (al = argv->list_node.list)->tag !=
+                                       T_WEXP) {

                        /*
                         * If there is a first argument which has
                         * no write widths, then it is potentially
                         * a file name.
                         */
                        codeoff();
                        /*
                         * If there is a first argument which has
                         * no write widths, then it is potentially
                         * a file name.
                         */
                        codeoff();

-                       ap = stkrval(argv[1], NIL , RREQ );
+                       ap = stkrval(argv->list_node.list, NLNIL, (long) RREQ );

                        codeon();
                        codeon();

-                       if (ap == NIL)
-                               argv = argv[2];
-                       if (ap != NIL && ap->class == FILET) {
+                       if (ap == NLNIL)
+                               argv = argv->list_node.next;
+                       if (ap != NLNIL && ap->class == FILET) {

                                /*
                                 * Got "write(f, ...", make
                                 * f the active file, and save
                                /*
                                 * Got "write(f, ...", make
                                 * f the active file, and save


@@ -168,34 +222,38 @@ proc(r)
                                 * processing the rest of the
                                 * arguments to write.
                                 */
                                 * processing the rest of the
                                 * arguments to write.
                                 */

-                               file = argv[1];
+                               file = argv->list_node.list;

                                filetype = ap->type;
                                filetype = ap->type;

-                               stkrval(argv[1], NIL , RREQ );
-                               put(1, O_UNIT);
+                               (void) stklval(argv->list_node.list, NIL );
+                               (void) put(1, O_UNIT);

                                /*
                                 * Skip over the first argument
                                 */
                                /*
                                 * Skip over the first argument
                                 */

-                               argv = argv[2];
+                               argv = argv->list_node.next;

                                argc--;
                                argc--;

-                       } else
+                       } else {

                                /*
                                 * Set up for writing on 
                                 * standard output.
                                 */
                                /*
                                 * Set up for writing on 
                                 * standard output.
                                 */

-                               put(1, O_UNITOUT);
-               } else
-                       put(1, O_UNITOUT);
+                               (void) put(1, O_UNITOUT);
+                               output->nl_flags |= NUSED;
+                       }
+               } else {
+                       (void) put(1, O_UNITOUT);
+                       output->nl_flags |= NUSED;
+               }

                /*
                 * Loop and process each
                 * of the arguments.
                 */
                /*
                 * Loop and process each
                 * of the arguments.
                 */

-               for (; argv != NIL; argv = argv[2]) {
+               for (; argv != TR_NIL; argv = argv->list_node.next) {

                        /*
                         * fmtspec indicates the type (CONstant or VARiable)
                         *      and number (none, WIDTH, and/or PRECision)
                         *      of the fields in the printf format for this
                         *      output variable.
                        /*
                         * fmtspec indicates the type (CONstant or VARiable)
                         *      and number (none, WIDTH, and/or PRECision)
                         *      of the fields in the printf format for this
                         *      output variable.

-                        * stkcnt is the number of longs pushed on the stack
+                        * stkcnt is the number of bytes pushed on the stack

                         * fmt is the format output indicator (D, E, F, O, X, S)
                         * fmtstart = 0 for leading blank; = 1 for no blank
                         */
                         * fmt is the format output indicator (D, E, F, O, X, S)
                         * fmtstart = 0 for leading blank; = 1 for no blank
                         */


@@ -203,22 +261,22 @@ proc(r)
                        stkcnt = 0;
                        fmt = 'D';
                        fmtstart = 1;
                        stkcnt = 0;
                        fmt = 'D';
                        fmtstart = 1;

-                       al = argv[1];
-                       if (al == NIL)
+                       al = argv->list_node.list;
+                       if (al == TR_NIL)

                                continue;
                                continue;

-                       if (al[0] == T_WEXP)
-                               alv = al[1];
+                       if (al->tag == T_WEXP)
+                               alv = al->wexpr_node.expr1;

                        else
                                alv = al;
                        else
                                alv = al;

-                       if (alv == NIL)
+                       if (alv == TR_NIL)

                                continue;
                        codeoff();
                                continue;
                        codeoff();

-                       ap = stkrval(alv, NIL , RREQ );
+                       ap = stkrval(alv, NLNIL , (long) RREQ );

                        codeon();
                        codeon();

-                       if (ap == NIL)
+                       if (ap == NLNIL)

                                continue;
                        typ = classify(ap);
                                continue;
                        typ = classify(ap);

-                       if (al[0] == T_WEXP) {
+                       if (al->tag == T_WEXP) {

                                /*
                                 * Handle width expressions.
                                 * The basic game here is that width
                                /*
                                 * Handle width expressions.
                                 * The basic game here is that width


@@ -229,15 +287,17 @@ proc(r)
                                 * the stack and an indirection is
                                 * put into the format string.
                                 */
                                 * the stack and an indirection is
                                 * put into the format string.
                                 */

-                               if (al[3] == OCT)
+                               if (al->wexpr_node.expr3 == 
+                                               (struct tnode *) OCT)

                                        fmt = 'O';
                                        fmt = 'O';

-                               else if (al[3] == HEX)
+                               else if (al->wexpr_node.expr3 == 
+                                               (struct tnode *) HEX)

                                        fmt = 'X';
                                        fmt = 'X';

-                               else if (al[3] != NIL) {
+                               else if (al->wexpr_node.expr3 != TR_NIL) {

                                        /*
                                         * Evaluate second format spec
                                         */
                                        /*
                                         * Evaluate second format spec
                                         */

-                                       if ( constval(al[3])
+                                       if ( constval(al->wexpr_node.expr3)

                                            && isa( con.ctype , "i" ) ) {
                                                fmtspec += CONPREC;
                                                prec = con.crval;
                                            && isa( con.ctype , "i" ) ) {
                                                fmtspec += CONPREC;
                                                prec = con.crval;


@@ -262,8 +322,8 @@ proc(r)
                                /*
                                 * Evaluate first format spec
                                 */
                                /*
                                 * Evaluate first format spec
                                 */

-                               if (al[2] != NIL) {
-                                       if ( constval(al[2])
+                               if (al->wexpr_node.expr2 != TR_NIL) {
+                                       if ( constval(al->wexpr_node.expr2)

                                            && isa( con.ctype , "i" ) ) {
                                                fmtspec += CONWIDTH;
                                                field = con.crval;
                                            && isa( con.ctype , "i" ) ) {
                                                fmtspec += CONWIDTH;
                                                field = con.crval;


@@ -276,6 +336,12 @@ proc(r)
                                        error("Negative widths are not allowed");
                                        continue;
                                }
                                        error("Negative widths are not allowed");
                                        continue;
                                }

+                               if ( opt('s') &&
+                                   ((fmtspec & CONPREC) && prec == 0 ||
+                                   (fmtspec & CONWIDTH) && field == 0)) {
+                                       standard();
+                                       error("Zero widths are non-standard");
+                               }

                        }
                        if (filetype != nl+T1CHAR) {
                                if (fmt == 'O' || fmt == 'X') {
                        }
                        if (filetype != nl+T1CHAR) {
                                if (fmt == 'O' || fmt == 'X') {


@@ -290,24 +356,25 @@ proc(r)
                                 * Generalized write, i.e.
                                 * to a non-textfile.
                                 */
                                 * Generalized write, i.e.
                                 * to a non-textfile.
                                 */

-                               stkrval(file, NIL , RREQ );
-                               put(1, O_FNIL);
+                               (void) stklval(file, NIL );
+                               (void) put(1, O_FNIL);

                                /*
                                 * file^ := ...
                                 */
                                /*
                                 * file^ := ...
                                 */

-                               ap = rvalue(argv[1], NIL);
-                               if (ap == NIL)
+                               ap = rvalue(argv->list_node.list, NLNIL, LREQ);
+                               if (ap == NLNIL)

                                        continue;
                                        continue;

-                               if (incompat(ap, filetype, argv[1])) {
+                               if (incompat(ap, filetype,
+                                               argv->list_node.list)) {

                                        cerror("Type mismatch in write to non-text file");
                                        continue;
                                }
                                convert(ap, filetype);
                                        cerror("Type mismatch in write to non-text file");
                                        continue;
                                }
                                convert(ap, filetype);

-                               put(2, O_AS, width(filetype));
+                               (void) put(2, O_AS, width(filetype));

                                /*
                                 * put(file)
                                 */
                                /*
                                 * put(file)
                                 */

-                               put(1, O_PUT);
+                               (void) put(1, O_PUT);

                                continue;
                        }
                        /*
                                continue;
                        }
                        /*


@@ -334,14 +401,22 @@ proc(r)
                         * the default.
                         */
                        switch (typ) {
                         * the default.
                         */
                        switch (typ) {

+                       case TPTR:
+                               warning();
+                               if (opt('s')) {
+                                       standard();
+                               }
+                               error("Writing %ss to text files is non-standard",
+                                   clnames[typ]);
+                               /* and fall through */

                        case TINT:
                                if (fmt != 'f') {
                        case TINT:
                                if (fmt != 'f') {

-                                       ap = stkrval(alv, NIL , RREQ );
-                                       stkcnt++;
+                                       ap = stkrval(alv, NLNIL, (long) RREQ );
+                                       stkcnt += sizeof(long);

                                } else {
                                } else {

-                                       ap = stkrval(alv, NIL , RREQ );
-                                       put(1, O_ITOD);
-                                       stkcnt += 2;
+                                       ap = stkrval(alv, NLNIL, (long) RREQ );
+                                       (void) put(1, O_ITOD);
+                                       stkcnt += sizeof(double);

                                        typ = TDOUBLE;
                                        goto tdouble;
                                }
                                        typ = TDOUBLE;
                                        goto tdouble;
                                }


@@ -359,51 +434,66 @@ proc(r)
                                break;
                        case TCHAR:
                             tchar:
                                break;
                        case TCHAR:
                             tchar:

-                               ap = stkrval(alv, NIL , RREQ );
-                               stkcnt++;
+                               if (fmtspec == NIL) {
+                                       (void) put(1, O_FILE);
+                                       ap = stkrval(alv, NLNIL, (long) RREQ );
+                                       convert(nl + T4INT, INT_TYP);
+                                       (void) put(2, O_WRITEC,
+                                               sizeof(char *) + sizeof(int));
+                                       fmtspec = SKIP;
+                                       break;
+                               }
+                               ap = stkrval(alv, NLNIL , (long) RREQ );
+                               convert(nl + T4INT, INT_TYP);
+                               stkcnt += sizeof(int);

                                fmt = 'c';
                                break;
                        case TSCAL:
                                fmt = 'c';
                                break;
                        case TSCAL:

+                               warning();

                                if (opt('s')) {
                                        standard();
                                if (opt('s')) {
                                        standard();

-                                       error("Writing scalars to text files is non-standard");

                                }
                                }

+                               error("Writing %ss to text files is non-standard",
+                                   clnames[typ]);
+                               /* and fall through */

                        case TBOOL:
                        case TBOOL:

-                               stkrval(alv, NIL , RREQ );
-                               put(2, O_NAM, listnames(ap));
-                               stkcnt++;
+                               (void) stkrval(alv, NLNIL , (long) RREQ );
+                               (void) put(2, O_NAM, (long)listnames(ap));
+                               stkcnt += sizeof(char *);

                                fmt = 's';
                                break;
                        case TDOUBLE:
                                fmt = 's';
                                break;
                        case TDOUBLE:

-                               ap = stkrval(alv, TDOUBLE , RREQ );
-                               stkcnt += 2;
+                               ap = stkrval(alv, (struct nl *) TDOUBLE , (long) RREQ );
+                               stkcnt += sizeof(double);

                             tdouble:
                                switch (fmtspec) {
                                case NIL:
                             tdouble:
                                switch (fmtspec) {
                                case NIL:

-                                       field = 21;
-                                       prec = 14;
-                                       fmt = 'E';
+                                       field = 14 + (5 + EXPOSIZE);
+                                       prec = field - (5 + EXPOSIZE);
+                                       fmt = 'e';

                                        fmtspec = CONWIDTH + CONPREC;
                                        break;
                                case CONWIDTH:
                                        fmtspec = CONWIDTH + CONPREC;
                                        break;
                                case CONWIDTH:

-                                       if (--field < 1)
+                                       field -= REALSPC;
+                                       if (field < 1)

                                                field = 1;
                                                field = 1;

-                                       prec = field - 7;
+                                       prec = field - (5 + EXPOSIZE);

                                        if (prec < 1)
                                                prec = 1;
                                        fmtspec += CONPREC;
                                        if (prec < 1)
                                                prec = 1;
                                        fmtspec += CONPREC;

-                                       fmt = 'E';
+                                       fmt = 'e';

                                        break;
                                case CONWIDTH + CONPREC:
                                case CONWIDTH + VARPREC:
                                        break;
                                case CONWIDTH + CONPREC:
                                case CONWIDTH + VARPREC:

-                                       if (--field < 1)
+                                       field -= REALSPC;
+                                       if (field < 1)

                                                field = 1;
                                }
                                format[0] = ' ';
                                                field = 1;
                                }
                                format[0] = ' ';

-                               fmtstart = 0;
+                               fmtstart = 1 - REALSPC;

                                break;
                        case TSTR:
                                break;
                        case TSTR:

-                               constval( alv );
+                               (void) constval( alv );

                                switch ( classify( con.ctype ) ) {
                                    case TCHAR:
                                        typ = TCHAR;
                                switch ( classify( con.ctype ) ) {
                                    case TCHAR:
                                        typ = TCHAR;


@@ -433,9 +523,9 @@ proc(r)
                                /*
                                 * push string to implement leading blank padding
                                 */
                                /*
                                 * push string to implement leading blank padding
                                 */

-                               put(2, O_LVCON, 2);
+                               (void) put(2, O_LVCON, 2);

                                putstr("", 0);
                                putstr("", 0);

-                               stkcnt++;
+                               stkcnt += sizeof(char *);

                                break;
                        default:
                                error("Can't write %ss to a text file", clnames[typ]);
                                break;
                        default:
                                error("Can't write %ss to a text file", clnames[typ]);


@@ -446,7 +536,8 @@ proc(r)
                         * the stack
                         */
                        if (fmtspec & VARPREC) {
                         * the stack
                         */
                        if (fmtspec & VARPREC) {

-                               ap = stkrval(al[3], NIL , RREQ );
+                               ap = stkrval(al->wexpr_node.expr3, NLNIL ,
+                                               (long) RREQ );

                                if (ap == NIL)
                                        continue;
                                if (isnta(ap,"i")) {
                                if (ap == NIL)
                                        continue;
                                if (isnta(ap,"i")) {


@@ -454,9 +545,10 @@ proc(r)
                                        continue;
                                }
                                if ( opt( 't' ) ) {
                                        continue;
                                }
                                if ( opt( 't' ) ) {

-                                   put(3, O_MAX, 0, 0);
+                                   (void) put(3, O_MAX, 0, 0);

                                }
                                }

-                               stkcnt++;
+                               convert(nl+T4INT, INT_TYP);
+                               stkcnt += sizeof(int);

                        }
                        /*
                         * If there is a variable width, evaluate it onto
                        }
                        /*
                         * If there is a variable width, evaluate it onto


@@ -465,19 +557,19 @@ proc(r)
                        if (fmtspec & VARWIDTH) {
                                if ( ( typ == TDOUBLE && fmtspec == VARWIDTH )
                                    || typ == TSTR ) {
                        if (fmtspec & VARWIDTH) {
                                if ( ( typ == TDOUBLE && fmtspec == VARWIDTH )
                                    || typ == TSTR ) {

-                                       i = sizes[cbn].om_off -= sizeof(int);
-                                       if (i < sizes[cbn].om_max)
-                                               sizes[cbn].om_max = i;
-                                       put(2, O_LV | cbn << 8 + INDX, i);
+                                       soffset = sizes[cbn].curtmps;
+                                       tempnlp = tmpalloc((long) (sizeof(long)),
+                                               nl+T4INT, REGOK);
+                                       (void) put(2, O_LV | cbn << 8 + INDX, 
+                                           tempnlp -> value[ NL_OFFS ] );

                                }
                                }

-                               ap = stkrval(al[2], NIL , RREQ );
+                               ap = stkrval(al->wexpr_node.expr2, NLNIL, (long) RREQ );

                                if (ap == NIL)
                                        continue;
                                if (isnta(ap,"i")) {
                                        error("First write width must be integer, not %s", nameof(ap));
                                        continue;
                                }
                                if (ap == NIL)
                                        continue;
                                if (isnta(ap,"i")) {
                                        error("First write width must be integer, not %s", nameof(ap));
                                        continue;
                                }

-                               stkcnt++;

                                /*
                                 * Perform special processing on widths based
                                 * on data type 
                                /*
                                 * Perform special processing on widths based
                                 * on data type 


@@ -485,27 +577,35 @@ proc(r)
                                switch (typ) {
                                case TDOUBLE:
                                        if (fmtspec == VARWIDTH) {
                                switch (typ) {
                                case TDOUBLE:
                                        if (fmtspec == VARWIDTH) {

-                                               fmt = 'E';
-                                               put(1, O_AS4);
-                                               put(2, O_RV4 | cbn << 8 + INDX, i);
-                                               put(3, O_MAX, 8, 1);
-                                               put(2, O_RV4 | cbn << 8 + INDX, i);
-                                               stkcnt++;
+                                               fmt = 'e';
+                                               (void) put(1, O_AS4);
+                                               (void) put(2, O_RV4 | cbn << 8 + INDX,
+                                                   tempnlp -> value[NL_OFFS] );
+                                               (void) put(3, O_MAX,
+                                                   5 + EXPOSIZE + REALSPC, 1);
+                                               convert(nl+T4INT, INT_TYP);
+                                               stkcnt += sizeof(int);
+                                               (void) put(2, O_RV4 | cbn << 8 + INDX, 
+                                                   tempnlp->value[NL_OFFS] );

                                                fmtspec += VARPREC;
                                                fmtspec += VARPREC;

+                                               tmpfree(&soffset);

                                        }
                                        }

-                                       put(3, O_MAX, 1, 1);
+                                       (void) put(3, O_MAX, REALSPC, 1);

                                        break;
                                case TSTR:
                                        break;
                                case TSTR:

-                                       put(1, O_AS4);
-                                       put(2, O_RV4 | cbn << 8 + INDX, i);
-                                       put(3, O_MAX, strnglen, 0);
+                                       (void) put(1, O_AS4);
+                                       (void) put(2, O_RV4 | cbn << 8 + INDX, 
+                                           tempnlp -> value[ NL_OFFS ] );
+                                       (void) put(3, O_MAX, strnglen, 0);

                                        break;
                                default:
                                        if ( opt( 't' ) ) {
                                        break;
                                default:
                                        if ( opt( 't' ) ) {

-                                           put(3, O_MAX, 0, 0);
+                                           (void) put(3, O_MAX, 0, 0);

                                        }
                                        break;
                                }
                                        }
                                        break;
                                }

+                               convert(nl+T4INT, INT_TYP);
+                               stkcnt += sizeof(int);

                        }
                        /*
                         * Generate the format string
                        }
                        /*
                         * Generate the format string


@@ -513,58 +613,58 @@ proc(r)
                        switch (fmtspec) {
                        default:
                                panic("fmt2");
                        switch (fmtspec) {
                        default:
                                panic("fmt2");

-                       case NIL:
-                               if (fmt == 'c')
-                                       put(1, O_WRITEC);
-                               else  {
-                                       sprintf(&format[1], "%%%c", fmt);
-                                       goto fmtgen;
-                               }

                        case SKIP:
                                break;
                        case SKIP:
                                break;

+                       case NIL:
+                               sprintf(&format[1], "%%%c", fmt);
+                               goto fmtgen;

                        case CONWIDTH:
                        case CONWIDTH:

-                               sprintf(&format[1], "%%%1D%c", field, fmt);
+                               sprintf(&format[1], "%%%d%c", field, fmt);

                                goto fmtgen;
                        case VARWIDTH:
                                sprintf(&format[1], "%%*%c", fmt);
                                goto fmtgen;
                        case CONWIDTH + CONPREC:
                                goto fmtgen;
                        case VARWIDTH:
                                sprintf(&format[1], "%%*%c", fmt);
                                goto fmtgen;
                        case CONWIDTH + CONPREC:

-                               sprintf(&format[1], "%%%1D.%1D%c", field, prec, fmt);
+                               sprintf(&format[1], "%%%d.%d%c", field, prec, fmt);

                                goto fmtgen;
                        case CONWIDTH + VARPREC:
                                goto fmtgen;
                        case CONWIDTH + VARPREC:

-                               sprintf(&format[1], "%%%1D.*%c", field, fmt);
+                               sprintf(&format[1], "%%%d.*%c", field, fmt);

                                goto fmtgen;
                        case VARWIDTH + CONPREC:
                                goto fmtgen;
                        case VARWIDTH + CONPREC:

-                               sprintf(&format[1], "%%*.%1D%c", prec, fmt);
+                               sprintf(&format[1], "%%*.%d%c", prec, fmt);

                                goto fmtgen;
                        case VARWIDTH + VARPREC:
                                sprintf(&format[1], "%%*.*%c", fmt);
                        fmtgen:
                                fmtlen = lenstr(&format[fmtstart], 0);
                                goto fmtgen;
                        case VARWIDTH + VARPREC:
                                sprintf(&format[1], "%%*.*%c", fmt);
                        fmtgen:
                                fmtlen = lenstr(&format[fmtstart], 0);

-                               put(2, O_LVCON, fmtlen);
+                               (void) put(2, O_LVCON, fmtlen);

                                putstr(&format[fmtstart], 0);
                                putstr(&format[fmtstart], 0);

-                               put(1, O_FILE);
-                               stkcnt += 2;
-                               put(2, O_WRITEF, stkcnt);
+                               (void) put(1, O_FILE);
+                               stkcnt += 2 * sizeof(char *);
+                               (void) put(2, O_WRITEF, stkcnt);

                        }
                        /*
                         * Write the string after its blank padding
                         */
                        if (typ == TSTR) {
                        }
                        /*
                         * Write the string after its blank padding
                         */
                        if (typ == TSTR) {

-                               put(1, O_FILE);
-                               put(2, O_CON24, 1);
+                               (void) put(1, O_FILE);
+                               (void) put(2, CON_INT, 1);

                                if (strfmt & VARWIDTH) {
                                if (strfmt & VARWIDTH) {

-                                       put(2, O_RV4 | cbn << 8 + INDX , i );
-                                       put(2, O_MIN, strnglen);
+                                       (void) put(2, O_RV4 | cbn << 8 + INDX , 
+                                           tempnlp -> value[ NL_OFFS ] );
+                                       (void) put(2, O_MIN, strnglen);
+                                       convert(nl+T4INT, INT_TYP);
+                                       tmpfree(&soffset);

                                } else {
                                        if ((fmtspec & SKIP) &&
                                           (strfmt & CONWIDTH)) {
                                                strnglen = field;
                                        }
                                } else {
                                        if ((fmtspec & SKIP) &&
                                           (strfmt & CONWIDTH)) {
                                                strnglen = field;
                                        }

-                                       put(2, O_CON24, strnglen);
+                                       (void) put(2, CON_INT, strnglen);

                                }
                                }

-                               ap = stkrval(alv, NIL , RREQ );
-                               put(1, O_WRITES);
+                               ap = stkrval(alv, NLNIL , (long) RREQ );
+                               (void) put(2, O_WRITES,
+                                       2 * sizeof(char *) + 2 * sizeof(int));

                        }
                }
                /*
                        }
                }
                /*


@@ -583,7 +683,7 @@ proc(r)
                        case O_WRITLN:
                                if (filetype != nl+T1CHAR)
                                        error("Can't 'writeln' a non text file");
                        case O_WRITLN:
                                if (filetype != nl+T1CHAR)
                                        error("Can't 'writeln' a non text file");

-                               put(1, O_WRITLN);
+                               (void) put(1, O_WRITLN);

                                break;
                }
                return;
                                break;
                }
                return;


@@ -601,13 +701,13 @@ proc(r)
                 * for the read and generate
                 * code to make it the active file.
                 */
                 * for the read and generate
                 * code to make it the active file.
                 */

-               if (argv != NIL) {
+               if (argv != TR_NIL) {

                        codeoff();
                        codeoff();

-                       ap = stkrval(argv[1], NIL , RREQ );
+                       ap = stkrval(argv->list_node.list, NLNIL, (long) RREQ );

                        codeon();
                        codeon();

-                       if (ap == NIL)
-                               argv = argv[2];
-                       if (ap != NIL && ap->class == FILET) {
+                       if (ap == NLNIL)
+                               argv = argv->list_node.next;
+                       if (ap != NLNIL && ap->class == FILET) {

                                /*
                                 * Got "read(f, ...", make
                                 * f the active file, and save
                                /*
                                 * Got "read(f, ...", make
                                 * f the active file, and save


@@ -615,49 +715,50 @@ proc(r)
                                 * processing the rest of the
                                 * arguments to read.
                                 */
                                 * processing the rest of the
                                 * arguments to read.
                                 */

-                               file = argv[1];
+                               file = argv->list_node.list;

                                filetype = ap->type;
                                filetype = ap->type;

-                               stkrval(argv[1], NIL , RREQ );
-                               put(1, O_UNIT);
-                               argv = argv[2];
+                               (void) stklval(argv->list_node.list, NIL );
+                               (void) put(1, O_UNIT);
+                               argv = argv->list_node.next;

                                argc--;
                        } else {
                                /*
                                 * Default is read from
                                 * standard input.
                                 */
                                argc--;
                        } else {
                                /*
                                 * Default is read from
                                 * standard input.
                                 */

-                               put(1, O_UNITINP);
+                               (void) put(1, O_UNITINP);

                                input->nl_flags |= NUSED;
                        }
                } else {
                                input->nl_flags |= NUSED;
                        }
                } else {

-                       put(1, O_UNITINP);
+                       (void) put(1, O_UNITINP);

                        input->nl_flags |= NUSED;
                }
                /*
                 * Loop and process each
                 * of the arguments.
                 */
                        input->nl_flags |= NUSED;
                }
                /*
                 * Loop and process each
                 * of the arguments.
                 */

-               for (; argv != NIL; argv = argv[2]) {
+               for (; argv != TR_NIL; argv = argv->list_node.next) {

                        /*
                         * Get the address of the target
                         * on the stack.
                         */
                        /*
                         * Get the address of the target
                         * on the stack.
                         */

-                       al = argv[1];
-                       if (al == NIL)
+                       al = argv->list_node.list;
+                       if (al == TR_NIL)

                                continue;
                                continue;

-                       if (al[0] != T_VAR) {
+                       if (al->tag != T_VAR) {

                                error("Arguments to %s must be variables, not expressions", p->symbol);
                                continue;
                        }
                        ap = stklval(al, MOD|ASGN|NOUSE);
                                error("Arguments to %s must be variables, not expressions", p->symbol);
                                continue;
                        }
                        ap = stklval(al, MOD|ASGN|NOUSE);

-                       if (ap == NIL)
+                       if (ap == NLNIL)

                                continue;
                        if (filetype != nl+T1CHAR) {
                                /*
                                 * Generalized read, i.e.
                                 * from a non-textfile.
                                 */
                                continue;
                        if (filetype != nl+T1CHAR) {
                                /*
                                 * Generalized read, i.e.
                                 * from a non-textfile.
                                 */

-                               if (incompat(filetype, ap, argv[1] )) {
+                               if (incompat(filetype, ap,
+                                       argv->list_node.list )) {

                                        error("Type mismatch in read from non-text file");
                                        continue;
                                }
                                        error("Type mismatch in read from non-text file");
                                        continue;
                                }


@@ -665,19 +766,39 @@ proc(r)
                                 * var := file ^;
                                 */
                                if (file != NIL)
                                 * var := file ^;
                                 */
                                if (file != NIL)

-                                       stkrval(file, NIL , RREQ );
+                                   (void) stklval(file, NIL);

                                else /* Magic */
                                else /* Magic */

-                                       put(2, O_RV2, input->value[0]);
-                               put(1, O_FNIL);
-                               put(2, O_IND, width(filetype));
-                               convert(filetype, ap);
-                               if (isa(ap, "bsci"))
-                                       rangechk(ap, ap);
-                               put(2, O_AS, width(ap));
+                                   (void) put(2, PTR_RV, (int)input->value[0]);
+                               (void) put(1, O_FNIL);
+                               if (isa(filetype, "bcsi")) {
+                                   int filewidth = width(filetype);
+
+                                   switch (filewidth) {
+                                       case 4:
+                                           (void) put(1, O_IND4);
+                                           break;
+                                       case 2:
+                                           (void) put(1, O_IND2);
+                                           break;
+                                       case 1:
+                                           (void) put(1, O_IND1);
+                                           break;
+                                       default:
+                                           (void) put(2, O_IND, filewidth);
+                                   }
+                                   convert(filetype, ap);
+                                   rangechk(ap, ap);
+                                   (void) gen(O_AS2, O_AS2,
+                                           filewidth, width(ap));
+                               } else {
+                                   (void) put(2, O_IND, width(filetype));
+                                   convert(filetype, ap);
+                                   (void) put(2, O_AS, width(ap));
+                               }

                                /*
                                 * get(file);
                                 */
                                /*
                                 * get(file);
                                 */

-                               put(1, O_GET);
+                               (void) put(1, O_GET);

                                continue;
                        }
                        typ = classify(ap);
                                continue;
                        }
                        typ = classify(ap);


@@ -687,13 +808,14 @@ proc(r)
                                continue;
                        }
                        if (op != O_READE)
                                continue;
                        }
                        if (op != O_READE)

-                               put(1, op);
+                               (void) put(1, op);

                        else {
                        else {

-                               put(2, op, listnames(ap));
+                               (void) put(2, op, (long)listnames(ap));
+                               warning();

                                if (opt('s')) {
                                        standard();
                                if (opt('s')) {
                                        standard();

-                                       error("Reading of enumerated types is non-standard");

                                }
                                }

+                               error("Reading scalars from text files is non-standard");

                        }
                        /*
                         * Data read is on the stack.
                        }
                        /*
                         * Data read is on the stack.


@@ -701,7 +823,7 @@ proc(r)
                         */
                        if (op != O_READ8 && op != O_READE)
                                rangechk(ap, op == O_READC ? ap : nl+T4INT);
                         */
                        if (op != O_READ8 && op != O_READE)
                                rangechk(ap, op == O_READC ? ap : nl+T4INT);

-                       gen(O_AS2, O_AS2, width(ap),
+                       (void) gen(O_AS2, O_AS2, width(ap),

                                op == O_READ8 ? 8 : op == O_READ4 ? 4 : 2);
                }
                /*
                                op == O_READ8 ? 8 : op == O_READ4 ? 4 : 2);
                }
                /*


@@ -712,7 +834,7 @@ proc(r)
                if (p->value[0] == O_READLN) {
                        if (filetype != nl+T1CHAR)
                                error("Can't 'readln' a non text file");
                if (p->value[0] == O_READLN) {
                        if (filetype != nl+T1CHAR)
                                error("Can't 'readln' a non text file");

-                       put(1, O_READLN);
+                       (void) put(1, O_READLN);

                }
                else if (argc == 0)
                        error("read requires an argument");
                }
                else if (argc == 0)
                        error("read requires an argument");


@@ -724,15 +846,15 @@ proc(r)
                        error("%s expects one argument", p->symbol);
                        return;
                }
                        error("%s expects one argument", p->symbol);
                        return;
                }

-               ap = stkrval(argv[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list, NIL );
+               if (ap == NLNIL)

                        return;
                if (ap->class != FILET) {
                        error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
                        return;
                }
                        return;
                if (ap->class != FILET) {
                        error("Argument to %s must be a file, not %s", p->symbol, nameof(ap));
                        return;
                }

-               put(1, O_UNIT);
-               put(1, op);
+               (void) put(1, O_UNIT);
+               (void) put(1, op);

                return;
 
        case O_RESET:
                return;
 
        case O_RESET:


@@ -745,35 +867,43 @@ proc(r)
                        standard();
                        error("Two argument forms of reset and rewrite are non-standard");
                }
                        standard();
                        error("Two argument forms of reset and rewrite are non-standard");
                }

-               ap = stklval(argv[1], MOD|NOUSE);
-               if (ap == NIL)
+               codeoff();
+               ap = stklval(argv->list_node.list, MOD|NOUSE);
+               codeon();
+               if (ap == NLNIL)

                        return;
                if (ap->class != FILET) {
                        error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
                        return;
                }
                        return;
                if (ap->class != FILET) {
                        error("First argument to %s must be a file, not %s", p->symbol, nameof(ap));
                        return;
                }

+               (void) put(2, O_CON24, text(ap) ? 0: width(ap->type));

                if (argc == 2) {
                        /*
                         * Optional second argument
                         * is a string name of a
                         * UNIX (R) file to be associated.
                         */
                if (argc == 2) {
                        /*
                         * Optional second argument
                         * is a string name of a
                         * UNIX (R) file to be associated.
                         */

-                       al = argv[2];
-                       al = stkrval(al[1], NOFLAGS , RREQ );
-                       if (al == NIL)
+                       al = argv->list_node.next;
+                       codeoff();
+                       al = (struct tnode *) stkrval(al->list_node.list,
+                                       (struct nl *) NOFLAGS , (long) RREQ );
+                       codeon();
+                       if (al == TR_NIL)

                                return;
                                return;

-                       if (classify(al) != TSTR) {
-                               error("Second argument to %s must be a string, not %s", p->symbol, nameof(al));
+                       if (classify((struct nl *) al) != TSTR) {
+                               error("Second argument to %s must be a string, not %s", p->symbol, nameof((struct nl *) al));

                                return;
                        }
                                return;
                        }

-                       strnglen = width(al);
+                       (void) put(2, O_CON24, width((struct nl *) al));
+                       al = argv->list_node.next;
+                       al = (struct tnode *) stkrval(al->list_node.list,
+                                       (struct nl *) NOFLAGS , (long) RREQ );

                } else {
                } else {

-                       put(2, O_CON24, NIL);
-                       strnglen = 0;
+                       (void) put(2, O_CON24, 0);
+                       (void) put(2, PTR_CON, NIL);

                }
                }

-               put(2, O_CON24, strnglen);
-               put(2, O_CON24, text(ap) ? 0: width(ap->type));
-               put(1, op);
+               ap = stklval(argv->list_node.list, MOD|NOUSE);
+               (void) put(1, op);

                return;
 
        case O_NEW:
                return;
 
        case O_NEW:


@@ -782,8 +912,9 @@ proc(r)
                        error("%s expects at least one argument", p->symbol);
                        return;
                }
                        error("%s expects at least one argument", p->symbol);
                        return;
                }

-               ap = stklval(argv[1], op == O_NEW ? ( MOD | NOUSE ) : MOD );
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list,
+                               op == O_NEW ? ( MOD | NOUSE ) : MOD );
+               if (ap == NLNIL)

                        return;
                if (ap->class != PTR) {
                        error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));
                        return;
                if (ap->class != PTR) {
                        error("(First) argument to %s must be a pointer, not %s", p->symbol, nameof(ap));


@@ -792,25 +923,28 @@ proc(r)
                ap = ap->type;
                if (ap == NIL)
                        return;
                ap = ap->type;
                if (ap == NIL)
                        return;

-               argv = argv[2];
-               if (argv != NIL) {
+               if ((ap->nl_flags & NFILES) && op == O_DISPOSE)
+                       op = O_DFDISP;
+               argv = argv->list_node.next;
+               if (argv != TR_NIL) {

                        if (ap->class != RECORD) {
                                error("Record required when specifying variant tags");
                                return;
                        }
                        if (ap->class != RECORD) {
                                error("Record required when specifying variant tags");
                                return;
                        }

-                       for (; argv != NIL; argv = argv[2]) {
+                       for (; argv != TR_NIL; argv = argv->list_node.next) {

                                if (ap->ptr[NL_VARNT] == NIL) {
                                        error("Too many tag fields");
                                        return;
                                }
                                if (ap->ptr[NL_VARNT] == NIL) {
                                        error("Too many tag fields");
                                        return;
                                }

-                               if (!isconst(argv[1])) {
+                               if (!isconst(argv->list_node.list)) {

                                        error("Second and successive arguments to %s must be constants", p->symbol);
                                        return;
                                }
                                        error("Second and successive arguments to %s must be constants", p->symbol);
                                        return;
                                }

-                               gconst(argv[1]);
+                               gconst(argv->list_node.list);

                                if (con.ctype == NIL)
                                        return;
                                if (con.ctype == NIL)
                                        return;

-                               if (incompat(con.ctype, (ap->ptr[NL_TAG])->type , NIL )) {
+                               if (incompat(con.ctype, (
+                                       ap->ptr[NL_TAG])->type , TR_NIL )) {

                                        cerror("Specified tag constant type clashed with variant case selector type");
                                        return;
                                }
                                        cerror("Specified tag constant type clashed with variant case selector type");
                                        return;
                                }


@@ -824,7 +958,7 @@ proc(r)
                                ap = ap->ptr[NL_VTOREC];
                        }
                }
                                ap = ap->ptr[NL_VTOREC];
                        }
                }

-               put(2, op, width(ap));
+               (void) put(2, op, width(ap));

                return;
 
        case O_DATE:
                return;
 
        case O_DATE:


@@ -833,14 +967,14 @@ proc(r)
                        error("%s expects one argument", p->symbol);
                        return;
                }
                        error("%s expects one argument", p->symbol);
                        return;
                }

-               ap = stklval(argv[1], MOD|NOUSE);
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list, MOD|NOUSE);
+               if (ap == NLNIL)

                        return;
                if (classify(ap) != TSTR || width(ap) != 10) {
                        error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
                        return;
                }
                        return;
                if (classify(ap) != TSTR || width(ap) != 10) {
                        error("Argument to %s must be a alfa, not %s", p->symbol, nameof(ap));
                        return;
                }

-               put(1, op);
+               (void) put(1, op);

                return;
 
        case O_HALT:
                return;
 
        case O_HALT:


@@ -848,8 +982,8 @@ proc(r)
                        error("halt takes no arguments");
                        return;
                }
                        error("halt takes no arguments");
                        return;
                }

-               put(1, op);
-               noreach = 1;
+               (void) put(1, op);
+               noreach = TRUE; /* used to be 1 */

                return;
 
        case O_ARGV:
                return;
 
        case O_ARGV:


@@ -857,22 +991,22 @@ proc(r)
                        error("argv takes two arguments");
                        return;
                }
                        error("argv takes two arguments");
                        return;
                }

-               ap = stkrval(argv[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
+               if (ap == NLNIL)

                        return;
                if (isnta(ap, "i")) {
                        error("argv's first argument must be an integer, not %s", nameof(ap));
                        return;
                }
                        return;
                if (isnta(ap, "i")) {
                        error("argv's first argument must be an integer, not %s", nameof(ap));
                        return;
                }

-               al = argv[2];
-               ap = stklval(al[1], MOD|NOUSE);
-               if (ap == NIL)
+               al = argv->list_node.next;
+               ap = stklval(al->list_node.list, MOD|NOUSE);
+               if (ap == NLNIL)

                        return;
                if (classify(ap) != TSTR) {
                        error("argv's second argument must be a string, not %s", nameof(ap));
                        return;
                }
                        return;
                if (classify(ap) != TSTR) {
                        error("argv's second argument must be a string, not %s", nameof(ap));
                        return;
                }

-               put(2, op, width(ap));
+               (void) put(2, op, width(ap));

                return;
 
        case O_STLIM:
                return;
 
        case O_STLIM:


@@ -880,16 +1014,16 @@ proc(r)
                        error("stlimit requires one argument");
                        return;
                }
                        error("stlimit requires one argument");
                        return;
                }

-               ap = stkrval(argv[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
+               if (ap == NLNIL)

                        return;
                if (isnta(ap, "i")) {
                        error("stlimit's argument must be an integer, not %s", nameof(ap));
                        return;
                }
                if (width(ap) != 4)
                        return;
                if (isnta(ap, "i")) {
                        error("stlimit's argument must be an integer, not %s", nameof(ap));
                        return;
                }
                if (width(ap) != 4)

-                       put(1, O_STOI);
-               put(1, op);
+                       (void) put(1, O_STOI);
+               (void) put(1, op);

                return;
 
        case O_REMOVE:
                return;
 
        case O_REMOVE:


@@ -897,15 +1031,20 @@ proc(r)
                        error("remove expects one argument");
                        return;
                }
                        error("remove expects one argument");
                        return;
                }

-               ap = stkrval(argv[1], NOFLAGS , RREQ );
-               if (ap == NIL)
+               codeoff();
+               ap = stkrval(argv->list_node.list, (struct nl *) NOFLAGS,
+                               (long) RREQ );
+               codeon();
+               if (ap == NLNIL)

                        return;
                if (classify(ap) != TSTR) {
                        error("remove's argument must be a string, not %s", nameof(ap));
                        return;
                }
                        return;
                if (classify(ap) != TSTR) {
                        error("remove's argument must be a string, not %s", nameof(ap));
                        return;
                }

-               put(2, O_CON24, width(ap));
-               put(1, op);
+               (void) put(2, O_CON24, width(ap));
+               ap = stkrval(argv->list_node.list, (struct nl *) NOFLAGS,
+                               (long) RREQ );
+               (void) put(1, op);

                return;
 
        case O_LLIMIT:
                return;
 
        case O_LLIMIT:


@@ -913,37 +1052,68 @@ proc(r)
                        error("linelimit expects two arguments");
                        return;
                }
                        error("linelimit expects two arguments");
                        return;
                }

-               ap = stklval(argv[1], NOFLAGS|NOUSE);
+               al = argv->list_node.next;
+               ap = stkrval(al->list_node.list, NLNIL , (long) RREQ );

                if (ap == NIL)
                        return;
                if (ap == NIL)
                        return;

-               if (!text(ap)) {
-                       error("linelimit's first argument must be a text file, not %s", nameof(ap));
+               if (isnta(ap, "i")) {
+                       error("linelimit's second argument must be an integer, not %s", nameof(ap));

                        return;
                }
                        return;
                }

-               al = argv[2];
-               ap = stkrval(al[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list, NOFLAGS|NOUSE);
+               if (ap == NLNIL)

                        return;
                        return;

-               if (isnta(ap, "i")) {
-                       error("linelimit's second argument must be an integer, not %s", nameof(ap));
+               if (!text(ap)) {
+                       error("linelimit's first argument must be a text file, not %s", nameof(ap));

                        return;
                }
                        return;
                }

-               put(1, op);
+               (void) put(1, op);

                return;
        case O_PAGE:
                if (argc != 1) {
                        error("page expects one argument");
                        return;
                }
                return;
        case O_PAGE:
                if (argc != 1) {
                        error("page expects one argument");
                        return;
                }

-               ap = stkrval(argv[1], NIL , RREQ );
-               if (ap == NIL)
+               ap = stklval(argv->list_node.list, NIL );
+               if (ap == NLNIL)

                        return;
                if (!text(ap)) {
                        error("Argument to page must be a text file, not %s", nameof(ap));
                        return;
                }
                        return;
                if (!text(ap)) {
                        error("Argument to page must be a text file, not %s", nameof(ap));
                        return;
                }

-               put(1, O_UNIT);
-               put(1, op);
+               (void) put(1, O_UNIT);
+               (void) put(1, op);
+               return;
+
+       case O_ASRT:
+               if (!opt('t'))
+                       return;
+               if (argc == 0 || argc > 2) {
+                       error("Assert expects one or two arguments");
+                       return;
+               }
+               if (argc == 2) {
+                       /*
+                        * Optional second argument is a string specifying
+                        * why the assertion failed.
+                        */
+                       al = argv->list_node.next;
+                       al1 =  stkrval(al->list_node.list, NLNIL , (long) RREQ );
+                       if (al1 == NIL)
+                               return;
+                       if (classify(al1) != TSTR) {
+                               error("Second argument to assert must be a string, not %s", nameof(al1));
+                               return;
+                       }
+               } else {
+                       (void) put(2, PTR_CON, NIL);
+               }
+               ap = stkrval(argv->list_node.list, NLNIL , (long) RREQ );
+               if (ap == NIL)
+                       return;
+               if (isnta(ap, "b"))
+                       error("Assert expression must be Boolean, not %ss", nameof(ap));
+               (void) put(1, O_ASRT);

                return;
 
        case O_PACK:
                return;
 
        case O_PACK:


@@ -952,9 +1122,11 @@ proc(r)
                        return;
                }
                pu = "pack(a,i,z)";
                        return;
                }
                pu = "pack(a,i,z)";

-               pua = (al = argv)[1];
-               pui = (al = al[2])[1];
-               puz = (al = al[2])[1];
+               pua = argv->list_node.list;
+               al = argv->list_node.next;
+               pui = al->list_node.list;
+               alv = al->list_node.next;
+               puz = alv->list_node.list;

                goto packunp;
        case O_UNPACK:
                if (argc != 3) {
                goto packunp;
        case O_UNPACK:
                if (argc != 3) {


@@ -962,51 +1134,52 @@ proc(r)
                        return;
                }
                pu = "unpack(z,a,i)";
                        return;
                }
                pu = "unpack(z,a,i)";

-               puz = (al = argv)[1];
-               pua = (al = al[2])[1];
-               pui = (al = al[2])[1];
+               puz = argv->list_node.list;
+               al = argv->list_node.next;
+               pua = al->list_node.list;
+               alv = al->list_node.next;
+               pui = alv->list_node.list;

 packunp:
 packunp:

-               ap = stkrval((int *) pui, NLNIL , RREQ );
-               if (ap == NIL)
-                       return;
+               codeoff();

                ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
                ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);

+               al1 = stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
+               codeon();

                if (ap == NIL)
                        return;
                if (ap->class != ARRAY) {
                        error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
                        return;
                }
                if (ap == NIL)
                        return;
                if (ap->class != ARRAY) {
                        error("%s requires a to be an unpacked array, not %s", pu, nameof(ap));
                        return;
                }

-               al = (struct nl *) stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
-               if (al->class != ARRAY) {
+               if (al1->class != ARRAY) {

                        error("%s requires z to be a packed array, not %s", pu, nameof(ap));
                        return;
                }
                        error("%s requires z to be a packed array, not %s", pu, nameof(ap));
                        return;
                }

-               if (al->type == NIL || ap->type == NIL)
+               if (al1->type == NIL || ap->type == NIL)

                        return;
                        return;

-               if (al->type != ap->type) {
+               if (al1->type != ap->type) {

                        error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
                        return;
                }
                        error("%s requires a and z to be arrays of the same type", pu, nameof(ap));
                        return;
                }

-               k = width(al);
+               k = width(al1);

                itemwidth = width(ap->type);
                ap = ap->chain;
                itemwidth = width(ap->type);
                ap = ap->chain;

-               al = al->chain;
-               if (ap->chain != NIL || al->chain != NIL) {
+               al1 = al1->chain;
+               if (ap->chain != NIL || al1->chain != NIL) {

                        error("%s requires a and z to be single dimension arrays", pu);
                        return;
                }
                        error("%s requires a and z to be single dimension arrays", pu);
                        return;
                }

-               if (ap == NIL || al == NIL)
+               if (ap == NIL || al1 == NIL)

                        return;
                /*
                        return;
                /*

-                * al is the range for z i.e. u..v
+                * al1 is the range for z i.e. u..v

                 * ap is the range for a i.e. m..n
                 * i will be n-m+1
                 * j will be v-u+1
                 */
                i = ap->range[1] - ap->range[0] + 1;
                 * ap is the range for a i.e. m..n
                 * i will be n-m+1
                 * j will be v-u+1
                 */
                i = ap->range[1] - ap->range[0] + 1;

-               j = al->range[1] - al->range[0] + 1;
+               j = al1->range[1] - al1->range[0] + 1;

                if (i < j) {
                if (i < j) {

-                       error("%s cannot have more elements in a (%d) than in z (%d)", pu, j, i);
+                       error("%s cannot have more elements in a (%d) than in z (%d)", pu, (char *) j, (char *) i);

                        return;
                }
                /*
                        return;
                }
                /*


@@ -1014,10 +1187,19 @@ packunp:
                 */
                i -= j;
                j = ap->range[0];
                 */
                i -= j;
                j = ap->range[0];

-               put(5, op, itemwidth , j, i, k);
+               (void) put(2, O_CON24, k);
+               (void) put(2, O_CON24, i);
+               (void) put(2, O_CON24, j);
+               (void) put(2, O_CON24, itemwidth);
+               al1 = stklval(puz, op == O_UNPACK ? NOFLAGS : MOD|NOUSE);
+               ap = stklval(pua, op == O_PACK ? NOFLAGS : MOD|NOUSE);
+               ap = stkrval(pui, NLNIL , (long) RREQ );
+               if (ap == NIL)
+                       return;
+               (void) put(1, op);

                return;
        case 0:
                return;
        case 0:

-               error("%s is an unimplemented 6400 extension", p->symbol);
+               error("%s is an unimplemented extension", p->symbol);

                return;
 
        default:
                return;
 
        default: