[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] debugging output for finalizers gets written t
From: |
Felix Winkelmann |
Subject: |
[Chicken-hackers] [PATCH] debugging output for finalizers gets written to stdout |
Date: |
Thu, 29 Aug 2013 12:49:53 +0200 (CEST) |
It turns out that debugging output enabled with the "-:d" option
writes information specific to finalizer-queue management to stdout,
interfering with whatever port happens to be the current standrd
output port, and particularly nasty when using "with-output-to-string"
and friends. The attached patch changes the code to output to stderr
instead.
This can produce rather ugly bugs, I recommend to add this to the
stability branch.
felix
>From d66f066a47bdcafaec6a0e88088080f91e32432e Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Wed, 28 Aug 2013 22:07:30 +0200
Subject: [PATCH] debugging output for finalizer-management blindly wrote to
stdout, which could interfere with code that uses
with-output-to-string, for example.
---
library.scm | 54 +++++++++++++++++++++++++++++++++++-------------------
1 file changed, 35 insertions(+), 19 deletions(-)
diff --git a/library.scm b/library.scm
index 5a2862e..a1f0470 100644
--- a/library.scm
+++ b/library.scm
@@ -4648,32 +4648,48 @@ EOF
(define ##sys#set-finalizer! (##core#primitive "C_register_finalizer"))
(define set-finalizer!
- (lambda (x y)
- (when (fx>= (##sys#fudge 26) _max_pending_finalizers)
- (if (##core#inline "C_resize_pending_finalizers" (fx* 2
_max_pending_finalizers))
- (begin
- (set! ##sys#pending-finalizers (##sys#grow-vector
##sys#pending-finalizers
- (fx+ (fx* 2
_max_pending_finalizers) 1)
-
(##core#undefined)))
- (when (##sys#fudge 13)
- (print "[debug] too many finalizers (" (##sys#fudge 26)
- "), resized max finalizers to " _max_pending_finalizers
"...") ) )
- (begin
- (when (##sys#fudge 13)
- (print "[debug] too many finalizers (" (##sys#fudge 26) "),
forcing ...") )
- (##sys#force-finalizers) ) ) )
- (##sys#set-finalizer! x y) ) )
+ (let ((string-append string-append))
+ (lambda (x y)
+ (when (fx>= (##sys#fudge 26) _max_pending_finalizers)
+ (cond ((##core#inline "C_resize_pending_finalizers" (fx* 2
_max_pending_finalizers))
+ (set! ##sys#pending-finalizers (##sys#grow-vector
##sys#pending-finalizers
+ (fx+ (fx* 2
_max_pending_finalizers) 1)
+
(##core#undefined)))
+ (when (##sys#fudge 13)
+ (##sys#print
+ (string-append
+ "[debug] too many finalizers ("
+ (##sys#number->string (##sys#fudge 26))
+ "), resized max finalizers to "
+ (##sys#number->string _max_pending_finalizers)
+ "\n")
+ #f ##sys#standard-error)))
+ (else
+ (when (##sys#fudge 13)
+ (##sys#print
+ (string-append
+ "[debug] too many finalizers ("
+ (##sys#fudge 26)
+ "), forcing ...\n")
+ #f ##sys#standard-error))
+ (##sys#force-finalizers) ) ) )
+ (##sys#set-finalizer! x y) ) ) )
(define ##sys#run-pending-finalizers
- (let ([vector-fill! vector-fill!]
- [working #f] )
+ (let ((vector-fill! vector-fill!)
+ (string-append string-append)
+ (working #f) )
(lambda (state)
(unless working
(set! working #t)
(let* ((c (##sys#slot ##sys#pending-finalizers 0)) )
(when (##sys#fudge 13)
- (print "[debug] running " c " finalizer(s) (" (##sys#fudge 26) "
live, "
- (##sys#fudge 27) " allocated) ..."))
+ (##sys#print
+ (string-append "[debug] running " (##sys#number->string c)
+ " finalizer(s) (" (##sys#number->string
(##sys#fudge 26))
+ " live, " (##sys#number->string (##sys#fudge 27))
+ " allocated) ...\n")
+ #f ##sys#standard-error))
(do ([i 0 (fx+ i 1)])
((fx>= i c))
(let ([i2 (fx+ 1 (fx* i 2))])
--
1.7.9.5
- [Chicken-hackers] [PATCH] debugging output for finalizers gets written to stdout,
Felix Winkelmann <=