jump_table = jump_table_pointer;
#endif
- /* 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++);
- }
+ if (SCM_I_SETJMP (registers))
+ {
+ /* Non-local return. Cache the VM registers back from the vp, and
+ go to the handler.
+
+ Note, at this point, we must assume that any variable local to
+ vm_engine that can be assigned *has* been assigned. So we need to pull
+ all our state back from the ip/fp/sp.
+ */
+ CACHE_REGISTER ();
+ program = SCM_FRAME_PROGRAM (fp);
+ CACHE_PROGRAM ();
+ /* The stack contains the values returned to this continuation,
+ along with a number-of-values marker -- like an MV return. */
+ ABORT_CONTINUATION_HOOK ();
+ NEXT;
+ }
+
- else if (SCM_NIMP (program) && SCM_TYP7 (program) == scm_tc7_smob
+ /* 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);
- fp[-1] = SCM_SMOB_DESCRIPTOR (program).apply_trampoline_objcode;
++ 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;
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_HAS_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)
+VM_DEFINE_INSTRUCTION (57, subr_call, "subr-call", 1, -1, -1)
{
SCM pointer, ret;
SCM (*subr)();
return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
}
-
- const scm_t_uint8 text[] = {
+
+ static SCM
+ make_boot_program (void)
+ {
+ struct scm_objcode *bp;
+ size_t bp_size;
+ SCM u8vec, ret;
- u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp, bp_size);
++
++ const scm_t_uint8 text[] = {
+ scm_op_make_int8_1,
+ scm_op_halt
+ };
+
+ bp_size = sizeof (struct scm_objcode) + sizeof (text);
+ bp = scm_gc_malloc_pointerless (bp_size, "boot-program");
+ memcpy (SCM_C_OBJCODE_BASE (bp), text, sizeof (text));
+ bp->len = sizeof(text);
+ bp->metalen = 0;
+
++ u8vec = scm_c_take_gc_bytevector ((scm_t_int8*)bp, bp_size, SCM_BOOL_F);
+ ret = scm_make_program (scm_bytecode_to_native_objcode (u8vec),
+ SCM_BOOL_F, SCM_BOOL_F);
+ SCM_SET_CELL_WORD_0 (ret, (SCM_CELL_WORD_0 (ret) | SCM_F_PROGRAM_IS_BOOT));
+
+ return ret;
+ }
+
void
scm_bootstrap_vm (void)
{