/* The bytecode interpreter */ #include <math.h>#include <setjmp.h>#include <stdlib.h> #include "alloc.h"#include "debugger.h"#include "fail.h"#include "instruct.h"#include "memory.h"#include "minor_gc.h"#include "misc.h"#include "mlvalues.h"#include "prims.h"#include "signals.h"#include "stacks.h"#include "str.h"#include "unalignd.h"#include "interp.h"#include "expand.h"#include "globals.h"#ifdef HAS_UI#include "ui.h"#endif #ifdef DEBUGstatic long icount = 0;static void stop_here (void) {}#endif /* 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. */ /* The empty environment */ #define null_env Atom(0) /* The type of bytecode instructions */ typedef unsigned char opcode_t; /* Code for raising the Interrupt exception (GETGLOBAL takes a short arg) */ static opcode_t byte_raise_break_exn[] = { GETGLOBAL, EXN_INTERRUPT, 0, RAISE };#define RAISE_CODE_LEN 4 /* Code for callbacks from C to ML code: POP, 1, 0 means pop(1) */ #if defined(MOSML_BIG_ENDIAN) && !defined(ALIGNMENT)static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 0, 1, STOP };static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 0, 1, STOP };static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 0, 1, STOP };#elsestatic opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 1, 0, STOP };static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 1, 0, STOP };static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 1, 0, STOP };#endif #define CALLBACK_CODE_LEN 6 CODE callback1_code; /* Set by interprete on initialization */CODE callback2_code;CODE callback3_code; /* 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++; } /* The interpreter itself */ EXTERN value interprete(int mode, bytecode_t bprog, int code_size, CODE* rprog){ /* mode = mode (0=init, 1=bytecode exec, 2=code exec) bprog = a bytecode array pointer (used in mode 1) code_size = the bytecode length rprog = a code pointer pointer (input in mode 2; output in mode 1)*/ /* Declarations for the registers of the abstract machine. The most heavily used registers come first. For reasonable performance, "pc" MUST reside in a register. Many ``optimizing'' compilers underestimate the importance of "pc", and don't put it in a register. For GCC users, I've hand-assigned registers for some architectures. */ #if defined(__GNUC__) && defined(sparc) register CODE pc asm("%l0"); register value accu asm("%l1"); register value * sp asm("%l2");#else#if defined(__GNUC__) && defined(mc68000) register CODE pc asm("a5"); register value accu; register value * sp;#else#if defined(__GNUC__) && defined(mips) register CODE pc asm("$20"); register value accu asm("$21"); register value * sp asm("$22");#else#if defined(__GNUC__) && defined(__alpha__) register CODE pc asm("$11"); register value accu asm("$12"); register value * sp asm("$13");#else#if defined(__GNUC__) && defined(hppa) register CODE pc asm("%r11"); register value accu asm("%r12"); register value * sp asm("%r13");#else #if defined(__GNUC__) && defined(i386)#if defined(MSDOS) register CODE pc asm("si"); register value * sp asm("di");#else register CODE pc asm("%esi"); register value * sp asm("%edi");#endif register value accu;#else register CODE pc; register value accu; register value * sp;#endif#endif#endif#endif#endif#endif value env; int extra_args; struct longjmp_buffer * initial_external_raise; int initial_sp_offset; value * initial_c_roots_head; struct longjmp_buffer raise_buf; value * modify_dest, modify_newval; value tmp; int cur_instr; double dtmp; #ifdef DIRECT_JUMP static void * jumptable[] = {# include "jumptbl.h" };#endif #if defined(DIRECT_JUMP) && defined(THREADED) realcode_t realcode; switch (mode) { case 0: // initialization raise_break_exn = expandcode(byte_raise_break_exn, RAISE_CODE_LEN, jumptable); callback1_code = expandcode(byte_callback1_code, CALLBACK_CODE_LEN, jumptable); callback2_code = expandcode(byte_callback2_code, CALLBACK_CODE_LEN, jumptable); callback3_code = expandcode(byte_callback3_code, CALLBACK_CODE_LEN, jumptable); return Atom(0); case 1: // bytecode threading and execution realcode = expandcode(bprog, code_size, jumptable); if (rprog != NULL) *rprog = realcode; break; case 2: // realcode execution, used by callback() realcode = *rprog; break; } /* To read immediate operands, read an entire word: */#undef s16#define s16(pc) (int)(*pc)#define u8pc (unsigned long)(*pc)#define u8pci (unsigned long)(*pc++)#define s16pc (long)(*pc)#define u16pc (unsigned long)(*pc) #define s32pc (long)(*pc) #define u32pc (long)(*pc) #define SHORT 1#define LONG 1#define JUMPTGT(tgt) (realcode_t)tgt#define JUMPSWITCHINDEX(pc, accu) (realcode_t)(*(pc + Long_val(accu))) pc = realcode;#else switch (mode) { case 0: // initialization raise_break_exn = byte_raise_break_exn; callback1_code = byte_callback1_code; callback2_code = byte_callback2_code; callback3_code = byte_callback3_code; return Atom(0); case 1: // bytecode execution pc = bprog; break; case 2: // bytecode execution, used by callback pc = *rprog; break; } /* To read immediate operands, read some bytes after pc: */ #define SHORT (sizeof(short))#define LONG (sizeof(int32))#define DOUBLE (sizeof(double)) #define u8pc (unsigned char)(*pc)#define u8pci (unsigned char)(*pc++)#define s16pc s16(pc)#define u16pc u16(pc)#define s32pc s32(pc)#define u32pc u32(pc)#define JUMPTGT(offset) (bytecode_t)(pc + offset)#define JUMPSWITCHINDEX(pc, accu) (bytecode_t)(pc + s32(pc + 4 * Long_val(accu))) #endif sp = extern_sp; extra_args = 0; env = null_env; accu = Val_long(0); initial_c_roots_head = c_roots_head; initial_sp_offset = stack_high - sp; initial_external_raise = external_raise; if (setjmp(raise_buf.buf)) { c_roots_head = initial_c_roots_head; accu = exn_bucket; goto raise_exception; } external_raise = &raise_buf; #ifdef DEBUG log_ptr = log_buffer;#endif #ifdef DIRECT_JUMP# define Instruct(name) lbl_##name# ifdef THREADED //# define Next printf("addr[%d] = ", pc-realcode); printf("%d\n", *pc-realcode[0]); goto **pc++ #define Next goto **pc++ # else //#define Next printf("addr[%d] = ", pc-bprog); cur_instr = *pc++; printf("%d\n", cur_instr); goto *jumptable[cur_instr]# define Next cur_instr = *pc++; goto *jumptable[cur_instr]# endif#else# define Instruct(name) case name# define Next break#endif #ifdef DIRECT_JUMP Next; /* Jump to the first instruction */#else while (1) {#ifdef DEBUG if (icount-- == 0) stop_here (); *log_ptr++ = pc; if (log_ptr >= log_buffer + LOG_BUFFER_SIZE) log_ptr = log_buffer; disasm_instr(pc); Assert(sp >= stack_low); Assert(sp <= stack_high);#endif cur_instr = *pc++; decode_instruction: switch (cur_instr) {#endif /* Basic stack operations */ Instruct(SWAP): { value tmp = accu; accu = sp[0]; sp[0] = tmp; Next; } Instruct(PUSH): // printf("PUSH\n"); Instruct(PUSHACC0): *--sp = accu; Next; Instruct(ACC0): accu = sp[0]; Next; Instruct(PUSHACC1): *--sp = accu; /* Fallthrough */ Instruct(ACC1): accu = sp[1]; Next; Instruct(PUSHACC2): *--sp = accu; /* Fallthrough */ Instruct(ACC2): accu = sp[2]; Next; Instruct(PUSHACC3): *--sp = accu; /* Fallthrough */ Instruct(ACC3): accu = sp[3]; Next; Instruct(PUSHACC4): *--sp = accu; /* Fallthrough */ Instruct(ACC4): accu = sp[4]; Next; Instruct(PUSHACC5): *--sp = accu; /* Fallthrough */ Instruct(ACC5): accu = sp[5]; Next; Instruct(PUSHACC6): *--sp = accu; /* Fallthrough */ Instruct(ACC6): accu = sp[6]; Next; Instruct(PUSHACC7): *--sp = accu; /* Fallthrough */ Instruct(ACC7): accu = sp[7]; Next; Instruct(PUSHACC): *--sp = accu; /* Fallthrough */ Instruct(ACCESS): accu = sp[u16pc]; pc += SHORT; Next; Instruct(POP): sp += u16pc; pc += SHORT; Next; Instruct(ASSIGN): sp[u16pc] = accu; pc += SHORT; accu = Val_unit; Next; /* Access in heap-allocated environment */ Instruct(PUSHENV1): *--sp = accu; /* Fallthrough */ Instruct(ENV1): accu = Field(env, 1); Next; Instruct(PUSHENV2): *--sp = accu; /* Fallthrough */ Instruct(ENV2): accu = Field(env, 2); Next; Instruct(PUSHENV3): *--sp = accu; /* Fallthrough */ Instruct(ENV3): accu = Field(env, 3); Next; Instruct(PUSHENV4): *--sp = accu; /* Fallthrough */ Instruct(ENV4): accu = Field(env, 4); Next; Instruct(PUSHENV5): *--sp = accu; /* Fallthrough */ Instruct(ENV5): accu = Field(env, 5); Next; Instruct(PUSHENV6): *--sp = accu; /* Fallthrough */ Instruct(ENV6): accu = Field(env, 6); Next; Instruct(PUSHENV7): *--sp = accu; /* Fallthrough */ Instruct(ENV7): accu = Field(env, 7); Next; Instruct(PUSHENVACC): *--sp = accu; /* Fallthrough */ Instruct(ENVACC): accu = Field(env, u16pc); pc += SHORT; Next; Instruct(PUSH_ENV1_APPLY1): { sp -= 4; sp[0] = accu; sp[1] = (value)pc; sp[2] = env; sp[3] = Val_long(extra_args); extra_args = 0; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY2): { value arg2 = sp[0]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = (value)pc; sp[3] = env; sp[4] = Val_long(extra_args); extra_args = 1; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY3): { value arg2 = sp[0]; value arg3 = sp[1]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = (value)pc; sp[4] = env; sp[5] = Val_long(extra_args); extra_args = 2; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY4): { value arg2 = sp[0]; value arg3 = sp[1]; value arg4 = sp[2]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = arg4; sp[4] = (value)pc; sp[5] = env; sp[6] = Val_long(extra_args); extra_args = 3; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPTERM1): { sp = sp + u16pc - 2; pc += SHORT; sp[0] = accu; } /* Fall through */ env1_appterm: accu = Field(env, 1); appterm: pc = Code_val(accu); env = accu; goto check_signals; Instruct(PUSH_ENV1_APPTERM2): { value arg2 = sp[0]; sp = sp + u16pc - 3; pc += SHORT; sp[0] = accu; sp[1] = arg2; extra_args += 1; goto env1_appterm; } Instruct(PUSH_ENV1_APPTERM3): { value arg2 = sp[0]; value arg3 = sp[1]; sp = sp + u16pc - 4; pc += SHORT; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; extra_args += 2; goto env1_appterm; } Instruct(PUSH_ENV1_APPTERM4): { value arg2 = sp[0]; value arg3 = sp[1]; value arg4 = sp[2]; sp = sp + u16pc - 5; pc += SHORT; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = arg4; extra_args += 3; goto env1_appterm; } /* Function application */ Instruct(PUSH_RETADDR): { sp -= 3; sp[0] = (value) (JUMPTGT(s32pc)); sp[1] = env; sp[2] = Val_long(extra_args); pc += LONG; Next; } Instruct(APPLY): { extra_args = u8pc - 1; goto apply; } Instruct(APPLY1): { value arg1 = sp[0]; sp -= 3; sp[0] = arg1; sp[1] = (value)pc; sp[2] = env; sp[3] = Val_long(extra_args); extra_args = 0; goto apply; } 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); extra_args = 1; goto apply; } Instruct(APPLY3): { value arg1 = sp[0]; value arg2 = sp[1]; value arg3 = sp[2]; sp -= 3;Lines 1–500 of 1623. Load more
/* The bytecode interpreter */ #include <math.h> #include <setjmp.h> #include <stdlib.h> #include "alloc.h" #include "debugger.h" #include "fail.h" #include "instruct.h" #include "memory.h" #include "minor_gc.h" #include "misc.h" #include "mlvalues.h" #include "prims.h" #include "signals.h" #include "stacks.h" #include "str.h" #include "unalignd.h" #include "interp.h" #include "expand.h" #include "globals.h" #ifdef HAS_UI #include "ui.h" #endif #ifdef DEBUG static long icount = 0; static void stop_here (void) {} #endif /* 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. */ /* The empty environment */ #define null_env Atom(0) /* The type of bytecode instructions */ typedef unsigned char opcode_t; /* Code for raising the Interrupt exception (GETGLOBAL takes a short arg) */ static opcode_t byte_raise_break_exn[] = { GETGLOBAL, EXN_INTERRUPT, 0, RAISE }; #define RAISE_CODE_LEN 4 /* Code for callbacks from C to ML code: POP, 1, 0 means pop(1) */ #if defined(MOSML_BIG_ENDIAN) && !defined(ALIGNMENT) static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 0, 1, STOP }; static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 0, 1, STOP }; static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 0, 1, STOP }; #else static opcode_t byte_callback1_code[] = { ACC1, APPLY1, POP, 1, 0, STOP }; static opcode_t byte_callback2_code[] = { ACC2, APPLY2, POP, 1, 0, STOP }; static opcode_t byte_callback3_code[] = { ACC3, APPLY3, POP, 1, 0, STOP }; #endif #define CALLBACK_CODE_LEN 6 CODE callback1_code; /* Set by interprete on initialization */ CODE callback2_code; CODE callback3_code; /* 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++; } /* The interpreter itself */ EXTERN value interprete(int mode, bytecode_t bprog, int code_size, CODE* rprog) { /* mode = mode (0=init, 1=bytecode exec, 2=code exec) bprog = a bytecode array pointer (used in mode 1) code_size = the bytecode length rprog = a code pointer pointer (input in mode 2; output in mode 1) */ /* Declarations for the registers of the abstract machine. The most heavily used registers come first. For reasonable performance, "pc" MUST reside in a register. Many ``optimizing'' compilers underestimate the importance of "pc", and don't put it in a register. For GCC users, I've hand-assigned registers for some architectures. */ #if defined(__GNUC__) && defined(sparc) register CODE pc asm("%l0"); register value accu asm("%l1"); register value * sp asm("%l2"); #else #if defined(__GNUC__) && defined(mc68000) register CODE pc asm("a5"); register value accu; register value * sp; #else #if defined(__GNUC__) && defined(mips) register CODE pc asm("$20"); register value accu asm("$21"); register value * sp asm("$22"); #else #if defined(__GNUC__) && defined(__alpha__) register CODE pc asm("$11"); register value accu asm("$12"); register value * sp asm("$13"); #else #if defined(__GNUC__) && defined(hppa) register CODE pc asm("%r11"); register value accu asm("%r12"); register value * sp asm("%r13"); #else #if defined(__GNUC__) && defined(i386) #if defined(MSDOS) register CODE pc asm("si"); register value * sp asm("di"); #else register CODE pc asm("%esi"); register value * sp asm("%edi"); #endif register value accu; #else register CODE pc; register value accu; register value * sp; #endif #endif #endif #endif #endif #endif value env; int extra_args; struct longjmp_buffer * initial_external_raise; int initial_sp_offset; value * initial_c_roots_head; struct longjmp_buffer raise_buf; value * modify_dest, modify_newval; value tmp; int cur_instr; double dtmp; #ifdef DIRECT_JUMP static void * jumptable[] = { # include "jumptbl.h" }; #endif #if defined(DIRECT_JUMP) && defined(THREADED) realcode_t realcode; switch (mode) { case 0: // initialization raise_break_exn = expandcode(byte_raise_break_exn, RAISE_CODE_LEN, jumptable); callback1_code = expandcode(byte_callback1_code, CALLBACK_CODE_LEN, jumptable); callback2_code = expandcode(byte_callback2_code, CALLBACK_CODE_LEN, jumptable); callback3_code = expandcode(byte_callback3_code, CALLBACK_CODE_LEN, jumptable); return Atom(0); case 1: // bytecode threading and execution realcode = expandcode(bprog, code_size, jumptable); if (rprog != NULL) *rprog = realcode; break; case 2: // realcode execution, used by callback() realcode = *rprog; break; } /* To read immediate operands, read an entire word: */ #undef s16 #define s16(pc) (int)(*pc) #define u8pc (unsigned long)(*pc) #define u8pci (unsigned long)(*pc++) #define s16pc (long)(*pc) #define u16pc (unsigned long)(*pc) #define s32pc (long)(*pc) #define u32pc (long)(*pc) #define SHORT 1 #define LONG 1 #define JUMPTGT(tgt) (realcode_t)tgt #define JUMPSWITCHINDEX(pc, accu) (realcode_t)(*(pc + Long_val(accu))) pc = realcode; #else switch (mode) { case 0: // initialization raise_break_exn = byte_raise_break_exn; callback1_code = byte_callback1_code; callback2_code = byte_callback2_code; callback3_code = byte_callback3_code; return Atom(0); case 1: // bytecode execution pc = bprog; break; case 2: // bytecode execution, used by callback pc = *rprog; break; } /* To read immediate operands, read some bytes after pc: */ #define SHORT (sizeof(short)) #define LONG (sizeof(int32)) #define DOUBLE (sizeof(double)) #define u8pc (unsigned char)(*pc) #define u8pci (unsigned char)(*pc++) #define s16pc s16(pc) #define u16pc u16(pc) #define s32pc s32(pc) #define u32pc u32(pc) #define JUMPTGT(offset) (bytecode_t)(pc + offset) #define JUMPSWITCHINDEX(pc, accu) (bytecode_t)(pc + s32(pc + 4 * Long_val(accu))) #endif sp = extern_sp; extra_args = 0; env = null_env; accu = Val_long(0); initial_c_roots_head = c_roots_head; initial_sp_offset = stack_high - sp; initial_external_raise = external_raise; if (setjmp(raise_buf.buf)) { c_roots_head = initial_c_roots_head; accu = exn_bucket; goto raise_exception; } external_raise = &raise_buf; #ifdef DEBUG log_ptr = log_buffer; #endif #ifdef DIRECT_JUMP # define Instruct(name) lbl_##name # ifdef THREADED //# define Next printf("addr[%d] = ", pc-realcode); printf("%d\n", *pc-realcode[0]); goto **pc++ #define Next goto **pc++ # else //#define Next printf("addr[%d] = ", pc-bprog); cur_instr = *pc++; printf("%d\n", cur_instr); goto *jumptable[cur_instr] # define Next cur_instr = *pc++; goto *jumptable[cur_instr] # endif #else # define Instruct(name) case name # define Next break #endif #ifdef DIRECT_JUMP Next; /* Jump to the first instruction */ #else while (1) { #ifdef DEBUG if (icount-- == 0) stop_here (); *log_ptr++ = pc; if (log_ptr >= log_buffer + LOG_BUFFER_SIZE) log_ptr = log_buffer; disasm_instr(pc); Assert(sp >= stack_low); Assert(sp <= stack_high); #endif cur_instr = *pc++; decode_instruction: switch (cur_instr) { #endif /* Basic stack operations */ Instruct(SWAP): { value tmp = accu; accu = sp[0]; sp[0] = tmp; Next; } Instruct(PUSH): // printf("PUSH\n"); Instruct(PUSHACC0): *--sp = accu; Next; Instruct(ACC0): accu = sp[0]; Next; Instruct(PUSHACC1): *--sp = accu; /* Fallthrough */ Instruct(ACC1): accu = sp[1]; Next; Instruct(PUSHACC2): *--sp = accu; /* Fallthrough */ Instruct(ACC2): accu = sp[2]; Next; Instruct(PUSHACC3): *--sp = accu; /* Fallthrough */ Instruct(ACC3): accu = sp[3]; Next; Instruct(PUSHACC4): *--sp = accu; /* Fallthrough */ Instruct(ACC4): accu = sp[4]; Next; Instruct(PUSHACC5): *--sp = accu; /* Fallthrough */ Instruct(ACC5): accu = sp[5]; Next; Instruct(PUSHACC6): *--sp = accu; /* Fallthrough */ Instruct(ACC6): accu = sp[6]; Next; Instruct(PUSHACC7): *--sp = accu; /* Fallthrough */ Instruct(ACC7): accu = sp[7]; Next; Instruct(PUSHACC): *--sp = accu; /* Fallthrough */ Instruct(ACCESS): accu = sp[u16pc]; pc += SHORT; Next; Instruct(POP): sp += u16pc; pc += SHORT; Next; Instruct(ASSIGN): sp[u16pc] = accu; pc += SHORT; accu = Val_unit; Next; /* Access in heap-allocated environment */ Instruct(PUSHENV1): *--sp = accu; /* Fallthrough */ Instruct(ENV1): accu = Field(env, 1); Next; Instruct(PUSHENV2): *--sp = accu; /* Fallthrough */ Instruct(ENV2): accu = Field(env, 2); Next; Instruct(PUSHENV3): *--sp = accu; /* Fallthrough */ Instruct(ENV3): accu = Field(env, 3); Next; Instruct(PUSHENV4): *--sp = accu; /* Fallthrough */ Instruct(ENV4): accu = Field(env, 4); Next; Instruct(PUSHENV5): *--sp = accu; /* Fallthrough */ Instruct(ENV5): accu = Field(env, 5); Next; Instruct(PUSHENV6): *--sp = accu; /* Fallthrough */ Instruct(ENV6): accu = Field(env, 6); Next; Instruct(PUSHENV7): *--sp = accu; /* Fallthrough */ Instruct(ENV7): accu = Field(env, 7); Next; Instruct(PUSHENVACC): *--sp = accu; /* Fallthrough */ Instruct(ENVACC): accu = Field(env, u16pc); pc += SHORT; Next; Instruct(PUSH_ENV1_APPLY1): { sp -= 4; sp[0] = accu; sp[1] = (value)pc; sp[2] = env; sp[3] = Val_long(extra_args); extra_args = 0; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY2): { value arg2 = sp[0]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = (value)pc; sp[3] = env; sp[4] = Val_long(extra_args); extra_args = 1; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY3): { value arg2 = sp[0]; value arg3 = sp[1]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = (value)pc; sp[4] = env; sp[5] = Val_long(extra_args); extra_args = 2; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPLY4): { value arg2 = sp[0]; value arg3 = sp[1]; value arg4 = sp[2]; sp -= 4; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = arg4; sp[4] = (value)pc; sp[5] = env; sp[6] = Val_long(extra_args); extra_args = 3; accu = Field(env, 1); goto apply; } Instruct(PUSH_ENV1_APPTERM1): { sp = sp + u16pc - 2; pc += SHORT; sp[0] = accu; } /* Fall through */ env1_appterm: accu = Field(env, 1); appterm: pc = Code_val(accu); env = accu; goto check_signals; Instruct(PUSH_ENV1_APPTERM2): { value arg2 = sp[0]; sp = sp + u16pc - 3; pc += SHORT; sp[0] = accu; sp[1] = arg2; extra_args += 1; goto env1_appterm; } Instruct(PUSH_ENV1_APPTERM3): { value arg2 = sp[0]; value arg3 = sp[1]; sp = sp + u16pc - 4; pc += SHORT; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; extra_args += 2; goto env1_appterm; } Instruct(PUSH_ENV1_APPTERM4): { value arg2 = sp[0]; value arg3 = sp[1]; value arg4 = sp[2]; sp = sp + u16pc - 5; pc += SHORT; sp[0] = accu; sp[1] = arg2; sp[2] = arg3; sp[3] = arg4; extra_args += 3; goto env1_appterm; } /* Function application */ Instruct(PUSH_RETADDR): { sp -= 3; sp[0] = (value) (JUMPTGT(s32pc)); sp[1] = env; sp[2] = Val_long(extra_args); pc += LONG; Next; } Instruct(APPLY): { extra_args = u8pc - 1; goto apply; } Instruct(APPLY1): { value arg1 = sp[0]; sp -= 3; sp[0] = arg1; sp[1] = (value)pc; sp[2] = env; sp[3] = Val_long(extra_args); extra_args = 0; goto apply; } 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); extra_args = 1; goto apply; } Instruct(APPLY3): { value arg1 = sp[0]; value arg2 = sp[1]; value arg3 = sp[2]; sp -= 3;