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

* Added make-bytevector and bytevector?

This commit is contained in:
Abdulaziz Ghuloum 2007-05-15 12:42:52 -04:00
parent 9d3e23fb6d
commit 49d254c89e
5 changed files with 42 additions and 11 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.

40
src/ikarus.compiler.ss
View File

@ -1921,7 +1921,8 @@
null? pair? not cons eq? vector symbol? error eof-object eof-object? null? pair? not cons eq? vector symbol? error eof-object eof-object?
void base-rtd $unbound-object? code? $forward-ptr? bwp-object? void base-rtd $unbound-object? code? $forward-ptr? bwp-object?
pointer-value top-level-value car cdr list* list $record 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 $make-port/input $make-port/output $make-port/both
$port-handler $port-handler
$port-input-buffer $port-input-index $port-input-size $port-input-buffer $port-input-index $port-input-size
@ -2335,7 +2336,7 @@
[($frame->continuation $code->closure) [($frame->continuation $code->closure)
(check-const (check-const
(fx+ disp-closure-data (fx* (length arg*) wordsize)) x)] (fx+ disp-closure-data (fx* (length arg*) wordsize)) x)]
[($make-string) [($make-string $make-bytevector)
(record-case (car arg*) (record-case (car arg*)
[(constant i) [(constant i)
(check-const (fx+ i (fx+ disp-string-data 1)) x)] (check-const (fx+ i (fx+ disp-string-data 1)) x)]
@ -2950,6 +2951,11 @@
;(define disp-symbol-unused 28) ;(define disp-symbol-unused 28)
;(define symbol-size 32) ;(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 symbol-record-tag #x5F)
(define disp-symbol-record-string 4) (define disp-symbol-record-string 4)
(define disp-symbol-record-ustring 8) (define disp-symbol-record-ustring 8)
@ -3228,10 +3234,11 @@
(cond-branch op Lt Lf ac))])) (cond-branch op Lt Lf ac))]))
(define (do-pred-prim op rand* Lt Lf ac) (define (do-pred-prim op rand* Lt Lf ac)
(case op (case op
[(fixnum?) (type-pred fx-mask fx-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)] [(pair?) (type-pred pair-mask pair-tag rand* Lt Lf ac)]
[(char?) (type-pred char-mask char-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)] [(string?) (type-pred string-mask string-tag rand* Lt Lf ac)]
[(bytevector?) (type-pred bytevector-mask bytevector-tag rand* Lt Lf ac)]
[(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)]
@ -3793,6 +3800,18 @@
(addl (int (fx+ disp-string-data object-alignment)) apr) (addl (int (fx+ disp-string-data object-alignment)) apr)
(sarl (int align-shift) apr) (sarl (int align-shift) apr)
(sall (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)] ac)]
[($make-vector) [($make-vector)
(list* (movl (Simple (car arg*)) ebx) (list* (movl (Simple (car arg*)) ebx)
@ -4007,7 +4026,7 @@
(do-effect-prim op arg* (do-effect-prim op arg*
(cons (movl (int void-object) eax) ac))] (cons (movl (int void-object) eax) ac))]
[(fixnum? bignum? flonum? immediate? $fxzero? boolean? char? pair? [(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? procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq?
$char= $char< $char<= $char> $char>= $unbound-object? code? $char= $char< $char<= $char> $char>= $unbound-object? code?
$record? $record/rtd? bwp-object? port? input-port? output-port?) $record? $record/rtd? bwp-object? port? input-port? output-port?)
@ -4098,6 +4117,13 @@
(movl (Simple (caddr arg*)) ebx) (movl (Simple (caddr arg*)) ebx)
(movb bh (mem (fx- disp-string-data string-tag) eax)) (movb bh (mem (fx- disp-string-data string-tag) eax))
ac)] 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!) [($set-car!)
(list* (movl (Simple (car arg*)) eax) (list* (movl (Simple (car arg*)) eax)
(movl (Simple (cadr arg*)) ebx) (movl (Simple (cadr arg*)) ebx)

8
src/ikarus.predicates.ss
View File

@ -3,14 +3,14 @@
(export fixnum? flonum? bignum? number? complex? real? rational? (export fixnum? flonum? bignum? number? complex? real? rational?
integer? exact? eof-object? bwp-object? immediate? 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?) symbol? code? not weak-pair? eq? eqv? equal?)
(import (import
(except (ikarus) fixnum? flonum? bignum? number? complex? real? (except (ikarus) fixnum? flonum? bignum? number? complex? real?
rational? integer? exact? eof-object? bwp-object? 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? null? pair? weak-pair? symbol? code? not eq? eqv? equal?
port? input-port? output-port?) port? input-port? output-port?)
(ikarus system $fx) (ikarus system $fx)
@ -20,7 +20,7 @@
(ikarus system $vectors) (ikarus system $vectors)
(rename (only (ikarus) fixnum? flonum? bignum? eof-object? (rename (only (ikarus) fixnum? flonum? bignum? eof-object?
bwp-object? immediate? boolean? char? vector? string? 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?) port? input-port? output-port?)
(fixnum? sys:fixnum?) (fixnum? sys:fixnum?)
(flonum? sys:flonum?) (flonum? sys:flonum?)
@ -31,6 +31,7 @@
(boolean? sys:boolean?) (boolean? sys:boolean?)
(char? sys:char?) (char? sys:char?)
(vector? sys:vector?) (vector? sys:vector?)
(bytevector? sys:bytevector?)
(string? sys:string?) (string? sys:string?)
(procedure? sys:procedure?) (procedure? sys:procedure?)
(null? sys:null?) (null? sys:null?)
@ -95,6 +96,7 @@
(define boolean? (lambda (x) (sys:boolean? x))) (define boolean? (lambda (x) (sys:boolean? x)))
(define char? (lambda (x) (sys:char? x))) (define char? (lambda (x) (sys:char? x)))
(define vector? (lambda (x) (sys:vector? x))) (define vector? (lambda (x) (sys:vector? x)))
(define bytevector? (lambda (x) (sys:bytevector? x)))
(define string? (lambda (x) (sys:string? x))) (define string? (lambda (x) (sys:string? x)))
(define procedure? (lambda (x) (sys:procedure? x))) (define procedure? (lambda (x) (sys:procedure? x)))
(define null? (lambda (x) (sys:null? x))) (define null? (lambda (x) (sys:null? x)))

3
src/makefile.ss
View File

@ -68,6 +68,7 @@
"ikarus.cafe.ss" "ikarus.cafe.ss"
"ikarus.posix.ss" "ikarus.posix.ss"
"ikarus.timer.ss" "ikarus.timer.ss"
"ikarus.bytevectors.ss"
"ikarus.main.ss")) "ikarus.main.ss"))
(define ikarus-system-macros (define ikarus-system-macros
@ -270,6 +271,8 @@
[vector-length i r] [vector-length i r]
[list->vector i r] [list->vector i r]
[vector->list i r] [vector->list i r]
[make-bytevector i]
[for-each i r] [for-each i r]
[map i r] [map i r]
[andmap i] [andmap i]

2
src/tests/bytevectors.ss
View File

@ -3,7 +3,7 @@
(export test-bytevectors) (export test-bytevectors)
(import (ikarus) (tests framework)) (import (ikarus) (tests framework))
(define (not-byte-vector? x) (define (not-bytevector? x)
(not (bytevector? x))) (not (bytevector? x)))
(define-tests test-bytevectors (define-tests test-bytevectors