mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

Second thoughts, keep handle-system-error but call it from

Browse source 
error-catching-loop.
This commit is contained in:
Gary Houston 1996-10-17 21:56:22 +00:00
parent 9a0d70e21e
commit 35c5db8731
2 changed files with 16 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
ice-9/ChangeLog
View file

@ -6,6 +6,9 @@ Thu Oct 17 20:33:08 1996 Gary Houston <ghouston@actrix.gen.nz>
Just interpret (almost) any throw with 4 args as an error throw. Just interpret (almost) any throw with 4 args as an error throw.
Delete some try-load stuff that was already commented out. Delete some try-load stuff that was already commented out.
Second thoughts, keep handle-system-error but call it from
error-catching-loop.
Tue Oct 15 17:07:20 1996 Jim Blandy <jimb@floss.cyclic.com> Tue Oct 15 17:07:20 1996 Jim Blandy <jimb@floss.cyclic.com>
* boot-9.scm: Doc fixes. * boot-9.scm: Doc fixes.

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

@ -2039,23 +2039,24 @@
;; This is the other cons-leak closure... ;; This is the other cons-leak closure...
(lambda () (lambda ()
(cond ((= (length args) 4) (cond ((= (length args) 4)
;; anything with 4 args is interpreted as an (apply handle-system-error key args))
;; error throw.
(let ((cep (current-error-port)))
(if (and (memq 'backtrace (debug-options))
(stack? the-last-stack))
(begin
(newline cep)
(display-backtrace the-last-stack cep)
(newline cep)))
(apply display-error the-last-stack cep args)
(force-output cep)
(throw 'abort key)))
(else (else
(apply bad-throw key args)))))))))) (apply bad-throw key args))))))))))
(and next (loop next)))) (and next (loop next))))
(loop (lambda () #t))) (loop (lambda () #t)))
(define (handle-system-error key . args)
(let ((cep (current-error-port)))
(if (and (memq 'backtrace (debug-options))
(stack? the-last-stack))
(begin
(newline cep)
(display-backtrace the-last-stack cep)
(newline cep)))
(apply display-error the-last-stack cep args)
(force-output cep)
(throw 'abort key)))
(define (quit . args) (define (quit . args)
(apply throw 'quit args)) (apply throw 'quit args))