reduce-historical/r37/lisp/csl/cslbase/eval4.c

/* eval4.c                           Copyright (C) 1991-2002, Codemist Ltd */

/*
 * Bytecode interpreter/main interpreter interfaces
 */

/*
 * This code may be used and modified, and redistributed in binary
 * or source form, subject to the "CCL Public License", which should
 * accompany it. This license is a variant on the BSD license, and thus
 * permits use of code derived from this in either open and commercial
 * projects: but it does require that updates to this code be made
 * available back to the originators of the package.
 * Before merging other code in with this or linking this code
 * with other packages or libraries please check that the license terms
 * of the other material are compatible with those of this.
 */



/* Signature: 2ff31eb7 10-Oct-2002 */

#include <stdarg.h>
#include <string.h>
#include <ctype.h>

#include "machine.h"
#include "tags.h"
#include "cslerror.h"
#include "externs.h"
#include "arith.h"
#include "entries.h"
#ifdef TIMEOUT
#include "timeout.h"
#endif

#ifdef DEBUG
int trace_all = 0;
#endif

#define name_from(def) elt(qcdr(def), 0)

Lisp_Object MS_CDECL bytecoded0(Lisp_Object def, int nargs, ...)
{
    Lisp_Object nil=C_nil;
    if (nargs != 0) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    push2(litvec, codevec);
    stackcheck1(2, def);
/*
 * The "-2" a few lines down is discussed in the file bytes1.c. It is
 * part of the mechanism for allowing functions to have a few data bytes
 * at the start of the code-vector.
 */
#ifdef DEBUG
    if (trace_all)
    {   trace_all = 0;
        push(def);
        freshline_trace();
        trace_printf("Entering ");
        loop_print_trace(name_from(def));
        trace_printf(" (no args)\n");
        trace_all = 1;
        nil = C_nil;
        if (exception_pending()) { popv(3); return nil; }
        pop(def);
    }
#endif
    def = bytestream_interpret(qcar(def)-2, qcdr(def), stack);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return def;
}

Lisp_Object bytecoded1(Lisp_Object def, Lisp_Object a)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push3(litvec, codevec, a);
    stackcheck1(3, def);
#ifdef DEBUG
    if (trace_all)
    {   trace_all = 0;
        push(def);
        freshline_trace();
        trace_printf("Entering ");
        loop_print_trace(name_from(def));
        trace_printf("\nArg1: ");
        loop_print_trace(stack[-1]);
        trace_printf("\n");
        trace_all = 1;
        nil = C_nil;
        if (exception_pending()) { popv(4); return nil; }
        pop(def);
    }
#endif
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-1);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
/*
 * If bytestream_interpret handed back a failure code then the VERY LAST
 * thing that it did was to move stack down, in effect losing the argument
 * that had been passed to the bytesteam code.  But nothing can touch the
 * stack between that action and here, so if I quickly increment the
 * stack pointer again I can find the argument again - or at least whetever
 * value the failed function left in that variable.  Yes this does look
 * a little delicate, but I do like seeing argument values in my backtraces,
 * and the software stack involved here it totally under my control.
 * NOTE however that if the function I am calling here does a tail call
 * to something that is not directly bytecoded then the stack can be
 * clobbered, and the results will be garbage in the backtrace.
 */
        stack++;
        pop3(a, codevec, litvec); 
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(a); err_printf("\n");
            ignore_exception();
        }
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object bytecoded2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push4(litvec, codevec, a, b);
    stackcheck1(4, def);
#ifdef DEBUG
    if (trace_all)
    {   trace_all = 0;
        push(def);
        freshline_trace();
        trace_printf("Entering ");
        loop_print_trace(name_from(def));
        trace_printf("\nArg1: ");
        loop_print_trace(stack[-2]);
        trace_printf("\n");
        trace_printf("Arg2: ");
        loop_print_trace(stack[-1]);
        trace_printf("\n");
        trace_all = 1;
        nil = C_nil;
        if (exception_pending()) { popv(5); return nil; }
        pop(def);
    }
#endif
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-2);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 2;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg 1: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg 2: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(2); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL bytecoded3(Lisp_Object def, int nargs, ...)
{
    va_list aa;
    Lisp_Object r, a, b, c;
    Lisp_Object nil = C_nil;
    if (nargs != 3) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    va_start(aa, nargs);
    a = va_arg(aa, Lisp_Object);
    b = va_arg(aa, Lisp_Object);
    c = va_arg(aa, Lisp_Object);
    va_end(aa);
    push5(litvec, codevec, a, b, c);
    stackcheck1(5, def);
#ifdef DEBUG
    if (trace_all)
    {   trace_all = 0;
        push(def);
        freshline_trace();
        trace_printf("Entering ");
        loop_print_trace(name_from(def));
        trace_printf("\nArg1: ");
        loop_print_trace(stack[-3]);
        trace_printf("\n");
        trace_printf("Arg2: ");
        loop_print_trace(stack[-2]);
        trace_printf("\n");
        trace_printf("Arg3: ");
        loop_print_trace(stack[-1]);
        trace_printf("\n");
        trace_all = 1;
        nil = C_nil;
        if (exception_pending()) { popv(6); return nil; }
        pop(def);
    }
#endif
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-3);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 3;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(stack[-2]); err_printf("\n");
            ignore_exception();
            err_printf("Arg2: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg3: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL bytecodedn(Lisp_Object def, int nargs, ...)
{
/*
 * The messing about here is to get the (unknown number of) args
 * into a nice neat vector so that they can be indexed into. If I knew
 * that the args were in consecutive locations on the stack I could
 * probably save a copying operation.
 */
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i;
    Lisp_Object *stack_save = stack;
    va_list a;
    push2(litvec, codevec);
    if (nargs != 0)
    {   va_start(a, nargs);
        push_args(a, nargs);
    }
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    if (nargs != ((unsigned char *)data_of_bps(r))[0])
    {   popv(nargs+2);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    r = bytestream_interpret(r-1, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
/*
 * Note that in this display if a function had over 50 args then the
 * final bunch of them will be bundled up in to a list (as if for &rest).
 */
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

/*
 * Now I have carbon copies of the above, but with some print statements
 * inserted.  These are installed when a function is marked for trace
 * output.
 */

Lisp_Object unpack_mv(Lisp_Object nil, Lisp_Object r)
{
    Lisp_Object *p = &mv_1;
    exit_count = 0;
    *p = nil;
    while (r != nil)
    {   *p++ = qcar(r);
        r = qcdr(r);
        exit_count++;
    }
    return mv_1;
}

Lisp_Object MS_CDECL tracebytecoded0(Lisp_Object def, int nargs, ...)
{
    Lisp_Object r, nil=C_nil;
    if (nargs != 0) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    push3(litvec, codevec, def);
    freshline_trace();
    trace_printf("Entering ");
    loop_print_trace(name_from(def));
    trace_printf(" (no args)\n");
    nil = C_nil;
    if (exception_pending()) { popv(3); return nil; }
    def = stack[0];
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack);
    nil = C_nil;
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (!exception_pending())
    {   trace_printf(" = ");
        loop_print_trace(r);
        trace_printf("\n");
    }
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object tracebytecoded1(Lisp_Object def, Lisp_Object a)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push4(litvec, codevec, def, a);
    freshline_trace();
    trace_printf("Entering ");
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(2); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf(" (1 arg)\nArg1: ");
    loop_print_trace(stack[0]);
    trace_printf("\n");
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(2); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    stackcheck0(4);
    def = stack[-1];
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-1);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack++;
        pop(a); popv(1); pop2(codevec, litvec);
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(a); err_printf("\n");
            ignore_exception();
        }
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" = ");
    loop_print_trace(r);
    trace_printf("\n");
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object tracebytecoded2(Lisp_Object def,
                        Lisp_Object a, Lisp_Object b)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push5(litvec, codevec, def, a, b);
    freshline_trace();
    trace_printf("Entering ");
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf(" (2 args)\nArg1: ");
    loop_print_trace(stack[-1]);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf("\nArg2: ");
    loop_print_trace(stack[0]);
    trace_printf("\n");
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    stackcheck0(5);
    def = stack[-2];
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-2);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 2;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg2: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" = ");
    loop_print_trace(r);
    trace_printf("\n");
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object MS_CDECL tracebytecoded3(Lisp_Object def, int nargs, ...)
{
    va_list aa;
    Lisp_Object r, a, b, c;
    Lisp_Object nil = C_nil;
    if (nargs != 3) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    va_start(aa, nargs);
    a = va_arg(aa, Lisp_Object);
    b = va_arg(aa, Lisp_Object);
    c = va_arg(aa, Lisp_Object);
    va_end(aa);
    push2(litvec, codevec);
    push4(def, a, b, c);
    freshline_trace();
    trace_printf("Entering ");
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(4); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf(" (3 args)\nArg1: ");
    loop_print_trace(stack[-2]);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(4); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf("\nArg2: ");
    loop_print_trace(stack[-1]);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(4); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    trace_printf("\nArg3: ");
    loop_print_trace(stack[0]);
    trace_printf("\n");
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        popv(4); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    stackcheck0(6);
    def = stack[-3];
    r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-3);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 3;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(stack[-2]); err_printf("\n");
            ignore_exception();
            err_printf("Arg2: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg3: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(4); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" = ");
    loop_print_trace(r);
    trace_printf("\n");
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object MS_CDECL tracebytecodedn(Lisp_Object def, int nargs, ...)
{
/*
 * The messing about here is to get the (unknown number of) args
 * into a nice neat vector so that they can be indexed into. If I knew
 * that the args were in consecutive locations on the stack I could
 * probably save a copying operation.
 */
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i;
    Lisp_Object *stack_save = stack;
    va_list a;
    push3(litvec, codevec, def);
    if (nargs != 0)
    {   va_start(a, nargs);
        push_args(a, nargs);
    }
    stackcheck1(stack-stack_save, def);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" (%d args)\n", nargs);
    for (i=1; i<=nargs; i++)
    {   trace_printf("Arg%d: ", i);
        loop_print_trace(stack[i-nargs]);
        trace_printf("\n");
    }
    def = stack[-nargs];
    r = qcar(def);
    if (nargs != ((unsigned char *)data_of_bps(r))[0])
    {   popv(nargs+3);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    r = bytestream_interpret(r-1, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs+1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" = ");
    loop_print_trace(r);
    trace_printf("\n");
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

int doubled_execution = 0;

Lisp_Object MS_CDECL double_bytecoded0(Lisp_Object def, int nargs, ...)
{
    Lisp_Object nil=C_nil;
    if (nargs != 0) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    push2(litvec, codevec);
    stackcheck1(2, def);
    if (!doubled_execution)
    {   push3(def, litvec, codevec);
        doubled_execution = 1;
        bytestream_interpret(qcar(def)-2, qcdr(def), stack);
        nil = C_nil;
        pop3(codevec, litvec, def);
        if (!exception_pending())
            def = bytestream_interpret(qcar(def)-2, qcdr(def), stack);
        doubled_execution = 0;
    }
    else def = bytestream_interpret(qcar(def)-2, qcdr(def), stack);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return def;
}

Lisp_Object double_bytecoded1(Lisp_Object def, Lisp_Object a)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push3(litvec, codevec, a);
    stackcheck1(3, def);
    if (!doubled_execution)
    {   push4(def, litvec, codevec, a);
        doubled_execution = 1;
        r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-1);
        nil = C_nil;
        pop3(codevec, litvec, def);
        if (!exception_pending())
            r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-1);
        doubled_execution = 0;
    }
    else r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-1);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack++;
        pop3(a, codevec, litvec); 
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(a); err_printf("\n");
            ignore_exception();
        }
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object double_bytecoded2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    push4(litvec, codevec, a, b);
    stackcheck1(4, def);
    if (!doubled_execution)
    {   push5(def, litvec, codevec, a, b);
        doubled_execution = 1;
        r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-2);
        nil = C_nil;
        pop3(codevec, litvec, def);
        if (!exception_pending())
            r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-2);
        doubled_execution = 0;
    }
    else r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-2);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 2;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg 1: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg 2: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(2); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL double_bytecoded3(Lisp_Object def, int nargs, ...)
{
    va_list aa;
    Lisp_Object r, a, b, c;
    Lisp_Object nil = C_nil;
    if (nargs != 3) return error(2, err_wrong_no_args, name_from(def),
                                    fixnum_of_int((int32)nargs));
    va_start(aa, nargs);
    a = va_arg(aa, Lisp_Object);
    b = va_arg(aa, Lisp_Object);
    c = va_arg(aa, Lisp_Object);
    va_end(aa);
    push5(litvec, codevec, a, b, c);
    stackcheck1(5, def);
    if (!doubled_execution)
    {   push6(def, litvec, codevec, a, b, c);
        doubled_execution = 1;
        r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-3);
        nil = C_nil;
        pop3(codevec, litvec, def);
        if (!exception_pending())
            r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-3);
        doubled_execution = 0;
    }
    else r = bytestream_interpret(qcar(def)-2, qcdr(def), stack-3);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += 3;
        if ((exit_reason & UNWIND_ERROR) != 0)
        {   err_printf("Arg1: ");
            loop_print_error(stack[-2]); err_printf("\n");
            ignore_exception();
            err_printf("Arg2: ");
            loop_print_error(stack[-1]); err_printf("\n");
            ignore_exception();
            err_printf("Arg3: ");
            loop_print_error(stack[0]); err_printf("\n");
            ignore_exception();
        }
        popv(3); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL double_bytecodedn(Lisp_Object def, int nargs, ...)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i;
    Lisp_Object *stack_save = stack;
    va_list a;
    push2(litvec, codevec);
    if (nargs != 0)
    {   va_start(a, nargs);
        push_args(a, nargs);
    }
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    if (nargs != ((unsigned char *)data_of_bps(r))[0])
    {   popv(nargs+2);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    trace_printf("Function with > 3 args not doubled\n");
    r = bytestream_interpret(r-1, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}


/*
 * The code that follows is just used to support compiled code that
 * has &optional or &rest arguments.
 */

Lisp_Object byteopt1(Lisp_Object def, Lisp_Object a)
{
    return byteoptn(def, 1, a);
}

Lisp_Object byteopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return byteoptn(def, 2, a, b);
}

static Lisp_Object vbyteoptn(Lisp_Object def, int nargs,
                             va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push2(litvec, codevec);
/*
 * Maybe I should raise an exception (continuable error) if too many args
 * are provided - for now I just silently ignore the excess.
 */
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs || nargs > wantargs+wantopts)
    {   popv(nargs); pop2(codevec, litvec)
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL byteoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vbyteoptn(def, nargs, a, C_nil);
}

Lisp_Object hardopt1(Lisp_Object def, Lisp_Object a)
{
    return hardoptn(def, 1, a);
}

Lisp_Object hardopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return hardoptn(def, 2, a, b);
}

Lisp_Object MS_CDECL hardoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vbyteoptn(def, nargs, a, SPID_NOARG);
}

Lisp_Object byteoptrest1(Lisp_Object def, Lisp_Object a)
{
    return byteoptrestn(def, 1, a);
}

Lisp_Object byteoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return byteoptrestn(def, 2, a, b);
}

static Lisp_Object vbyterestn(Lisp_Object def, int nargs,
                              va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push2(litvec, codevec);
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs)
    {   popv(nargs+2);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    {   Lisp_Object rest = nil;
        while (nargs > wantargs+wantopts)
        {   Lisp_Object w = stack[0];
            stack[0] = def;
            rest = cons(w, rest);
            errexitn(nargs+2);
            pop(def);
            nargs--;
        }
        push(rest);
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL byteoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vbyterestn(def, nargs, a, C_nil);
}

Lisp_Object hardoptrest1(Lisp_Object def, Lisp_Object a)
{
    return hardoptrestn(def, 1, a);
}

Lisp_Object hardoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return hardoptrestn(def, 2, a, b);
}

Lisp_Object MS_CDECL hardoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vbyterestn(def, nargs, a, SPID_NOARG);
}

/*
 * Next the execution-doubling versions of the &opt/&rest interfaces
 */

Lisp_Object double_byteopt1(Lisp_Object def, Lisp_Object a)
{
    return double_byteoptn(def, 1, a);
}

Lisp_Object double_byteopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return double_byteoptn(def, 2, a, b);
}

static Lisp_Object double_vbyteoptn(Lisp_Object def, int nargs,
                             va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push2(litvec, codevec);
/*
 * Maybe I should raise an exception (continuable error) if too many args
 * are provided - for now I just silently ignore th excess.
 */
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs || nargs > wantargs+wantopts)
    {   popv(nargs); pop2(codevec, litvec)
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    trace_printf("Function with simple &opt arg not doubled\n");
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL double_byteoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return double_vbyteoptn(def, nargs, a, C_nil);
}

Lisp_Object double_hardopt1(Lisp_Object def, Lisp_Object a)
{
    return double_hardoptn(def, 1, a);
}

Lisp_Object double_hardopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return double_hardoptn(def, 2, a, b);
}

Lisp_Object MS_CDECL double_hardoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return double_vbyteoptn(def, nargs, a, SPID_NOARG);
}

Lisp_Object double_byteoptrest1(Lisp_Object def, Lisp_Object a)
{
    return double_byteoptrestn(def, 1, a);
}

Lisp_Object double_byteoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return double_byteoptrestn(def, 2, a, b);
}

static Lisp_Object double_vbyterestn(Lisp_Object def, int nargs,
                              va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push2(litvec, codevec);
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs)
    {   popv(nargs+2);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    {   Lisp_Object rest = nil;
        while (nargs > wantargs+wantopts)
        {   Lisp_Object w = stack[0];
            stack[0] = def;
            rest = cons(w, rest);
            errexitn(nargs+2);
            pop(def);
            nargs--;
        }
        push(rest);
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    trace_printf("Function with simple &rest arg not doubled\n");
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop2(codevec, litvec);
    return r;
}

Lisp_Object MS_CDECL double_byteoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return double_vbyterestn(def, nargs, a, C_nil);
}

Lisp_Object double_hardoptrest1(Lisp_Object def, Lisp_Object a)
{
    return double_hardoptrestn(def, 1, a);
}

Lisp_Object double_hardoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return double_hardoptrestn(def, 2, a, b);
}

Lisp_Object MS_CDECL double_hardoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return double_vbyterestn(def, nargs, a, SPID_NOARG);
}

Lisp_Object tracebyteopt1(Lisp_Object def, Lisp_Object a)
{
    return tracebyteoptn(def, 1, a);
}

Lisp_Object tracebyteopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return tracebyteoptn(def, 2, a, b);
}

static Lisp_Object vtracebyteoptn(Lisp_Object def, int nargs,
                             va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push3(litvec, codevec, def);
/*
 * Maybe I should raise an exception (continuable error) if too many args
 * are provided - for now I just silently ignore th excess.
 */
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs || nargs > wantargs+wantopts)
    {   popv(nargs+1); pop2(codevec, litvec)
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" (%d args)\n", nargs);
    for (i=1; i<=nargs; i++)
    {   trace_printf("Arg%d: ", i);
        loop_print_trace(stack[i-nargs]);
        trace_printf("\n");
    }
    def = stack[-nargs];
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs+1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (!exception_pending())
    {   trace_printf(" = ");
        loop_print_trace(r);
        trace_printf("\n");
    }
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object MS_CDECL tracebyteoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vtracebyteoptn(def, nargs, a, C_nil);
}

Lisp_Object tracehardopt1(Lisp_Object def, Lisp_Object a)
{
    return tracehardoptn(def, 1, a);
}

Lisp_Object tracehardopt2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return tracehardoptn(def, 2, a, b);
}

Lisp_Object MS_CDECL tracehardoptn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vtracebyteoptn(def, nargs, a, SPID_NOARG);
}

Lisp_Object tracebyteoptrest1(Lisp_Object def, Lisp_Object a)
{
    return tracebyteoptrestn(def, 1, a);
}

Lisp_Object tracebyteoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return tracebyteoptrestn(def, 2, a, b);
}

static Lisp_Object vtracebyterestn(Lisp_Object def, int nargs,
                              va_list a, Lisp_Object dflt)
{
    Lisp_Object r;
    Lisp_Object nil = C_nil;
    int i, wantargs, wantopts;
    Lisp_Object *stack_save = stack;
    push3(litvec, codevec, def);
    if (nargs != 0) push_args(a, nargs);
    else va_end(a);
    stackcheck1(stack-stack_save, def);
    r = qcar(def);
    wantargs = ((unsigned char *)data_of_bps(r))[0];
    wantopts = ((unsigned char *)data_of_bps(r))[1];
    if (nargs < wantargs)
    {   popv(nargs+2);
        return error(2, err_wrong_no_args, name_from(def),
                        fixnum_of_int((int32)nargs));
    }
    while (nargs < wantargs+wantopts)
    {   push(dflt);   /* Provide value for all optional args */
        nargs++;
    }
    {   Lisp_Object rest = nil;
        while (nargs > wantargs+wantopts)
        {   Lisp_Object w = stack[0];
            stack[0] = def;
            rest = cons(w, rest);
            errexitn(nargs+2);
            pop(def);
            nargs--;
        }
        push(rest);
        nargs++;
    }
    stackcheck1(stack-stack_save, def);
    freshline_trace();
    loop_print_trace(name_from(def));
    trace_printf(" (%d args)\n", nargs);
    for (i=1; i<=nargs; i++)
    {   trace_printf("Arg%d: ", i);
        loop_print_trace(stack[i-nargs]);
        trace_printf("\n");
    }
    def = stack[-nargs];
    r = qcar(def);
    r = bytestream_interpret(r, qcdr(def), stack-nargs);
    nil = C_nil;
    if (exception_pending())
    {   flip_exception();
        stack += nargs;
        if ((exit_reason & UNWIND_ERROR) != 0)
        for (i=1; i<=nargs; i++)
        {   err_printf("Arg%d: ", i);
            loop_print_error(stack[i-nargs]); err_printf("\n");
            ignore_exception();
        }
        popv(nargs+1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#ifdef COMMON
    r = Lmv_list(nil, r);
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
#endif
    pop(def);
    push(r);
    freshline_trace();
    loop_print_trace(name_from(def));
    nil = C_nil;
    if (!exception_pending())
    {   trace_printf(" = ");
        loop_print_trace(r);
        trace_printf("\n");
    }
    if (exception_pending()) 
    {   flip_exception();
        popv(1); pop2(codevec, litvec);
        flip_exception();
        return nil;
    }
    pop3(r, codevec, litvec);
#ifdef COMMON
    r = unpack_mv(nil, r);
#endif
    return r;
}

Lisp_Object MS_CDECL tracebyteoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vtracebyterestn(def, nargs, a, C_nil);
}

Lisp_Object tracehardoptrest1(Lisp_Object def, Lisp_Object a)
{
    return tracehardoptrestn(def, 1, a);
}

Lisp_Object tracehardoptrest2(Lisp_Object def, Lisp_Object a, Lisp_Object b)
{
    return tracehardoptrestn(def, 2, a, b);
}

Lisp_Object MS_CDECL tracehardoptrestn(Lisp_Object def, int nargs, ...)
{
    va_list a;
    va_start(a, nargs);
    return vtracebyterestn(def, nargs, a, SPID_NOARG);
}

static Lisp_Object Lis_spid(Lisp_Object nil, Lisp_Object a)
{   /* Used in compilation for optional args */
    return onevalue(Lispify_predicate(is_spid(a)));
}

static Lisp_Object Lspid_to_nil(Lisp_Object nil, Lisp_Object a)
{   /* Used in compilation for optional args */
    if (is_spid(a)) a = nil;
    return onevalue(a);
}

static Lisp_Object MS_CDECL Lload_spid(Lisp_Object nil, int nargs, ...)
{   /* Used in compilation of UNWIND-PROTECT */
    CSL_IGNORE(nil);
    CSL_IGNORE(nargs);
    return onevalue(SPID_PROTECT);
}

Lisp_Object Lmv_list(Lisp_Object nil, Lisp_Object a)
/*
 * This does a (multiple-value-list A) on just one form.  It must be used
 * carefully so that the value-count information does not get lost between
 * the evaluation of A and calling this code.
 */
{
#ifdef COMMON
    Lisp_Object r, *save_stack = stack;
    int i, x = exit_count;
    stackcheck1(0, a);
    if (x > 0) push(a);
    for (i=2; i<=x; i++) push((&work_0)[i]);
    r = nil;
    for (i=0; i<x; i++)
    {   Lisp_Object w;
        pop(w);
        r = cons(w, r);
        nil = C_nil;
        if (exception_pending())
        {   stack = save_stack;
            return nil;
        }
    }
    return onevalue(r);
#else
    CSL_IGNORE(nil);
    return ncons(a);
#endif
}

/*
 * In these tables there are some functions that would need adjusting
 * for a Common Lisp compiler, since they take different numbers of
 * args in Common and Standard Lisp.
 * This means, to be specific:
 *
 *  Lgensym     Lread       Latan       Ltruncate   Lfloat
 *  Lintern     Lmacroexpand            Lmacroexpand_1
 *  Lrandom     Lunintern   Lappend     Leqn        Lgcd
 *  Lgeq        Lgreaterp   Llcm        Lleq        Llessp
 *  Lquotient
 *
 * In these cases (at least!) the Common Lisp version of the compiler will
 * need to avoid generating the call that uses this table.
 *
 * Some functions are missing from the list here because they seemed
 * critical enough to be awarded single-byte opcodes or because the
 * compiler always expands them away - car through cddddr are the main
 * cases, together with eq and equal.
 */


n_args *zero_arg_functions[] =
{
    Lbatchp,                /* 0 */
    Ldate,                  /* 1 */
    Leject,                 /* 2 */
    Lerror0,                /* 3 */
    Lgctime,                /* 4 */
    Lgensym,                /* 5 */
    Llposn,                 /* 6 */
    Lnext_random,           /* 7 */
    Lposn,                  /* 8 */
    Lread,                  /* 9 */
    Lreadch,                /* 10 */
    Lterpri,                /* 11 */
    Ltime,                  /* 12 */
    Ltyi,                   /* 13 */
    Lload_spid,             /* 14 */  /* ONLY used in compiled code */
    NULL
};

one_args *one_arg_functions[] =
{
    Labsval,                /* 0 */
    Ladd1,                  /* 1 */
    Latan,                  /* 2 */
    Lapply0,                /* 3 */
    Latom,                  /* 4 */
    Lboundp,                /* 5 */
    Lchar_code,             /* 6 */
    Lclose,                 /* 7 */
    Lcodep,                 /* 8 */
    Lcompress,              /* 9 */
    Lconstantp,             /* 10 */
    Ldigitp,                /* 11 */
    Lendp,                  /* 12 */
    Leval,                  /* 13 */
    Levenp,                 /* 14 */
    Levlis,                 /* 15 */
    Lexplode,               /* 16 */
    Lexplode2lc,            /* 17 */
    Lexplodec,              /* 18 */
    Lfixp,                  /* 19 */
    Lfloat,                 /* 20 */
    Lfloatp,                /* 21 */
    Lsymbol_specialp,       /* 22 */
    Lgc,                    /* 23 */
    Lgensym1,               /* 24 */
    Lgetenv,                /* 25 */
    Lsymbol_globalp,        /* 26 */
    Liadd1,                 /* 27 */
    Lsymbolp,               /* 28 */
    Liminus,                /* 29 */
    Liminusp,               /* 30 */
    Lindirect,              /* 31 */
    Lintegerp,              /* 32 */
    Lintern,                /* 33 */
    Lisub1,                 /* 34 */
    Llength,                /* 35 */
    Llengthc,               /* 36 */
    Llinelength,            /* 37 */
    Lalpha_char_p,          /* 38 */
    Lload_module,           /* 39 */
    Llognot,                /* 40 */
    Lmacroexpand,           /* 41 */
    Lmacroexpand_1,         /* 42 */
    Lmacro_function,        /* 43 */
    Lget_bps,               /* 44 */
    Lmake_global,           /* 45 */
    Lsmkvect,               /* 46 */
    Lmake_special,          /* 47 */
    Lminus,                 /* 48 */
    Lminusp,                /* 49 */
    Lmkvect,                /* 50 */
    Lmodular_minus,         /* 51 */
    Lmodular_number,        /* 52 */
    Lmodular_reciprocal,    /* 53 */
    Lnull,                  /* 54 */
    Loddp,                  /* 55 */
    Lonep,                  /* 56 */
    Lpagelength,            /* 57 */
    Lconsp,                 /* 58 */
    Lplist,                 /* 59 */
    Lplusp,                 /* 60 */
    Lprin,                  /* 61 */
    Lprinc,                 /* 62 */
    Lprint,                 /* 63 */
    Lprintc,                /* 64 */
    Lrandom,                /* 65 */
    Lrational,              /* 66 */
    Lrdf1,                  /* 67 */
    Lrds,                   /* 68 */
    Lremd,                  /* 69 */
    Lreverse,               /* 70 */
    Lnreverse,              /* 71 */
    Lwhitespace_char_p,     /* 72 */
    Lset_small_modulus,     /* 73 */
    Lxtab,                  /* 74 */
    Lspecial_char,          /* 75 */
    Lspecial_form_p,        /* 76 */
    Lspool,                 /* 77 */
    Lstop,                  /* 78 */
    Lstringp,               /* 79 */
    Lsub1,                  /* 80 */
    Lsymbol_env,            /* 81 */
    Lsymbol_function,       /* 82 */
    Lsymbol_name,           /* 83 */
    Lsymbol_value,          /* 84 */
    Lsystem,                /* 85 */
    Ltruncate,              /* 86 */
    Lttab,                  /* 87 */
    Ltyo,                   /* 88 */
    Lunintern,              /* 89 */
    Lunmake_global,         /* 90 */
    Lunmake_special,        /* 91 */
    Lupbv,                  /* 92 */
    Lsimple_vectorp,        /* 93 */
    Lverbos,                /* 94 */
    Lwrs,                   /* 95 */
    Lzerop,                 /* 96 */
    Lcar,                   /* 97 */
    Lcdr,                   /* 98 */
    Lcaar,                  /* 99 */
    Lcadr,                  /* 100 */
    Lcdar,                  /* 101 */
    Lcddr,                  /* 102 */
    Lcar,                   /* 103 */   /* Really QCAR (unchecked) */
    Lcdr,                   /* 104 */
    Lcaar,                  /* 105 */
    Lcadr,                  /* 106 */
    Lcdar,                  /* 107 */
    Lcddr,                  /* 108 */
    Lncons,                 /* 109 */
    Lnumberp,               /* 110 */
    Lis_spid,               /* 111 */  /* ONLY used in compiled code */
    Lspid_to_nil,           /* 112 */  /* ONLY used in compiled code */
    Lmv_list,               /* 113 */  /* ONLY used in compiled code */
    NULL
};

two_args *two_arg_functions[] =
{
    Lappend,                /* 0 */
    Lash,                   /* 1 */
    Lassoc,                 /* 2 */
    Latsoc,                 /* 3 */
    Ldeleq,                 /* 4 */
    Ldelete,                /* 5 */
    Ldivide,                /* 6 */
    Leqcar,                 /* 7 */
    Leql,                   /* 8 */
    Leqn,                   /* 9 */
    Lexpt,                  /* 10 */
    Lflag,                  /* 11 */
    Lflagpcar,              /* 12 */
    Lgcd,                   /* 13 */
    Lgeq,                   /* 14 */
    Lgetv,                  /* 15 */
    Lgreaterp,              /* 16 */
    Lidifference,           /* 17 */
    Ligreaterp,             /* 18 */
    Lilessp,                /* 19 */
    Limax,                  /* 20 */
    Limin,                  /* 21 */
    Liplus2,                /* 22 */
    Liquotient,             /* 23 */
    Liremainder,            /* 24 */
    Lirightshift,           /* 25 */
    Litimes2,               /* 26 */
    Llcm,                   /* 27 */
    Lleq,                   /* 28 */
    Llessp,                 /* 29 */
    Lmake_random_state,     /* 30 */
    Lmax2,                  /* 31 */
    Lmember,                /* 32 */
    Lmemq,                  /* 33 */
    Lmin2,                  /* 34 */
    Lmod,                   /* 35 */
    Lmodular_difference,    /* 36 */
    Lmodular_expt,          /* 37 */
    Lmodular_plus,          /* 38 */
    Lmodular_quotient,      /* 39 */
    Lmodular_times,         /* 40 */
    Lnconc,                 /* 41 */
    Lneq,                   /* 42 */
    Lorderp,                /* 43 */
    Lquotient,              /* 44 */
    Lrem,                   /* 45 */
    Lremflag,               /* 46 */
    Lremprop,               /* 47 */
    Lrplaca,                /* 48 */
    Lrplacd,                /* 49 */
    Lsgetv,                 /* 50 */
    Lset,                   /* 51 */
    Lsmemq,                 /* 52 */
    Lsubla,                 /* 53 */
    Lsublis,                /* 54 */
    Lsymbol_set_definition, /* 55 */
    Lsymbol_set_env,        /* 56 */
    Ltimes2,                /* 57 */
    Lxcons,                 /* 58 */
    Lequal,                 /* 59 */
    Leq,                    /* 60 */
    Lcons,                  /* 61 */
    Llist2,                 /* 62 */
    Lget,                   /* 63 */
    Lgetv,                  /* 64 */   /* QGETV */
    Lflagp,                 /* 65 */
    Lapply1,                /* 66 */
    Ldifference2,           /* 67 */
    Lplus2,                 /* 68 */
    Ltimes2,                /* 69 */
    Lequalcar,              /* 70 */
    Leq,                    /* 71 */   /* IEQUAL */
    Lnreverse2,             /* 72 */
    NULL
};

n_args *three_arg_functions[] =
{                         
    Lbpsputv,               /* 0 */
    Lerrorsetn,             /* 1 */
    Llist2star,             /* 2 */
    Llist3,                 /* 3 */
    Lputprop,               /* 4 */
    Lputv,                  /* 5 */
    Lsputv,                 /* 6 */
    Lsubst,                 /* 7 */
    Lapply2,                /* 8 */
    Lacons,                 /* 9 */
    NULL
};

/* end of eval4.c */