* reinstated (ikarus fasl read)

src/ikarus.compiler.ss

@@ -840,7 +840,8 @@
   645 list
 |#
 
-;;; FIXME: should handle (+ x k), (- x k) where k is a fixnum
+;;; FIXME URGENT: should handle (+ x k), (- x k) where k is a fixnum
+;;;               also fx+, fx-
 (module (optimize-primcall)
   (define (optimize-primcall ctxt op rand*)
     (cond
@@ -4748,7 +4749,6 @@
              (map CodeExpr ls)))]))
 
 (module ;assembly-labels
-
   (refresh-cached-labels!
    sl-apply-label sl-fx+-type-label sl-fx+-types-label
    sl-continuation-code-label sl-invalid-args-label
@@ -4756,7 +4756,6 @@
    sl-cwv-label sl-top-level-value-error-label sl-cadr-error-label
    sl-cdr-error-label sl-car-error-label sl-nonprocedure-error-label
    sl-fxsub1-error-label sl-fxadd1-error-label sl-fx+-overflow-label)
-
   (define-syntax define-cached
     (lambda (x)
       (syntax-case x ()
@@ -5067,8 +5066,7 @@
           (movl (primref-loc 'fx+-overflow-error) cpr)
           (movl (int (argc-convention 2)) eax)
           (tail-indirect-cpr-call))))
-    SL_fx+_overflow])
+    SL_fx+_overflow]))
-)
 
 (define (compile-core-expr->code p)
   (let* ([p (recordize p)]

src/ikarus.fasl.ss

@@ -237,15 +237,12 @@
 
 
 
-#!eof
-
-#not working yet
-
-
-
 (library (ikarus fasl read)
-  (export)
+  (export fasl-read)
-  (import )
+  (import (ikarus)
+          (ikarus code-objects)
+          (ikarus system $codes)
+          (ikarus system $records))
 
   (define who 'fasl-read)
   (define (assert-eq? x y)
@@ -457,5 +454,15 @@
       (assert-eq? (read-char p) #\K)
       (assert-eq? (read-char p) #\0)
       (assert-eq? (read-char p) #\1)
-      (do-read p))))
+      (do-read p)))
+  
+  (define fasl-read
+    (case-lambda
+      [() ($fasl-read (current-input-port))]
+      [(p) 
+       (if (input-port? p) 
+           ($fasl-read p)
+           (error 'fasl-read "~s is not an input port" p))]))
+
+  )
 

src/makefile.ss

@@ -392,6 +392,7 @@
     [record-length           i]
     [record-printer          i]
     [record-ref              i]
+    [record-set!             i]
     [record-field-accessor   i]
     [record-field-mutator    i]
     [identifier?             i syncase]
@@ -588,6 +589,7 @@
           [(assq x (export-subst))
            (error who "ambiguous export of ~s" x)]
           [(assq x subst) =>
+           ;;; primitive defined (exported) within the compiled libraries
            (lambda (p)
              (let ([label (cdr p)])
                (cond
@@ -603,7 +605,8 @@
                          (error #f "invalid binding ~s for ~s" p x)])))]
                  [else (error #f "cannot find binding for ~s" x)])))]
           [else 
-           ;;; core primitive with no backing definition
+           ;;; core primitive with no backing definition, assumed to
+           ;;; be defined in other strata of the system
            (let ([label (gensym)])
              (export-subst (cons x label))
              (export-env (cons label (cons 'core-prim x))))]))