summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/stacks.c8
-rw-r--r--module/language/scheme/compile-ghil.scm10
-rw-r--r--module/system/base/compile.scm5
3 files changed, 13 insertions, 10 deletions
diff --git a/libguile/stacks.c b/libguile/stacks.c
index d020d36b0..b9595e364 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -552,8 +552,12 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
SCM_STACK (stack) -> length = n;
/* Translate the current chain of stack frames into debugging information. */
- if (read_frames (dframe, offset, vmframe, n, iframe) != n)
- abort (); /* we counted wrong, this really shouldn't happen */
+ n = read_frames (dframe, offset, vmframe, n, iframe);
+ if (n != SCM_STACK (stack)->length)
+ {
+ scm_puts ("warning: stack count incorrect!\n", scm_current_error_port ());
+ SCM_STACK (stack)->length = n;
+ }
/* Narrow the stack according to the arguments given to scm_make_stack. */
SCM_VALIDATE_REST_ARGUMENT (args);
diff --git a/module/language/scheme/compile-ghil.scm b/module/language/scheme/compile-ghil.scm
index 1213703a8..9376be48c 100644
--- a/module/language/scheme/compile-ghil.scm
+++ b/module/language/scheme/compile-ghil.scm
@@ -317,11 +317,11 @@
;; (lambda FORMALS BODY...)
((,formals . ,body)
(receive (syms rest) (parse-formals formals)
- (call-with-ghil-environment e syms
- (lambda (env vars)
- (receive (meta body) (parse-lambda-meta body)
- (make-ghil-lambda env l vars rest meta
- (trans-body env l body))))))))
+ (call-with-ghil-environment e syms
+ (lambda (env vars)
+ (receive (meta body) (parse-lambda-meta body)
+ (make-ghil-lambda env l vars rest meta
+ (trans-body env l body))))))))
(define-scheme-translator delay
;; FIXME not hygienic
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index f83834da9..d9abe9d08 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -48,7 +48,7 @@
(format (current-error-port)
"~A:~A: ~A: ~A~%" (car loc) (cdr loc) msg exp)
(format (current-error-port)
- "unknown location: ~A: ~A~%" msg exp)))))
+ "unknown location: ~A: ~S~%" msg exp)))))
;;;
@@ -77,8 +77,7 @@
(lambda ()
(with-throw-handler #t
(lambda ()
- (with-output-to-port tmp
- (lambda () (proc (current-output-port))))
+ (proc tmp)
(rename-file template filename))
(lambda args
(delete-file template)))))))