diff options
-rw-r--r-- | libguile/stacks.c | 8 | ||||
-rw-r--r-- | module/language/scheme/compile-ghil.scm | 10 | ||||
-rw-r--r-- | module/system/base/compile.scm | 5 |
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))))))) |