conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

- fixed bugs in pass-specify-rep where some (known) types were 

unhandled causing compile time errors.
- fixed some bootstrapping issues with pointer? (which was moved out
  of the (ikarus) library)
- freshened up the bootfiles for both 32- and 64-bit version of
  ikarus.
This commit is contained in:
Abdulaziz Ghuloum 2008-10-12 01:15:20 -04:00
parent 69c62649cc
commit 811c94361b
7 changed files with 25 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.4.prebuilt
View File

Binary file not shown.

BIN
scheme/ikarus.boot.8.prebuilt
View File

Binary file not shown.

2
scheme/ikarus.main.ss
View File

@ -72,7 +72,7 @@
(library (ikarus main) (library (ikarus main)
(export) (export)
(import (ikarus) (import (ikarus)
(ikarus startup) (except (ikarus startup) host-info)
(only (ikarus load) load-r6rs-top-level)) (only (ikarus load) load-r6rs-top-level))
(init-library-path) (init-library-path)
(let-values ([(files script script-type args) (let-values ([(files script script-type args)

1
scheme/ikarus.writer.ss
View File

@ -27,6 +27,7 @@
(ikarus system $symbols) (ikarus system $symbols)
(ikarus system $bytevectors) (ikarus system $bytevectors)
(ikarus system $transcoders) (ikarus system $transcoders)
(only (ikarus system $foreign) pointer? pointer->integer)
(only (ikarus.pretty-formats) get-fmt) (only (ikarus.pretty-formats) get-fmt)
(except (ikarus) (except (ikarus)
write display format printf fprintf print-error print-unicode print-graph write display format printf fprintf print-error print-unicode print-graph

2
scheme/last-revision
View File

@ -1 +1 @@
1621 1622

2
scheme/makefile.ss
View File

@ -271,7 +271,7 @@
[$stack (ikarus system $stack) #f #t] [$stack (ikarus system $stack) #f #t]
[$interrupts (ikarus system $interrupts) #f #t] [$interrupts (ikarus system $interrupts) #f #t]
[$io (ikarus system $io) #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] [$all (psyntax system $all) #f #t]
[$boot (psyntax system $bootstrap) #f #t] [$boot (psyntax system $bootstrap) #f #t]
[ne (psyntax null-environment-5) #f #f] [ne (psyntax null-environment-5) #f #f]

30
scheme/pass-specify-rep-primops.ss
View File

@ -233,7 +233,8 @@
(cond (cond
[(list? ls) (nop)] [(list? ls) (nop)]
[else (interrupt)])] [else (interrupt)])]
[(known) (error 'translate "memq")] [(known expr t)
(cogen-effect-memq x expr)]
[else (interrupt)])]) [else (interrupt)])])
(define (equable? x) (define (equable? x)
@ -247,7 +248,8 @@
[(and (list? lsv) (andmap equable? lsv)) [(and (list? lsv) (andmap equable? lsv))
(cogen-value-$memq x ls)] (cogen-value-$memq x ls)]
[else (interrupt)])] [else (interrupt)])]
[(known) (error 'translate "memv")] [(known expr t)
(cogen-value-memv x expr)]
[else (interrupt)])] [else (interrupt)])]
[(P x ls) [(P x ls)
(struct-case ls (struct-case ls
@ -256,7 +258,8 @@
[(and (list? lsv) (andmap equable? lsv)) [(and (list? lsv) (andmap equable? lsv))
(cogen-pred-$memq x ls)] (cogen-pred-$memq x ls)]
[else (interrupt)])] [else (interrupt)])]
[(known) (error 'translate "memv")] [(known expr t)
(cogen-pred-memv x expr)]
[else (interrupt)])] [else (interrupt)])]
[(E x ls) [(E x ls)
(struct-case ls (struct-case ls
@ -264,7 +267,8 @@
(cond (cond
[(list? lsv) (nop)] [(list? lsv) (nop)]
[else (interrupt)])] [else (interrupt)])]
[(known) (error 'translate "memv")] [(known expr t)
(cogen-effect-memv x expr)]
[else (interrupt)])]) [else (interrupt)])])
/section) /section)
@ -639,7 +643,8 @@
(prm 'mref (T x) (prm 'mref (T x)
(K (+ (- disp-closure-data closure-tag) (K (+ (- disp-closure-data closure-tag)
(* i wordsize))))] (* i wordsize))))]
[(known) (error 'translate "$cpref")] [(known expr t)
(cogen-value-$cpref x expr)]
[else (interrupt)])]) [else (interrupt)])])
/section) /section)
@ -717,7 +722,8 @@
(interrupt-when (cogen-pred-$unbound-object? v)) (interrupt-when (cogen-pred-$unbound-object? v))
v) v)
(interrupt))] (interrupt))]
[(known) (error 'translate "top-level-value")] [(known expr t)
(cogen-value-top-level-value expr)]
[else [else
(with-tmp ([x (T x)]) (with-tmp ([x (T x)])
(interrupt-unless (cogen-pred-symbol? x)) (interrupt-unless (cogen-pred-symbol? x))
@ -731,7 +737,8 @@
(with-tmp ([v (cogen-value-$symbol-value x)]) (with-tmp ([v (cogen-value-$symbol-value x)])
(interrupt-when (cogen-pred-$unbound-object? v))) (interrupt-when (cogen-pred-$unbound-object? v)))
(interrupt))] (interrupt))]
[(known) (error 'translate "top-level-value")] [(known expr t)
(cogen-effect-top-level-value expr)]
[else [else
(with-tmp ([x (T x)]) (with-tmp ([x (T x)])
(interrupt-unless (cogen-pred-symbol? x)) (interrupt-unless (cogen-pred-symbol? x))
@ -1047,7 +1054,8 @@
(K (+ (- 7 i) (- disp-flonum-data record-tag)))) (K (+ (- 7 i) (- disp-flonum-data record-tag))))
(K 255)) (K 255))
(K fx-shift))] (K fx-shift))]
[(known) (error 'translate "$flonum-u8-ref")] [(known expr t)
(cogen-value-$flonum-u8-ref s expr)]
[else (interrupt)])] [else (interrupt)])]
[(P s i) (K #t)] [(P s i) (K #t)]
[(E s i) (nop)]) [(E s i) (nop)])
@ -1070,7 +1078,8 @@
(T x) (T x)
(K (+ (- 7 i) (- disp-flonum-data vector-tag))) (K (+ (- 7 i) (- disp-flonum-data vector-tag)))
(prm 'sra (T v) (K fx-shift)))] (prm 'sra (T v) (K fx-shift)))]
[(known) (error 'translate "$flonum-set!")] [(known expr t)
(cogen-effect-$flonum-set! x expr v)]
[else (interrupt)])]) [else (interrupt)])])
(define-primop $fixnum->flonum unsafe (define-primop $fixnum->flonum unsafe
@ -1605,7 +1614,8 @@
(K fx-shift))))] (K fx-shift))))]
[else [else
(interrupt)])] (interrupt)])]
[(known) (error 'translate "div")] [(known expr t)
(cogen-value-div x expr)]
[else (interrupt)])]) [else (interrupt)])])
(define-primop quotient safe (define-primop quotient safe