diff --git a/scheme/ikarus.boot.4.prebuilt b/scheme/ikarus.boot.4.prebuilt index 2172bc5..d269109 100644 Binary files a/scheme/ikarus.boot.4.prebuilt and b/scheme/ikarus.boot.4.prebuilt differ diff --git a/scheme/ikarus.boot.8.prebuilt b/scheme/ikarus.boot.8.prebuilt index 90ff0bf..052eead 100644 Binary files a/scheme/ikarus.boot.8.prebuilt and b/scheme/ikarus.boot.8.prebuilt differ diff --git a/scheme/ikarus.main.ss b/scheme/ikarus.main.ss index de7addd..3ae5454 100644 --- a/scheme/ikarus.main.ss +++ b/scheme/ikarus.main.ss @@ -72,7 +72,7 @@ (library (ikarus main) (export) (import (ikarus) - (ikarus startup) + (except (ikarus startup) host-info) (only (ikarus load) load-r6rs-top-level)) (init-library-path) (let-values ([(files script script-type args) diff --git a/scheme/ikarus.writer.ss b/scheme/ikarus.writer.ss index 33ef19f..8156d33 100644 --- a/scheme/ikarus.writer.ss +++ b/scheme/ikarus.writer.ss @@ -27,6 +27,7 @@ (ikarus system $symbols) (ikarus system $bytevectors) (ikarus system $transcoders) + (only (ikarus system $foreign) pointer? pointer->integer) (only (ikarus.pretty-formats) get-fmt) (except (ikarus) write display format printf fprintf print-error print-unicode print-graph diff --git a/scheme/last-revision b/scheme/last-revision index ff0ba09..fed8f61 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1621 +1622 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 8a69fbe..c2087f4 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -271,7 +271,7 @@ [$stack (ikarus system $stack) #f #t] [$interrupts (ikarus system $interrupts) #f #t] [$io (ikarus system $io) #f #t] - [$for (ikarus system $foreign) #f #f] + [$for (ikarus system $foreign) #f #t] [$all (psyntax system $all) #f #t] [$boot (psyntax system $bootstrap) #f #t] [ne (psyntax null-environment-5) #f #f] @@ -1484,7 +1484,7 @@ [pointer-ref-double $for] [make-callout $for] [make-callback $for] - [host-info i] + [host-info i] )) diff --git a/scheme/pass-specify-rep-primops.ss b/scheme/pass-specify-rep-primops.ss index fc838f4..222675e 100644 --- a/scheme/pass-specify-rep-primops.ss +++ b/scheme/pass-specify-rep-primops.ss @@ -233,7 +233,8 @@ (cond [(list? ls) (nop)] [else (interrupt)])] - [(known) (error 'translate "memq")] + [(known expr t) + (cogen-effect-memq x expr)] [else (interrupt)])]) (define (equable? x) @@ -247,7 +248,8 @@ [(and (list? lsv) (andmap equable? lsv)) (cogen-value-$memq x ls)] [else (interrupt)])] - [(known) (error 'translate "memv")] + [(known expr t) + (cogen-value-memv x expr)] [else (interrupt)])] [(P x ls) (struct-case ls @@ -256,7 +258,8 @@ [(and (list? lsv) (andmap equable? lsv)) (cogen-pred-$memq x ls)] [else (interrupt)])] - [(known) (error 'translate "memv")] + [(known expr t) + (cogen-pred-memv x expr)] [else (interrupt)])] [(E x ls) (struct-case ls @@ -264,7 +267,8 @@ (cond [(list? lsv) (nop)] [else (interrupt)])] - [(known) (error 'translate "memv")] + [(known expr t) + (cogen-effect-memv x expr)] [else (interrupt)])]) /section) @@ -639,7 +643,8 @@ (prm 'mref (T x) (K (+ (- disp-closure-data closure-tag) (* i wordsize))))] - [(known) (error 'translate "$cpref")] + [(known expr t) + (cogen-value-$cpref x expr)] [else (interrupt)])]) /section) @@ -717,7 +722,8 @@ (interrupt-when (cogen-pred-$unbound-object? v)) v) (interrupt))] - [(known) (error 'translate "top-level-value")] + [(known expr t) + (cogen-value-top-level-value expr)] [else (with-tmp ([x (T x)]) (interrupt-unless (cogen-pred-symbol? x)) @@ -731,7 +737,8 @@ (with-tmp ([v (cogen-value-$symbol-value x)]) (interrupt-when (cogen-pred-$unbound-object? v))) (interrupt))] - [(known) (error 'translate "top-level-value")] + [(known expr t) + (cogen-effect-top-level-value expr)] [else (with-tmp ([x (T x)]) (interrupt-unless (cogen-pred-symbol? x)) @@ -1047,7 +1054,8 @@ (K (+ (- 7 i) (- disp-flonum-data record-tag)))) (K 255)) (K fx-shift))] - [(known) (error 'translate "$flonum-u8-ref")] + [(known expr t) + (cogen-value-$flonum-u8-ref s expr)] [else (interrupt)])] [(P s i) (K #t)] [(E s i) (nop)]) @@ -1070,7 +1078,8 @@ (T x) (K (+ (- 7 i) (- disp-flonum-data vector-tag))) (prm 'sra (T v) (K fx-shift)))] - [(known) (error 'translate "$flonum-set!")] + [(known expr t) + (cogen-effect-$flonum-set! x expr v)] [else (interrupt)])]) (define-primop $fixnum->flonum unsafe @@ -1605,7 +1614,8 @@ (K fx-shift))))] [else (interrupt)])] - [(known) (error 'translate "div")] + [(known expr t) + (cogen-value-div x expr)] [else (interrupt)])]) (define-primop quotient safe