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

* Added flonum, ratnum, and bignum fasl writers.

This commit is contained in:
Abdulaziz Ghuloum 2007-06-14 19:38:00 +03:00
parent e061dcd504
commit f147e391eb
3 changed files with 34 additions and 0 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.

3
src/ikarus.fasl.ss
View File

@ -28,6 +28,9 @@
;;; "<" + 4-bytes(i) : dereference the object marked with index i ;;; "<" + 4-bytes(i) : dereference the object marked with index i
;;; "x" : denotes code ;;; "x" : denotes code
;;; "T" : Thunk; followed by code. ;;; "T" : Thunk; followed by code.
;;; "r" + numerator + denominator : ratnum
;;; "f" + 8-byte : IEEE flonum
;;; "b" + 4-byte(n) + n-bytes denotes a bignum (sign is sign of n).

31
src/ikarus.fasl.write.ss
View File

@ -10,6 +10,8 @@
(ikarus system $fx) (ikarus system $fx)
(ikarus system $chars) (ikarus system $chars)
(ikarus system $strings) (ikarus system $strings)
(ikarus system $flonums)
(ikarus system $bignums)
(ikarus code-objects) (ikarus code-objects)
(except (ikarus) fasl-write)) (except (ikarus) fasl-write))
@ -166,6 +168,30 @@
(write-int n p) (write-int n p)
(write-bytevector x 0 n p)) (write-bytevector x 0 n p))
m] m]
[(flonum? x)
(write-char #\f p)
(write-byte ($flonum-u8-ref x 0) p)
(write-byte ($flonum-u8-ref x 1) p)
(write-byte ($flonum-u8-ref x 2) p)
(write-byte ($flonum-u8-ref x 3) p)
(write-byte ($flonum-u8-ref x 4) p)
(write-byte ($flonum-u8-ref x 5) p)
(write-byte ($flonum-u8-ref x 6) p)
(write-byte ($flonum-u8-ref x 7) p)
m]
[(ratnum? x)
(write-char #\r p)
(fasl-write-object (numerator x) p h
(fasl-write-object (denominator x) p h m))]
[(bignum? x)
(write-char #\b p)
(let ([sz ($bignum-size x)])
(write-int (if ($bignum-positive? x) sz (- sz)) p)
(let f ([i 0])
(unless (fx= i sz)
(write-byte ($bignum-byte-ref x i) p)
(f (fxadd1 i)))))
m]
[else (error 'fasl-write "~s is not fasl-writable" x)]))) [else (error 'fasl-write "~s is not fasl-writable" x)])))
(define (write-bytevector x i j p) (define (write-bytevector x i j p)
(unless ($fx= i j) (unless ($fx= i j)
@ -242,6 +268,11 @@
(code-freevars code))) (code-freevars code)))
(make-graph code h))] (make-graph code h))]
[(bytevector? x) (void)] [(bytevector? x) (void)]
[(flonum? x) (void)]
[(bignum? x) (void)]
[(ratnum? x)
(make-graph (numerator x) h)
(make-graph (denominator x) h)]
[else (error 'fasl-write "~s is not fasl-writable" x)])])))) [else (error 'fasl-write "~s is not fasl-writable" x)])]))))
(define fasl-write-to-port (define fasl-write-to-port
(lambda (x port) (lambda (x port)