diff options
author | Andy Wingo <wingo@pobox.com> | 2012-05-10 13:02:11 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-05-10 13:02:11 +0200 |
commit | 968a9add65c5e3a33ab9f5b7697051c5b9282060 (patch) | |
tree | f793baeb1f36037956c161c0ddc168fdbe5ec387 /libguile/vm-engine.c | |
parent | a3ded46520b35a8dbda22097b74792b8282d12ce (diff) | |
parent | 67b699cc77d5e2f74daca77aa26b1ba8af0d0808 (diff) | |
download | guile-968a9add65c5e3a33ab9f5b7697051c5b9282060.tar.gz |
Merge remote-tracking branch 'local-2.0/stable-2.0'
Conflicts:
libguile/vm-engine.c
libguile/vm-i-system.c
libguile/vm.c
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r-- | libguile/vm-engine.c | 74 |
1 files changed, 49 insertions, 25 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 4b6c98a1f..159310250 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -104,31 +104,55 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs) NEXT; } - /* Initialization */ - { - SCM prog = program; - - /* Boot program */ - program = vm_make_boot_program (nargs); - - /* Initial frame */ - CACHE_REGISTER (); - PUSH (SCM_PACK (fp)); /* dynamic link */ - PUSH (SCM_PACK (0)); /* mvra */ - PUSH (SCM_PACK (ip)); /* ra */ - CACHE_PROGRAM (); - PUSH (program); - fp = sp + 1; - ip = SCM_C_OBJCODE_BASE (bp); - /* MV-call frame, function & arguments */ - PUSH (SCM_PACK (0)); /* dynamic link */ - PUSH (SCM_PACK (0)); /* mvra */ - PUSH (SCM_PACK (0)); /* ra */ - PUSH (prog); - VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs)); - while (nargs--) - PUSH (*argv++); - } + /* Initial frame */ + CACHE_REGISTER (); + PUSH (SCM_PACK (fp)); /* dynamic link */ + PUSH (SCM_PACK (0)); /* mvra */ + PUSH (SCM_PACK (ip)); /* ra */ + PUSH (boot_continuation); + fp = sp + 1; + ip = SCM_C_OBJCODE_BASE (SCM_PROGRAM_DATA (boot_continuation)); + + /* MV-call frame, function & arguments */ + PUSH (SCM_PACK (fp)); /* dynamic link */ + PUSH (SCM_PACK (ip + 1)); /* mvra */ + PUSH (SCM_PACK (ip)); /* ra */ + PUSH (program); + fp = sp + 1; + VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs)); + while (nargs--) + PUSH (*argv++); + + PUSH_CONTINUATION_HOOK (); + + apply: + program = fp[-1]; + if (!SCM_PROGRAM_P (program)) + { + if (SCM_STRUCTP (program) && SCM_STRUCT_APPLICABLE_P (program)) + fp[-1] = SCM_STRUCT_PROCEDURE (program); + else if (SCM_HAS_TYP7 (program, scm_tc7_smob) + && SCM_SMOB_APPLICABLE_P (program)) + { + /* (smob arg0 ... argN) => (apply-smob smob arg0 ... argN) */ + int i; + PUSH (SCM_BOOL_F); + for (i = sp - fp; i >= 0; i--) + fp[i] = fp[i - 1]; + fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline; + } + else + { + SYNC_ALL(); + vm_error_wrong_type_apply (program); + } + goto apply; + } + + CACHE_PROGRAM (); + ip = SCM_C_OBJCODE_BASE (bp); + + APPLY_HOOK (); /* Let's go! */ NEXT; |