Adapt GDB integration to newest patches
[bpt/guile.git] / libguile / control.c
index 7120ffe..347d697 100644 (file)
 
 /* Only to be called if the SCM_I_SETJMP returns 1 */
 SCM
-scm_i_prompt_pop_abort_args_x (SCM vm)
+scm_i_prompt_pop_abort_args_x (struct scm_vm *vp)
 {
   size_t i, n;
   SCM vals = SCM_EOL;
 
-  n = scm_to_size_t (SCM_VM_DATA (vm)->sp[0]);
+  n = scm_to_size_t (vp->sp[0]);
   for (i = 0; i < n; i++)
-    vals = scm_cons (SCM_VM_DATA (vm)->sp[-(i + 1)], vals);
+    vals = scm_cons (vp->sp[-(i + 1)], vals);
 
   /* The abort did reset the VM's registers, but then these values
      were pushed on; so we need to pop them ourselves. */
-  SCM_VM_DATA (vm)->sp -= n + 1;
+  vp->sp -= n + 1;
   /* FIXME NULLSTACK */
 
   return vals;
@@ -59,7 +59,7 @@ scm_i_prompt_pop_abort_args_x (SCM vm)
 
 static const scm_t_uint32 compose_continuation_code[] =
   {
-    SCM_PACK_RTL_24 (scm_rtl_op_compose_continuation, 0)
+    SCM_PACK_OP_24 (compose_continuation, 0)
   };
 
 
@@ -70,16 +70,18 @@ make_partial_continuation (SCM vm_cont)
   scm_t_bits flags = SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION;
   SCM ret;
 
-  ret = scm_words (scm_tc7_rtl_program | (nfree << 16) | flags, nfree + 2);
+  ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
   SCM_SET_CELL_WORD_1 (ret, compose_continuation_code);
-  SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
+  SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
 
   return ret;
 }
 
 static SCM
-reify_partial_continuation (SCM vm,
-                            SCM *saved_fp, SCM *saved_sp, scm_t_uint8 *saved_ip,
+reify_partial_continuation (struct scm_vm *vp,
+                            SCM *saved_fp,
+                            SCM *saved_sp,
+                            scm_t_uint32 *saved_ip,
                             scm_i_jmp_buf *saved_registers,
                             scm_t_dynstack *dynstack,
                             scm_i_jmp_buf *current_registers)
@@ -101,20 +103,18 @@ reify_partial_continuation (SCM vm,
      could determine the stack bottom in O(1) time, but that's no longer
      the case, since the thunk application doesn't occur where the
      prompt is saved.  */
-  for (bottom_fp = SCM_VM_DATA (vm)->fp;
+  for (bottom_fp = vp->fp;
        SCM_FRAME_DYNAMIC_LINK (bottom_fp) > saved_fp;
        bottom_fp = SCM_FRAME_DYNAMIC_LINK (bottom_fp));
 
   if (SCM_FRAME_DYNAMIC_LINK (bottom_fp) != saved_fp)
     abort();
 
-  /* Capture from the top of the thunk application frame up to the end. Set an
-     MVRA only, as the post-abort code is in an MV context. */
-  vm_cont = scm_i_vm_capture_stack (bottom_fp - 1,
-                                    SCM_VM_DATA (vm)->fp,
-                                    SCM_VM_DATA (vm)->sp,
-                                    NULL,
-                                    SCM_VM_DATA (vm)->ip,
+  /* Capture from the top of the thunk application frame up to the end. */
+  vm_cont = scm_i_vm_capture_stack (&SCM_FRAME_LOCAL (bottom_fp, 0),
+                                    vp->fp,
+                                    vp->sp,
+                                    vp->ip,
                                     dynstack,
                                     flags);
 
@@ -122,24 +122,29 @@ reify_partial_continuation (SCM vm,
 }
 
 void
-scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
+scm_c_abort (struct scm_vm *vp, SCM tag, size_t n, SCM *argv,
              scm_i_jmp_buf *current_registers)
 {
   SCM cont;
   scm_t_dynstack *dynstack = &SCM_I_CURRENT_THREAD->dynstack;
   scm_t_bits *prompt;
   scm_t_dynstack_prompt_flags flags;
+  scm_t_ptrdiff fp_offset, sp_offset;
   SCM *fp, *sp;
-  scm_t_uint8 *ip;
+  scm_t_uint32 *ip;
   scm_i_jmp_buf *registers;
   size_t i;
 
   prompt = scm_dynstack_find_prompt (dynstack, tag,
-                                     &flags, &fp, &sp, &ip, &registers);
+                                     &flags, &fp_offset, &sp_offset, &ip,
+                                     &registers);
 
   if (!prompt)
     scm_misc_error ("abort", "Abort to unknown prompt", scm_list_1 (tag));
 
+  fp = vp->stack_base + fp_offset;
+  sp = vp->stack_base + sp_offset;
+
   /* Only reify if the continuation referenced in the handler. */
   if (flags & SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY)
     cont = SCM_BOOL_F;
@@ -148,32 +153,28 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
       scm_t_dynstack *captured;
 
       captured = scm_dynstack_capture (dynstack, SCM_DYNSTACK_NEXT (prompt));
-      cont = reify_partial_continuation (vm, fp, sp, ip, registers, captured,
+      cont = reify_partial_continuation (vp, fp, sp, ip, registers, captured,
                                          current_registers);
     }
 
   /* Unwind.  */
   scm_dynstack_unwind (dynstack, prompt);
 
-  /* Unwinding may have changed the current thread's VM, so use the
-     new one.  */
-  vm = scm_the_vm ();
-
   /* Restore VM regs */
-  SCM_VM_DATA (vm)->fp = fp;
-  SCM_VM_DATA (vm)->sp = sp;
-  SCM_VM_DATA (vm)->ip = ip;
+  vp->fp = fp;
+  vp->sp = sp;
+  vp->ip = ip;
 
   /* Since we're jumping down, we should always have enough space.  */
-  if (SCM_VM_DATA (vm)->sp + n + 1 >= SCM_VM_DATA (vm)->stack_limit)
+  if (vp->sp + n + 1 >= vp->stack_limit)
     abort ();
 
   /* Push vals */
-  *(++(SCM_VM_DATA (vm)->sp)) = cont;
+  *(++(vp->sp)) = cont;
   for (i = 0; i < n; i++)
-    *(++(SCM_VM_DATA (vm)->sp)) = argv[i];
+    *(++(vp->sp)) = argv[i];
   if (flags & SCM_F_DYNSTACK_PROMPT_PUSH_NARGS)
-    *(++(SCM_VM_DATA (vm)->sp)) = scm_from_size_t (n+1); /* +1 for continuation */
+    *(++(vp->sp)) = scm_from_size_t (n+1); /* +1 for continuation */
 
   /* Jump! */
   SCM_I_LONGJMP (*registers, 1);