diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-16 00:26:22 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-16 00:26:22 +0200 |
commit | efbd589204408fe8af33b9d86a7e33104997bf6a (patch) | |
tree | fa534cfd59b892c82c72911e0f62eb323f6e6bb7 /libguile/vm-i-system.c | |
parent | ef24c01bffb41a9855fe1aea36c4444742aba660 (diff) | |
download | guile-efbd589204408fe8af33b9d86a7e33104997bf6a.tar.gz |
compile call-with-values, woot!
* libguile/vm-engine.c (vm_run): Add another byte onto the bootstrap
program, as the offset passed to mv-call now takes two bytes.
* module/system/vm/frame.scm (bootstrap-frame?): Update for the new
bootstrap length. Really we should just check for 'halt though.
* libguile/vm-i-system.c (FETCH_OFFSET): New helper, used in BR().
(goto/nargs, call/nargs): Versions of goto/args and call, respectively,
that take the number of arguments from a value on the top of the stack.
(mv-call): Call FETCH_OFFSET to get the offset.
* module/language/scheme/translate.scm (custom-transformer-table):
Compile call-with-values to <ghil-mv-call>. There is some trickery
because of the r4rs.scm call-with-values trampolines.
* module/system/il/ghil.scm: Add <ghil-mv-call> and accessors.
* module/system/il/compile.scm (codegen): Compile <ghil-mv-call>.
* module/system/il/glil.scm: Add <glil-mv-call>, which needs some special
assembly because of the label. Fix some typos.
* module/system/vm/assemble.scm (byte-length): New helper, factored out
and made more general.
(codegen): Assemble mv-call, including the label.
(check-length): New helper, makes sure that the addressing is
consistent within the produced object code.
(stack->bytes): Rewrite to be more generic -- now `br' instructions
aren't the only ones jumping around in the instruction stream.
* module/system/vm/conv.scm (make-byte-decoder): Return two values in the
#f case.
* module/system/vm/disasm.scm (disassemble-bytecode): Rewrite, because
the previous implementation depended on a guile interpreter quirk:
namely, that multiple values could be represented within one value, and
destructured later.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 33 |
1 files changed, 28 insertions, 5 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 75642b5ba..05fc7476e 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -376,11 +376,18 @@ VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0) * branch and jump */ -#define BR(p) \ +/* offset must be a signed short!!! */ +#define FETCH_OFFSET(offset) \ { \ int h = FETCH (); \ int l = FETCH (); \ - signed short offset = (h << 8) + l; \ + offset = (h << 8) + l; \ +} + +#define BR(p) \ +{ \ + signed short offset; \ + FETCH_OFFSET (offset); \ if (p) \ ip += offset; \ DROP (); \ @@ -701,13 +708,29 @@ VM_DEFINE_INSTRUCTION (goto_args, "goto/args", 1, -1, 1) goto vm_error_wrong_type_apply; } -VM_DEFINE_INSTRUCTION (mv_call, "mv-call", 2, -1, 1) +VM_DEFINE_INSTRUCTION (goto_nargs, "goto/nargs", 0, 0, 1) +{ + SCM x; + POP (x); + nargs = scm_to_int (x); + goto vm_goto_args; +} + +VM_DEFINE_INSTRUCTION (call_nargs, "call/nargs", 0, 0, 1) +{ + SCM x; + POP (x); + nargs = scm_to_int (x); + goto vm_call; +} + +VM_DEFINE_INSTRUCTION (mv_call, "mv-call", 3, -1, 1) { SCM x; - int offset; + signed short offset; nargs = FETCH (); - offset = FETCH (); + FETCH_OFFSET (offset); x = sp[-nargs]; |