* Added (ikarus system $ratnums) library.
This commit is contained in:
parent
d062baee17
commit
67765257cf
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -139,6 +139,11 @@
|
||||||
[$bignum-size 1 value]
|
[$bignum-size 1 value]
|
||||||
[$bignum-byte-ref 2 value]
|
[$bignum-byte-ref 2 value]
|
||||||
[$bignum-byte-set! 3 effect]
|
[$bignum-byte-set! 3 effect]
|
||||||
|
;;; ratnums
|
||||||
|
[$make-ratnum 2 value]
|
||||||
|
[$ratnum? 1 pred]
|
||||||
|
[$ratnum-n 1 value]
|
||||||
|
[$ratnum-d 1 value]
|
||||||
;;; symbols
|
;;; symbols
|
||||||
[$make-symbol 1 value]
|
[$make-symbol 1 value]
|
||||||
[$symbol-value 1 value]
|
[$symbol-value 1 value]
|
||||||
|
@ -1965,6 +1970,7 @@
|
||||||
[($symbol-string $symbol-unique-string)
|
[($symbol-string $symbol-unique-string)
|
||||||
(andmap (check op symbol?) rand*)]
|
(andmap (check op symbol?) rand*)]
|
||||||
[($constant-ref $set-constant! $intern $pcb-set! $pcb-ref $make-symbol
|
[($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!
|
$symbol-value $set-symbol-value! $set-symbol-function! $symbol-plist $set-symbol-plist!
|
||||||
$set-symbol-system-value! $set-symbol-system-value!
|
$set-symbol-system-value! $set-symbol-system-value!
|
||||||
$set-symbol-unique-string!
|
$set-symbol-unique-string!
|
||||||
|
@ -2370,6 +2376,7 @@
|
||||||
(check-const (fx* (length arg*) pair-size) x)]
|
(check-const (fx* (length arg*) pair-size) x)]
|
||||||
[(vector $record $string)
|
[(vector $record $string)
|
||||||
(check-const (fx+ (fx* (length arg*) wordsize) disp-vector-data) x)]
|
(check-const (fx+ (fx* (length arg*) wordsize) disp-vector-data) x)]
|
||||||
|
[($make-ratnum) (check-const ratnum-size x)]
|
||||||
[else x]))]
|
[else x]))]
|
||||||
[(forcall op arg*)
|
[(forcall op arg*)
|
||||||
(make-forcall op (map Expr arg*))]
|
(make-forcall op (map Expr arg*))]
|
||||||
|
@ -2933,6 +2940,11 @@
|
||||||
(define flonum-size 16)
|
(define flonum-size 16)
|
||||||
(define disp-flonum-data 8)
|
(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-mask #b111)
|
||||||
(define bignum-tag #b011)
|
(define bignum-tag #b011)
|
||||||
(define bignum-sign-mask #b1000)
|
(define bignum-sign-mask #b1000)
|
||||||
|
@ -3248,6 +3260,9 @@
|
||||||
[(symbol?)
|
[(symbol?)
|
||||||
(indirect-type-pred vector-mask vector-tag #f
|
(indirect-type-pred vector-mask vector-tag #f
|
||||||
symbol-record-tag rand* Lt Lf ac)]
|
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)]
|
[(procedure?) (type-pred closure-mask closure-tag rand* Lt Lf ac)]
|
||||||
[(boolean?) (type-pred bool-mask bool-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)]
|
[(null?) (type-pred #f nil rand* Lt Lf ac)]
|
||||||
|
@ -3710,6 +3725,10 @@
|
||||||
(indirect-ref arg* (fx- disp-port-output-index vector-tag) ac)]
|
(indirect-ref arg* (fx- disp-port-output-index vector-tag) ac)]
|
||||||
[($port-output-size)
|
[($port-output-size)
|
||||||
(indirect-ref arg* (fx- disp-port-output-size vector-tag) ac)]
|
(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)
|
[(pointer-value)
|
||||||
(list*
|
(list*
|
||||||
(movl (Simple (car arg*)) eax)
|
(movl (Simple (car arg*)) eax)
|
||||||
|
@ -3958,6 +3977,17 @@
|
||||||
(addl (int record-tag) eax)
|
(addl (int record-tag) eax)
|
||||||
(addl (int (align symbol-record-size)) apr)
|
(addl (int (align symbol-record-size)) apr)
|
||||||
ac)]
|
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/input) (do-make-port input-port-tag arg* ac)]
|
||||||
[($make-port/output) (do-make-port output-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)]
|
[($make-port/both) (do-make-port input/output-port-tag arg* ac)]
|
||||||
|
|
|
@ -122,6 +122,7 @@
|
||||||
[$bignums (ikarus system $bignums) #f]
|
[$bignums (ikarus system $bignums) #f]
|
||||||
[$bytes (ikarus system $bytevectors) #f]
|
[$bytes (ikarus system $bytevectors) #f]
|
||||||
[$fx (ikarus system $fx) #f]
|
[$fx (ikarus system $fx) #f]
|
||||||
|
[$rat (ikarus system $ratnums) #f]
|
||||||
[$symbols (ikarus system $symbols) #f]
|
[$symbols (ikarus system $symbols) #f]
|
||||||
[$records (ikarus system $records) #f]
|
[$records (ikarus system $records) #f]
|
||||||
[$ports (ikarus system $ports) #f]
|
[$ports (ikarus system $ports) #f]
|
||||||
|
@ -134,11 +135,42 @@
|
||||||
[$boot (ikarus system $bootstrap) #f]
|
[$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
|
(define bootstrap-collection
|
||||||
(let ([ls (map
|
(let ([ls (map
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(find-library-by-name (cadr x)))
|
(find-library-by-name (cadr x)))
|
||||||
library-legend)])
|
library-legend2)])
|
||||||
(case-lambda
|
(case-lambda
|
||||||
[() ls]
|
[() ls]
|
||||||
[(x) (unless (memq x ls)
|
[(x) (unless (memq x ls)
|
||||||
|
@ -515,6 +547,11 @@
|
||||||
[$bignum-byte-ref $bignums]
|
[$bignum-byte-ref $bignums]
|
||||||
[$bignum-byte-set! $bignums]
|
[$bignum-byte-set! $bignums]
|
||||||
|
|
||||||
|
[$make-ratnum $rat]
|
||||||
|
[$ratnum-n $rat]
|
||||||
|
[$ratnum-d $rat]
|
||||||
|
[$ratnum? $rat]
|
||||||
|
|
||||||
[$make-vector $vectors]
|
[$make-vector $vectors]
|
||||||
[$vector-length $vectors]
|
[$vector-length $vectors]
|
||||||
[$vector-ref $vectors]
|
[$vector-ref $vectors]
|
||||||
|
|
Loading…
Reference in New Issue