diff --git a/src/ikarus.boot b/src/ikarus.boot index b47d436..e65f2a1 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 2becfc1..9d7b59c 100644 --- a/src/ikarus.compiler.ss +++ b/src/ikarus.compiler.ss @@ -1921,7 +1921,8 @@ null? pair? not cons eq? vector symbol? error eof-object eof-object? void base-rtd $unbound-object? code? $forward-ptr? bwp-object? pointer-value top-level-value car cdr list* list $record - port? input-port? output-port? + port? input-port? output-port? $bytevector-set! + $make-bytevector $bytevector-ref bytevector? $make-port/input $make-port/output $make-port/both $port-handler $port-input-buffer $port-input-index $port-input-size @@ -2335,7 +2336,7 @@ [($frame->continuation $code->closure) (check-const (fx+ disp-closure-data (fx* (length arg*) wordsize)) x)] - [($make-string) + [($make-string $make-bytevector) (record-case (car arg*) [(constant i) (check-const (fx+ i (fx+ disp-string-data 1)) x)] @@ -2950,6 +2951,11 @@ ;(define disp-symbol-unused 28) ;(define symbol-size 32) + (define bytevector-mask 7) + (define bytevector-tag 2) + (define disp-bytevector-length 0) + (define disp-bytevector-data 4) + (define symbol-record-tag #x5F) (define disp-symbol-record-string 4) (define disp-symbol-record-ustring 8) @@ -3228,10 +3234,11 @@ (cond-branch op Lt Lf ac))])) (define (do-pred-prim op rand* Lt Lf ac) (case op - [(fixnum?) (type-pred fx-mask fx-tag rand* Lt Lf ac)] - [(pair?) (type-pred pair-mask pair-tag rand* Lt Lf ac)] - [(char?) (type-pred char-mask char-tag rand* Lt Lf ac)] - [(string?) (type-pred string-mask string-tag rand* Lt Lf ac)] + [(fixnum?) (type-pred fx-mask fx-tag rand* Lt Lf ac)] + [(pair?) (type-pred pair-mask pair-tag rand* Lt Lf ac)] + [(char?) (type-pred char-mask char-tag rand* Lt Lf ac)] + [(string?) (type-pred string-mask string-tag rand* Lt Lf ac)] + [(bytevector?) (type-pred bytevector-mask bytevector-tag rand* Lt Lf ac)] [(symbol?) (indirect-type-pred vector-mask vector-tag #f symbol-record-tag rand* Lt Lf ac)] @@ -3793,6 +3800,18 @@ (addl (int (fx+ disp-string-data object-alignment)) apr) (sarl (int align-shift) apr) (sall (int align-shift) apr) + ac)] + [($make-bytevector) + (list* (movl (Simple (car arg*)) ebx) + (movl ebx (mem disp-bytevector-length apr)) + (movl apr eax) + (addl (int bytevector-tag) eax) + (sarl (int fx-shift) ebx) + (addl ebx apr) + (movb (int 0) (mem disp-bytevector-data apr)) + (addl (int (fx+ disp-bytevector-data object-alignment)) apr) + (sarl (int align-shift) apr) + (sall (int align-shift) apr) ac)] [($make-vector) (list* (movl (Simple (car arg*)) ebx) @@ -4007,7 +4026,7 @@ (do-effect-prim op arg* (cons (movl (int void-object) eax) ac))] [(fixnum? bignum? flonum? immediate? $fxzero? boolean? char? pair? - vector? string? symbol? + vector? bytevector? string? symbol? procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq? $char= $char< $char<= $char> $char>= $unbound-object? code? $record? $record/rtd? bwp-object? port? input-port? output-port?) @@ -4098,6 +4117,13 @@ (movl (Simple (caddr arg*)) ebx) (movb bh (mem (fx- disp-string-data string-tag) eax)) ac)] + [($bytevector-set!) + (list* (movl (Simple (cadr arg*)) eax) + (sarl (int fx-shift) eax) + (addl (Simple (car arg*)) eax) + (movl (Simple (caddr arg*)) ebx) + (movb bh (mem (fx- disp-bytevector-data bytevector-tag) eax)) + ac)] [($set-car!) (list* (movl (Simple (car arg*)) eax) (movl (Simple (cadr arg*)) ebx) diff --git a/src/ikarus.predicates.ss b/src/ikarus.predicates.ss index d671735..d5b29a7 100644 --- a/src/ikarus.predicates.ss +++ b/src/ikarus.predicates.ss @@ -3,14 +3,14 @@ (export fixnum? flonum? bignum? number? complex? real? rational? integer? exact? eof-object? bwp-object? immediate? - boolean? char? vector? string? procedure? null? pair? + boolean? char? vector? bytevector? string? procedure? null? pair? symbol? code? not weak-pair? eq? eqv? equal?) (import (except (ikarus) fixnum? flonum? bignum? number? complex? real? rational? integer? exact? eof-object? bwp-object? - immediate? boolean? char? vector? string? procedure? + immediate? boolean? char? vector? bytevector? string? procedure? null? pair? weak-pair? symbol? code? not eq? eqv? equal? port? input-port? output-port?) (ikarus system $fx) @@ -20,7 +20,7 @@ (ikarus system $vectors) (rename (only (ikarus) fixnum? flonum? bignum? eof-object? bwp-object? immediate? boolean? char? vector? string? - procedure? null? pair? symbol? code? eq? + bytevector? procedure? null? pair? symbol? code? eq? port? input-port? output-port?) (fixnum? sys:fixnum?) (flonum? sys:flonum?) @@ -31,6 +31,7 @@ (boolean? sys:boolean?) (char? sys:char?) (vector? sys:vector?) + (bytevector? sys:bytevector?) (string? sys:string?) (procedure? sys:procedure?) (null? sys:null?) @@ -95,6 +96,7 @@ (define boolean? (lambda (x) (sys:boolean? x))) (define char? (lambda (x) (sys:char? x))) (define vector? (lambda (x) (sys:vector? x))) + (define bytevector? (lambda (x) (sys:bytevector? x))) (define string? (lambda (x) (sys:string? x))) (define procedure? (lambda (x) (sys:procedure? x))) (define null? (lambda (x) (sys:null? x))) diff --git a/src/makefile.ss b/src/makefile.ss index 2d5a7a4..fe86dea 100755 --- a/src/makefile.ss +++ b/src/makefile.ss @@ -68,6 +68,7 @@ "ikarus.cafe.ss" "ikarus.posix.ss" "ikarus.timer.ss" + "ikarus.bytevectors.ss" "ikarus.main.ss")) (define ikarus-system-macros @@ -270,6 +271,8 @@ [vector-length i r] [list->vector i r] [vector->list i r] + [make-bytevector i] + [for-each i r] [map i r] [andmap i] diff --git a/src/tests/bytevectors.ss b/src/tests/bytevectors.ss index 06318e5..a6a5528 100644 --- a/src/tests/bytevectors.ss +++ b/src/tests/bytevectors.ss @@ -3,7 +3,7 @@ (export test-bytevectors) (import (ikarus) (tests framework)) - (define (not-byte-vector? x) + (define (not-bytevector? x) (not (bytevector? x))) (define-tests test-bytevectors