diff options
author | Andy Wingo <wingo@pobox.com> | 2012-05-10 12:43:33 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-05-10 12:59:45 +0200 |
commit | 67b699cc77d5e2f74daca77aa26b1ba8af0d0808 (patch) | |
tree | 42dd52d6cad54d3c5acf63796bf17ffc87ad6bca /libguile/vm-i-system.c | |
parent | 0eba699d12f638c624efcdc2b617b0aa9099ee1f (diff) | |
download | guile-67b699cc77d5e2f74daca77aa26b1ba8af0d0808.tar.gz |
refactor vm application of non-programs; boot continuation refactor
* libguile/frames.c (scm_frame_instruction_pointer):
* module/system/vm/frame.scm (frame-bindings):
(frame-next-source, frame-call-representation): Fix a few locations
that thought that the frame-procedure will always be a VM
procedure. This will not not be the case when traversing the stack of
an application of a non-procedure.
* libguile/vm-i-system.c (call, tail-call, mv-call): Instead of
special-casing structs and smobs at these call sites, just set up the
stack, and jump to a generic apply loop if the proc is not a program.
* libguile/vm-engine.c: The generic apply loop is here. Also, the boot
program is now simply a boot continuation, and can handle any number
of arguments.
* libguile/vm.c (make_boot_program): Update the code that makes the boot
continuation.
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r-- | libguile/vm-i-system.c | 145 |
1 files changed, 44 insertions, 101 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index b8c18f077..5c808a08b 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -764,33 +764,8 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1) nargs = FETCH (); vm_call: - program = sp[-nargs]; - VM_HANDLE_INTERRUPTS; - if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) - { - if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) - { - sp[-nargs] = SCM_STRUCT_PROCEDURE (program); - goto vm_call; - } - else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob - && SCM_SMOB_APPLICABLE_P (program)) - { - PUSH (program); - prepare_smob_call (sp, ++nargs, program); - goto vm_call; - } - else - { - SYNC_ALL(); - vm_error_wrong_type_apply (program); - } - } - - CACHE_PROGRAM (); - { SCM *old_fp = fp; @@ -804,8 +779,16 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1) SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0); } - ip = SCM_C_OBJCODE_BASE (bp); PUSH_CONTINUATION_HOOK (); + + program = fp[-1]; + + if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) + goto apply; + + CACHE_PROGRAM (); + ip = SCM_C_OBJCODE_BASE (bp); + APPLY_HOOK (); NEXT; } @@ -815,53 +798,34 @@ VM_DEFINE_INSTRUCTION (54, tail_call, "tail-call", 1, -1, 1) nargs = FETCH (); vm_tail_call: - program = sp[-nargs]; - VM_HANDLE_INTERRUPTS; - if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) - { - if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) - { - sp[-nargs] = SCM_STRUCT_PROCEDURE (program); - goto vm_tail_call; - } - else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob - && SCM_SMOB_APPLICABLE_P (program)) - { - PUSH (program); - prepare_smob_call (sp, ++nargs, program); - goto vm_tail_call; - } - else - { - SYNC_ALL(); - vm_error_wrong_type_apply (program); - } - } - else - { - int i; + { + int i; #ifdef VM_ENABLE_STACK_NULLING - SCM *old_sp = sp; - CHECK_STACK_LEAK (); + SCM *old_sp = sp; + CHECK_STACK_LEAK (); #endif - /* switch programs */ - CACHE_PROGRAM (); - /* shuffle down the program and the arguments */ - for (i = -1, sp = sp - nargs + 1; i < nargs; i++) - SCM_FRAME_STACK_ADDRESS (fp)[i] = sp[i]; + /* shuffle down the program and the arguments */ + for (i = -1, sp = sp - nargs + 1; i < nargs; i++) + SCM_FRAME_STACK_ADDRESS (fp)[i] = sp[i]; - sp = fp + i - 1; + sp = fp + i - 1; - NULLSTACK (old_sp - sp); + NULLSTACK (old_sp - sp); + } - ip = SCM_C_OBJCODE_BASE (bp); + program = fp[-1]; - APPLY_HOOK (); - NEXT; - } + if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) + goto apply; + + CACHE_PROGRAM (); + ip = SCM_C_OBJCODE_BASE (bp); + + APPLY_HOOK (); + NEXT; } VM_DEFINE_INSTRUCTION (55, subr_call, "subr-call", 1, -1, -1) @@ -1071,54 +1035,33 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1) { scm_t_int32 offset; scm_t_uint8 *mvra; + SCM *old_fp = fp; nargs = FETCH (); FETCH_OFFSET (offset); mvra = ip + offset; - vm_mv_call: - program = sp[-nargs]; - VM_HANDLE_INTERRUPTS; - if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) - { - if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) - { - sp[-nargs] = SCM_STRUCT_PROCEDURE (program); - goto vm_mv_call; - } - else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob - && SCM_SMOB_APPLICABLE_P (program)) - { - PUSH (program); - prepare_smob_call (sp, ++nargs, program); - goto vm_mv_call; - } - else - { - SYNC_ALL(); - vm_error_wrong_type_apply (program); - } - } + fp = sp - nargs + 1; + + ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0); + ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); + ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); + SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp); + SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); + SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra); + + PUSH_CONTINUATION_HOOK (); - CACHE_PROGRAM (); + program = fp[-1]; - { - SCM *old_fp = fp; + if (SCM_UNLIKELY (!SCM_PROGRAM_P (program))) + goto apply; - fp = sp - nargs + 1; - - ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0); - ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0); - ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0); - SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp); - SCM_FRAME_SET_RETURN_ADDRESS (fp, ip); - SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra); - } - + CACHE_PROGRAM (); ip = SCM_C_OBJCODE_BASE (bp); - PUSH_CONTINUATION_HOOK (); + APPLY_HOOK (); NEXT; } |