1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 16:50:21 +02:00

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.
This commit is contained in:
Andy Wingo 2008-09-16 00:26:22 +02:00
parent ef24c01bff
commit efbd589204
10 changed files with 134 additions and 47 deletions

View file

@ -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;
int offset;
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;
signed short offset;
nargs = FETCH ();
offset = FETCH ();
FETCH_OFFSET (offset);
x = sp[-nargs];