* doc/ref/api-debug.texi (VM Hooks): Update documentation.
* libguile/vm.c (vm_dispatch_hook):
* libguile/vm-engine.c: Rework the hook machinery so that they can
receive an arbitrary number of arguments. The return and abort
hooks will pass the values that they return to their continuations.
(vm_engine): Adapt to ABORT_CONTINUATION_HOOK change.
* libguile/vm-i-system.c (return, return/values): Adapt to
POP_CONTINUATION_HOOK change.
* module/system/vm/frame.scm (frame-return-values): Remove. The
pop-continuation-hook will pass the values directly.
* module/system/vm/trace.scm (print-return):
(trace-calls-to-procedure):
(trace-calls-in-procedure): Update to receive return values
directly.
* module/system/vm/traps.scm (trap-in-procedure)
(trap-in-dynamic-extent): Ignore return values.
(trap-frame-finish, trap-calls-in-dynamic-extent)
(trap-calls-to-procedure): Pass return values to the handlers.
fired at different times, which may be accessed with the following
procedures.
-All hooks are called with one argument, the frame in
-question. @xref{Frames}. Since these hooks may be fired very
-frequently, Guile does a terrible thing: it allocates the frames on the
-C stack instead of the garbage-collected heap.
+The first argument of calls to these hooks is the frame in question.
+@xref{Frames}. Some hooks may call their procedures with more
+arguments. Since these hooks may be fired very frequently, Guile does a
+terrible thing: it allocates the frames on the C stack instead of the
+garbage-collected heap.
The upshot here is that the frames are only valid within the dynamic
extent of the call to the hook. If a hook procedure keeps a reference to
@deffn {Scheme Procedure} vm-pop-continuation-hook vm
The hook that will be fired before returning from a frame.
-This hook is a bit trickier than the rest, in that there is a particular
-interpretation of the values on the stack. Specifically, the top value
-on the stack is the number of values being returned, and the next
-@var{n} values are the actual values being returned, with the last value
-highest on the stack.
+This hook fires with a variable number of arguments, corresponding to
+the values that the frame returns to its continuation.
@end deffn
@deffn {Scheme Procedure} vm-apply-hook vm
@deffn {Scheme Procedure} vm-abort-continuation-hook vm
The hook that will be called after aborting to a
-prompt. @xref{Prompts}. The stack will be in the same state as for
-@code{vm-pop-continuation-hook}.
+prompt. @xref{Prompts}.
+
+Like the pop-continuation hook, this hook fires with a variable number
+of arguments, corresponding to the values that returned to the
+continuation.
@end deffn
@deffn {Scheme Procedure} vm-restore-continuation-hook vm
# define ASSERT(condition)
#endif
+#if VM_USE_HOOKS
+#define RUN_HOOK(h, args, n) \
+ do { \
+ if (SCM_UNLIKELY (vp->trace_level > 0)) \
+ { \
+ SYNC_REGISTER (); \
+ vm_dispatch_hook (vm, h, args, n); \
+ } \
+ } while (0)
+#else
+#define RUN_HOOK(h, args, n)
+#endif
+#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0)
+
+#define APPLY_HOOK() \
+ RUN_HOOK0 (SCM_VM_APPLY_HOOK)
+#define PUSH_CONTINUATION_HOOK() \
+ RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
+#define POP_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n)
+#define NEXT_HOOK() \
+ RUN_HOOK0 (SCM_VM_NEXT_HOOK)
+#define ABORT_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n)
+#define RESTORE_CONTINUATION_HOOK() \
+ RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
+
+#define VM_HANDLE_INTERRUPTS \
+ SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
+
+
+\f
/* Cache the VM's instruction, stack, and frame pointer in local variables. */
#define CACHE_REGISTER() \
#define CHECK_FREE_VARIABLE(_num)
\f
-/*
- * Hooks
- */
-
-#if VM_USE_HOOKS
-#define RUN_HOOK(h) \
- { \
- if (SCM_UNLIKELY (vp->trace_level > 0)) \
- { \
- SYNC_REGISTER (); \
- vm_dispatch_hook (vm, h); \
- } \
- }
-#define RUN_HOOK1(h, x) \
- { \
- if (SCM_UNLIKELY (vp->trace_level > 0)) \
- { \
- PUSH (x); \
- SYNC_REGISTER (); \
- vm_dispatch_hook (vm, h); \
- DROP(); \
- } \
- }
-#else
-#define RUN_HOOK(h)
-#define RUN_HOOK1(h, x)
-#endif
-
-#define APPLY_HOOK() \
- RUN_HOOK (SCM_VM_APPLY_HOOK)
-#define PUSH_CONTINUATION_HOOK() \
- RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
-#define POP_CONTINUATION_HOOK(n) \
- RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
-#define NEXT_HOOK() \
- RUN_HOOK (SCM_VM_NEXT_HOOK)
-#define ABORT_CONTINUATION_HOOK() \
- RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
-#define RESTORE_CONTINUATION_HOOK() \
- RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
-
-#define VM_HANDLE_INTERRUPTS \
- SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
-
-\f
/*
* Stack operation
*/
CACHE_PROGRAM ();
/* The stack contains the values returned to this continuation,
along with a number-of-values marker -- like an MV return. */
- ABORT_CONTINUATION_HOOK ();
+ ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp));
NEXT;
}
VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1)
{
vm_return:
- POP_CONTINUATION_HOOK (1);
+ POP_CONTINUATION_HOOK (sp, 1);
VM_HANDLE_INTERRUPTS;
that perhaps it might be used without declaration. Fooey to that, I say. */
nvalues = FETCH ();
vm_return_values:
- POP_CONTINUATION_HOOK (nvalues);
+ POP_CONTINUATION_HOOK (sp + 1 - nvalues, nvalues);
VM_HANDLE_INTERRUPTS;
0);
}
+static void vm_dispatch_hook (SCM vm, int hook_num,
+ SCM *argv, int n) SCM_NOINLINE;
+
static void
-vm_dispatch_hook (SCM vm, int hook_num)
+vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
{
struct scm_vm *vp;
SCM hook;
struct scm_frame c_frame;
scm_t_cell *frame;
- SCM args[1];
int saved_trace_level;
vp = SCM_VM_DATA (vm);
frame->word_0 = SCM_PACK (scm_tc7_frame);
frame->word_1 = SCM_PACK_POINTER (&c_frame);
- args[0] = SCM_PACK_POINTER (frame);
- scm_c_run_hookn (hook, args, 1);
+ if (n == 0)
+ {
+ SCM args[1];
+
+ args[0] = SCM_PACK_POINTER (frame);
+ scm_c_run_hookn (hook, args, 1);
+ }
+ else if (n == 1)
+ {
+ SCM args[2];
+
+ args[0] = SCM_PACK_POINTER (frame);
+ args[1] = argv[0];
+ scm_c_run_hookn (hook, args, 2);
+ }
+ else
+ {
+ SCM args = SCM_EOL;
+
+ while (n--)
+ args = scm_cons (argv[n], args);
+ scm_c_run_hook (hook, scm_cons (SCM_PACK_POINTER (frame), args));
+ }
vp->trace_level = saved_trace_level;
}
#:use-module (system vm program)
#:use-module (system vm trap-state)
#:use-module (system vm vm)
- #:use-module ((system vm frame) #:select (frame-return-values))
#:autoload (system base language) (lookup-language language-reader)
#:autoload (system vm trace) (call-with-trace)
#:use-module (ice-9 format)
(format #t "Trap ~a: ~a.~%" idx (trap-name idx)))))
(define (repl-pop-continuation-resumer repl msg)
- ;; Capture the dynamic environment with this prompt thing. The
- ;; result is a procedure that takes a frame.
+ ;; Capture the dynamic environment with this prompt thing. The result
+ ;; is a procedure that takes a frame and number of values returned.
(% (call-with-values
(lambda ()
(abort
;; Call frame->stack-vector before reinstating the
;; continuation, so that we catch the %stacks fluid at
;; the time of capture.
- (lambda (frame)
+ (lambda (frame . values)
(k frame
(frame->stack-vector
- (frame-previous frame)))))))
- (lambda (from stack)
+ (frame-previous frame))
+ values)))))
+ (lambda (from stack values)
(format #t "~a~%" msg)
- (let ((vals (frame-return-values from)))
- (if (null? vals)
- (format #t "No return values.~%")
- (begin
- (format #t "Return values:~%")
- (for-each (lambda (x) (repl-print repl x)) vals))))
+ (if (null? values)
+ (format #t "No return values.~%")
+ (begin
+ (format #t "Return values:~%")
+ (for-each (lambda (x) (repl-print repl x)) values)))
((module-ref (resolve-interface '(system repl repl)) 'start-repl)
#:debug (make-debug stack 0 msg #t))))))
frame-binding-ref frame-binding-set!
frame-next-source frame-call-representation
frame-environment
- frame-object-binding frame-object-name
- frame-return-values))
+ frame-object-binding frame-object-name))
(define (frame-bindings frame)
(let ((p (frame-procedure frame)))
(define (frame-object-name frame obj)
(cond ((frame-object-binding frame obj) => binding:name)
(else #f)))
-
-;; Nota bene, only if frame is in a return context (i.e. in a
-;; pop-continuation hook dispatch).
-(define (frame-return-values frame)
- (let* ((len (frame-num-locals frame))
- (nvalues (frame-local-ref frame (1- len))))
- (map (lambda (i)
- (frame-local-ref frame (+ (- len nvalues 1) i)))
- (iota nvalues))))
;;; Guile VM tracer
-;; Copyright (C) 2001, 2009, 2010, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009, 2010, 2012, 2013 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
width
(frame-call-representation frame))))
-(define* (print-return frame depth width prefix max-indent)
+(define* (print-return frame depth width prefix max-indent values)
(let* ((len (frame-num-locals frame))
- (nvalues (frame-local-ref frame (1- len)))
(prefix (build-prefix prefix depth "| " "~d< "max-indent)))
- (case nvalues
+ (case (length values)
((0)
(format (current-error-port) "~ano values\n" prefix))
((1)
(format (current-error-port) "~a~v:@y\n"
prefix
width
- (frame-local-ref frame (- len 2))))
+ (car values)))
(else
;; this should work, but there appears to be a bug
;; "~a~d values:~:{ ~v:@y~}\n"
(format (current-error-port) "~a~d values:~{ ~a~}\n"
- prefix nvalues
+ prefix (length values)
(map (lambda (val)
(format #f "~v:@y" width val))
- (frame-return-values frame)))))))
-
+ values))))))
+
(define* (trace-calls-to-procedure proc #:key (width 80) (vm (the-vm))
(prefix "trace: ")
(max-indent (- width 40)))
(define (apply-handler frame depth)
(print-application frame depth width prefix max-indent))
- (define (return-handler frame depth)
- (print-return frame depth width prefix max-indent))
+ (define (return-handler frame depth . values)
+ (print-return frame depth width prefix max-indent values))
(trap-calls-to-procedure proc apply-handler return-handler
#:vm vm))
(max-indent (- width 40)))
(define (apply-handler frame depth)
(print-application frame depth width prefix max-indent))
- (define (return-handler frame depth)
- (print-return frame depth width prefix max-indent))
+ (define (return-handler frame depth . values)
+ (print-return frame depth width prefix max-indent values))
(trap-calls-in-dynamic-extent proc apply-handler return-handler
#:vm vm))
;;; Traps: stepping, breakpoints, and such.
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2012 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
(if in-proc?
(exit-proc frame)))
- (define (pop-cont-hook frame)
+ (define (pop-cont-hook frame . values)
(if in-proc?
(exit-proc frame))
(if (our-frame? (frame-previous frame))
(enter-proc (frame-previous frame))))
- (define (abort-hook frame)
+ (define (abort-hook frame . values)
(if in-proc?
(exit-proc frame))
(if (our-frame? frame)
(arg-check return-handler procedure?)
(arg-check abort-handler procedure?)
(let ((fp (frame-address frame)))
- (define (pop-cont-hook frame)
+ (define (pop-cont-hook frame . values)
(if (and fp (eq? (frame-address frame) fp))
(begin
(set! fp #f)
- (return-handler frame))))
+ (apply return-handler frame values))))
- (define (abort-hook frame)
+ (define (abort-hook frame . values)
(if (and fp (< (frame-address frame) fp))
(begin
(set! fp #f)
- (abort-handler frame))))
+ (apply abort-handler frame values))))
(new-enabled-trap
vm frame
(arg-check return-handler procedure?)
(arg-check abort-handler procedure?)
(let ((exit-trap #f))
- (define (return-hook frame)
+ (define (return-hook frame . values)
(exit-trap frame) ; disable the return/abort trap.
(set! exit-trap #f)
(return-handler frame))
- (define (abort-hook frame)
+ (define (abort-hook frame . values)
(exit-trap frame) ; disable the return/abort trap.
(set! exit-trap #f)
(abort-handler frame))
(define (trace-push frame)
(set! *call-depth* (1+ *call-depth*)))
- (define (trace-pop frame)
- (return-handler frame *call-depth*)
+ (define (trace-pop frame . values)
+ (apply return-handler frame *call-depth* values)
(set! *call-depth* (1- *call-depth*)))
(define (trace-apply frame)
(delq finish-trap pending-finish-traps))
(set! finish-trap #f))
- (define (return-hook frame)
+ (define (return-hook frame . values)
(frame-finished frame)
- (return-handler frame depth))
+ (apply return-handler frame depth values))
;; FIXME: abort handler?
- (define (abort-hook frame)
+ (define (abort-hook frame . values)
(frame-finished frame))
(set! finish-trap