fixed bug in fasl-reading #0=((x . #0#) (y . z))

scheme/ikarus.fasl.ss

@@ -222,6 +222,18 @@
              (let ([code (read-code cm m)])
                (if m (vector-ref marks m) ($code->closure code))))]
           [else (die who "invalid code header" c)])))
+
+    (define (read-list len m)
+      (let ([ls (make-list (+ len 1))])
+        (when m (put-mark m ls))
+        (let f ([ls ls])
+          (set-car! ls (read))
+          (let ([d (cdr ls)])
+            (if (null? d)
+                (set-cdr! ls (read))
+                (f d))))
+        ls))
+ 
     (define (read/mark m)
       (define (nom)
         (when m (die who "unhandled mark")))
@@ -333,27 +345,9 @@
              (or (vector-ref marks m)
                  (error who "uninitialized mark" m)))]
           [(#\l) ;;; list of length <= 255
-           (let ([ls 
+           (read-list (read-u8 p) m)]
-                  (let ([n (read-u8 p)])
-                    (let f ([n n])
-                      (cond
-                        [(< n 0) (read)]
-                        [else 
-                         (let ([x (read)])
-                           (cons x (f (- n 1))))])))])
-             (when m (put-mark m ls))
-             ls)]
           [(#\L) ;;; list of length > 255
-           (let ([ls 
+           (read-list (read-int p) m)]
-                  (let ([n (read-int p)])
-                    (let f ([n n])
-                      (cond
-                        [(< n 0) (read)]
-                        [else 
-                         (let ([x (read)])
-                           (cons x (f (- n 1))))])))])
-             (when m (put-mark m ls))
-             ls)]
           [(#\W) ;;; r6rs record type descriptor
            (let* ([name    (read)]
                   [parent  (read)]

scheme/last-revision

@@ -1 +1 @@
-1692
+1693

scheme/tests/fasl.ss

@@ -49,7 +49,9 @@
     (test (make-rectangular 12.0 13.0))
     (test (string #\a))
     (test (string #\x3bb))
-    (test-cycle))
+    (test-cycle)
+    (test '#1=((x . #1#) (y . z)))
+    )
 
 )