Ticket #989: signal-handler-hack.patch

library.scm

@@ -4445 +4445 @@
 
 (define ##sys#signal-vector (make-vector 256 #f))
 
-(define (##sys#interrupt-hook reason state)
-  (let loop ((reason reason))
-    (cond ((and reason (##sys#slot ##sys#signal-vector reason)) =>
-           (lambda (handler)
-             (handler reason)
-             (loop (##core#inline "C_i_pending_interrupt" #f))))
-          ((fx> (##sys#slot ##sys#pending-finalizers 0) 0)
-           (##sys#run-pending-finalizers state) )
-          ((procedure? state) (state))
-          (else (##sys#context-switch state) ) ) ) )
+(define ##sys#interrupt-hook
+  (let ((foo #f))
+    (lambda (reason state)
+      (if foo
+          (begin
+            (cond ((and reason (##sys#slot ##sys#signal-vector reason)) =>
+                   (lambda (handler)
+                     (handler reason))))
+            (##sys#context-switch state))
+          (begin
+            (set! foo #t)
+            (let loop ((reason reason))
+              (cond ((and reason (##sys#slot ##sys#signal-vector reason)) =>
+                     (lambda (handler)
+                       (handler reason)
+                       (loop (##core#inline "C_i_pending_interrupt" #f))))
+                    ((fx> (##sys#slot ##sys#pending-finalizers 0) 0)
+                     (##sys#run-pending-finalizers state) )
+                    ((procedure? state) (state))
+                    (else (##sys#context-switch state) ) ) )
+            (set! foo #f))))) )
 
 (define (##sys#dispatch-interrupt k)
   (##sys#interrupt-hook