* keyboard interrupts are now continuable.

benchmarks/rnrs-benchmarks/sum1.ss

@@ -25,7 +25,10 @@
     (run-benchmark
      "sum1"
      sum1-iters
-     (lambda (result) (and (fl>=? result 15794.974999999)
+     (lambda (result) 
-                           (fl<=? result 15794.975000001)))
+       (display result)
+       (newline)
+       (and (fl>=? result 15794.974999999)
+            (fl<=? result 15794.975000001)))
      (lambda () (lambda () (go))))))
 

scheme/ikarus.compiler.altcogen.ss

@@ -421,12 +421,26 @@
           (if value-dest
               (make-seq body (make-set value-dest return-value-register))
               body)))))
+  ;;; (define (alloc-check size)
+  ;;;   (E (make-conditional ;;; PCB ALLOC-REDLINE
+  ;;;        (make-primcall '<= 
+  ;;;          (list (make-primcall 'int+ (list apr size)) 
+  ;;;                (make-primcall 'mref (list pcr (make-constant 4)))))
+  ;;;        (make-primcall 'nop '())
+  ;;;        (make-funcall 
+  ;;;          (make-primcall 'mref
+  ;;;            (list
+  ;;;              (make-constant (make-object (primref->symbol 'do-overflow)))
+  ;;;              (make-constant (- disp-symbol-record-proc symbol-ptag))))
+  ;;;          (list size)))))
   (define (alloc-check size)
-    (E (make-conditional ;;; PCB ALLOC-REDLINE
+    (E (make-shortcut
-         (make-primcall '<= 
+         (make-conditional ;;; PCB ALLOC-REDLINE
-           (list (make-primcall 'int+ (list apr size)) 
+           (make-primcall '<= 
-                 (make-primcall 'mref (list pcr (make-constant 4)))))
+             (list (make-primcall 'int+ (list apr size)) 
-         (make-primcall 'nop '())
+                   (make-primcall 'mref (list pcr (make-constant 4)))))
+           (make-primcall 'nop '())
+           (make-primcall 'interrupt '()))
          (make-funcall 
            (make-primcall 'mref
              (list

scheme/ikarus.handlers.ss

@@ -45,8 +45,13 @@
   (define interrupt-handler
     (make-parameter
       (lambda ()
+        (define-condition-type &interrupted &condition
+          make-interrupted-condition interrupted-condition?)
         (set-port-output-index! (console-output-port) 0)
-        (error #f "interrupted"))
+        (raise-continuable
+          (condition
+            (make-interrupted-condition)
+            (make-message-condition "received an interrupt signal"))))
       (lambda (x)
         (if (procedure? x)
             x

scheme/ikarus.numerics.ss

@@ -625,9 +625,9 @@
                 (+ q (->flonum r d))))))
     (let ([n (numerator x)] [d (denominator x)])
       (let ([b (bitwise-first-bit-set n)])
-        (if (eqv? b 0) 
+        (if (eqv? b 0)
             (let ([b (bitwise-first-bit-set d)])
-              (if (eqv? b 0) 
+              (if (eqv? b 0)
                   (->flonum n d)
                   (/ (->flonum n (bitwise-arithmetic-shift-right d b))
                      (expt 2.0 b))))

scheme/run-tests.ss

@@ -30,6 +30,7 @@
         (tests string-to-number)
         (tests input-ports)
         (tests fldiv-and-mod)
+        (tests parse-flonums)
         )
 
 (define (test-exact-integer-sqrt)
@@ -45,6 +46,8 @@
   (f 0 536870911000 536870911)
   (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
 
+(test-parse-flonums)
+
 (test-reader)
 (test-char-syntax)
 (test-bytevectors)