This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=74870c0d2f2cfb2a15ab732c0cc0378bbf268682 The branch, master has been updated via 74870c0d2f2cfb2a15ab732c0cc0378bbf268682 (commit) via f42cfbf0b72da57a1dfae29d2525ef71abe1bc9d (commit) via 20b1b91394bf588757492bbbdbb0fab46f2e1cf4 (commit) via 095100bbdbfc79ccba39fa68b75d8530361299d3 (commit) via 3fe96dd8088957a09cfd15747ae646595934f83a (commit) via 1b780c134b1714966ae39c6b3de10875eb5c1bd2 (commit) from ef6b7f718acaceba9408ad16d007cc4cb76e0a84 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 74870c0d2f2cfb2a15ab732c0cc0378bbf268682 Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 21:27:38 2013 +0100 Fix gsubr comment * libguile/gsubr.c: Update comment to excise RTL. commit f42cfbf0b72da57a1dfae29d2525ef71abe1bc9d Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 21:26:26 2013 +0100 Lingering RTL excision in vm.c * libguile/vm-engine.c: * libguile/vm.c: Rework VM inclusion so that we don't define VM_ENGINE and expect vm-engine.c to understand that -- since there is only VM_USE_HOOKS, define that in vm.c directly. Rename rtl_vm_foo to vm_foo. * libguile/vm.h: Remove scm_t_vm_engine typedef. commit 20b1b91394bf588757492bbbdbb0fab46f2e1cf4 Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 21:11:28 2013 +0100 Move RTL unpack macros to vm-engine.c * libguile/instructions.h: Remove SCM_UNPACK macros from here. * libguile/vm-engine.c: Add them here, without the RTL_, and without the SCM_ prefix. commit 095100bbdbfc79ccba39fa68b75d8530361299d3 Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 21:04:24 2013 +0100 Change SCM_PACK_RTL macros to SCM_PACK_OP / SCM_PACK_OP_ARG * libguile/instructions.h: Guard in BUILDING_LIBGUILE. (SCM_PACK_OP_24): (SCM_PACK_OP_8_8_8): (SCM_PACK_OP_8_16): (SCM_PACK_OP_16_8): (SCM_PACK_OP_12_12): Rename from SCM_PACK_RTL_*, and splice in the opcode. (SCM_PACK_OP_ARG_8_24): New helper. * libguile/vm.c: * libguile/gsubr.c: * libguile/foreign.c: * libguile/control.c: * libguile/continuations.c: Adapt. commit 3fe96dd8088957a09cfd15747ae646595934f83a Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 20:31:21 2013 +0100 scm_rtl_op_* -> scm_op_* * libguile/instructions.h (scm_opcode): Rename from scm_rtl_opcode. Rename opcodes from scm_rtl_op_* to scm_op_*. * libguile/continuations.c: * libguile/control.c: * libguile/foreign.c: * libguile/gsubr.c: * libguile/instructions.c: * libguile/vm.c: Adapt. commit 1b780c134b1714966ae39c6b3de10875eb5c1bd2 Author: Andy Wingo <wi...@pobox.com> Date: Tue Nov 19 20:45:57 2013 +0100 (system vm instruction) rtl-instruction-list -> (language rtl) instruction-list * libguile/instructions.c (struct scm_instruction, fetch_instruction_table) (scm_instruction_list): Remove rtl_ infix. * libguile/instructions.h: Adapt. * module/system/vm/instruction.scm: Remove. * module/language/rtl.scm: Export instruction-list from here. * module/Makefile.am: * module/language/cps/primitives.scm: * module/system/vm/assembler.scm: * module/system/vm/disassembler.scm: * module/system/vm/frame.scm: * module/system/vm/program.scm: * module/system/vm/trace.scm: * module/system/vm/traps.scm: Adapt. ----------------------------------------------------------------------- Summary of changes: libguile/continuations.c | 2 +- libguile/control.c | 2 +- libguile/foreign.c | 6 +- libguile/gsubr.c | 44 ++++---- libguile/instructions.c | 43 +++---- libguile/instructions.h | 61 ++-------- libguile/vm-engine.c | 218 +++++++++++++++++++++--------------- libguile/vm.c | 54 +++++----- libguile/vm.h | 2 - module/Makefile.am | 1 - module/language/cps/primitives.scm | 2 +- module/language/rtl.scm | 9 +- module/system/vm/assembler.scm | 8 +- module/system/vm/disassembler.scm | 2 +- module/system/vm/frame.scm | 1 - module/system/vm/instruction.scm | 25 ---- module/system/vm/program.scm | 1 - module/system/vm/trace.scm | 1 - module/system/vm/traps.scm | 1 - 19 files changed, 224 insertions(+), 259 deletions(-) delete mode 100644 module/system/vm/instruction.scm diff --git a/libguile/continuations.c b/libguile/continuations.c index 90c9ccf..cb586e3 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -65,7 +65,7 @@ static scm_t_bits tc16_continuation; static const scm_t_uint32 continuation_stub_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_continuation_call, 0) + SCM_PACK_OP_24 (continuation_call, 0) }; static SCM diff --git a/libguile/control.c b/libguile/control.c index dbd6522..0ef8e23 100644 --- a/libguile/control.c +++ b/libguile/control.c @@ -59,7 +59,7 @@ scm_i_prompt_pop_abort_args_x (SCM vm) static const scm_t_uint32 compose_continuation_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_compose_continuation, 0) + SCM_PACK_OP_24 (compose_continuation, 0) }; diff --git a/libguile/foreign.c b/libguile/foreign.c index 2ec0a1e..5ee225d 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -766,10 +766,10 @@ SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0, /* We support calling foreign functions with up to 100 arguments. */ #define CODE(nreq) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, nreq + 1), \ - SCM_PACK_RTL_12_12 (scm_rtl_op_foreign_call, 0, 1) + SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \ + SCM_PACK_OP_12_12 (foreign_call, 0, 1) -#define CODE_10(n) \ +#define CODE_10(n) \ CODE (n + 0), CODE (n + 1), CODE (n + 2), CODE (n + 3), CODE (n + 4), \ CODE (n + 5), CODE (n + 6), CODE (n + 7), CODE (n + 8), CODE (n + 9) diff --git a/libguile/gsubr.c b/libguile/gsubr.c index f089a41..49edd3c 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -75,45 +75,45 @@ /* A: req; B: opt; C: rest */ #define A(nreq) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, nreq + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0, \ 0 #define B(nopt) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_le, nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (assert_nargs_le, nopt + 1), \ + SCM_PACK_OP_24 (alloc_frame, nopt + 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0 #define C() \ - SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (bind_rest, 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0, \ 0 #define AB(nreq, nopt) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_le, nreq + nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, nreq + nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0) + SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ + SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1), \ + SCM_PACK_OP_24 (alloc_frame, nreq + nopt + 1), \ + SCM_PACK_OP_24 (subr_call, 0) #define AC(nreq) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nreq + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ + SCM_PACK_OP_24 (bind_rest, nreq + 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0 #define BC(nopt) \ - SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (bind_rest, nopt + 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0, \ 0 #define ABC(nreq, nopt) \ - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nreq + nopt + 1), \ - SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \ + SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ + SCM_PACK_OP_24 (bind_rest, nreq + nopt + 1), \ + SCM_PACK_OP_24 (subr_call, 0), \ 0 @@ -253,9 +253,9 @@ create_subr (int define, const char *name, return ret; } -/* Given an RTL primitive, determine its minimum arity. This is - possible because each RTL primitive is 4 32-bit words long, and they - are laid out contiguously in an ordered pattern. */ +/* Given a program that is a primitive, determine its minimum arity. + This is possible because each primitive's code is 4 32-bit words + long, and they are laid out contiguously in an ordered pattern. */ int scm_i_primitive_arity (SCM prim, int *req, int *opt, int *rest) { diff --git a/libguile/instructions.c b/libguile/instructions.c index 3dc15c2..8e90f28 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -76,14 +76,14 @@ static SCM word_type_symbols[] = #define OP(n,type) ((type) << (n*TYPE_WIDTH)) /* The VM_DEFINE_OP macro uses a CPP-based DSL to describe what kinds of - arguments each RTL instruction takes. This piece of code is the only + arguments each instruction takes. This piece of code is the only bit that actually interprets that language. These macro definitions encode the operand types into bits in a 32-bit integer. - (rtl-instruction-list) parses those encoded values into lists of - symbols, one for each 32-bit word that the operator takes. (system - vm rtl) uses those word types to generate assemblers and - disassemblers for the instructions. */ + (instruction-list) parses those encoded values into lists of symbols, + one for each 32-bit word that the operator takes. This list is used + by Scheme to generate assemblers and disassemblers for the + instructions. */ #define OP1(type0) \ (OP (0, type0)) @@ -101,33 +101,26 @@ static SCM word_type_symbols[] = #define WORD_TYPE(n, word) \ (((word) >> ((n) * TYPE_WIDTH)) & ((1 << TYPE_WIDTH) - 1)) -struct scm_rtl_instruction { - enum scm_rtl_opcode opcode; /* opcode */ +struct scm_instruction { + enum scm_opcode opcode; /* opcode */ const char *name; /* instruction name */ scm_t_uint32 meta; SCM symname; /* filled in later */ }; -#define SCM_VALIDATE_LOOKUP_INSTRUCTION(pos, var, cvar) \ - do { \ - cvar = scm_lookup_instruction_by_name (var); \ - SCM_ASSERT_TYPE (cvar, var, pos, FUNC_NAME, "INSTRUCTION_P"); \ - } while (0) - - static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; -static const struct scm_rtl_instruction* -fetch_rtl_instruction_table () +static const struct scm_instruction* +fetch_instruction_table () { - static struct scm_rtl_instruction *table = NULL; + static struct scm_instruction *table = NULL; scm_i_pthread_mutex_lock (&itable_lock); if (SCM_UNLIKELY (!table)) { - size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_rtl_instruction); + size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction); int i; table = malloc (bytes); memset (table, 0, bytes); @@ -153,14 +146,14 @@ fetch_rtl_instruction_table () /* Scheme interface */ -SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0, +SCM_DEFINE (scm_instruction_list, "instruction-list", 0, 0, 0, (void), "") -#define FUNC_NAME s_scm_rtl_instruction_list +#define FUNC_NAME s_scm_instruction_list { SCM list = SCM_EOL; int i; - const struct scm_rtl_instruction *ip = fetch_rtl_instruction_table (); + const struct scm_instruction *ip = fetch_instruction_table (); for (i = 0; i < SCM_VM_NUM_INSTRUCTIONS; i++) if (ip[i].name) { @@ -216,16 +209,16 @@ scm_bootstrap_instructions (void) "scm_init_instructions", (scm_t_extension_init_func)scm_init_instructions, NULL); +} +void +scm_init_instructions (void) +{ #define INIT(type) \ word_type_symbols[type] = scm_from_utf8_symbol (#type); FOR_EACH_INSTRUCTION_WORD_TYPE (INIT) #undef INIT -} -void -scm_init_instructions (void) -{ #ifndef SCM_MAGIC_SNARFER #include "libguile/instructions.x" #endif diff --git a/libguile/instructions.h b/libguile/instructions.h index fc9bce8..ad058cd 100644 --- a/libguile/instructions.h +++ b/libguile/instructions.h @@ -22,63 +22,28 @@ #include <libguile.h> #include <libguile/vm-operations.h> -enum scm_rtl_opcode +#ifdef BUILDING_LIBGUILE + +enum scm_opcode { -#define ENUM(opcode, tag, name, meta) scm_rtl_op_##tag = opcode, +#define ENUM(opcode, tag, name, meta) scm_op_##tag = opcode, FOR_EACH_VM_OPERATION(ENUM) #undef ENUM }; -#define SCM_PACK_RTL_8_8_8(op,a,b,c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24)) -#define SCM_PACK_RTL_8_16(op,a,b) ((op) | ((a) << 8) | ((b) << 16)) -#define SCM_PACK_RTL_16_8(op,a,b) ((op) | ((a) << 8) | ((b) << 24)) -#define SCM_PACK_RTL_12_12(op,a,b) ((op) | ((a) << 8) | ((b) << 20)) -#define SCM_PACK_RTL_24(op,a) ((op) | ((a) << 8)) - -#define SCM_UNPACK_RTL_8_8_8(op,a,b,c) \ - do \ - { \ - a = (op >> 8) & 0xff; \ - b = (op >> 16) & 0xff; \ - c = op >> 24; \ - } \ - while (0) - -#define SCM_UNPACK_RTL_8_16(op,a,b) \ - do \ - { \ - a = (op >> 8) & 0xff; \ - b = op >> 16; \ - } \ - while (0) - -#define SCM_UNPACK_RTL_16_8(op,a,b) \ - do \ - { \ - a = (op >> 8) & 0xffff; \ - b = op >> 24; \ - } \ - while (0) - -#define SCM_UNPACK_RTL_12_12(op,a,b) \ - do \ - { \ - a = (op >> 8) & 0xfff; \ - b = op >> 20; \ - } \ - while (0) - -#define SCM_UNPACK_RTL_24(op,a) \ - do \ - { \ - a = op >> 8; \ - } \ - while (0) +#define SCM_PACK_OP_24(op,arg) (scm_op_##op | (arg) << 8) +#define SCM_PACK_OP_8_8_8(op,a,b,c) SCM_PACK_OP_24 (op, (a) | ((b) << 8) | ((c) << 16)) +#define SCM_PACK_OP_8_16(op,a,b) SCM_PACK_OP_24 (op, (a) | (b) << 8) +#define SCM_PACK_OP_16_8(op,a,b) SCM_PACK_OP_24 (op, (a) | (b) << 16) +#define SCM_PACK_OP_12_12(op,a,b) SCM_PACK_OP_24 (op, (a) | (b) << 12) +#define SCM_PACK_OP_ARG_8_24(a,b) ((a) | ((b) << 8)) #define SCM_VM_NUM_INSTRUCTIONS (1<<8) #define SCM_VM_INSTRUCTION_MASK (SCM_VM_NUM_INSTRUCTIONS-1) -SCM_INTERNAL SCM scm_rtl_instruction_list (void); +#endif /* BUILDING_LIBGUILE */ + +SCM_INTERNAL SCM scm_instruction_list (void); SCM_INTERNAL void scm_bootstrap_instructions (void); SCM_INTERNAL void scm_init_instructions (void); diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index b13fab0..85674c0 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -19,13 +19,46 @@ /* This file is included in vm.c multiple times. */ -#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) -# define VM_USE_HOOKS 0 /* Various hooks */ -#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) -# define VM_USE_HOOKS 1 -#else -# error unknown debug engine VM_ENGINE -#endif +#define UNPACK_8_8_8(op,a,b,c) \ + do \ + { \ + a = (op >> 8) & 0xff; \ + b = (op >> 16) & 0xff; \ + c = op >> 24; \ + } \ + while (0) + +#define UNPACK_8_16(op,a,b) \ + do \ + { \ + a = (op >> 8) & 0xff; \ + b = op >> 16; \ + } \ + while (0) + +#define UNPACK_16_8(op,a,b) \ + do \ + { \ + a = (op >> 8) & 0xffff; \ + b = op >> 24; \ + } \ + while (0) + +#define UNPACK_12_12(op,a,b) \ + do \ + { \ + a = (op >> 8) & 0xfff; \ + b = op >> 20; \ + } \ + while (0) + +#define UNPACK_24(op,a) \ + do \ + { \ + a = op >> 8; \ + } \ + while (0) + /* Assign some registers by hand. There used to be a bigger list here, but it was never tested, and in the case of x86-32, was a source of @@ -258,7 +291,7 @@ #define BR_NARGS(rel) \ scm_t_uint32 expected; \ - SCM_UNPACK_RTL_24 (op, expected); \ + UNPACK_24 (op, expected); \ if (FRAME_LOCALS_COUNT() rel expected) \ { \ scm_t_int32 offset = ip[1]; \ @@ -270,7 +303,7 @@ #define BR_UNARY(x, exp) \ scm_t_uint32 test; \ SCM x; \ - SCM_UNPACK_RTL_24 (op, test); \ + UNPACK_24 (op, test); \ x = LOCAL_REF (test); \ if ((ip[1] & 0x1) ? !(exp) : (exp)) \ { \ @@ -285,7 +318,7 @@ #define BR_BINARY(x, y, exp) \ scm_t_uint16 a, b; \ SCM x, y; \ - SCM_UNPACK_RTL_12_12 (op, a, b); \ + UNPACK_12_12 (op, a, b); \ x = LOCAL_REF (a); \ y = LOCAL_REF (b); \ if ((ip[1] & 0x1) ? !(exp) : (exp)) \ @@ -302,7 +335,7 @@ { \ scm_t_uint16 a, b; \ SCM x, y; \ - SCM_UNPACK_RTL_12_12 (op, a, b); \ + UNPACK_12_12 (op, a, b); \ x = LOCAL_REF (a); \ y = LOCAL_REF (b); \ if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ @@ -339,12 +372,12 @@ #define ARGS1(a1) \ scm_t_uint16 dst, src; \ SCM a1; \ - SCM_UNPACK_RTL_12_12 (op, dst, src); \ + UNPACK_12_12 (op, dst, src); \ a1 = LOCAL_REF (src) #define ARGS2(a1, a2) \ scm_t_uint8 dst, src1, src2; \ SCM a1, a2; \ - SCM_UNPACK_RTL_8_8_8 (op, dst, src1, src2); \ + UNPACK_8_8_8 (op, dst, src1, src2); \ a1 = LOCAL_REF (src1); \ a2 = LOCAL_REF (src2) #define RETURN(x) \ @@ -386,7 +419,7 @@ ((scm_t_uintptr) (ptr) % alignof_type (type) == 0) static SCM -RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) +VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { /* Instruction pointer: A pointer to the opcode that is currently running. */ @@ -570,8 +603,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 proc, nlocals; SCM *old_fp = fp; - SCM_UNPACK_RTL_24 (op, proc); - SCM_UNPACK_RTL_24 (ip[1], nlocals); + UNPACK_24 (op, proc); + UNPACK_24 (ip[1], nlocals); VM_HANDLE_INTERRUPTS; @@ -601,7 +634,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint32 nlocals; - SCM_UNPACK_RTL_24 (op, nlocals); + UNPACK_24 (op, nlocals); VM_HANDLE_INTERRUPTS; @@ -627,7 +660,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint32 n, from, nlocals; - SCM_UNPACK_RTL_24 (op, from); + UNPACK_24 (op, from); VM_HANDLE_INTERRUPTS; @@ -658,8 +691,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, proc; scm_t_uint32 nlocals; - SCM_UNPACK_RTL_12_12 (op, dst, proc); - SCM_UNPACK_RTL_24 (ip[1], nlocals); + UNPACK_12_12 (op, dst, proc); + UNPACK_24 (ip[1], nlocals); VM_ASSERT (FRAME_LOCALS_COUNT () > proc + 1, vm_error_no_values ()); LOCAL_SET (dst, LOCAL_REF (proc + 1)); RESET_FRAME (nlocals); @@ -677,8 +710,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (5, receive_values, "receive-values", OP2 (U8_U24, B1_X7_U24)) { scm_t_uint32 proc, nvalues; - SCM_UNPACK_RTL_24 (op, proc); - SCM_UNPACK_RTL_24 (ip[1], nvalues); + UNPACK_24 (op, proc); + UNPACK_24 (ip[1], nvalues); if (ip[1] & 0x1) VM_ASSERT (FRAME_LOCALS_COUNT () > proc + nvalues, vm_error_not_enough_values ()); @@ -695,7 +728,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (6, return, "return", OP1 (U8_U24)) { scm_t_uint32 src; - SCM_UNPACK_RTL_24 (op, src); + UNPACK_24 (op, src); RETURN_ONE_VALUE (LOCAL_REF (src)); } @@ -744,7 +777,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM pointer, ret; SCM (*subr)(); - SCM_UNPACK_RTL_24 (op, ptr_idx); + UNPACK_24 (op, ptr_idx); pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx); subr = SCM_POINTER_VALUE (pointer); @@ -813,7 +846,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint16 cif_idx, ptr_idx; SCM closure, cif, pointer, ret; - SCM_UNPACK_RTL_12_12 (op, cif_idx, ptr_idx); + UNPACK_12_12 (op, cif_idx, ptr_idx); closure = LOCAL_REF (0); cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx); @@ -847,7 +880,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM contregs; scm_t_uint32 contregs_idx; - SCM_UNPACK_RTL_24 (op, contregs_idx); + UNPACK_24 (op, contregs_idx); contregs = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx); @@ -877,7 +910,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM vmcont; scm_t_uint32 cont_idx; - SCM_UNPACK_RTL_24 (op, cont_idx); + UNPACK_24 (op, cont_idx); vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx); SYNC_IP (); @@ -1018,7 +1051,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, idx; - SCM_UNPACK_RTL_12_12 (op, dst, idx); + UNPACK_12_12 (op, dst, idx); LOCAL_SET (dst, scm_vm_builtin_ref (idx)); NEXT (1); @@ -1062,7 +1095,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (19, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24)) { scm_t_uint32 expected; - SCM_UNPACK_RTL_24 (op, expected); + UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () == expected, vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); NEXT (1); @@ -1070,7 +1103,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (20, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24)) { scm_t_uint32 expected; - SCM_UNPACK_RTL_24 (op, expected); + UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () >= expected, vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); NEXT (1); @@ -1078,7 +1111,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (21, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24)) { scm_t_uint32 expected; - SCM_UNPACK_RTL_24 (op, expected); + UNPACK_24 (op, expected); VM_ASSERT (FRAME_LOCALS_COUNT () <= expected, vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); NEXT (1); @@ -1093,7 +1126,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (22, alloc_frame, "alloc-frame", OP1 (U8_U24)) { scm_t_uint32 nlocals, nargs; - SCM_UNPACK_RTL_24 (op, nlocals); + UNPACK_24 (op, nlocals); nargs = FRAME_LOCALS_COUNT (); ALLOC_FRAME (nlocals); @@ -1112,7 +1145,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (23, reset_frame, "reset-frame", OP1 (U8_U24)) { scm_t_uint32 nlocals; - SCM_UNPACK_RTL_24 (op, nlocals); + UNPACK_24 (op, nlocals); RESET_FRAME (nlocals); NEXT (1); } @@ -1125,7 +1158,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (24, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1 (U8_U12_U12)) { scm_t_uint16 expected, nlocals; - SCM_UNPACK_RTL_12_12 (op, expected, nlocals); + UNPACK_12_12 (op, expected, nlocals); VM_ASSERT (FRAME_LOCALS_COUNT () == expected, vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp))); ALLOC_FRAME (expected + nlocals); @@ -1149,8 +1182,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint32 nreq, npos; - SCM_UNPACK_RTL_24 (op, nreq); - SCM_UNPACK_RTL_24 (ip[1], npos); + UNPACK_24 (op, nreq); + UNPACK_24 (ip[1], npos); /* We can only have too many positionals if there are more arguments than NPOS. */ @@ -1190,11 +1223,11 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM kw; char allow_other_keys, has_rest; - SCM_UNPACK_RTL_24 (op, nreq); + UNPACK_24 (op, nreq); allow_other_keys = ip[1] & 0x1; has_rest = ip[1] & 0x2; - SCM_UNPACK_RTL_24 (ip[1], nreq_and_opt); - SCM_UNPACK_RTL_24 (ip[2], ntotal); + UNPACK_24 (ip[1], nreq_and_opt); + UNPACK_24 (ip[2], ntotal); kw_offset = ip[3]; kw_bits = (scm_t_bits) (ip + kw_offset); VM_ASSERT (!(kw_bits & 0x7), abort()); @@ -1273,7 +1306,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 dst, nargs; SCM rest = SCM_EOL; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); nargs = FRAME_LOCALS_COUNT (); if (nargs <= dst) @@ -1471,7 +1504,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint16 dst; scm_t_uint16 src; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); LOCAL_SET (dst, LOCAL_REF (src)); NEXT (1); @@ -1486,8 +1519,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 dst; scm_t_uint32 src; - SCM_UNPACK_RTL_24 (op, dst); - SCM_UNPACK_RTL_24 (ip[1], src); + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], src); LOCAL_SET (dst, LOCAL_REF (src)); NEXT (2); @@ -1500,7 +1533,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (44, box, "box", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF (src)))); NEXT (1); } @@ -1514,7 +1547,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; SCM var; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); var = LOCAL_REF (src); VM_ASSERT (SCM_VARIABLEP (var), vm_error_not_a_variable ("variable-ref", var)); @@ -1532,7 +1565,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; SCM var; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); var = LOCAL_REF (dst); VM_ASSERT (SCM_VARIABLEP (var), vm_error_not_a_variable ("variable-set!", var)); @@ -1553,9 +1586,9 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_int32 offset; SCM closure; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); offset = ip[1]; - SCM_UNPACK_RTL_24 (ip[2], nfree); + UNPACK_24 (ip[2], nfree); // FIXME: Assert range of nfree? closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2); @@ -1575,8 +1608,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; scm_t_uint32 idx; - SCM_UNPACK_RTL_12_12 (op, dst, src); - SCM_UNPACK_RTL_24 (ip[1], idx); + UNPACK_12_12 (op, dst, src); + UNPACK_24 (ip[1], idx); /* CHECK_FREE_VARIABLE (src); */ LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx)); NEXT (2); @@ -1590,8 +1623,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; scm_t_uint32 idx; - SCM_UNPACK_RTL_12_12 (op, dst, src); - SCM_UNPACK_RTL_24 (ip[1], idx); + UNPACK_12_12 (op, dst, src); + UNPACK_24 (ip[1], idx); /* CHECK_FREE_VARIABLE (src); */ SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src)); NEXT (2); @@ -1614,7 +1647,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst; scm_t_bits val; - SCM_UNPACK_RTL_8_16 (op, dst, val); + UNPACK_8_16 (op, dst, val); LOCAL_SET (dst, SCM_PACK (val)); NEXT (1); } @@ -1629,7 +1662,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 dst; scm_t_bits val; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); val = ip[1]; LOCAL_SET (dst, SCM_PACK (val)); NEXT (2); @@ -1644,7 +1677,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 dst; scm_t_bits val; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); #if SIZEOF_SCM_T_BITS > 4 val = ip[1]; val <<= 32; @@ -1677,7 +1710,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32* loc; scm_t_bits unpacked; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); offset = ip[1]; loc = ip + offset; unpacked = (scm_t_bits) loc; @@ -1706,7 +1739,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32* loc; scm_t_uintptr loc_bits; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); offset = ip[1]; loc = ip + offset; loc_bits = (scm_t_uintptr) loc; @@ -1728,7 +1761,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_int32 offset; scm_t_uint32* loc; - SCM_UNPACK_RTL_24 (op, src); + UNPACK_24 (op, src); offset = ip[1]; loc = ip + offset; VM_ASSERT (ALIGNED_P (loc, SCM), abort()); @@ -1806,7 +1839,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint32 dst; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); SYNC_IP (); LOCAL_SET (dst, scm_current_module ()); @@ -1825,8 +1858,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint32 sym; SCM var; - SCM_UNPACK_RTL_24 (op, dst); - SCM_UNPACK_RTL_24 (ip[1], sym); + UNPACK_24 (op, dst); + UNPACK_24 (ip[1], sym); SYNC_IP (); var = scm_lookup (LOCAL_REF (sym)); @@ -1846,7 +1879,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (59, define, "define!", OP1 (U8_U12_U12)) { scm_t_uint16 sym, val; - SCM_UNPACK_RTL_12_12 (op, sym, val); + UNPACK_12_12 (op, sym, val); SYNC_IP (); scm_define (LOCAL_REF (sym), LOCAL_REF (val)); NEXT (1); @@ -1879,7 +1912,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM *var_loc; SCM var; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); var_offset = ip[1]; var_loc_u32 = ip + var_offset; VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort()); @@ -1931,7 +1964,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM *var_loc; SCM var; - SCM_UNPACK_RTL_24 (op, dst); + UNPACK_24 (op, dst); var_offset = ip[1]; var_loc_u32 = ip + var_offset; VM_ASSERT (ALIGNED_P (var_loc_u32, SCM), abort()); @@ -2000,9 +2033,9 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 escape_only_p; scm_t_dynstack_prompt_flags flags; - SCM_UNPACK_RTL_24 (op, tag); + UNPACK_24 (op, tag); escape_only_p = ip[1] & 0x1; - SCM_UNPACK_RTL_24 (ip[1], proc_slot); + UNPACK_24 (ip[1], proc_slot); offset = ip[2]; offset >>= 8; /* Sign extension */ @@ -2028,7 +2061,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (63, wind, "wind", OP1 (U8_U12_U12)) { scm_t_uint16 winder, unwinder; - SCM_UNPACK_RTL_12_12 (op, winder, unwinder); + UNPACK_12_12 (op, winder, unwinder); scm_dynstack_push_dynwind (¤t_thread->dynstack, LOCAL_REF (winder), LOCAL_REF (unwinder)); NEXT (1); @@ -2055,7 +2088,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint32 fluid, value; - SCM_UNPACK_RTL_12_12 (op, fluid, value); + UNPACK_12_12 (op, fluid, value); scm_dynstack_push_fluid (¤t_thread->dynstack, LOCAL_REF (fluid), LOCAL_REF (value), @@ -2086,7 +2119,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) size_t num; SCM fluid, fluids; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); fluid = LOCAL_REF (src); fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state); if (SCM_UNLIKELY (!SCM_FLUID_P (fluid)) @@ -2119,7 +2152,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) size_t num; SCM fluid, fluids; - SCM_UNPACK_RTL_12_12 (op, a, b); + UNPACK_12_12 (op, a, b); fluid = LOCAL_REF (a); fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state); if (SCM_UNLIKELY (!SCM_FLUID_P (fluid)) @@ -2189,7 +2222,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); SYNC_IP (); LOCAL_SET (dst, scm_string_to_number (LOCAL_REF (src), @@ -2205,7 +2238,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 dst, src; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); SYNC_IP (); LOCAL_SET (dst, scm_string_to_symbol (LOCAL_REF (src))); NEXT (1); @@ -2218,7 +2251,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (73, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) | OP_DST) { scm_t_uint16 dst, src; - SCM_UNPACK_RTL_12_12 (op, dst, src); + UNPACK_12_12 (op, dst, src); SYNC_IP (); LOCAL_SET (dst, scm_symbol_to_keyword (LOCAL_REF (src))); NEXT (1); @@ -2270,7 +2303,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 a, b; SCM x, y; - SCM_UNPACK_RTL_12_12 (op, a, b); + UNPACK_12_12 (op, a, b); x = LOCAL_REF (a); y = LOCAL_REF (b); VM_VALIDATE_PAIR (x, "set-car!"); @@ -2286,7 +2319,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) { scm_t_uint16 a, b; SCM x, y; - SCM_UNPACK_RTL_12_12 (op, a, b); + UNPACK_12_12 (op, a, b); x = LOCAL_REF (a); y = LOCAL_REF (b); VM_VALIDATE_PAIR (x, "set-car!"); @@ -2513,7 +2546,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_int32 length, n; SCM val, vector; - SCM_UNPACK_RTL_8_8_8 (op, dst, length, init); + UNPACK_8_8_8 (op, dst, length, init); val = LOCAL_REF (init); vector = scm_words (scm_tc7_vector | (length << 8), length + 1); @@ -2570,7 +2603,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst, src, idx; SCM v; - SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx); + UNPACK_8_8_8 (op, dst, src, idx); v = LOCAL_REF (src); if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v) && idx < SCM_I_VECTOR_LENGTH (v))) @@ -2590,7 +2623,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM vect, idx, val; scm_t_signed_bits i = 0; - SCM_UNPACK_RTL_8_8_8 (op, dst, idx_var, src); + UNPACK_8_8_8 (op, dst, idx_var, src); vect = LOCAL_REF (dst); idx = LOCAL_REF (idx_var); val = LOCAL_REF (src); @@ -2618,7 +2651,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst, idx, src; SCM vect, val; - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); + UNPACK_8_8_8 (op, dst, idx, src); vect = LOCAL_REF (dst); val = LOCAL_REF (src); @@ -2662,7 +2695,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst, vtable, nfields; SCM ret; - SCM_UNPACK_RTL_8_8_8 (op, dst, vtable, nfields); + UNPACK_8_8_8 (op, dst, vtable, nfields); SYNC_IP (); ret = scm_allocate_struct (LOCAL_REF (vtable), SCM_I_MAKINUM (nfields)); @@ -2681,7 +2714,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst, src, idx; SCM obj; - SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx); + UNPACK_8_8_8 (op, dst, src, idx); obj = LOCAL_REF (src); @@ -2706,7 +2739,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_uint8 dst, idx, src; SCM obj, val; - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); + UNPACK_8_8_8 (op, dst, idx, src); obj = LOCAL_REF (dst); val = LOCAL_REF (src); @@ -2750,7 +2783,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (103, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST) { scm_t_uint8 dst, src, idx; - SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx); + UNPACK_8_8_8 (op, dst, src, idx); LOCAL_SET (dst, SCM_PACK (SCM_STRUCT_DATA (LOCAL_REF (src))[idx])); NEXT (1); @@ -2764,7 +2797,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (104, slot_set, "slot-set!", OP1 (U8_U8_U8_U8)) { scm_t_uint8 dst, idx, src; - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); + UNPACK_8_8_8 (op, dst, idx, src); SCM_STRUCT_DATA (LOCAL_REF (dst))[idx] = SCM_UNPACK (LOCAL_REF (src)); NEXT (1); } @@ -2788,7 +2821,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) scm_t_int32 offset; scm_t_uint32 len; - SCM_UNPACK_RTL_8_8_8 (op, dst, type, shape); + UNPACK_8_8_8 (op, dst, type, shape); offset = ip[1]; len = ip[2]; SYNC_IP (); @@ -2805,8 +2838,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST) { scm_t_uint16 dst, type, fill, bounds; - SCM_UNPACK_RTL_12_12 (op, dst, type); - SCM_UNPACK_RTL_12_12 (ip[1], fill, bounds); + UNPACK_12_12 (op, dst, type); + UNPACK_12_12 (ip[1], fill, bounds); SYNC_IP (); LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill), LOCAL_REF (bounds))); @@ -2959,7 +2992,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM bv, scm_idx, val; \ scm_t_ ## type *int_ptr; \ \ - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \ + UNPACK_8_8_8 (op, dst, idx, src); \ bv = LOCAL_REF (dst); \ scm_idx = LOCAL_REF (idx); \ val = LOCAL_REF (src); \ @@ -2990,7 +3023,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM bv, scm_idx, val; \ scm_t_ ## type *int_ptr; \ \ - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \ + UNPACK_8_8_8 (op, dst, idx, src); \ bv = LOCAL_REF (dst); \ scm_idx = LOCAL_REF (idx); \ val = LOCAL_REF (src); \ @@ -3018,7 +3051,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM bv, scm_idx, val; \ type *float_ptr; \ \ - SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src); \ + UNPACK_8_8_8 (op, dst, idx, src); \ bv = LOCAL_REF (dst); \ scm_idx = LOCAL_REF (idx); \ val = LOCAL_REF (src); \ @@ -3127,6 +3160,11 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) #undef SYNC_BEFORE_GC #undef SYNC_IP #undef SYNC_REGISTER +#undef UNPACK_8_8_8 +#undef UNPACK_8_16 +#undef UNPACK_16_8 +#undef UNPACK_12_12 +#undef UNPACK_24 #undef VARIABLE_BOUNDP #undef VARIABLE_REF #undef VARIABLE_SET diff --git a/libguile/vm.c b/libguile/vm.c index 9b0e080..8758088 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -600,37 +600,37 @@ static SCM vm_builtin_call_with_values; static SCM vm_builtin_call_with_current_continuation; static const scm_t_uint32 vm_boot_continuation_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_halt, 0) + SCM_PACK_OP_24 (halt, 0) }; static const scm_t_uint32 vm_builtin_apply_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, 3), - SCM_PACK_RTL_24 (scm_rtl_op_tail_apply, 0), /* proc in r1, args from r2 */ + SCM_PACK_OP_24 (assert_nargs_ge, 3), + SCM_PACK_OP_24 (tail_apply, 0), /* proc in r1, args from r2 */ }; static const scm_t_uint32 vm_builtin_values_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_return_values, 0) /* vals from r1 */ + SCM_PACK_OP_24 (return_values, 0) /* vals from r1 */ }; static const scm_t_uint32 vm_builtin_abort_to_prompt_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, 2), - SCM_PACK_RTL_24 (scm_rtl_op_abort, 0), /* tag in r1, vals from r2 */ + SCM_PACK_OP_24 (assert_nargs_ge, 2), + SCM_PACK_OP_24 (abort, 0), /* tag in r1, vals from r2 */ /* FIXME: Partial continuation should capture caller regs. */ - SCM_PACK_RTL_24 (scm_rtl_op_return_values, 0) /* vals from r1 */ + SCM_PACK_OP_24 (return_values, 0) /* vals from r1 */ }; static const scm_t_uint32 vm_builtin_call_with_values_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, 3), - SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, 7), - SCM_PACK_RTL_12_12 (scm_rtl_op_mov, 6, 1), - SCM_PACK_RTL_24 (scm_rtl_op_call, 6), SCM_PACK_RTL_24 (0, 1), - SCM_PACK_RTL_12_12 (scm_rtl_op_mov, 0, 2), - SCM_PACK_RTL_24 (scm_rtl_op_tail_call_shuffle, 7) + SCM_PACK_OP_24 (assert_nargs_ee, 3), + SCM_PACK_OP_24 (alloc_frame, 7), + SCM_PACK_OP_12_12 (mov, 6, 1), + SCM_PACK_OP_24 (call, 6), SCM_PACK_OP_ARG_8_24 (0, 1), + SCM_PACK_OP_12_12 (mov, 0, 2), + SCM_PACK_OP_24 (tail_call_shuffle, 7) }; static const scm_t_uint32 vm_builtin_call_with_current_continuation_code[] = { - SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, 2), - SCM_PACK_RTL_24 (scm_rtl_op_call_cc, 0) + SCM_PACK_OP_24 (assert_nargs_ee, 2), + SCM_PACK_OP_24 (call_cc, 0) }; @@ -755,26 +755,26 @@ initialize_default_stack_size (void) vm_stack_size = size; } -#define RTL_VM_NAME rtl_vm_regular_engine +#define VM_NAME vm_regular_engine +#define VM_USE_HOOKS 0 #define FUNC_NAME "vm-regular-engine" -#define VM_ENGINE SCM_VM_REGULAR_ENGINE #include "vm-engine.c" -#undef RTL_VM_NAME #undef FUNC_NAME -#undef VM_ENGINE +#undef VM_USE_HOOKS +#undef VM_NAME -#define RTL_VM_NAME rtl_vm_debug_engine +#define VM_NAME vm_debug_engine +#define VM_USE_HOOKS 1 #define FUNC_NAME "vm-debug-engine" -#define VM_ENGINE SCM_VM_DEBUG_ENGINE #include "vm-engine.c" -#undef RTL_VM_NAME #undef FUNC_NAME -#undef VM_ENGINE +#undef VM_USE_HOOKS +#undef VM_NAME -typedef SCM (*scm_t_rtl_vm_engine) (SCM vm, SCM program, SCM *argv, size_t nargs); +typedef SCM (*scm_t_vm_engine) (SCM vm, SCM program, SCM *argv, size_t nargs); -static const scm_t_rtl_vm_engine rtl_vm_engines[] = - { rtl_vm_regular_engine, rtl_vm_debug_engine }; +static const scm_t_vm_engine vm_engines[SCM_VM_NUM_ENGINES] = + { vm_regular_engine, vm_debug_engine }; #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN @@ -859,7 +859,7 @@ scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs) { struct scm_vm *vp = SCM_VM_DATA (vm); SCM_CHECK_STACK; - return rtl_vm_engines[vp->engine](vm, program, argv, nargs); + return vm_engines[vp->engine](vm, program, argv, nargs); } /* Scheme interface */ diff --git a/libguile/vm.h b/libguile/vm.h index c678e42..bb07454 100644 --- a/libguile/vm.h +++ b/libguile/vm.h @@ -34,8 +34,6 @@ enum { struct scm_vm; -typedef SCM (*scm_t_vm_engine) (SCM vm, SCM program, SCM *argv, int nargs); - #define SCM_VM_REGULAR_ENGINE 0 #define SCM_VM_DEBUG_ENGINE 1 #define SCM_VM_NUM_ENGINES 2 diff --git a/module/Makefile.am b/module/Makefile.am index 3074fd9..d3878cd 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -355,7 +355,6 @@ SYSTEM_SOURCES = \ system/vm/elf.scm \ system/vm/linker.scm \ system/vm/frame.scm \ - system/vm/instruction.scm \ system/vm/objcode.scm \ system/vm/program.scm \ system/vm/trace.scm \ diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm index 323f623..5a5fadc 100644 --- a/module/language/cps/primitives.scm +++ b/module/language/cps/primitives.scm @@ -91,7 +91,7 @@ (let ((table (make-hash-table))) (for-each (match-lambda ((inst . _) (hashq-set! table inst inst))) - (rtl-instruction-list)) + (instruction-list)) (for-each (match-lambda ((prim . inst) (hashq-set! table prim inst))) *rtl-instruction-aliases*) diff --git a/module/language/rtl.scm b/module/language/rtl.scm index 8ec9fe2..89b9ac8 100644 --- a/module/language/rtl.scm +++ b/module/language/rtl.scm @@ -21,13 +21,14 @@ (define-module (language rtl) #:use-module (ice-9 match) #:use-module ((srfi srfi-1) #:select (fold)) - #:use-module (system vm instruction) - #:re-export (rtl-instruction-list) - #:export (rtl-instruction-arity + #:export (instruction-list + rtl-instruction-arity builtin-name->index builtin-index->name)) (load-extension (string-append "libguile-" (effective-version)) + "scm_init_instructions") +(load-extension (string-append "libguile-" (effective-version)) "scm_init_vm_builtins") (define (compute-rtl-instruction-arity name args) @@ -84,7 +85,7 @@ ((name op '<- . args) (hashq-set! table name (cons 1 (1- (compute-rtl-instruction-arity name args)))))) - (rtl-instruction-list)) + (instruction-list)) (for-each (match-lambda ((name . arity) (hashq-set! table name arity))) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 7c1d589..7a0cdcc 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -26,7 +26,7 @@ ;;; ;;; "Primitive instructions" correspond to RTL VM operations. ;;; Assemblers for primitive instructions are generated programmatically -;;; from (rtl-instruction-list), which itself is derived from the VM +;;; from (instruction-list), which itself is derived from the VM ;;; sources. There are also "macro-instructions" like "label" or ;;; "load-constant" that expand to 0 or more primitive instructions. ;;; @@ -44,10 +44,10 @@ (define-module (system vm assembler) #:use-module (system base target) - #:use-module (system vm instruction) #:use-module (system vm dwarf) #:use-module (system vm elf) #:use-module (system vm linker) + #:use-module (language rtl) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (ice-9 vlist) @@ -342,7 +342,7 @@ later by the linker." ;;; ;;; Primitive assemblers are defined by expanding `assembler' for each -;;; opcode in `(rtl-instruction-list)'. +;;; opcode in `(instruction-list)'. ;;; (eval-when (expand compile load eval) @@ -476,7 +476,7 @@ later by the linker." ((visit-opcodes macro arg ...) (with-syntax (((inst ...) (map (lambda (x) (datum->syntax #'macro x)) - (rtl-instruction-list)))) + (instruction-list)))) #'(begin (macro arg ... . inst) ...)))))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index cfc8a15..6e8c631 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -48,7 +48,7 @@ ((visit-opcodes macro arg ...) (with-syntax (((inst ...) (map (lambda (x) (datum->syntax #'macro x)) - (rtl-instruction-list)))) + (instruction-list)))) #'(begin (macro arg ... . inst) ...)))))) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index 3c0cbb5..a5de861 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -21,7 +21,6 @@ (define-module (system vm frame) #:use-module (system base pmatch) #:use-module (system vm program) - #:use-module (system vm instruction) #:export (frame-bindings frame-lookup-binding frame-binding-ref frame-binding-set! diff --git a/module/system/vm/instruction.scm b/module/system/vm/instruction.scm deleted file mode 100644 index 78d9db1..0000000 --- a/module/system/vm/instruction.scm +++ /dev/null @@ -1,25 +0,0 @@ -;;; Guile VM instructions - -;; Copyright (C) 2001, 2010, 2012, 2013 Free Software Foundation, Inc. - -;;; This library is free software; you can redistribute it and/or -;;; modify it under the terms of the GNU Lesser General Public -;;; License as published by the Free Software Foundation; either -;;; version 3 of the License, or (at your option) any later version. -;;; -;;; This library 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 -;;; Lesser General Public License for more details. -;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with this library; if not, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - -;;; Code: - -(define-module (system vm instruction) - #:export (rtl-instruction-list)) - -(load-extension (string-append "libguile-" (effective-version)) - "scm_init_instructions") diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index bbb9ef7..a2d774d 100644 --- a/module/system/vm/program.scm +++ b/module/system/vm/program.scm @@ -20,7 +20,6 @@ (define-module (system vm program) #:use-module (ice-9 match) - #:use-module (system vm instruction) #:use-module (system vm debug) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm index 717013f..0135b39 100644 --- a/module/system/vm/trace.scm +++ b/module/system/vm/trace.scm @@ -25,7 +25,6 @@ #:use-module (system vm program) #:use-module (system vm traps) #:use-module (rnrs bytevectors) - #:use-module (system vm instruction) #:use-module (ice-9 format) #:export (trace-calls-in-procedure trace-calls-to-procedure diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm index c7ee2a0..2d1a09a 100644 --- a/module/system/vm/traps.scm +++ b/module/system/vm/traps.scm @@ -60,7 +60,6 @@ #:use-module (system vm debug) #:use-module (system vm frame) #:use-module (system vm program) - #:use-module (system vm instruction) #:use-module (system xref) #:use-module (rnrs bytevectors) #:export (trap-at-procedure-call hooks/post-receive -- GNU Guile