/* lispmach.c -- Interpreter for compiled Lisp forms Copyright (C) 1993, 1994 John Harper This file is part of Jade. Jade is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. Jade is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Jade; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #include "jade.h" #include "jade_protos.h" #ifdef HAVE_ALLOCA # include #endif _PR void lispmach_init(void); #define OP_CALL 0x08 #define OP_PUSH 0x10 #define OP_VREFC 0x18 #define OP_VSETC 0x20 #define OP_LIST 0x28 #define OP_BIND 0x30 #define OP_LAST_WITH_ARGS 0x38 #define OP_VREF 0x40 #define OP_VSET 0x41 #define OP_FREF 0x42 #define OP_FSET 0x43 #define OP_INIT_BIND 0x44 #define OP_UNBIND 0x45 #define OP_DUP 0x46 #define OP_SWAP 0x47 #define OP_POP 0x48 #define OP_NIL 0x49 #define OP_T 0x4a #define OP_CONS 0x4b #define OP_CAR 0x4c #define OP_CDR 0x4d #define OP_RPLACA 0x4e #define OP_RPLACD 0x4f #define OP_NTH 0x50 #define OP_NTHCDR 0x51 #define OP_ASET 0x52 #define OP_AREF 0x53 #define OP_LENGTH 0x54 #define OP_EVAL 0x55 #define OP_PLUS_2 0x56 #define OP_NEGATE 0x57 #define OP_MINUS_2 0x58 #define OP_PRODUCT_2 0x59 #define OP_DIVIDE_2 0x5a #define OP_MOD_2 0x5b #define OP_LOGNOT 0x5c #define OP_NOT 0x5d #define OP_LOGIOR_2 0x5e #define OP_LOGAND_2 0x5f #define OP_EQUAL 0x60 #define OP_EQ 0x61 #define OP_NUM_EQ 0x62 #define OP_NUM_NOTEQ 0x63 #define OP_GTTHAN 0x64 #define OP_GETHAN 0x65 #define OP_LTTHAN 0x66 #define OP_LETHAN 0x67 #define OP_INC 0x68 #define OP_DEC 0x69 #define OP_LSH 0x6a #define OP_ZEROP 0x6b #define OP_NULL 0x6c #define OP_ATOM 0x6d #define OP_CONSP 0x6e #define OP_LISTP 0x6f #define OP_NUMBERP 0x70 #define OP_STRINGP 0x71 #define OP_VECTORP 0x72 #define OP_CATCH_KLUDGE 0x73 #define OP_THROW 0x74 #define OP_UNWIND_PRO 0x75 #define OP_UN_UNWIND_PRO 0x76 #define OP_FBOUNDP 0x77 #define OP_BOUNDP 0x78 #define OP_SYMBOLP 0x79 #define OP_GET 0x7a #define OP_PUT 0x7b #define OP_ERROR_PRO 0x7c #define OP_SIGNAL 0x7d #define OP_RETURN 0x7e #define OP_REVERSE 0x7f /* new 12/7/94 */ #define OP_NREVERSE 0x80 #define OP_ASSOC 0x81 #define OP_ASSQ 0x82 #define OP_RASSOC 0x83 #define OP_RASSQ 0x84 #define OP_LAST 0x85 #define OP_MAPCAR 0x86 #define OP_MAPC 0x87 #define OP_MEMBER 0x88 #define OP_MEMQ 0x89 #define OP_DELETE 0x8a #define OP_DELQ 0x8b #define OP_DELETE_IF 0x8c #define OP_DELETE_IF_NOT 0x8d #define OP_COPY_SEQUENCE 0x8e #define OP_SEQUENCEP 0x8f #define OP_FUNCTIONP 0x90 #define OP_SPECIAL_FORM_P 0x91 #define OP_SUBRP 0x92 #define OP_EQL 0x93 #define OP_LOGXOR_2 0x94 /* new 23-8-94 */ #define OP_SET_CURRENT_BUFFER 0xb0 #define OP_SWAP_BUFFER 0xb1 #define OP_CURRENT_BUFFER 0xb2 #define OP_BUFFERP 0xb3 #define OP_MARKP 0xb4 #define OP_WINDOWP 0xb5 #define OP_SWAP_WINDOW 0xb6 #define OP_LAST_BEFORE_JMPS 0xfa #define OP_JMP 0xfb #define OP_JN 0xfc #define OP_JT 0xfd #define OP_JNP 0xfe #define OP_JTP 0xff #define TOP (*stackp) #define RET_POP (*stackp--) #define POP (stackp--) #define POPN(n) (stackp -= n) #define PUSH(v) (*(++stackp) = (v)) #define STK_USE (stackp - (stackbase - 1)) #define ARG_SHIFT 8 #define OP_ARG_MASK 0x07 #define OP_OP_MASK 0xf8 #define OP_ARG_1BYTE 6 #define OP_ARG_2BYTE 7 /* These macros pop as many args as required then call the specified function properly. */ #define CALL_1(cmd) \ if((TOP = cmd (TOP))) \ break; \ goto error #define CALL_2(cmd) \ tmp = RET_POP; \ if((TOP = cmd (TOP, tmp))) \ break; \ goto error #define CALL_3(cmd) \ tmp = RET_POP; \ tmp2 = RET_POP; \ if((TOP = cmd (TOP, tmp2, tmp))) \ break; \ goto error _PR VALUE cmd_jade_byte_code(VALUE code, VALUE consts, VALUE stkreq); DEFUN("jade-byte-code", cmd_jade_byte_code, subr_jade_byte_code, (VALUE code, VALUE consts, VALUE stkreq), V_Subr3, DOC_jade_byte_code) /* ::doc:jade_byte_code:: jade-byte-code CODE-STRING CONST-VEC MAX-STACK Evaluates the string of byte codes CODE-STRING, the constants that it references are contained in the vector CONST-VEC. MAX-STACK is a number defining how much stack space is required to evaluate the code. Do *not* attempt to call this function manually, the lisp file `compiler.jl' contains a simple compiler which translates files of lisp forms into files of byte code. See the functions `compile-file', `compile-directory' and `compile-lisp-lib' for more details. ::end:: */ { VALUE *stackbase; register VALUE *stackp; /* This holds a list of sets of bindings, it can also hold the form of an unwind-protect that always gets eval'd (when the car is t). */ VALUE bindstack = sym_nil; register u_char *pc; u_char c; GCVAL gcv_code, gcv_consts, gcv_bindstack; /* The `gcv_N' field is only filled in with the stack-size when there's a chance of gc. */ GCVALN gcv_stackbase; DECLARE1(code, STRINGP); DECLARE2(consts, VECTORP); DECLARE3(stkreq, NUMBERP); #ifdef HAVE_ALLOCA stackbase = alloca(sizeof(VALUE) * VNUM(stkreq)); #else if(!(stackbase = str_alloc(sizeof(VALUE) * VNUM(stkreq)))) return(NULL); #endif stackp = stackbase - 1; PUSHGC(gcv_code, code); PUSHGC(gcv_consts, consts); PUSHGC(gcv_bindstack, bindstack); PUSHGCN(gcv_stackbase, stackbase, 0); pc = VSTR(code); while((c = *pc++) != 0) { if(c < OP_LAST_WITH_ARGS) { register short arg; switch(c & OP_ARG_MASK) { case OP_ARG_1BYTE: arg = *pc++; break; case OP_ARG_2BYTE: arg = (pc[0] << ARG_SHIFT) | pc[1]; pc += 2; break; default: arg = c & OP_ARG_MASK; } switch(c & OP_OP_MASK) { register VALUE tmp; VALUE tmp2; case OP_CALL: #ifdef MINSTACK if(STK_SIZE <= MINSTACK) { STK_WARN("lisp-code"); TOP = cmd_signal(sym_stack_error, sym_nil); goto quit; } #endif /* args are still available above the top of the stack, this just makes things a bit easier. */ POPN(arg); tmp = TOP; if(SYMBOLP(tmp)) { if(VSYM(tmp)->sym_Flags & SF_DEBUG) single_step_flag = TRUE; if(!(tmp = cmd_symbol_function(tmp, sym_nil))) goto error; } gcv_stackbase.gcv_N = STK_USE; switch(VTYPE(tmp)) { case V_Subr0: TOP = VSUBR0FUN(tmp)(); break; case V_Subr1: TOP = VSUBR1FUN(tmp)(arg >= 1 ? stackp[1] : sym_nil); break; case V_Subr2: switch(arg) { case 0: TOP = VSUBR2FUN(tmp)(sym_nil, sym_nil); break; case 1: TOP = VSUBR2FUN(tmp)(stackp[1], sym_nil); break; default: TOP = VSUBR2FUN(tmp)(stackp[1], stackp[2]); break; } break; case V_Subr3: switch(arg) { case 0: TOP = VSUBR3FUN(tmp)(sym_nil, sym_nil, sym_nil); break; case 1: TOP = VSUBR3FUN(tmp)(stackp[1], sym_nil, sym_nil); break; case 2: TOP = VSUBR3FUN(tmp)(stackp[1], stackp[2], sym_nil); break; default: TOP = VSUBR3FUN(tmp)(stackp[1], stackp[2], stackp[3]); break; } break; case V_Subr4: switch(arg) { case 0: TOP = VSUBR4FUN(tmp)(sym_nil, sym_nil, sym_nil, sym_nil); break; case 1: TOP = VSUBR4FUN(tmp)(stackp[1], sym_nil, sym_nil, sym_nil); break; case 2: TOP = VSUBR4FUN(tmp)(stackp[1], stackp[2], sym_nil, sym_nil); break; case 3: TOP = VSUBR4FUN(tmp)(stackp[1], stackp[2], stackp[3], sym_nil); break; default: TOP = VSUBR4FUN(tmp)(stackp[1], stackp[2], stackp[3], stackp[4]); break; } break; case V_Subr5: switch(arg) { case 0: TOP = VSUBR5FUN(tmp)(sym_nil, sym_nil, sym_nil, sym_nil, sym_nil); break; case 1: TOP = VSUBR5FUN(tmp)(stackp[1], sym_nil, sym_nil, sym_nil, sym_nil); break; case 2: TOP = VSUBR5FUN(tmp)(stackp[1], stackp[2], sym_nil, sym_nil, sym_nil); break; case 3: TOP = VSUBR5FUN(tmp)(stackp[1], stackp[2], stackp[3], sym_nil, sym_nil); break; case 4: TOP = VSUBR5FUN(tmp)(stackp[1], stackp[2], stackp[3], stackp[4], sym_nil); default: TOP = VSUBR5FUN(tmp)(stackp[1], stackp[2], stackp[3], stackp[4], stackp[5]); break; } break; case V_SubrN: tmp2 = sym_nil; POPN(-arg); /* reclaim my args */ while(arg--) tmp2 = cmd_cons(RET_POP, tmp2); TOP = VSUBRNFUN(tmp)(tmp2); break; case V_Cons: tmp2 = sym_nil; POPN(-arg); while(arg--) tmp2 = cmd_cons(RET_POP, tmp2); if(VCAR(tmp) == sym_lambda) { struct LispCall lc; lc.lc_Next = lisp_call_stack; lc.lc_Fun = TOP; lc.lc_Args = tmp2; lc.lc_ArgsEvalledP = sym_t; lisp_call_stack = &lc; if(!(TOP = eval_lambda(tmp, tmp2, FALSE)) && throw_value && (VCAR(throw_value) == sym_defun)) { TOP = VCDR(throw_value); throw_value = NULL; } lisp_call_stack = lc.lc_Next; } else if(VCAR(tmp) == sym_autoload) /* I can't be bothered to go to all the hassle of doing this here, it's going to be slow anyway so just pass it to funcall. */ TOP = funcall(TOP, tmp2); else { cmd_signal(sym_invalid_function, LIST_1(TOP)); goto error; } break; default: cmd_signal(sym_invalid_function, LIST_1(TOP)); goto error; } if(!TOP) goto error; break; case OP_PUSH: PUSH(VVECT(consts)->vc_Array[arg]); break; case OP_VREFC: if(PUSH(cmd_symbol_value(VVECT(consts)->vc_Array[arg], sym_nil))) { break; } goto error; case OP_VSETC: if(cmd_set(VVECT(consts)->vc_Array[arg], RET_POP)) break; goto error; case OP_LIST: tmp = sym_nil; while(arg--) tmp = cmd_cons(RET_POP, tmp); PUSH(tmp); break; case OP_BIND: tmp = VVECT(consts)->vc_Array[arg]; if(SYMBOLP(tmp)) { VCAR(bindstack) = bind_symbol(VCAR(bindstack), tmp, RET_POP); break; } goto error; } } else { switch(c) { register VALUE tmp; VALUE tmp2; int i; case OP_POP: POP; break; case OP_VREF: if((TOP = cmd_symbol_value(TOP, sym_nil))) break; goto error; case OP_VSET: tmp = RET_POP; if(cmd_set(tmp, RET_POP)) break; goto error; case OP_FREF: if((TOP = cmd_symbol_function(TOP, sym_nil))) break; goto error; case OP_FSET: tmp = RET_POP; if(cmd_fset(tmp, RET_POP)) break; goto error; case OP_INIT_BIND: bindstack = cmd_cons(sym_nil, bindstack); break; case OP_UNBIND: unbind_symbols(VCAR(bindstack)); bindstack = VCDR(bindstack); break; case OP_DUP: tmp = TOP; PUSH(tmp); break; case OP_SWAP: tmp = TOP; TOP = stackp[-1]; stackp[-1] = tmp; break; case OP_NIL: PUSH(sym_nil); break; case OP_T: PUSH(sym_t); break; case OP_CONS: CALL_2(cmd_cons); case OP_CAR: tmp = TOP; if(CONSP(tmp)) TOP = VCAR(tmp); else TOP = sym_nil; break; case OP_CDR: tmp = TOP; if(CONSP(tmp)) TOP = VCDR(tmp); else TOP = sym_nil; break; case OP_RPLACA: CALL_2(cmd_rplaca); case OP_RPLACD: CALL_2(cmd_rplacd); case OP_NTH: CALL_2(cmd_nth); case OP_NTHCDR: CALL_2(cmd_nthcdr); case OP_ASET: CALL_3(cmd_aset); case OP_AREF: CALL_2(cmd_aref); case OP_LENGTH: CALL_1(cmd_length); case OP_EVAL: gcv_stackbase.gcv_N = STK_USE; CALL_1(cmd_eval); case OP_PLUS_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) + VNUM(tmp)); break; } goto error; case OP_NEGATE: if(NUMBERP(TOP)) { TOP = make_number(-VNUM(TOP)); break; } goto error; case OP_MINUS_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) - VNUM(tmp)); break; } goto error; case OP_PRODUCT_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) * VNUM(tmp)); break; } goto error; case OP_DIVIDE_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) / VNUM(tmp)); break; } goto error; case OP_MOD_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) % VNUM(tmp)); break; } goto error; case OP_LOGNOT: if(NUMBERP(TOP)) { TOP = make_number(~VNUM(TOP)); break; } goto error; case OP_NOT: if(TOP == sym_nil) TOP = sym_t; else TOP = sym_nil; break; case OP_LOGIOR_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) | VNUM(tmp)); break; } goto error; case OP_LOGXOR_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) ^ VNUM(tmp)); break; } goto error; case OP_LOGAND_2: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) & VNUM(tmp)); break; } goto error; case OP_EQUAL: tmp = RET_POP; if(!(VALUE_CMP(TOP, tmp))) TOP = sym_t; else TOP = sym_nil; break; case OP_EQ: tmp = RET_POP; if(TOP == tmp) TOP = sym_t; else TOP = sym_nil; break; case OP_NUM_EQ: CALL_2(cmd_num_eq); case OP_NUM_NOTEQ: CALL_2(cmd_num_noteq); case OP_GTTHAN: tmp = RET_POP; if(VALUE_CMP(TOP, tmp) > 0) TOP = sym_t; else TOP = sym_nil; break; case OP_GETHAN: tmp = RET_POP; if(VALUE_CMP(TOP, tmp) >= 0) TOP = sym_t; else TOP = sym_nil; break; case OP_LTTHAN: tmp = RET_POP; if(VALUE_CMP(TOP, tmp) < 0) TOP = sym_t; else TOP = sym_nil; break; case OP_LETHAN: tmp = RET_POP; if(VALUE_CMP(TOP, tmp) <= 0) TOP = sym_t; else TOP = sym_nil; break; case OP_INC: if(NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) + 1); break; } goto error; case OP_DEC: if(NUMBERP(TOP)) { TOP = make_number(VNUM(TOP) - 1); break; } goto error; case OP_LSH: CALL_2(cmd_lsh); case OP_ZEROP: if(NUMBERP(TOP) && (VNUM(TOP) == 0)) TOP = sym_t; else TOP = sym_nil; break; case OP_NULL: if(NILP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_ATOM: if(!CONSP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_CONSP: if(CONSP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_LISTP: if(CONSP(TOP) || NILP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_NUMBERP: if(NUMBERP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_STRINGP: if(STRINGP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_VECTORP: if(VECTORP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_CATCH_KLUDGE: /* This is very crude. */ tmp = RET_POP; tmp = cmd_cons(tmp, cmd_cons(TOP, sym_nil)); gcv_stackbase.gcv_N = STK_USE; if((TOP = cmd_catch(tmp))) break; goto error; case OP_THROW: tmp = RET_POP; if(!throw_value) throw_value = cmd_cons(TOP, tmp); /* This isn't really an error :-) */ goto error; case OP_UNWIND_PRO: tmp = RET_POP; bindstack = cmd_cons(cmd_cons(sym_t, tmp), bindstack); break; case OP_UN_UNWIND_PRO: gcv_stackbase.gcv_N = STK_USE; /* there will only be one form (a lisp-code) */ cmd_eval(VCDR(VCAR(bindstack))); bindstack = VCDR(bindstack); break; case OP_FBOUNDP: CALL_1(cmd_fboundp); case OP_BOUNDP: CALL_1(cmd_boundp); case OP_SYMBOLP: if(SYMBOLP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_GET: CALL_2(cmd_get); case OP_PUT: CALL_3(cmd_put); case OP_ERROR_PRO: /* bit of a kludge, this just calls the special-form, it takes an extra argument on top of the stack - the number of arguments that it has been given. */ i = VNUM(RET_POP); tmp = sym_nil; while(i--) tmp = cmd_cons(RET_POP, tmp); gcv_stackbase.gcv_N = STK_USE; tmp = cmd_error_protect(tmp); if(tmp) { PUSH(tmp); break; } goto error; case OP_SIGNAL: CALL_2(cmd_signal); case OP_RETURN: if(!throw_value) throw_value = cmd_cons(sym_defun, TOP); goto error; case OP_REVERSE: CALL_1(cmd_reverse); case OP_NREVERSE: CALL_1(cmd_nreverse); case OP_ASSOC: CALL_2(cmd_assoc); case OP_ASSQ: CALL_2(cmd_assq); case OP_RASSOC: CALL_2(cmd_rassoc); case OP_RASSQ: CALL_2(cmd_rassq); case OP_LAST: CALL_1(cmd_last); case OP_MAPCAR: CALL_2(cmd_mapcar); case OP_MAPC: CALL_2(cmd_mapc); case OP_MEMBER: CALL_2(cmd_member); case OP_MEMQ: CALL_2(cmd_memq); case OP_DELETE: CALL_2(cmd_delete); case OP_DELQ: CALL_2(cmd_delq); case OP_DELETE_IF: CALL_2(cmd_delete_if); case OP_DELETE_IF_NOT: CALL_2(cmd_delete_if_not); case OP_COPY_SEQUENCE: CALL_1(cmd_copy_sequence); case OP_SEQUENCEP: CALL_1(cmd_sequencep); case OP_FUNCTIONP: CALL_1(cmd_functionp); case OP_SPECIAL_FORM_P: CALL_1(cmd_special_form_p); case OP_SUBRP: CALL_1(cmd_subrp); case OP_EQL: tmp = RET_POP; if(NUMBERP(tmp) && NUMBERP(TOP)) TOP = (VNUM(TOP) == VNUM(tmp) ? sym_t : sym_nil); else TOP = (TOP == tmp ? sym_t : sym_nil); break; case OP_SET_CURRENT_BUFFER: CALL_2(cmd_set_current_buffer); case OP_SWAP_BUFFER: if(!BUFFERP(TOP)) goto error; TOP = VAL(swap_buffers_tmp(curr_vw, VTX(TOP))); break; case OP_CURRENT_BUFFER: CALL_1(cmd_current_buffer); case OP_BUFFERP: if(BUFFERP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_MARKP: if(MARKP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_WINDOWP: if(WINDOWP(TOP)) TOP = sym_t; else TOP = sym_nil; break; case OP_SWAP_WINDOW: tmp = TOP; if(!WINDOWP(tmp)) goto error; TOP = VAL(curr_vw); curr_vw = VWIN(tmp); break; case OP_JN: if(NILP(RET_POP)) goto do_jmp; pc += 2; break; case OP_JT: if(!NILP(RET_POP)) goto do_jmp; pc += 2; break; case OP_JNP: if(NILP(TOP)) goto do_jmp; POP; pc += 2; break; case OP_JTP: if(NILP(TOP)) { POP; pc += 2; break; } /* FALL THROUGH */ case OP_JMP: do_jmp: pc = VSTR(code) + ((pc[0] << ARG_SHIFT) | pc[1]); /* Test if an error occurred (or an interrupt) */ TEST_INT; if(INT_P) goto error; /* Test for gc time */ if((data_after_gc >= gc_threshold) && !gc_inhibit) { gcv_stackbase.gcv_N = STK_USE; cmd_garbage_collect(sym_t); } break; default: cmd_signal(sym_error, LIST_1(MKSTR("Unknown lisp opcode"))); error: while(CONSP(bindstack)) { if(VCAR(VCAR(bindstack)) == sym_t) { /* an unwind-pro */ GCVAL gcv_throwval; VALUE throwval = throw_value; throw_value = NULL; PUSHGC(gcv_throwval, throwval); cmd_eval(VCDR(VCAR(bindstack))); POPGC; throw_value = throwval; } else unbind_symbols(VCAR(bindstack)); bindstack = VCDR(bindstack); } TOP = NULL; goto quit; } } #ifdef PARANOID if(stackp < (stackbase - 1)) { fprintf(stderr, "jade: stack underflow in lisp-code: aborting...\n"); abort(); } if(stackp > (stackbase + VNUM(stkreq))) { fprintf(stderr, "jade: stack overflow in lisp-code: aborting...\n"); abort(); } #endif } #ifdef PARANOID if(stackp != stackbase) fprintf(stderr, "jade: (stackp != stackbase) at end of lisp-code\n"); #endif quit: /* only use this var to save declaring another */ bindstack = TOP; #ifndef HAVE_ALLOCA str_free(stackbase); #endif POPGCN; POPGC; POPGC; POPGC; return(bindstack); } void lispmach_init(void) { ADD_SUBR(subr_jade_byte_code); }