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

* Added (ikarus system $ratnums) library.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-20 22:52:11 -04:00
parent d062baee17
commit 67765257cf
3 changed files with 68 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

30
src/ikarus.compiler.ss
View File

@ -139,6 +139,11 @@
[$bignum-size 1 value]
[$bignum-byte-ref 2 value]
[$bignum-byte-set! 3 effect]
;;; ratnums
[$make-ratnum 2 value]
[$ratnum? 1 pred]
[$ratnum-n 1 value]
[$ratnum-d 1 value]
;;; symbols
[$make-symbol 1 value]
[$symbol-value 1 value]
@ -1965,6 +1970,7 @@
[($symbol-string $symbol-unique-string)
(andmap (check op symbol?) rand*)]
[($constant-ref $set-constant! $intern $pcb-set! $pcb-ref $make-symbol
$make-ratnum $ratnum? $ratnum-n $ratnum-d
$symbol-value $set-symbol-value! $set-symbol-function! $symbol-plist $set-symbol-plist!
$set-symbol-system-value! $set-symbol-system-value!
$set-symbol-unique-string!
@ -2370,6 +2376,7 @@
(check-const (fx* (length arg*) pair-size) x)]
[(vector $record $string)
(check-const (fx+ (fx* (length arg*) wordsize) disp-vector-data) x)]
[($make-ratnum) (check-const ratnum-size x)]
[else x]))]
[(forcall op arg*)
(make-forcall op (map Expr arg*))]
@ -2933,6 +2940,11 @@
(define flonum-size 16)
(define disp-flonum-data 8)
(define ratnum-tag #x27)
(define disp-ratnum-num 4)
(define disp-ratnum-den 8)
(define ratnum-size 16)
(define bignum-mask #b111)
(define bignum-tag #b011)
(define bignum-sign-mask #b1000)
@ -3248,6 +3260,9 @@
[(symbol?)
(indirect-type-pred vector-mask vector-tag #f
symbol-record-tag rand* Lt Lf ac)]
[($ratnum?)
(indirect-type-pred vector-mask vector-tag #f
ratnum-tag rand* Lt Lf ac)]
[(procedure?) (type-pred closure-mask closure-tag rand* Lt Lf ac)]
[(boolean?) (type-pred bool-mask bool-tag rand* Lt Lf ac)]
[(null?) (type-pred #f nil rand* Lt Lf ac)]
@ -3710,6 +3725,10 @@
(indirect-ref arg* (fx- disp-port-output-index vector-tag) ac)]
[($port-output-size)
(indirect-ref arg* (fx- disp-port-output-size vector-tag) ac)]
[($ratnum-n)
(indirect-ref arg* (fx- disp-ratnum-num vector-tag) ac)]
[($ratnum-d)
(indirect-ref arg* (fx- disp-ratnum-den vector-tag) ac)]
[(pointer-value)
(list*
(movl (Simple (car arg*)) eax)
@ -3958,6 +3977,17 @@
(addl (int record-tag) eax)
(addl (int (align symbol-record-size)) apr)
ac)]
[($make-ratnum)
(list*
(movl (int ratnum-tag) (mem 0 apr))
(movl (Simple (car arg*)) eax)
(movl eax (mem disp-ratnum-num apr))
(movl (Simple (cadr arg*)) eax)
(movl eax (mem disp-ratnum-den apr))
(movl apr eax)
(addl (int vector-tag) eax)
(addl (int ratnum-size) apr)
ac)]
[($make-port/input) (do-make-port input-port-tag arg* ac)]
[($make-port/output) (do-make-port output-port-tag arg* ac)]
[($make-port/both) (do-make-port input/output-port-tag arg* ac)]

39
src/makefile.ss
View File

@ -122,6 +122,7 @@
[$bignums (ikarus system $bignums) #f]
[$bytes (ikarus system $bytevectors) #f]
[$fx (ikarus system $fx) #f]
[$rat (ikarus system $ratnums) #f]
[$symbols (ikarus system $symbols) #f]
[$records (ikarus system $records) #f]
[$ports (ikarus system $ports) #f]
@ -134,11 +135,42 @@
[$boot (ikarus system $bootstrap) #f]
))
(define library-legend2
'([i (ikarus) #t]
[symbols (ikarus symbols) #t]
[parameters (ikarus parameters) #t]
[interaction (ikarus interaction) #t]
[r (r6rs) #t]
[syncase (r6rs syntax-case) #t]
[cm (chez modules) #t]
[$all (ikarus system $all) #f]
[$pairs (ikarus system $pairs) #f]
[$lists (ikarus system $lists) #f]
[$chars (ikarus system $chars) #f]
[$strings (ikarus system $strings) #f]
[$vectors (ikarus system $vectors) #f]
[$bignums (ikarus system $bignums) #f]
[$bytes (ikarus system $bytevectors) #f]
[$fx (ikarus system $fx) #f]
[$rat (ikarus system $ratnums) #f]
[$symbols (ikarus system $symbols) #f]
[$records (ikarus system $records) #f]
[$ports (ikarus system $ports) #f]
[$codes (ikarus system $codes) #f]
[$tcbuckets (ikarus system $tcbuckets) #f]
[$io (ikarus system $io) #f]
[$arg-list (ikarus system $arg-list) #f]
[$stack (ikarus system $stack) #f]
[$interrupts (ikarus system $interrupts) #f]
[$boot (ikarus system $bootstrap) #f]
))
(define bootstrap-collection
(let ([ls (map
(lambda (x)
(find-library-by-name (cadr x)))
library-legend)])
library-legend2)])
(case-lambda
[() ls]
[(x) (unless (memq x ls)
@ -515,6 +547,11 @@
[$bignum-byte-ref $bignums]
[$bignum-byte-set! $bignums]
[$make-ratnum $rat]
[$ratnum-n $rat]
[$ratnum-d $rat]
[$ratnum? $rat]
[$make-vector $vectors]
[$vector-length $vectors]
[$vector-ref $vectors]