connect a few more wires to promptenstein

* libguile/tags.h (scm_tc7_prompt): Allocate a tc7 for prompt objects.

* libguile/control.h (SCM_F_PROMPT_INLINE, SCM_F_PROMPT_ESCAPE)
  (SCM_PROMPT_P, SCM_PROMPT_FLAGS, SCM_PROMPT_INLINE_P)
  (SCM_PROMPT_ESCAPE_P, SCM_PROMPT_TAG, SCM_PROMPT_REGISTERS)
  (SCM_PROMPT_DYNENV, SCM_PROMPT_HANDLER)
  (SCM_PROMPT_PRE_UNWIND_HANDLER, SCM_PROMPT_SETJMP)
  (struct scm_prompt_registers):
* libguile/control.c (scm_c_make_prompt): Flesh out a simple prompts
  implementation.

* libguile/vm-i-system.c (prompt): Wire up the implementation.
* libguile/vm.c: Add a needed #include.

libguile/control.c

@@ -22,6 +22,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/control.h"
+#include "libguile/vm.h"
 
 
 
@@ -47,6 +48,36 @@ SCM_DEFINE (scm_atprompt, "@prompt", 4, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
+                   scm_t_uint8 inline_p, scm_t_uint8 escape_only_p)
+{
+  scm_t_bits tag;
+  SCM ret;
+  struct scm_prompt_registers *regs;
+
+  tag = scm_tc7_prompt;
+  if (inline_p)
+    tag |= SCM_F_PROMPT_INLINE;
+  if (escape_only_p)
+    tag |= SCM_F_PROMPT_ESCAPE;
+  ret = scm_words (tag, 6);
+
+  regs = scm_gc_malloc_pointerless (sizeof (*regs), "prompt registers");
+  regs->fp = SCM_VM_DATA (vm)->fp;
+  regs->sp = SCM_VM_DATA (vm)->sp;
+  regs->ip = SCM_VM_DATA (vm)->ip;
+
+  SCM_SET_CELL_OBJECT (ret, 1, k);
+  SCM_SET_CELL_WORD (ret, 2, (scm_t_bits)regs);
+  SCM_SET_CELL_OBJECT (ret, 3, scm_i_dynwinds ());
+  SCM_SET_CELL_OBJECT (ret, 4, handler);
+  SCM_SET_CELL_OBJECT (ret, 5, pre_unwind);
+
+  return ret;
+}
+
+
 
 
 static void

libguile/control.h

@@ -20,6 +20,34 @@
 #define SCM_CONTROL_H
 
 
+#define SCM_F_PROMPT_INLINE 0x1
+#define SCM_F_PROMPT_ESCAPE 0x2
+
+#define SCM_PROMPT_P(x)		(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_prompt)
+#define SCM_PROMPT_FLAGS(x)	(SCM_CELL_WORD ((x), 0) >> 8)
+#define SCM_PROMPT_INLINE_P(x)	(SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_INLINE)
+#define SCM_PROMPT_ESCAPE_P(x)	(SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
+#define SCM_PROMPT_TAG(x)	(SCM_CELL_OBJECT ((x), 1)
+#define SCM_PROMPT_REGISTERS(x)	((struct scm_prompt_registers*)SCM_CELL_WORD ((x), 2))
+#define SCM_PROMPT_DYNENV(x)	(SCM_CELL_OBJECT ((x), 3))
+#define SCM_PROMPT_HANDLER(x)	(SCM_CELL_OBJECT ((x), 4))
+#define SCM_PROMPT_PRE_UNWIND_HANDLER(x) (SCM_CELL_OBJECT ((x), 5))
+
+#define SCM_PROMPT_SETJMP(p)	(SCM_I_SETJMP (SCM_PROMPT_REGISTERS (p)->regs))
+
+struct scm_prompt_registers
+{
+  scm_t_uint8 *ip;
+  SCM *sp;
+  SCM *fp;
+  scm_i_jmp_buf regs;  
+};
+
+
+SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
+                                    scm_t_uint8 inline_p, scm_t_uint8 escape_only_p);
+
+
 SCM_INTERNAL void scm_register_control (void);
 
 

libguile/tags.h

@@ -421,7 +421,7 @@ typedef scm_t_uintptr scm_t_bits;
 #define scm_tc7_vm		55
 #define scm_tc7_vm_cont		71
 
-#define scm_tc7_unused_17	61
+#define scm_tc7_prompt		61
 #define scm_tc7_unused_21	63
 #define scm_tc7_unused_19	69
 #define scm_tc7_program		79

libguile/vm-i-system.c

@@ -1446,7 +1446,7 @@ 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;
+  SCM k, handler, pre_unwind, prompt;
 
   inline_handler_p = FETCH ();
   escape_only_p = FETCH ();
@@ -1458,9 +1458,11 @@ VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
   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))
+  /* FIXME: do more error checking */
+  prompt = scm_c_make_prompt (vm, k, handler, pre_unwind,
+                              inline_handler_p, escape_only_p);
+  scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
+  if (SCM_PROMPT_SETJMP (prompt))
     {
       /* 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

libguile/vm.c

@@ -28,6 +28,7 @@
 #include <gc/gc_mark.h>
 
 #include "_scm.h"
+#include "control.h"
 #include "frames.h"
 #include "instructions.h"
 #include "objcodes.h"
@@ -173,14 +174,6 @@ vm_dispatch_hook (SCM vm, int hook_num)
 /*
  * The dynamic stack
  */
-static SCM
-vm_prepare_prompt_jmpbuf (SCM vm, SCM k, SCM handler, SCM pre_unwind,
-                          scm_t_uint8 inline_p, scm_t_uint8 escape_only_p)
-{
-  abort ();
-  return SCM_BOOL_F;
-}
-
 #define VM_SETJMP(jmpbuf) 0
 
 static void vm_throw (SCM vm, SCM k, SCM args) SCM_NORETURN;