summaryrefslogtreecommitdiff
path: root/libguile/vm-i-system.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/vm-i-system.c')
-rw-r--r--libguile/vm-i-system.c81
1 files changed, 81 insertions, 0 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 8c280fd28..258aa529e 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1433,6 +1433,87 @@ VM_DEFINE_INSTRUCTION (82, make_symbol, "make-symbol", 0, 1, 1)
NEXT;
}
+VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
+{
+ scm_t_int32 offset;
+ scm_t_uint8 inline_handler_p, escape_only_p;
+ SCM k, handler, pre_unwind, jmpbuf;
+
+ inline_handler_p = FETCH ();
+ escape_only_p = FETCH ();
+ FETCH_OFFSET (offset);
+ POP (pre_unwind);
+ POP (handler);
+ POP (k);
+
+ SYNC_REGISTER ();
+ /* Push the prompt onto the dynamic stack. The setjmp itself has to be local
+ to this procedure. */
+ jmpbuf = vm_prepare_prompt_jmpbuf (vm, k, handler, pre_unwind,
+ inline_handler_p, escape_only_p);
+ if (VM_SETJMP (jmpbuf))
+ {
+ /* The prompt exited nonlocally. Cache the regs back from the vp, and go
+ to the handler or post-handler label. (The meaning of the label differs
+ depending on whether the prompt's handler is rendered inline or not.)
+ */
+ CACHE_REGISTER (); /* Really we only need SP. FP and IP should be
+ unmodified. */
+ ip += offset;
+ NEXT;
+ }
+
+ /* Otherwise setjmp returned for the first time, so we go to execute the
+ prompt's body. */
+ NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (85, wind, "wind", 0, 2, 0)
+{
+ SCM wind, unwind;
+ POP (unwind);
+ POP (wind);
+ SYNC_REGISTER ();
+ /* Push wind and unwind procedures onto the dynamic stack. Note that neither
+ are actually called; the compiler should emit calls to wind and unwind for
+ the normal dynamic-wind control flow. */
+ if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (wind))))
+ {
+ finish_args = wind;
+ goto vm_error_not_a_thunk;
+ }
+ if (SCM_UNLIKELY (scm_is_false (scm_thunk_p (unwind))))
+ {
+ finish_args = unwind;
+ goto vm_error_not_a_thunk;
+ }
+ scm_i_set_dynwinds (scm_cons (scm_cons (wind, unwind), scm_i_dynwinds ()));
+ NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (86, throw, "throw", 1, -1, -1)
+{
+ unsigned n = FETCH ();
+ SCM k;
+ SCM args;
+ POP_LIST (n);
+ POP (args);
+ POP (k);
+ SYNC_REGISTER ();
+ vm_throw (vm, k, args);
+ /* vm_throw should not return */
+ abort ();
+}
+
+VM_DEFINE_INSTRUCTION (87, unwind, "unwind", 0, 0, 0)
+{
+ /* A normal exit from the dynamic extent of an expression. Pop the top entry
+ off of the dynamic stack. */
+ scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
+ NEXT;
+}
+
+
/*
(defun renumber-ops ()