[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-16-gb782ed0
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-16-gb782ed0 |
|
Date: |
Mon, 27 May 2013 05:17:00 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b782ed0137e93f3bcfcffdbfe2785e6425ef9e32
The branch, master has been updated
via b782ed0137e93f3bcfcffdbfe2785e6425ef9e32 (commit)
via a0ec1ca11650ad7c16cf1c3261ec1b8665d46ac8 (commit)
via c850a0ff4d0073364612ff5785bda8217ea9ae7f (commit)
via 27319ffaa90dc5789843d8b80842b9a6d36120e1 (commit)
from 8dd6bfa7bb786e802be49fb72ff4f526244d341d (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit b782ed0137e93f3bcfcffdbfe2785e6425ef9e32
Author: Andy Wingo <address@hidden>
Date: Mon May 28 12:25:43 2012 +0200
refactor to resolve_variable
* libguile/vm.c (resolve_variable): Slight refactor.
commit a0ec1ca11650ad7c16cf1c3261ec1b8665d46ac8
Author: Andy Wingo <address@hidden>
Date: Thu May 17 18:35:05 2012 +0200
cpp hygiene in the vm
* libguile/vm-engine.c:
* libguile/vm-i-scheme.c:
* libguile/vm-i-system.c: CPP hygiene: the code that #defines, #undefs.
Makes things cleaner given the multiple inclusion dance we do.
commit c850a0ff4d0073364612ff5785bda8217ea9ae7f
Author: Andy Wingo <address@hidden>
Date: Thu May 23 15:07:37 2013 +0200
pop-continuation abort-continuation hooks pass return vals directly
* 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.
commit 27319ffaa90dc5789843d8b80842b9a6d36120e1
Author: Andy Wingo <address@hidden>
Date: Thu May 23 15:16:20 2013 +0200
Allow vm_engine caller to pass arguments on the stack.
* libguile/vm-engine.c (vm_engine): Allow the caller to pass arguments
on the stack.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-debug.texi | 23 ++++----
libguile/vm-engine.c | 122 +++++++++++++++++++++++----------------
libguile/vm-i-scheme.c | 24 ++++++--
libguile/vm-i-system.c | 7 ++-
libguile/vm.c | 60 +++++++++++++-------
module/system/repl/command.scm | 23 ++++----
module/system/vm/frame.scm | 12 +----
module/system/vm/trace.scm | 23 ++++----
module/system/vm/traps.scm | 28 +++++-----
9 files changed, 184 insertions(+), 138 deletions(-)
diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi
index f6c706c..4e1b822 100644
--- a/doc/ref/api-debug.texi
+++ b/doc/ref/api-debug.texi
@@ -799,10 +799,11 @@ To digress, Guile's VM has 6 different hooks
(@pxref{Hooks}) that can be
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.
address@hidden 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
@@ -832,11 +833,8 @@ corresponding apply-hook.
@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
address@hidden 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
@@ -852,8 +850,11 @@ hook.
@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
address@hidden
+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
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index b7e355d..4454632 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -68,6 +68,38 @@
# 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 ())
+
+
+
/* Cache the VM's instruction, stack, and frame pointer in local variables. */
#define CACHE_REGISTER() \
@@ -143,51 +175,6 @@
/*
- * 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 ())
-
-
-/*
* Stack operation
*/
@@ -352,12 +339,23 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
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;
}
- /* Initial frame */
CACHE_REGISTER ();
+
+ /* Since it's possible to receive the arguments on the stack itself,
+ and indeed the RTL VM invokes us that way, shuffle up the
+ arguments first. */
+ VM_ASSERT (sp + 8 + nargs < stack_limit, vm_error_too_many_args (nargs));
+ {
+ int i;
+ for (i = nargs - 1; i >= 0; i--)
+ sp[9 + i] = argv[i];
+ }
+
+ /* Initial frame */
PUSH (SCM_PACK (fp)); /* dynamic link */
PUSH (SCM_PACK (0)); /* mvra */
PUSH (SCM_PACK (ip)); /* ra */
@@ -371,9 +369,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
PUSH (SCM_PACK (ip)); /* ra */
PUSH (program);
fp = sp + 1;
- VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs));
- while (nargs--)
- PUSH (*argv++);
+ sp += nargs;
PUSH_CONTINUATION_HOOK ();
@@ -437,8 +433,34 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
abort (); /* never reached */
}
+#undef ALIGNED_P
+#undef CACHE_REGISTER
+#undef CHECK_OVERFLOW
+#undef FREE_VARIABLE_REF
+#undef FUNC2
+#undef INIT
+#undef INUM_MAX
+#undef INUM_MIN
+#undef jump_table
+#undef LOCAL_REF
+#undef LOCAL_SET
+#undef NEXT
+#undef NEXT_JUMP
+#undef REL
+#undef RETURN
+#undef RETURN_ONE_VALUE
+#undef RETURN_VALUE_LIST
#undef RUN_HOOK
#undef RUN_HOOK1
+#undef SYNC_ALL
+#undef SYNC_BEFORE_GC
+#undef SYNC_IP
+#undef SYNC_REGISTER
+#undef VARIABLE_BOUNDP
+#undef VARIABLE_REF
+#undef VARIABLE_SET
+#undef VM_DEFINE_OP
+#undef VM_INSTRUCTION_TO_LABEL
#undef VM_USE_HOOKS
/*
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index c12c42b..ef3d02b 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -176,7 +176,6 @@ VM_DEFINE_INSTRUCTION (146, set_cdr, "set-cdr!", 0, 2, 0)
* Numeric relational tests
*/
-#undef REL
#define REL(crel,srel) \
{ \
ARGS2 (x, y); \
@@ -212,18 +211,17 @@ VM_DEFINE_FUNCTION (151, ge, "ge?", 2)
REL (>=, scm_geq_p);
}
+#undef REL
+
/*
* Numeric functions
*/
/* The maximum/minimum tagged integers. */
-#undef INUM_MAX
-#undef INUM_MIN
#define INUM_MAX (INTPTR_MAX - 1)
#define INUM_MIN (INTPTR_MIN + scm_tc2_int)
-#undef FUNC2
#define FUNC2(CFUNC,SFUNC) \
{ \
ARGS2 (x, y); \
@@ -357,8 +355,11 @@ VM_DEFINE_FUNCTION (155, sub1, "sub1", 1)
RETURN (scm_difference (x, SCM_I_MAKINUM (1)));
}
-# undef ASM_ADD
-# undef ASM_SUB
+#undef ASM_ADD
+#undef ASM_SUB
+#undef FUNC2
+#undef INUM_MAX
+#undef INUM_MIN
VM_DEFINE_FUNCTION (156, mul, "mul", 2)
{
@@ -992,6 +993,17 @@ BV_FLOAT_SET (f64, ieee_double, double, 8)
#undef BV_INT_SET
#undef BV_FLOAT_SET
+#undef ALIGNED_P
+#undef VM_VALIDATE_BYTEVECTOR
+
+#undef VM_VALIDATE_STRUCT
+#undef VM_VALIDATE_CONS
+
+#undef ARGS1
+#undef ARGS2
+#undef ARGS3
+#undef RETURN
+
/*
(defun renumber-ops ()
"start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 4445d0c..9b24c92 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -538,6 +538,9 @@ VM_DEFINE_INSTRUCTION (42, br_if_not_nil, "br-if-not-nil",
3, 0, 0)
POP (x);
BR (!scm_is_lisp_false (x));
}
+
+#undef BR
+
/*
* Subprogram call
@@ -1150,7 +1153,7 @@ VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc",
0, 1, 1)
VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1)
{
vm_return:
- POP_CONTINUATION_HOOK (1);
+ POP_CONTINUATION_HOOK (sp, 1);
VM_HANDLE_INTERRUPTS;
@@ -1189,7 +1192,7 @@ VM_DEFINE_INSTRUCTION (70, return_values,
"return/values", 1, -1, -1)
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;
diff --git a/libguile/vm.c b/libguile/vm.c
index 0b0650d..cbef0d9 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -202,14 +202,16 @@ scm_i_capture_current_stack (void)
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);
@@ -242,9 +244,30 @@ vm_dispatch_hook (SCM vm, int hook_num)
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;
}
@@ -577,30 +600,27 @@ static SCM boot_continuation;
*/
static SCM
-resolve_variable (SCM what, SCM program_module)
+resolve_variable (SCM what, SCM module)
{
if (SCM_LIKELY (scm_is_symbol (what)))
{
- if (scm_is_true (program_module))
- return scm_module_lookup (program_module, what);
+ if (scm_is_true (module))
+ return scm_module_lookup (module, what);
else
return scm_module_lookup (scm_the_root_module (), what);
}
else
{
- SCM mod;
- /* compilation of @ or @@
- `what' is a three-element list: (MODNAME SYM INTERFACE?)
- INTERFACE? is #t if we compiled @ or #f if we compiled @@
- */
- mod = scm_resolve_module (SCM_CAR (what));
- if (scm_is_true (SCM_CADDR (what)))
- mod = scm_module_public_interface (mod);
- if (scm_is_false (mod))
- scm_misc_error (NULL, "no such module: ~S",
- scm_list_1 (SCM_CAR (what)));
- /* might longjmp */
- return scm_module_lookup (mod, SCM_CADR (what));
+ SCM modname, sym, public;
+
+ modname = SCM_CAR (what);
+ sym = SCM_CADR (what);
+ public = SCM_CADDR (what);
+
+ if (scm_is_true (public))
+ return scm_public_lookup (modname, sym);
+ else
+ return scm_private_lookup (modname, sym);
}
}
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index a3e43fe..1a6f72a 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -29,7 +29,6 @@
#: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)
@@ -688,8 +687,8 @@ Note that the given source location must be inside a
procedure."
(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
@@ -697,18 +696,18 @@ Note that the given source location must be inside a
procedure."
;; 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))))))
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 40d4080..b8077db 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -28,8 +28,7 @@
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)))
@@ -158,12 +157,3 @@
(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))))
diff --git a/module/system/vm/trace.scm b/module/system/vm/trace.scm
index e27dc37..7b96af5 100644
--- a/module/system/vm/trace.scm
+++ b/module/system/vm/trace.scm
@@ -1,6 +1,6 @@
;;; 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
@@ -53,34 +53,33 @@
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))
@@ -89,8 +88,8 @@
(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))
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index cccd6ea..14aee55 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -1,6 +1,6 @@
;;; 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
@@ -184,13 +184,13 @@
(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)
@@ -409,17 +409,17 @@
(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
@@ -447,12 +447,12 @@
(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))
@@ -490,8 +490,8 @@
(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)
@@ -570,12 +570,12 @@
(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
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-16-gb782ed0,
Andy Wingo <=