[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] handle calls to exit in on-exit handlers
From: |
Felix |
Subject: |
[Chicken-hackers] [PATCH] handle calls to exit in on-exit handlers |
Date: |
Fri, 02 Aug 2013 14:29:51 +0200 (CEST) |
Currently calling "exit" inside an "on-exit" handler will result
in an endless loop or similarly disastrous behaviour. This patch
is an attempt to fix it.
cheers,
felix
>From 95cd37998b8f3fff4b327906224ccbb9055c2bbd Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Thu, 1 Aug 2013 16:51:31 +0200
Subject: [PATCH] Fixes "on-exit": previously calls to "exit" inside an
on-exit handler would loop endlessly.
---
library.scm | 47 +++++++++++++++++++++++++++--------------------
1 file changed, 27 insertions(+), 20 deletions(-)
diff --git a/library.scm b/library.scm
index 7b5c61b..e01e868 100644
--- a/library.scm
+++ b/library.scm
@@ -34,6 +34,7 @@
current-print-length setter-tag read-marks
##sys#print-exit
##sys#format-here-doc-warning
+ exit-in-progress
maximal-string-length)
(not inline ##sys#user-read-hook ##sys#error-hook ##sys#signal-hook
##sys#schedule
##sys#default-read-info-hook ##sys#infix-list-hook
##sys#sharp-number-hook
@@ -3957,17 +3958,17 @@ EOF
(lambda ()
((##sys#exit-handler) _ex_software)) ) )
+(define exit-in-progress #f)
+
(define exit-handler
(make-parameter
- (lambda code
- (##sys#cleanup-before-exit)
- (##core#inline
- "C_exit_runtime"
- (if (null? code)
- 0
- (let ([code (car code)])
- (##sys#check-exact code)
- code) ) ) ) ) )
+ (lambda (#!optional (code 0))
+ (##sys#check-exact code)
+ (cond (exit-in-progress
+ (##sys#warn "\"exit\" called while processing on-exit tasks"))
+ (else
+ (##sys#cleanup-before-exit)
+ (##core#inline "C_exit_runtime" code))))))
(define implicit-exit-handler
(make-parameter
@@ -3980,19 +3981,25 @@ EOF
(define force-finalizers (make-parameter #t))
-(define ##sys#cleanup-before-exit
- (lambda ()
- (when (##sys#fudge 37)
- (##sys#print "\n" #f ##sys#standard-error)
- (##sys#dump-heap-state))
- (when (##sys#fudge 13)
- (##sys#print "[debug] forcing finalizers...\n" #f ##sys#standard-error) )
- (when (force-finalizers) (##sys#force-finalizers)) ) )
+(define ##sys#cleanup-tasks '())
+
+(define (##sys#cleanup-before-exit)
+ (set! exit-in-progress #t)
+ (when (##sys#fudge 37) ; -:H given?
+ (##sys#print "\n" #f ##sys#standard-error)
+ (##sys#dump-heap-state))
+ (let loop ()
+ (let ((tasks ##sys#cleanup-tasks))
+ (set! ##sys#cleanup-tasks '())
+ (unless (null? tasks)
+ (for-each (lambda (t) (t)) tasks)
+ (loop))))
+ (when (##sys#fudge 13) ; debug mode
+ (##sys#print "[debug] forcing finalizers...\n" #f ##sys#standard-error) )
+ (when (force-finalizers) (##sys#force-finalizers)) )
(define (on-exit thunk)
- (set! ##sys#cleanup-before-exit
- (let ((old ##sys#cleanup-before-exit))
- (lambda () (old) (thunk)) ) ) )
+ (set! ##sys#cleanup-tasks (cons thunk ##sys#cleanup-tasks)))
;;; Condition handling:
--
1.7.9.5
- [Chicken-hackers] [PATCH] handle calls to exit in on-exit handlers,
Felix <=