mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 03:30:27 +02:00
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.
This commit is contained in:
Andy Wingo
parent
dedf73d370
commit
f4c50447dd
8 changed files with 132 additions and 110 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -126,8 +126,7 @@
|
|||
#define RUN_HOOK1(h, arg) RUN_HOOK (vm_dispatch_##h##_hook (thread, arg))
|
||||
|
||||
#define APPLY_HOOK() RUN_HOOK0 (apply)
|
||||
#define PUSH_CONTINUATION_HOOK() RUN_HOOK0 (push_continuation)
|
||||
#define POP_CONTINUATION_HOOK(old_fp) RUN_HOOK1 (pop_continuation, old_fp)
|
||||
#define RETURN_HOOK() RUN_HOOK0 (return)
|
||||
#define NEXT_HOOK() RUN_HOOK0 (next)
|
||||
#define ABORT_CONTINUATION_HOOK() RUN_HOOK0 (abort)
|
||||
|
||||
|
|
@ -367,8 +366,6 @@ VM_NAME (scm_thread *thread)
|
|||
UNPACK_24 (op, proc);
|
||||
UNPACK_24 (ip[1], nlocals);
|
||||
|
||||
PUSH_CONTINUATION_HOOK ();
|
||||
|
||||
old_fp = VP->fp;
|
||||
VP->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
|
||||
SCM_FRAME_SET_DYNAMIC_LINK (VP->fp, old_fp);
|
||||
|
|
@ -409,8 +406,6 @@ VM_NAME (scm_thread *thread)
|
|||
UNPACK_24 (ip[1], nlocals);
|
||||
label = ip[2];
|
||||
|
||||
PUSH_CONTINUATION_HOOK ();
|
||||
|
||||
old_fp = VP->fp;
|
||||
VP->fp = SCM_FRAME_SLOT (old_fp, proc - 1);
|
||||
SCM_FRAME_SET_DYNAMIC_LINK (VP->fp, old_fp);
|
||||
|
|
@ -569,6 +564,8 @@ VM_NAME (scm_thread *thread)
|
|||
union scm_vm_stack_element *old_fp;
|
||||
size_t frame_size = 3;
|
||||
|
||||
RETURN_HOOK ();
|
||||
|
||||
old_fp = VP->fp;
|
||||
ip = SCM_FRAME_VIRTUAL_RETURN_ADDRESS (VP->fp);
|
||||
VP->fp = SCM_FRAME_DYNAMIC_LINK (VP->fp);
|
||||
|
|
@ -577,8 +574,6 @@ VM_NAME (scm_thread *thread)
|
|||
while (frame_size--)
|
||||
old_fp[frame_size].as_scm = SCM_BOOL_F;
|
||||
|
||||
POP_CONTINUATION_HOOK (old_fp);
|
||||
|
||||
NEXT (0);
|
||||
}
|
||||
|
||||
|
|
@ -3014,8 +3009,7 @@ VM_NAME (scm_thread *thread)
|
|||
#undef SP_SET
|
||||
#undef NEXT
|
||||
#undef NEXT_HOOK
|
||||
#undef POP_CONTINUATION_HOOK
|
||||
#undef PUSH_CONTINUATION_HOOK
|
||||
#undef RETURN_HOOK
|
||||
#undef RUN_HOOK
|
||||
#undef RUN_HOOK0
|
||||
#undef RUN_HOOK1
|
||||
|
|
|
|||
|
|
@ -196,9 +196,7 @@ scm_i_capture_current_stack (void)
|
|||
}
|
||||
|
||||
static void vm_dispatch_apply_hook (scm_thread *thread) SCM_NOINLINE;
|
||||
static void vm_dispatch_push_continuation_hook (scm_thread *thread) SCM_NOINLINE;
|
||||
static void vm_dispatch_pop_continuation_hook
|
||||
(scm_thread *thread, union scm_vm_stack_element *old_fp) SCM_NOINLINE;
|
||||
static void vm_dispatch_return_hook (scm_thread *thread) SCM_NOINLINE;
|
||||
static void vm_dispatch_next_hook (scm_thread *thread) SCM_NOINLINE;
|
||||
static void vm_dispatch_abort_hook (scm_thread *thread) SCM_NOINLINE;
|
||||
|
||||
|
|
@ -285,21 +283,18 @@ vm_dispatch_apply_hook (scm_thread *thread)
|
|||
{
|
||||
return vm_dispatch_hook (thread, SCM_VM_APPLY_HOOK, 0);
|
||||
}
|
||||
static void vm_dispatch_push_continuation_hook (scm_thread *thread)
|
||||
static void
|
||||
vm_dispatch_return_hook (scm_thread *thread)
|
||||
{
|
||||
return vm_dispatch_hook (thread, SCM_VM_PUSH_CONTINUATION_HOOK, 0);
|
||||
return vm_dispatch_hook (thread, SCM_VM_RETURN_HOOK, 0);
|
||||
}
|
||||
static void vm_dispatch_pop_continuation_hook (scm_thread *thread,
|
||||
union scm_vm_stack_element *old_fp)
|
||||
{
|
||||
return vm_dispatch_hook (thread, SCM_VM_POP_CONTINUATION_HOOK,
|
||||
SCM_FRAME_NUM_LOCALS (old_fp, thread->vm.sp));
|
||||
}
|
||||
static void vm_dispatch_next_hook (scm_thread *thread)
|
||||
static void
|
||||
vm_dispatch_next_hook (scm_thread *thread)
|
||||
{
|
||||
return vm_dispatch_hook (thread, SCM_VM_NEXT_HOOK, 0);
|
||||
}
|
||||
static void vm_dispatch_abort_hook (scm_thread *thread)
|
||||
static void
|
||||
vm_dispatch_abort_hook (scm_thread *thread)
|
||||
{
|
||||
return vm_dispatch_hook (thread, SCM_VM_ABORT_CONTINUATION_HOOK,
|
||||
SCM_FRAME_NUM_LOCALS (thread->vm.fp, thread->vm.sp));
|
||||
|
|
@ -1023,9 +1018,6 @@ push_interrupt_frame (scm_thread *thread, uint8_t *mra)
|
|||
size_t old_frame_size = frame_locals_count (thread);
|
||||
SCM proc = scm_i_async_pop (thread);
|
||||
|
||||
/* No PUSH_CONTINUATION_HOOK, as we can't usefully
|
||||
POP_CONTINUATION_HOOK because there are no return values. */
|
||||
|
||||
/* Reserve space for frame and callee. */
|
||||
alloc_frame (thread, old_frame_size + frame_overhead + 1);
|
||||
|
||||
|
|
@ -1464,21 +1456,12 @@ SCM_DEFINE (scm_vm_apply_hook, "vm-apply-hook", 0, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_vm_push_continuation_hook, "vm-push-continuation-hook", 0, 0, 0,
|
||||
SCM_DEFINE (scm_vm_return_hook, "vm-return-hook", 0, 0, 0,
|
||||
(void),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_vm_push_continuation_hook
|
||||
#define FUNC_NAME s_scm_vm_return_hook
|
||||
{
|
||||
VM_DEFINE_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_vm_pop_continuation_hook, "vm-pop-continuation-hook", 0, 0, 0,
|
||||
(void),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_vm_pop_continuation_hook
|
||||
{
|
||||
VM_DEFINE_HOOK (SCM_VM_POP_CONTINUATION_HOOK);
|
||||
VM_DEFINE_HOOK (SCM_VM_RETURN_HOOK);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
|
|||
|
|
@ -27,8 +27,7 @@
|
|||
|
||||
enum {
|
||||
SCM_VM_APPLY_HOOK,
|
||||
SCM_VM_PUSH_CONTINUATION_HOOK,
|
||||
SCM_VM_POP_CONTINUATION_HOOK,
|
||||
SCM_VM_RETURN_HOOK,
|
||||
SCM_VM_NEXT_HOOK,
|
||||
SCM_VM_ABORT_CONTINUATION_HOOK,
|
||||
SCM_VM_NUM_HOOKS,
|
||||
|
|
@ -68,8 +67,7 @@ SCM_API SCM scm_call_with_stack_overflow_handler (SCM limit, SCM thunk,
|
|||
SCM handler);
|
||||
|
||||
SCM_API SCM scm_vm_apply_hook (void);
|
||||
SCM_API SCM scm_vm_push_continuation_hook (void);
|
||||
SCM_API SCM scm_vm_pop_continuation_hook (void);
|
||||
SCM_API SCM scm_vm_return_hook (void);
|
||||
SCM_API SCM scm_vm_abort_continuation_hook (void);
|
||||
SCM_API SCM scm_vm_next_hook (void);
|
||||
SCM_API SCM scm_vm_trace_level (void);
|
||||
|
|
|
|||
|
|
@ -38,6 +38,7 @@
|
|||
binding-ref binding-set!
|
||||
|
||||
frame-call-representation
|
||||
frame-return-values
|
||||
frame-environment
|
||||
frame-object-binding frame-object-name))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile VM tracer
|
||||
|
||||
;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2001,2009-2010,2012-2014,2018 Free Software Foundation, Inc.
|
||||
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -48,8 +48,9 @@
|
|||
width
|
||||
(frame-call-representation frame #:top-frame? #t))))
|
||||
|
||||
(define (print-return depth width prefix max-indent values)
|
||||
(let ((prefix (build-prefix prefix depth "| " "~d< "max-indent)))
|
||||
(define (print-return frame depth width prefix max-indent)
|
||||
(let ((prefix (build-prefix prefix depth "| " "~d< "max-indent))
|
||||
(values (frame-return-values frame)))
|
||||
(case (length values)
|
||||
((0)
|
||||
(format (current-error-port) "~ano values\n" prefix))
|
||||
|
|
@ -72,8 +73,8 @@
|
|||
(max-indent (- width 40)))
|
||||
(define (apply-handler frame depth)
|
||||
(print-application frame depth width prefix max-indent))
|
||||
(define (return-handler frame depth . values)
|
||||
(print-return depth width prefix max-indent values))
|
||||
(define (return-handler frame depth values)
|
||||
(print-return frame depth width prefix max-indent))
|
||||
(trap-calls-to-procedure proc apply-handler return-handler))
|
||||
|
||||
(define* (trace-calls-in-procedure proc #:key (width 80)
|
||||
|
|
@ -81,8 +82,8 @@
|
|||
(max-indent (- width 40)))
|
||||
(define (apply-handler frame depth)
|
||||
(print-application frame depth width prefix max-indent))
|
||||
(define (return-handler frame depth . values)
|
||||
(print-return depth width prefix max-indent values))
|
||||
(define (return-handler frame depth)
|
||||
(print-return frame depth width prefix max-indent))
|
||||
(trap-calls-in-dynamic-extent proc apply-handler return-handler))
|
||||
|
||||
(define* (trace-instructions-in-procedure proc #:key (width 80)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Traps: stepping, breakpoints, and such.
|
||||
|
||||
;; Copyright (C) 2010, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
|
||||
;; Copyright (C) 2010,2012-2014,2017-2018 Free Software Foundation, Inc.
|
||||
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -55,7 +55,7 @@
|
|||
;;; Code:
|
||||
|
||||
(define-module (system vm traps)
|
||||
#:use-module (system base pmatch)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (system vm vm)
|
||||
#:use-module (system vm debug)
|
||||
#:use-module (system vm frame)
|
||||
|
|
@ -190,11 +190,12 @@
|
|||
(if (our-frame? frame)
|
||||
(enter-proc frame)))
|
||||
|
||||
(define (pop-cont-hook frame . values)
|
||||
(define (return-hook frame)
|
||||
(if in-proc?
|
||||
(exit-proc frame))
|
||||
(if (our-frame? frame)
|
||||
(enter-proc frame)))
|
||||
(let ((prev (frame-previous frame)))
|
||||
(if (our-frame? prev)
|
||||
(enter-proc prev))))
|
||||
|
||||
(define (abort-hook frame . values)
|
||||
(if in-proc?
|
||||
|
|
@ -206,7 +207,7 @@
|
|||
current-frame
|
||||
(lambda (frame)
|
||||
(add-hook! (vm-apply-hook) apply-hook)
|
||||
(add-hook! (vm-pop-continuation-hook) pop-cont-hook)
|
||||
(add-hook! (vm-return-hook) return-hook)
|
||||
(add-hook! (vm-abort-continuation-hook) abort-hook)
|
||||
(if (and frame (our-frame? frame))
|
||||
(enter-proc frame)))
|
||||
|
|
@ -214,7 +215,7 @@
|
|||
(if in-proc?
|
||||
(exit-proc frame))
|
||||
(remove-hook! (vm-apply-hook) apply-hook)
|
||||
(remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
|
||||
(remove-hook! (vm-return-hook) return-hook)
|
||||
(remove-hook! (vm-abort-continuation-hook) abort-hook)))))
|
||||
|
||||
;; Building on trap-in-procedure, we have trap-instructions-in-procedure
|
||||
|
|
@ -307,34 +308,31 @@
|
|||
(let ((code (program-code proc)))
|
||||
(let lp ((sources (program-sources proc))
|
||||
(out '()))
|
||||
(if (pair? sources)
|
||||
(lp (cdr sources)
|
||||
(pmatch (car sources)
|
||||
((,start-ip ,start-file ,start-line . ,start-col)
|
||||
(if (equal? start-file file)
|
||||
(acons start-line
|
||||
(if (pair? (cdr sources))
|
||||
(pmatch (cadr sources)
|
||||
((,end-ip . _)
|
||||
(cons (+ start-ip code)
|
||||
(+ end-ip code)))
|
||||
(else (error "unexpected")))
|
||||
(cons (+ start-ip code)
|
||||
(program-last-ip proc)))
|
||||
out)
|
||||
out))
|
||||
(else (error "unexpected"))))
|
||||
(let ((alist '()))
|
||||
(for-each
|
||||
(lambda (pair)
|
||||
(set! alist
|
||||
(assv-set! alist (car pair)
|
||||
(cons (cdr pair)
|
||||
(or (assv-ref alist (car pair))
|
||||
'())))))
|
||||
out)
|
||||
(sort! alist (lambda (x y) (< (car x) (car y))))
|
||||
alist)))))
|
||||
(match sources
|
||||
(((start-ip start-file start-line . start-col) . sources)
|
||||
(lp sources
|
||||
(if (equal? start-file file)
|
||||
(acons start-line
|
||||
(cons (+ start-ip code)
|
||||
(match sources
|
||||
(((end-ip . _) . _)
|
||||
(+ end-ip code))
|
||||
(()
|
||||
(program-last-ip proc))))
|
||||
out)
|
||||
out)))
|
||||
(()
|
||||
(let ((alist '()))
|
||||
(for-each
|
||||
(lambda (pair)
|
||||
(set! alist
|
||||
(assv-set! alist (car pair)
|
||||
(cons (cdr pair)
|
||||
(or (assv-ref alist (car pair))
|
||||
'())))))
|
||||
out)
|
||||
(sort! alist (lambda (x y) (< (car x) (car y))))
|
||||
alist))))))
|
||||
(else '())))
|
||||
|
||||
(define (source->ip-range proc file line)
|
||||
|
|
@ -398,14 +396,14 @@
|
|||
(arg-check return-handler procedure?)
|
||||
(arg-check abort-handler procedure?)
|
||||
(let ((fp (frame-address frame)))
|
||||
(define (pop-cont-hook frame . values)
|
||||
(if (and fp (< (frame-address frame) fp))
|
||||
(define (return-hook frame)
|
||||
(if (and fp (<= (frame-address frame) fp))
|
||||
(begin
|
||||
(set! fp #f)
|
||||
(apply return-handler frame values))))
|
||||
(return-handler frame))))
|
||||
|
||||
(define (abort-hook frame . values)
|
||||
(if (and fp (< (frame-address frame) fp))
|
||||
(if (and fp (<= (frame-address frame) fp))
|
||||
(begin
|
||||
(set! fp #f)
|
||||
(apply abort-handler frame values))))
|
||||
|
|
@ -415,11 +413,11 @@
|
|||
(lambda (frame)
|
||||
(if (not fp)
|
||||
(error "return-or-abort traps may only be enabled once"))
|
||||
(add-hook! (vm-pop-continuation-hook) pop-cont-hook)
|
||||
(add-hook! (vm-return-hook) return-hook)
|
||||
(add-hook! (vm-abort-continuation-hook) abort-hook))
|
||||
(lambda (frame)
|
||||
(set! fp #f)
|
||||
(remove-hook! (vm-pop-continuation-hook) pop-cont-hook)
|
||||
(remove-hook! (vm-return-hook) return-hook)
|
||||
(remove-hook! (vm-abort-continuation-hook) abort-hook)))))
|
||||
|
||||
;; A more traditional dynamic-wind trap. Perhaps this should not be
|
||||
|
|
@ -433,7 +431,7 @@
|
|||
(arg-check return-handler procedure?)
|
||||
(arg-check abort-handler procedure?)
|
||||
(let ((exit-trap #f))
|
||||
(define (return-hook frame . values)
|
||||
(define (return-hook frame)
|
||||
(exit-trap frame) ; disable the return/abort trap.
|
||||
(set! exit-trap #f)
|
||||
(return-handler frame))
|
||||
|
|
@ -469,27 +467,44 @@
|
|||
(arg-check proc procedure?)
|
||||
(arg-check apply-handler procedure?)
|
||||
(arg-check return-handler procedure?)
|
||||
(let ((*call-depth* 0))
|
||||
(define (trace-push frame)
|
||||
(set! *call-depth* (1+ *call-depth*)))
|
||||
|
||||
(define (trace-pop frame . values)
|
||||
(apply return-handler frame *call-depth* values)
|
||||
(set! *call-depth* (1- *call-depth*)))
|
||||
(let ((*stack* '()))
|
||||
(define (trace-return frame)
|
||||
(let ((fp* (frame-address frame)))
|
||||
(let lp ((stack *stack*))
|
||||
(match stack
|
||||
(() (values))
|
||||
((fp . stack)
|
||||
(cond
|
||||
((> fp fp*)
|
||||
(set! *stack* stack)
|
||||
(lp stack))
|
||||
((= fp fp*) (set! *stack* stack))
|
||||
((< fp fp*) (values)))))))
|
||||
(return-handler frame (1+ (length *stack*))))
|
||||
|
||||
(define (trace-apply frame)
|
||||
(apply-handler frame *call-depth*))
|
||||
(let ((fp* (frame-address frame)))
|
||||
(define (same-fp? fp) (= fp fp*))
|
||||
(define (newer-fp? fp) (> fp fp*))
|
||||
(let lp ((stack *stack*))
|
||||
(match stack
|
||||
(((? same-fp?) . stack)
|
||||
;; A tail call, nothing to do.
|
||||
(values))
|
||||
(((? newer-fp?) . stack)
|
||||
;; Unless there are continuations, we shouldn't get here.
|
||||
(set! *stack* stack)
|
||||
(lp stack))
|
||||
(stack
|
||||
(set! *stack* (cons fp* stack))))))
|
||||
(apply-handler frame (length *stack*)))
|
||||
|
||||
;; FIXME: recalc depth on abort
|
||||
|
||||
(define (enter frame)
|
||||
(add-hook! (vm-push-continuation-hook) trace-push)
|
||||
(add-hook! (vm-pop-continuation-hook) trace-pop)
|
||||
(add-hook! (vm-return-hook) trace-return)
|
||||
(add-hook! (vm-apply-hook) trace-apply))
|
||||
|
||||
(define (leave frame)
|
||||
(remove-hook! (vm-push-continuation-hook) trace-push)
|
||||
(remove-hook! (vm-pop-continuation-hook) trace-pop)
|
||||
(remove-hook! (vm-return-hook) trace-return)
|
||||
(remove-hook! (vm-apply-hook) trace-apply))
|
||||
|
||||
(define (return frame)
|
||||
|
|
@ -550,9 +565,9 @@
|
|||
(delq finish-trap pending-finish-traps))
|
||||
(set! finish-trap #f))
|
||||
|
||||
(define (return-hook frame . values)
|
||||
(define (return-hook frame)
|
||||
(frame-finished frame)
|
||||
(apply return-handler frame depth values))
|
||||
(return-handler frame depth))
|
||||
|
||||
;; FIXME: abort handler?
|
||||
(define (abort-hook frame . values)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;; Guile VM core
|
||||
|
||||
;;; Copyright (C) 2001, 2009, 2010, 2013, 2014 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2001,2009-2010,2013-2014,2018 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software; you can redistribute it and/or
|
||||
;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
|
@ -23,8 +23,7 @@
|
|||
call-with-stack-overflow-handler
|
||||
vm-trace-level set-vm-trace-level!
|
||||
vm-engine set-vm-engine! set-default-vm-engine!
|
||||
vm-push-continuation-hook vm-pop-continuation-hook
|
||||
vm-apply-hook
|
||||
vm-apply-hook vm-return-hook
|
||||
vm-next-hook
|
||||
vm-abort-continuation-hook))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue