diff --git a/src/ikarus.boot b/src/ikarus.boot index 59ca01e..94e5720 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.fasl.ss b/src/ikarus.fasl.ss index f4b69d4..60b9905 100644 --- a/src/ikarus.fasl.ss +++ b/src/ikarus.fasl.ss @@ -16,8 +16,8 @@ ;;; "I" + 4-bytes : denoting a fixnum (in host byte order) ;;; "C" + 1-byte : denoting a character ;;; "P" + object1 + object2 : a pair -;;; "V" + 4-bytes(n) + object ... : a vector of length n followed by n -;;; objects +;;; "V" + 4-bytes(n) + object ... : a vector of length n followed by n objects +;;; "v" + 4-byte(n) + octet ... : a bytevector of length n followed by n octets ;;; "S" + 4-bytes(n) + char ... : a string ;;; "M" + symbol-name : a symbol ;;; "G" + pretty-name + unique-name : a gensym diff --git a/src/ikarus.fasl.write.ss b/src/ikarus.fasl.write.ss index ef1c1c1..110a77c 100644 --- a/src/ikarus.fasl.write.ss +++ b/src/ikarus.fasl.write.ss @@ -4,6 +4,9 @@ (import (ikarus system $codes) (ikarus system $records) + (ikarus system $io) + (ikarus system $bytevectors) + (ikarus system $fx) (ikarus code-objects) (except (ikarus) fasl-write)) @@ -111,7 +114,17 @@ [(procedure? x) (write-char #\Q p) (fasl-write-object ($closure-code x) p h m)] + [(bytevector? x) + (write-char #\v p) + (let ([n ($bytevector-length x)]) + (write-int n p) + (write-bytevector x 0 n p)) + m] [else (error 'fasl-write "~s is not fasl-writable" x)]))) + (define (write-bytevector x i j p) + (unless ($fx= i j) + ($write-byte ($bytevector-u8-ref x i) p) + (write-bytevector x ($fxadd1 i) j p))) (define fasl-write-object (lambda (x p h m) (cond @@ -182,6 +195,7 @@ "Cannot write a non-thunk procedure; the one given has ~s free vars" (code-freevars code))) (make-graph code h))] + [(bytevector? x) (void)] [else (error 'fasl-write "~s is not fasl-writable" x)])])))) (define fasl-write-to-port (lambda (x port)