diff --git a/src/ikarus.boot b/src/ikarus.boot index 523e6f4..817fb49 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 25bb4eb..33d8dbd 100644 --- a/src/ikarus.compiler.ss +++ b/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)] diff --git a/src/ikarus.fasl.ss b/src/ikarus.fasl.ss index 1a1f49b..bd30941 100644 --- a/src/ikarus.fasl.ss +++ b/src/ikarus.fasl.ss @@ -237,15 +237,12 @@ -#!eof - -#not working yet - - - (library (ikarus fasl read) - (export) - (import ) + (export fasl-read) + (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))])) + + ) diff --git a/src/makefile.ss b/src/makefile.ss index 4fd7d4c..acefc1c 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -122,7 +122,7 @@ (define ikarus-macros-map '([define i r] [define-syntax i r] - [module i cm] + [module i cm] [begin i r] [set! i r] [foreign-call i] @@ -137,7 +137,7 @@ [if i r] [when i r] [unless i r] - [parameterize i parameters] + [parameterize i parameters] [case i r] [let-values i r] [define-record i r] @@ -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))))]))