Remove push continuation hook; return hook runs before FP pop

* libguile/frames.c (scm_frame_return_values): New function, for use
  when a frame is at "return-values".
  (scm_init_frames_builtins): Register frame-return-values.
* libguile/vm-engine.c (RETURN_HOOK): Rename from POP_CONTINUATION_HOOK.
  (call, call-label): Remove PUSH_CONTINUATION_HOOK; it's unneeded, as
  you can always check the FP from an apply hook.
  (return-values): Run return hook before popping frame.
* libguile/vm.c (vm_dispatch_return_hook): Rename from
  vm_dispatch_pop_continuation_hook.  Remove push continuation hook.
  (scm_vm_return_hook):
* libguile/vm.h (SCM_VM_PUSH_CONTINUATION_HOOK): Remove.
  (SCM_VM_RETURN_HOOK): Rename from SCM_VM_POP_CONTINUATION_HOOK.
* module/system/vm/frame.scm (frame-return-values): Export.
* module/system/vm/trace.scm (print-return, trace-calls-to-procedure)
  (trace-calls-in-procedure): Adapt to not receiving values as
  arguments.
* module/system/vm/traps.scm (trap-in-procedure, trap-frame-finish):
  Adapt to return hook coming from returning frame.
  (program-sources-by-line): Update to use match instead of pmatch.
* module/system/vm/traps.scm (trap-in-dynamic-extent)
  (trap-calls-to-procedure): Adapt to return hook not receiving values.
* module/system/vm/vm.scm: Remove push continuation hook and rename
  return hook.

1 files changed, 31 insertions, 0 deletions

diff --git a/libguile/frames.c b/libguile/frames.c
index d989d6292..0ad40edd3 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -28,8 +28,10 @@
 #include "eval.h"
 #include "extensions.h"
 #include "gsubr.h"
+#include "instructions.h"
 #include "modules.h"
 #include "numbers.h"
+#include "pairs.h"
 #include "ports.h"
 #include "symbols.h"
 #include "threads.h"
@@ -328,6 +330,33 @@ scm_frame_local_set_x (SCM frame, SCM index, SCM val, SCM representation)
 }
 #undef FUNC_NAME
 
+static const char s_scm_frame_return_values[] = "frame-return-values";
+static SCM
+scm_frame_return_values (SCM frame)
+#define FUNC_NAME s_scm_frame_return_values
+{
+  const uint32_t *ip;
+  union scm_vm_stack_element *fp, *sp;
+  SCM vals = SCM_EOL;
+  size_t n;
+
+  SCM_VALIDATE_VM_FRAME (1, frame);
+
+  ip = SCM_VM_FRAME_IP (frame);
+  fp = SCM_VM_FRAME_FP (frame);
+  sp = SCM_VM_FRAME_SP (frame);
+
+  if ((*ip & 0xff) != scm_op_return_values)
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, frame, "not a return frame");
+
+  n = SCM_FRAME_NUM_LOCALS (fp, sp);
+  while (n--)
+    vals = scm_cons (SCM_FRAME_LOCAL (fp, n), vals);
+
+  return vals;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_frame_address, "frame-address", 1, 0, 0,
 	    (SCM frame),
 	    "Return the frame pointer for @var{frame}.")
@@ -442,6 +471,8 @@ scm_init_frames_builtins (void *unused)
                       (scm_t_subr) scm_frame_local_ref);
   scm_c_define_gsubr (s_scm_frame_local_set_x, 4, 0, 0,
                       (scm_t_subr) scm_frame_local_set_x);
+  scm_c_define_gsubr (s_scm_frame_return_values, 1, 0, 0,
+                      (scm_t_subr) scm_frame_return_values);
 }
 
 void