summaryrefslogtreecommitdiff
path: root/byterun/interp.c
diff options
context:
space:
mode:
Diffstat (limited to 'byterun/interp.c')
-rw-r--r--byterun/interp.c865
1 files changed, 0 insertions, 865 deletions
diff --git a/byterun/interp.c b/byterun/interp.c
deleted file mode 100644
index f96dd10d57..0000000000
--- a/byterun/interp.c
+++ /dev/null
@@ -1,865 +0,0 @@
-/* The bytecode interpreter */
-
-#include "alloc.h"
-#include "fail.h"
-#include "fix_code.h"
-#include "instruct.h"
-#include "interp.h"
-#include "memory.h"
-#include "misc.h"
-#include "mlvalues.h"
-#include "prims.h"
-#include "signals.h"
-#include "stacks.h"
-#include "str.h"
-#include "instrtrace.h"
-
-/* Registers for the abstract machine:
- pc the code pointer
- sp the stack pointer (grows downward)
- accu the accumulator
- env heap-allocated environment
- trapsp pointer to the current trap frame
- extra_args number of extra arguments provided by the caller
-
-sp is a local copy of the global variable extern_sp. */
-
-extern value global_data;
-extern code_t start_code;
-
-/* Instruction decoding */
-
-#ifdef THREADED_CODE
-# define Instruct(name) lbl_##name
-# ifdef DEBUG
-# define Next goto next_instr
-# else
-# define Next goto *((void *)((unsigned long)(*pc++)))
-# endif
-#else
-# define Instruct(name) case name
-# define Next break
-#endif
-
-/* GC interface */
-
-#define Setup_for_gc { sp -= 2; sp[0] = accu; sp[1] = env; extern_sp = sp; }
-#define Restore_after_gc { accu = sp[0]; env = sp[1]; sp += 2; }
-#define Setup_for_c_call { *--sp = env; extern_sp = sp; }
-#define Restore_after_c_call { sp = extern_sp; env = *sp++; }
-
-/* Register optimization.
- Many compilers underestimate the use of the local variables representing
- the abstract machine registers, and don't put them in hardware registers,
- which slows down the interpreter considerably.
- For GCC, I have hand-assigned hardware registers for several architectures.
-*/
-
-#if defined(__GNUC__) && !defined(DEBUG)
-#ifdef __mips__
-#define PC_REG asm("$16")
-#define SP_REG asm("$17")
-#define ACCU_REG asm("$18")
-#endif
-#ifdef __sparc__
-#define PC_REG asm("%l0")
-#define SP_REG asm("%l1")
-#define ACCU_REG asm("%l2")
-#endif
-#ifdef __alpha__
-#define PC_REG asm("$9")
-#define SP_REG asm("$10")
-#define ACCU_REG asm("$11")
-#endif
-#ifdef __i386__
-#define PC_REG asm("%esi")
-#define SP_REG asm("%edi")
-#define ACCU_REG
-#endif
-#endif
-
-/* The interpreter itself */
-
-value interprete(prog, prog_size)
- code_t prog;
- asize_t prog_size;
-{
-#ifdef PC_REG
- register code_t pc PC_REG;
- register value * sp SP_REG;
- register value accu ACCU_REG;
-#else
- register code_t pc;
- register value * sp;
- register value accu;
-#endif
- value env;
- long extra_args;
- struct longjmp_buffer * initial_external_raise;
- int initial_sp_offset;
- value * initial_local_roots;
- struct longjmp_buffer raise_buf;
- value * modify_dest, modify_newval;
-
-#ifdef THREADED_CODE
- static void * jumptable[] = {
-# include "jumptbl.h"
- };
-#endif
-
-#ifdef THREADED_CODE
- if (prog[0] <= STOP) thread_code(prog, prog_size, jumptable);
-#endif
-
- sp = extern_sp;
- pc = prog;
- extra_args = 0;
- env = Atom(0);
- accu = Val_long(0);
- initial_local_roots = local_roots;
- initial_sp_offset = stack_high - sp;
- initial_external_raise = external_raise;
- if (setjmp(raise_buf.buf)) {
- local_roots = initial_local_roots;
- accu = exn_bucket;
- goto raise_exception;
- }
- external_raise = &raise_buf;
-
-#ifdef THREADED_CODE
-#ifdef DEBUG
- next_instr:
- if (icount-- == 0) stop_here ();
- Assert(sp >= stack_low);
- Assert(sp <= stack_high);
- goto *((void *)((unsigned long)(*pc++)));
-#else
- Next; /* Jump to the first instruction */
-#endif
-#else
- while(1) {
-#ifdef DEBUG
- if (icount-- == 0) stop_here ();
- if (trace_flag) disasm_instr(pc);
- Assert(sp >= stack_low);
- Assert(sp <= stack_high);
-#endif
- switch(*pc++) {
-#endif
-
-/* Basic stack operations */
-
- Instruct(ACC0):
- accu = sp[0]; Next;
- Instruct(ACC1):
- accu = sp[1]; Next;
- Instruct(ACC2):
- accu = sp[2]; Next;
- Instruct(ACC3):
- accu = sp[3]; Next;
- Instruct(ACC4):
- accu = sp[4]; Next;
- Instruct(ACC5):
- accu = sp[5]; Next;
- Instruct(ACC6):
- accu = sp[6]; Next;
- Instruct(ACC7):
- accu = sp[7]; Next;
-
- Instruct(PUSH): Instruct(PUSHACC0):
- *--sp = accu; Next;
- Instruct(PUSHACC1):
- *--sp = accu; accu = sp[1]; Next;
- Instruct(PUSHACC2):
- *--sp = accu; accu = sp[2]; Next;
- Instruct(PUSHACC3):
- *--sp = accu; accu = sp[3]; Next;
- Instruct(PUSHACC4):
- *--sp = accu; accu = sp[4]; Next;
- Instruct(PUSHACC5):
- *--sp = accu; accu = sp[5]; Next;
- Instruct(PUSHACC6):
- *--sp = accu; accu = sp[6]; Next;
- Instruct(PUSHACC7):
- *--sp = accu; accu = sp[7]; Next;
-
- Instruct(PUSHACC):
- *--sp = accu;
- /* Fallthrough */
- Instruct(ACC):
- accu = sp[*pc++];
- Next;
-
- Instruct(POP):
- sp += *pc++;
- Next;
- Instruct(ASSIGN):
- sp[*pc++] = accu;
- Next;
-
-/* Access in heap-allocated environment */
-
- Instruct(ENVACC0):
- accu = Field(env, 0); Next;
- Instruct(ENVACC1):
- accu = Field(env, 1); Next;
- Instruct(ENVACC2):
- accu = Field(env, 2); Next;
- Instruct(ENVACC3):
- accu = Field(env, 3); Next;
-
- Instruct(PUSHENVACC0):
- *--sp = accu; accu = Field(env, 0); Next;
- Instruct(PUSHENVACC1):
- *--sp = accu; accu = Field(env, 1); Next;
- Instruct(PUSHENVACC2):
- *--sp = accu; accu = Field(env, 2); Next;
- Instruct(PUSHENVACC3):
- *--sp = accu; accu = Field(env, 3); Next;
-
- Instruct(PUSHENVACC):
- *--sp = accu;
- /* Fallthrough */
- Instruct(ENVACC):
- accu = Field(env, *pc++);
- Next;
-
-/* Function application */
-
- Instruct(PUSH_RETADDR): {
- sp -= 3;
- sp[0] = (value) (pc + *pc);
- sp[1] = env;
- sp[2] = Val_long(extra_args);
- pc++;
- Next;
- }
- Instruct(APPLY): {
- extra_args = *pc++ - 1;
- pc = Code_val(accu);
- env = Env_val(accu);
- goto check_stacks;
- }
- Instruct(APPLY1): {
- value arg1 = sp[0];
- sp -= 3;
- sp[0] = arg1;
- sp[1] = (value)pc;
- sp[2] = env;
- sp[3] = Val_long(extra_args);
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args = 0;
- goto check_stacks;
- }
- Instruct(APPLY2): {
- value arg1 = sp[0];
- value arg2 = sp[1];
- sp -= 3;
- sp[0] = arg1;
- sp[1] = arg2;
- sp[2] = (value)pc;
- sp[3] = env;
- sp[4] = Val_long(extra_args);
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args = 1;
- goto check_stacks;
- }
- Instruct(APPLY3): {
- value arg1 = sp[0];
- value arg2 = sp[1];
- value arg3 = sp[2];
- sp -= 3;
- sp[0] = arg1;
- sp[1] = arg2;
- sp[2] = arg3;
- sp[3] = (value)pc;
- sp[4] = env;
- sp[5] = Val_long(extra_args);
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args = 2;
- goto check_stacks;
- }
-
- Instruct(APPTERM): {
- int nargs = *pc++;
- int slotsize = *pc++;
- value * newsp;
- int i;
- /* Slide the nargs bottom words of the current frame to the top
- of the frame, and discard the remainder of the frame */
- newsp = sp + slotsize - nargs;
- for (i = nargs - 1; i >= 0; i--) newsp[i] = sp[i];
- sp = newsp;
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args += nargs - 1;
- goto check_stacks;
- }
- Instruct(APPTERM1): {
- value arg1 = sp[0];
- sp = sp + *pc++ - 1;
- sp[0] = arg1;
- pc = Code_val(accu);
- env = Env_val(accu);
- goto check_stacks;
- }
- Instruct(APPTERM2): {
- value arg1 = sp[0];
- value arg2 = sp[1];
- sp = sp + *pc++ - 2;
- sp[0] = arg1;
- sp[1] = arg2;
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args += 1;
- goto check_stacks;
- }
- Instruct(APPTERM3): {
- value arg1 = sp[0];
- value arg2 = sp[1];
- value arg3 = sp[2];
- sp = sp + *pc++ - 3;
- sp[0] = arg1;
- sp[1] = arg2;
- sp[2] = arg3;
- pc = Code_val(accu);
- env = Env_val(accu);
- extra_args += 2;
- goto check_stacks;
- }
-
- Instruct(RETURN): {
- sp += *pc++;
- if (extra_args > 0) {
- extra_args--;
- pc = Code_val(accu);
- env = Env_val(accu);
- } else {
- pc = (code_t)(sp[0]);
- env = sp[1];
- extra_args = Long_val(sp[2]);
- sp += 3;
- }
- Next;
- }
-
- Instruct(RESTART): {
- int num_args = Wosize_val(env) - 1;
- int i;
- sp -= num_args;
- for (i = 0; i < num_args; i++) sp[i] = Field(env, i);
- env = Field(env, num_args);
- extra_args += num_args;
- Next;
- }
-
- Instruct(GRAB): {
- int required = *pc++;
- if (extra_args >= required) {
- extra_args -= required;
- } else {
- value clos;
- mlsize_t num_args, i;
- num_args = 1 + extra_args; /* arg1 + extra args */
- Alloc_small(accu, num_args + 1, 0);
- for (i = 0; i < num_args; i++) Field(accu, i) = sp[i];
- Field(accu, num_args) = env;
- sp += num_args;
- Alloc_small(clos, Closure_wosize, Closure_tag);
- Code_val(clos) = pc - 3; /* Point to the preceding RESTART instr. */
- Env_val(clos) = accu;
- pc = (code_t)(sp[0]);
- env = sp[1];
- extra_args = Long_val(sp[2]);
- sp += 3;
- accu = clos;
- }
- Next;
- }
-
- Instruct(CLOSURE): {
- int nvars = *pc++;
- value clos;
- int i;
- if (nvars == 0) {
- accu = Val_int(0);
- } else {
- *--sp = accu;
- Alloc_small(accu, nvars, 0);
- for (i = 0; i < nvars; i++) Field(accu, i) = sp[i];
- sp += nvars;
- }
- Alloc_small(clos, Closure_wosize, Closure_tag);
- Code_val(clos) = pc + *pc;
- Env_val(clos) = accu;
- accu = clos;
- pc++;
- Next;
- }
-
- Instruct(CLOSUREREC): {
- int nvars = *pc++;
- value fun_clos, fun_env;
- int i;
- Alloc_small(fun_env, nvars + 1, 0);
- Field(fun_env, 0) = Val_int(0);
- if (nvars > 0) {
- *--sp = accu;
- for (i = 0; i < nvars; i++) Field(fun_env, i+1) = sp[i];
- sp += nvars;
- }
- accu = fun_env;
- Alloc_small(fun_clos, Closure_wosize, Closure_tag);
- Code_val(fun_clos) = pc + *pc;
- Env_val(fun_clos) = accu;
- modify(&Field(accu, 0), fun_clos);
- accu = fun_clos;
- pc++;
- Next;
- }
-
- Instruct(PUSHGETGLOBAL):
- *--sp = accu;
- /* Fallthrough */
- Instruct(GETGLOBAL):
- accu = Field(global_data, *pc);
- pc++;
- Next;
-
- Instruct(PUSHGETGLOBALFIELD):
- *--sp = accu;
- /* Fallthrough */
- Instruct(GETGLOBALFIELD): {
- accu = Field(global_data, *pc);
- pc++;
- accu = Field(accu, *pc);
- pc++;
- Next;
- }
-
- Instruct(SETGLOBAL):
- modify(&Field(global_data, *pc), accu);
- accu = Val_unit;
- pc++;
- Next;
-
-/* Allocation of blocks */
-
- Instruct(ATOM0):
- accu = Atom(0); Next;
- Instruct(ATOM1):
- accu = Atom(1); Next;
- Instruct(ATOM2):
- accu = Atom(2); Next;
- Instruct(ATOM3):
- accu = Atom(3); Next;
-
- Instruct(PUSHATOM0):
- *--sp = accu; accu = Atom(0); Next;
- Instruct(PUSHATOM1):
- *--sp = accu; accu = Atom(1); Next;
- Instruct(PUSHATOM2):
- *--sp = accu; accu = Atom(2); Next;
- Instruct(PUSHATOM3):
- *--sp = accu; accu = Atom(3); Next;
-
- Instruct(PUSHATOM):
- *--sp = accu;
- /* Fallthrough */
- Instruct(ATOM):
- accu = Atom(*pc);
- pc++;
- Next;
-
- Instruct(MAKEBLOCK): {
- mlsize_t wosize = *pc++;
- tag_t tag = *pc++;
- mlsize_t i;
- value block;
- Alloc_small(block, wosize, tag);
- Field(block, 0) = accu;
- for (i = 1; i < wosize; i++) Field(block, i) = *sp++;
- accu = block;
- Next;
- }
- Instruct(MAKEBLOCK1): {
- tag_t tag = *pc++;
- value block;
- Alloc_small(block, 1, tag);
- Field(block, 0) = accu;
- accu = block;
- Next;
- }
- Instruct(MAKEBLOCK2): {
- tag_t tag = *pc++;
- value block;
- Alloc_small(block, 2, tag);
- Field(block, 0) = accu;
- Field(block, 1) = sp[0];
- sp += 1;
- accu = block;
- Next;
- }
- Instruct(MAKEBLOCK3): {
- tag_t tag = *pc++;
- value block;
- Alloc_small(block, 3, tag);
- Field(block, 0) = accu;
- Field(block, 1) = sp[0];
- Field(block, 2) = sp[1];
- sp += 2;
- accu = block;
- Next;
- }
-
-/* Access to components of blocks */
-
- Instruct(GETFIELD0):
- accu = Field(accu, 0); Next;
- Instruct(GETFIELD1):
- accu = Field(accu, 1); Next;
- Instruct(GETFIELD2):
- accu = Field(accu, 2); Next;
- Instruct(GETFIELD3):
- accu = Field(accu, 3); Next;
- Instruct(GETFIELD):
- accu = Field(accu, *pc); pc++; Next;
-
- Instruct(SETFIELD0):
- modify_dest = &Field(accu, 0);
- modify_newval = *sp++;
- modify:
- Modify(modify_dest, modify_newval);
- accu = Val_unit;
- Next;
- Instruct(SETFIELD1):
- modify_dest = &Field(accu, 1);
- modify_newval = *sp++;
- goto modify;
- Instruct(SETFIELD2):
- modify_dest = &Field(accu, 2);
- modify_newval = *sp++;
- goto modify;
- Instruct(SETFIELD3):
- modify_dest = &Field(accu, 3);
- modify_newval = *sp++;
- goto modify;
- Instruct(SETFIELD):
- modify_dest = &Field(accu, *pc);
- pc++;
- modify_newval = *sp++;
- goto modify;
-
- Instruct(TAGOF):
- accu = Val_int(Tag_val(accu));
- Next;
-
-/* For recursive definitions */
-
- Instruct(DUMMY): {
- int size = *pc++;
- Alloc_small(accu, size, 0);
- while (size--) Field(accu, size) = Val_long(0);
- Next;
- }
- Instruct(UPDATE): {
- value newval = *sp++;
- mlsize_t size, n;
- Tag_val(accu) = Tag_val(newval);
- size = Wosize_val(newval);
- for (n = 0; n < size; n++) {
- modify(&Field(accu, n), Field(newval, n));
- }
- accu = Val_unit;
- Next;
- }
-
-/* Array operations */
-
- Instruct(VECTLENGTH):
- accu = Val_long(Wosize_val(accu));
- Next;
- Instruct(GETVECTITEM):
- accu = Field(accu, Long_val(sp[0]));
- sp += 1;
- Next;
- Instruct(SETVECTITEM):
- modify_dest = &Field(accu, Long_val(sp[0]));
- modify_newval = sp[1];
- sp += 2;
- goto modify;
-
-/* String operations */
-
- Instruct(GETSTRINGCHAR):
- accu = Val_int(Byte_u(accu, Long_val(sp[0])));
- sp += 1;
- Next;
- Instruct(SETSTRINGCHAR):
- Byte_u(accu, Long_val(sp[0])) = Int_val(sp[1]);
- sp += 2;
- Next;
-
-/* Branches and conditional branches */
-
- Instruct(BRANCH):
- pc += *pc;
- Next;
- Instruct(BRANCHIF):
- if (Tag_val(accu) != 0) pc += *pc; else pc++;
- Next;
- Instruct(BRANCHIFNOT):
- if (Tag_val(accu) == 0) pc += *pc; else pc++;
- Next;
- Instruct(SWITCH): {
- long index = Long_val(accu);
- Assert(index >= 0 && index < *pc);
- pc++;
- pc += pc[index];
- Next;
- }
- Instruct(TRANSLATE): {
- long arg = Long_val(accu);
- int num_cases = *pc++;
- int low, high, i;
- uint32 interv;
- for (low = 0, high = num_cases - 1, accu = Val_int(0);
- low <= high;
- /*nothing*/) {
- i = (low + high) / 2;
- interv = pc[i];
- if (arg < (interv & 0xFF))
- high = i - 1;
- else if (arg > ((interv >> 8) & 0xFF))
- low = i + 1;
- else {
- accu = Val_long(arg + (interv >> 16) - (interv & 0xFF));
- break;
- }
- }
- pc += num_cases;
- Next;
- }
- Instruct(BOOLNOT):
- accu = Atom(Tag_val(accu) == 0);
- Next;
-
-/* Exceptions */
-
- Instruct(PUSHTRAP):
- sp -= 4;
- Trap_pc(sp) = pc + *pc;
- Trap_link(sp) = trapsp;
- sp[2] = env;
- sp[3] = Val_long(extra_args);
- trapsp = sp;
- pc++;
- Next;
-
- Instruct(POPTRAP):
- /* We should check here if a signal is pending, to preserve the
- semantics of the program w.r.t. exceptions. Unfortunately,
- process_signal destroys the accumulator, and there is no
- convenient way to preserve it... */
- trapsp = Trap_link(sp);
- sp += 4;
- Next;
-
- Instruct(RAISE): /* arg */
- raise_exception:
- sp = trapsp;
- if (sp >= stack_high - initial_sp_offset) {
- exn_bucket = accu;
- external_raise = initial_external_raise;
- longjmp(external_raise->buf, 1);
- }
- pc = Trap_pc(sp);
- trapsp = Trap_link(sp);
- env = sp[2];
- extra_args = Long_val(sp[3]);
- sp += 4;
- Next;
-
-/* Stack checks */
-
- check_stacks:
- if (sp < stack_threshold) {
- extern_sp = sp;
- realloc_stack();
- sp = extern_sp;
- }
- /* Fall through CHECK_SIGNALS */
-
-/* Signal handling */
-
- Instruct(CHECK_SIGNALS): /* accu not preserved */
- if (something_to_do) goto process_signal;
- Next;
-
- process_signal:
- something_to_do = 0;
- if (force_minor_flag){
- force_minor_flag = 0;
- Setup_for_gc;
- minor_collection ();
- Restore_after_gc;
- }
- /* If a signal arrives between the following two instructions,
- it will be lost. */
- { int signal_number = pending_signal;
- pending_signal = 0;
- if (signal_number) {
- /* Push a return frame to the current code location */
- sp -= 4;
- sp[0] = Val_int(signal_number);
- sp[1] = (value) pc;
- sp[2] = env;
- sp[3] = Val_long(extra_args);
- pc = Code_val(Field(signal_handlers, signal_number));
- env = Env_val(Field(signal_handlers, signal_number));
- extra_args = 0;
- }
- }
- Next;
-
-/* Calling C functions */
-
- Instruct(C_CALL1):
- Setup_for_c_call;
- accu = cprim[*pc](accu);
- Restore_after_c_call;
- pc++;
- Next;
- Instruct(C_CALL2):
- Setup_for_c_call;
- accu = cprim[*pc](accu, sp[1]);
- Restore_after_c_call;
- sp += 1;
- pc++;
- Next;
- Instruct(C_CALL3):
- Setup_for_c_call;
- accu = cprim[*pc](accu, sp[1], sp[2]);
- Restore_after_c_call;
- sp += 2;
- pc++;
- Next;
- Instruct(C_CALL4):
- Setup_for_c_call;
- accu = cprim[*pc](accu, sp[1], sp[2], sp[3]);
- Restore_after_c_call;
- sp += 3;
- pc++;
- Next;
- Instruct(C_CALLN): {
- int nargs = *pc++;
- *--sp = accu;
- Setup_for_c_call;
- accu = cprim[*pc](sp + 1, nargs);
- Restore_after_c_call;
- sp += nargs;
- pc++;
- Next;
- }
-
-/* Integer arithmetic */
-
- Instruct(CONSTINT):
- accu = Val_int(*pc);
- pc++;
- Next;
- Instruct(PUSHCONSTINT):
- *--sp = accu;
- accu = Val_int(*pc);
- pc++;
- Next;
- Instruct(NEGINT):
- accu = (value)(2 - (long)accu); Next;
- Instruct(ADDINT):
- accu = (value)((long) accu + (long) *sp++ - 1); Next;
- Instruct(SUBINT):
- accu = (value)((long) accu - (long) *sp++ + 1); Next;
- Instruct(MULINT):
- accu = Val_long(Long_val(accu) * Long_val(*sp++)); Next;
- Instruct(DIVINT): {
- value div = *sp++;
- if (div == Val_long(0)) {
- accu = Field(global_data, ZERO_DIVIDE_EXN);
- goto raise_exception;
- }
- accu = Val_long(Long_val(accu) / Long_val(div));
- Next;
- }
- Instruct(MODINT): {
- value div = *sp++;
- if (div == Val_long(0)) {
- accu = Field(global_data, ZERO_DIVIDE_EXN);
- goto raise_exception;
- }
- accu = Val_long(Long_val(accu) % Long_val(div));
- Next;
- }
- Instruct(ANDINT):
- accu = (value)((long) accu & (long) *sp++); Next;
- Instruct(ORINT):
- accu = (value)((long) accu | (long) *sp++); Next;
- Instruct(XORINT):
- accu = (value)(((long) accu ^ (long) *sp++) | 1); Next;
- Instruct(LSLINT):
- accu = (value)((((long) accu - 1) << Long_val(*sp++)) + 1); Next;
- Instruct(LSRINT):
- accu = (value)((((long) accu - 1) >> Long_val(*sp++)) | 1); Next;
- Instruct(ASRINT):
- accu = (value)((((unsigned long) accu - 1) >> Long_val(*sp++)) | 1);
- Next;
-
-#define Integer_comparison(opname,tst) \
- Instruct(opname): \
- accu = Atom((long) accu tst (long) *sp++); Next;
-
- Integer_comparison(EQ, ==)
- Integer_comparison(NEQ, !=)
- Integer_comparison(LTINT, <)
- Integer_comparison(LEINT, <=)
- Integer_comparison(GTINT, >)
- Integer_comparison(GEINT, >=)
-
- Instruct(OFFSETINT):
- accu += *pc << 1;
- pc++;
- Next;
- Instruct(OFFSETREF):
- Field(accu, 0) += *pc << 1;
- pc++;
- Next;
-
-/* Machine control */
-
- Instruct(STOP):
- external_raise = initial_external_raise;
- extern_sp = sp;
- return accu;
-
-#ifndef THREADED_CODE
- default:
- fatal_error("bad opcode");
- }
- }
-#endif
-}
-
-static opcode_t callback_code[] = {
- ACC1, APPLY1, POP, 1, STOP
-};
-
-value callback(closure, argument)
- value closure, argument;
-{
- extern_sp -= 2;
- extern_sp[0] = argument;
- extern_sp[1] = closure;
- return interprete(callback_code, sizeof(callback_code));
-}
View Lorry Controller Status