mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-13 07:10:20 +02:00
Code Activity

* boot-9.scm (error-catching-loop, signal-handler,

Browse source 
handle-system-error): Backtracing now works for signals aswell;
Backtracing mechanism can now identify the stack root created by
start-stack so that the user isn't exposed to system stack frames.
This commit is contained in:
Mikael Djurfeldt 1996-10-14 20:28:39 +00:00
parent c6b8a41a55
commit 4cdee789b7
1 changed files with 11 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

15
ice-9/boot-9.scm
View file

@ -652,6 +652,9 @@
(define (alarm-thunk) #t) (define (alarm-thunk) #t)
(define (signal-handler n) (define (signal-handler n)
(set! the-last-stack (make-stack #f 1 5))
(if (not (eq? (stack-id the-last-stack) 'repl-stack))
(set! the-last-stack #f))
(let* ( (let* (
;; these numbers are set in libguile, not the same as those ;; these numbers are set in libguile, not the same as those
;; interned in posix.c for SIGSEGV etc. ;; interned in posix.c for SIGSEGV etc.
@ -684,7 +687,8 @@
(write arg-list cep) (write arg-list cep)
(newline cep)) (newline cep))
(else (else
(if (memq 'backtrace (debug-options)) (if (and (memq 'backtrace (debug-options))
(stack? the-last-stack))
(begin (begin
(newline cep) (newline cep)
(display-backtrace the-last-stack cep) (display-backtrace the-last-stack cep)
@ -2084,8 +2088,11 @@
(let ((options (debug-options))) (let ((options (debug-options)))
(if (and (or (memq 'deval options) (if (and (or (memq 'deval options)
(memq 'backtrace options)) (memq 'backtrace options))
(not (memq key '(quit switch-repl abort)))) (not (memq key '(quit switch-repl abort error-signal))))
(set! the-last-stack (make-stack #f 6 1))) (begin
(set! the-last-stack (make-stack #f 1 7))
(if (not (eq? (stack-id the-last-stack) 'repl-stack))
(set! the-last-stack #f))))
(apply throw key args))))) (apply throw key args)))))
(lambda (key . args) (lambda (key . args)
@ -2161,7 +2168,7 @@
(-eval (lambda (sourc) (-eval (lambda (sourc)
(repl-report-start-timing) (repl-report-start-timing)
(start-stack (eval sourc)))) (start-stack 'repl-stack (eval sourc))))
(-print (lambda (result) (-print (lambda (result)
(if (not scm-repl-silent) (if (not scm-repl-silent)