VM_DEFINE_INSTRUCTION (halt, "halt", 0, 0, 0)
{
- SCM ret = *sp;
+ SCM ret;
vp->time += scm_c_get_internal_run_time () - start_time;
HALT_HOOK ();
+ POP (ret);
FREE_FRAME ();
SYNC_ALL ();
+ vp->ip = NULL;
+ scm_dynwind_end ();
return ret;
}
+VM_DEFINE_INSTRUCTION (break, "break", 0, 0, 0)
+{
+ BREAK_HOOK ();
+ NEXT;
+}
+
VM_DEFINE_INSTRUCTION (drop, "drop", 0, 0, 0)
{
DROP ();
VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
{
- PUSH (SCM_MAKINUM ((signed char) FETCH ()));
+ PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
NEXT;
}
VM_DEFINE_INSTRUCTION (make_int8_0, "make-int8:0", 0, 0, 1)
{
- PUSH (SCM_MAKINUM (0));
+ PUSH (SCM_INUM0);
NEXT;
}
VM_DEFINE_INSTRUCTION (make_int8_1, "make-int8:1", 0, 0, 1)
{
- PUSH (SCM_MAKINUM (1));
+ PUSH (SCM_I_MAKINUM (1));
NEXT;
}
{
int h = FETCH ();
int l = FETCH ();
- PUSH (SCM_MAKINUM ((signed short) (h << 8) + l));
+ PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
NEXT;
}
NEXT;
}
-VM_DEFINE_INSTRUCTION (list, "list", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (list, "list", 2, -1, 1)
{
- int n = FETCH ();
- POP_LIST (n);
+ unsigned h = FETCH ();
+ unsigned l = FETCH ();
+ unsigned len = ((h << 8) + l);
+ POP_LIST (len);
NEXT;
}
-VM_DEFINE_INSTRUCTION (vector, "vector", 1, -1, 1)
+VM_DEFINE_INSTRUCTION (vector, "vector", 2, -1, 1)
{
- int n = FETCH ();
- POP_LIST (n);
+ unsigned h = FETCH ();
+ unsigned l = FETCH ();
+ unsigned len = ((h << 8) + l);
+ POP_LIST (len);
*sp = scm_vector (*sp);
NEXT;
}
#define OBJECT_REF(i) objects[i]
#define OBJECT_SET(i,o) objects[i] = o
-#define LOCAL_REF(i) SCM_VM_FRAME_VARIABLE (fp, i)
-#define LOCAL_SET(i,o) SCM_VM_FRAME_VARIABLE (fp, i) = o
+#define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i)
+#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o
-#define VARIABLE_REF(v) SCM_CDR (v)
-#define VARIABLE_SET(v,o) SCM_SETCDR (v, o)
+/* For the variable operations, we _must_ obviously avoid function calls to
+ `scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
+ nothing more than the corresponding macros. */
+#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
+#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
+#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
/* ref */
VM_DEFINE_INSTRUCTION (object_ref, "object-ref", 1, 0, 1)
{
- PUSH (OBJECT_REF (FETCH ()));
+ register unsigned objnum = FETCH ();
+ CHECK_OBJECT (objnum);
+ PUSH (OBJECT_REF (objnum));
NEXT;
}
VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
{
SCM x = *sp;
- SCM o = VARIABLE_REF (x);
- if (SCM_UNBNDP (o))
+
+ if (!VARIABLE_BOUNDP (x))
{
- err_args = SCM_LIST1 (SCM_CAR (x));
+ err_args = SCM_LIST1 (x);
+ /* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
goto vm_error_unbound;
}
- *sp = o;
+ else
+ {
+ SCM o = VARIABLE_REF (x);
+ *sp = o;
+ }
+
+ NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (late_variable_ref, "late-variable-ref", 1, 0, 1)
+{
+ unsigned objnum = FETCH ();
+ SCM pair_or_var;
+ CHECK_OBJECT (objnum);
+ pair_or_var = OBJECT_REF (objnum);
+
+ if (!SCM_VARIABLEP (pair_or_var))
+ {
+ SYNC_REGISTER ();
+ /* either one of these calls might longjmp */
+ SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+ pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+ OBJECT_SET (objnum, pair_or_var);
+ if (!VARIABLE_BOUNDP (pair_or_var))
+ {
+ err_args = SCM_LIST1 (pair_or_var);
+ goto vm_error_unbound;
+ }
+ }
+
+ PUSH (VARIABLE_REF (pair_or_var));
NEXT;
}
VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
{
VARIABLE_SET (sp[0], sp[-1]);
- scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
sp -= 2;
NEXT;
}
+VM_DEFINE_INSTRUCTION (late_variable_set, "late-variable-set", 1, 1, 0)
+{
+ unsigned objnum = FETCH ();
+ SCM pair_or_var;
+ CHECK_OBJECT (objnum);
+ pair_or_var = OBJECT_REF (objnum);
+
+ if (!SCM_VARIABLEP (pair_or_var))
+ {
+ SYNC_BEFORE_GC ();
+ SCM mod = scm_resolve_module (SCM_CAR (pair_or_var));
+ /* module_lookup might longjmp */
+ pair_or_var = scm_module_lookup (mod, SCM_CDR (pair_or_var));
+ OBJECT_SET (objnum, pair_or_var);
+ }
+
+ VARIABLE_SET (pair_or_var, *sp);
+ DROP ();
+ NEXT;
+}
+
\f
/*
* branch and jump
APPLY_HOOK ();
NEXT;
}
+#ifdef ENABLE_TRAMPOLINE
+ /* Seems to slow down the fibo test, dunno why */
+ /*
+ * Subr call
+ */
+ switch (nargs)
+ {
+ case 0:
+ {
+ scm_t_trampoline_0 call = scm_trampoline_0 (x);
+ if (call)
+ {
+ SYNC_ALL ();
+ *sp = call (x);
+ NEXT;
+ }
+ break;
+ }
+ case 1:
+ {
+ scm_t_trampoline_1 call = scm_trampoline_1 (x);
+ if (call)
+ {
+ SCM arg1;
+ POP (arg1);
+ SYNC_ALL ();
+ *sp = call (x, arg1);
+ NEXT;
+ }
+ break;
+ }
+ case 2:
+ {
+ scm_t_trampoline_2 call = scm_trampoline_2 (x);
+ if (call)
+ {
+ SCM arg1, arg2;
+ POP (arg2);
+ POP (arg1);
+ SYNC_ALL ();
+ *sp = call (x, arg1, arg2);
+ NEXT;
+ }
+ break;
+ }
+ }
+#endif
/*
- * Function call
+ * 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);
NEXT;
}
*/
if (SCM_VM_CONT_P (x))
{
+ program = x;
vm_call_cc:
/* Check the number of arguments */
if (nargs != 1)
- scm_wrong_num_args (x);
+ scm_wrong_num_args (program);
/* Reinstate the continuation */
EXIT_HOOK ();
- reinstate_vm_cont (vp, x);
+ reinstate_vm_cont (vp, program);
CACHE_REGISTER ();
- program = SCM_VM_FRAME_PROGRAM (fp);
+ program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
NEXT;
}
VM_DEFINE_INSTRUCTION (tail_call, "tail-call", 1, -1, 1)
{
- SCM x;
+ register SCM x;
nargs = FETCH ();
x = sp[-nargs];
sp -= bp->nargs - 1;
for (i = 0; i < bp->nargs; i++)
LOCAL_SET (i, sp[i]);
- sp--;
+
+ /* Drop the first argument and the program itself. */
+ sp -= 2;
/* Call itself */
ip = bp->base;
*/
if (SCM_PROGRAM_P (x))
{
- SCM *limit = sp;
- SCM *base = sp - nargs - 1;
-
- /* Exit the current frame */
EXIT_HOOK ();
FREE_FRAME ();
-
- /* Move arguments */
- while (base < limit)
- *++sp = *++base;
-
- /* Call the program */
program = x;
goto vm_call_program;
}
+#ifdef ENABLE_TRAMPOLINE
+ /* This seems to actually slow down the fibo test -- dunno why */
+ /*
+ * Subr call
+ */
+ switch (nargs)
+ {
+ case 0:
+ {
+ scm_t_trampoline_0 call = scm_trampoline_0 (x);
+ if (call)
+ {
+ SYNC_ALL ();
+ *sp = call (x);
+ goto vm_return;
+ }
+ break;
+ }
+ case 1:
+ {
+ scm_t_trampoline_1 call = scm_trampoline_1 (x);
+ if (call)
+ {
+ SCM arg1;
+ POP (arg1);
+ SYNC_ALL ();
+ *sp = call (x, arg1);
+ goto vm_return;
+ }
+ break;
+ }
+ case 2:
+ {
+ scm_t_trampoline_2 call = scm_trampoline_2 (x);
+ if (call)
+ {
+ SCM arg1, arg2;
+ POP (arg2);
+ POP (arg1);
+ SYNC_ALL ();
+ *sp = call (x, arg1, arg2);
+ goto vm_return;
+ }
+ break;
+ }
+ }
+#endif
+
/*
- * Function call
+ * Other interpreted or compiled call
*/
if (!SCM_FALSEP (scm_procedure_p (x)))
{
SCM args;
POP_LIST (nargs);
POP (args);
+ SYNC_REGISTER ();
*sp = scm_apply (x, args, SCM_EOL);
goto vm_return;
}
+
+ program = x;
+
/*
* Continuation call
*/
- if (SCM_VM_CONT_P (x))
+ if (SCM_VM_CONT_P (program))
goto vm_call_cc;
- program = x;
goto vm_error_wrong_type_apply;
}
VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
{
- SCM ret;
vm_return:
- ret = *sp;
EXIT_HOOK ();
RETURN_HOOK ();
FREE_FRAME ();
/* Restore the last program */
- program = SCM_VM_FRAME_PROGRAM (fp);
+ program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
- external = fp[bp->nargs + bp->nlocs];
- PUSH (ret);
+ CACHE_EXTERNAL ();
+ CHECK_IP ();
NEXT;
}
HCoop / bpt / guile.git / blobdiff