diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-14 17:06:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-14 17:06:52 +0200 |
commit | a222b0fa91fe33461db1c7f8f4370ce6a5db588f (patch) | |
tree | 6d4ef7189f72dd48c0a23d09c8e9720ae32146f6 /libguile/vm-i-system.c | |
parent | 7e97ad2dd69cbc0066cfe2fee71088d22b8b8021 (diff) | |
download | guile-a222b0fa91fe33461db1c7f8f4370ce6a5db588f.tar.gz |
add multiple values support to the vm
* libguile/vm-engine.c (vm_run): The bootstrap program now uses mv_call,
so as to allow multiple values out of the VM. (It did before, because
multiple values were represented internally as single scm_values
objects, but now that values go on the stack, we need to note the boot
frame as accepting multiple values.)
(vm_error_no_values): New error, happens if you pass no values into a
single-value continuation. Passing more than one is OK though, it just
takes the first one.
* libguile/vm-i-system.c (halt): Assume that someone has pushed the
number of values onto the stack, and package up that number of values
as a scm_values() object, for communication with the interpreter.
(mv-call): New instruction, calls a procedure with a multiple-value
continuation, even handling calls out to the interpreter.
(return/values): New instruction, returns multiple values to the
continuation. If the continuation is single-valued, takes the first
value or errors if there are no values. Otherwise it returns to the
multiple-value return address, pushing the number of values on top of
the values.
* module/system/il/compile.scm (codegen): Compile <ghil-values> forms.
* module/system/il/ghil.scm (<ghil-values>) Add new GHIL data structure
and associated procedures.
* module/language/scheme/translate.scm (custom-transformer-table):
Compile (values .. ) forms into <ghil-values>.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 134 |
1 files changed, 133 insertions, 1 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index 86e65787b..4e9ec4263 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -55,9 +55,19 @@ VM_DEFINE_INSTRUCTION (nop, "nop", 0, 0, 0) VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0) { SCM ret; + int nvalues; vp->time += scm_c_get_internal_run_time () - start_time; HALT_HOOK (); - POP (ret); + nvalues = SCM_I_INUM (*sp--); + if (nvalues == 1) + POP (ret); + else + { + POP_LIST (nvalues); + POP (ret); + ret = scm_values (ret); + } + { #ifdef THE_GOVERNMENT_IS_AFTER_ME if (sp != stack_base) @@ -692,6 +702,68 @@ 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) +{ + SCM x; + int offset; + + nargs = FETCH (); + offset = FETCH (); + + x = sp[-nargs]; + + /* + * Subprogram call + */ + if (SCM_PROGRAM_P (x)) + { + program = x; + CACHE_PROGRAM (); + INIT_ARGS (); + NEW_FRAME (); + SCM_FRAME_DATA_ADDRESS (fp)[3] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset); + ENTER_HOOK (); + APPLY_HOOK (); + NEXT; + } + /* + * Other interpreted or compiled call + */ + if (!SCM_FALSEP (scm_procedure_p (x))) + { + /* At this point, the stack contains the procedure and each one of its + arguments. */ + SCM args; + POP_LIST (nargs); + POP (args); + SYNC_REGISTER (); + *sp = scm_apply (x, args, SCM_EOL); + if (SCM_VALUESP (*sp)) + { + SCM values, len; + POP (values); + values = scm_struct_ref (values, SCM_INUM0); + len = scm_length (values); + while (!SCM_NULLP (values)) + PUSH (SCM_CAR (values)); + PUSH (len); + ip += offset; + } + NEXT; + } + /* + * Continuation call + */ + if (SCM_VM_CONT_P (x)) + { + program = x; + goto vm_call_continuation; + } + + program = x; + goto vm_error_wrong_type_apply; +} + VM_DEFINE_INSTRUCTION (apply, "apply", 1, -1, 1) { int len; @@ -785,6 +857,66 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1) NEXT; } +VM_DEFINE_INSTRUCTION (return_values, "return/values", 1, -1, -1) +{ + EXIT_HOOK (); + RETURN_HOOK (); + { + int nvalues = FETCH (); + SCM *data = SCM_FRAME_DATA_ADDRESS (fp); +#ifdef THE_GOVERNMENT_IS_AFTER_ME + if (stack_base != data + 4) + abort (); +#endif + + /* data[3] is the mv return address */ + if (nvalues != 1 && data[3]) + { + int i; + /* Restore registers */ + sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; + ip = SCM_FRAME_BYTE_CAST (data[3]); /* multiple value ra */ + fp = SCM_FRAME_STACK_CAST (data[2]); + + /* Push return values, and the number of values */ + for (i = 0; i < nvalues; i++) + *++sp = stack_base[1+i]; + *++sp = SCM_I_MAKINUM (nvalues); + + /* Finally set new stack_base */ + stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; + } + else if (nvalues >= 1) + { + /* Multiple values for a single-valued continuation -- here's where I + break with guile tradition and try and do something sensible. (Also, + this block handles the single-valued return to an mv + continuation.) */ + /* Restore registers */ + sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; + ip = SCM_FRAME_BYTE_CAST (data[4]); /* single value ra */ + fp = SCM_FRAME_STACK_CAST (data[2]); + + /* Push first value */ + *++sp = stack_base[1]; + + /* Finally set new stack_base */ + stack_base = SCM_FRAME_UPPER_ADDRESS (fp) - 1; + } + else + goto vm_error_no_values; + + + } + + /* Restore the last program */ + program = SCM_FRAME_PROGRAM (fp); + CACHE_PROGRAM (); + CACHE_EXTERNAL (); + CHECK_IP (); + NEXT; +} + /* Local Variables: c-file-style: "gnu" |