diff options
author | Andy Wingo <wingo@pobox.com> | 2013-11-03 21:45:34 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-11-03 21:48:48 +0100 |
commit | d65514a2de2ef922d3613f0e35dea27a88313392 (patch) | |
tree | 7019c09ba8b323b0de16c0871a4b1b1373eb2226 /module | |
parent | 9ae9debbd35505ef4040c1a876f7bd64434d6d14 (diff) | |
download | guile-d65514a2de2ef922d3613f0e35dea27a88313392.tar.gz |
RTL compiler supports static bitvectors
* libguile/arrays.c (scm_from_contiguous_typed_array):
* libguile/bytevectors.c (scm_uniform_array_to_bytevector): For
bitvectors, round up the length to 32-bit units, as they are stored
internally. Otherwise I think this probably does the wrong thing for
the last word on big-endian systems.
* libguile/bitvectors.c (BITVECTOR_LENGTH, BITVECTOR_BITS):
(scm_c_make_bitvector): Reorder the length and pointer words to match
the layout of bytevectors.
* module/language/cps/primitives.scm (*branching-primcall-arities*):
* module/system/vm/assembler.scm (br-if-bitvector):
* module/system/vm/disassembler.scm (code-annotation): Add bitvector
test support.
* module/system/vm/assembler.scm (<uniform-vector-backing-store>): Add
an element-size field.
(intern-constant): Adapt make-uniform-vector-backing-store call. Use
uniform-array->bytevector, as the old compiler did.
(link-data): Add bitvector cases.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/cps/primitives.scm | 1 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 34 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 1 |
3 files changed, 27 insertions, 9 deletions
diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm index ac0d336a1..323f62371 100644 --- a/module/language/cps/primitives.scm +++ b/module/language/cps/primitives.scm @@ -75,6 +75,7 @@ (vector? . (1 . 1)) (symbol? . (1 . 1)) (variable? . (1 . 1)) + (bitvector? . (1 . 1)) (bytevector? . (1 . 1)) (char? . (1 . 1)) (eq? . (1 . 2)) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index abfd5fbc2..0e3c3cd47 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -531,9 +531,10 @@ list of lists. This procedure can be called many times before calling (code static-procedure-code)) (define-record-type <uniform-vector-backing-store> - (make-uniform-vector-backing-store bytes) + (make-uniform-vector-backing-store bytes element-size) uniform-vector-backing-store? - (bytes uniform-vector-backing-store-bytes)) + (bytes uniform-vector-backing-store-bytes) + (element-size uniform-vector-backing-store-element-size)) (define-record-type <cache-cell> (make-cache-cell scope key) @@ -603,7 +604,13 @@ table, its existing label is used directly." ((uniform-vector-backing-store? obj) '()) ((simple-uniform-vector? obj) `((static-patch! ,label 2 - ,(recur (make-uniform-vector-backing-store obj))))) + ,(recur (make-uniform-vector-backing-store + (uniform-array->bytevector obj) + (if (bitvector? obj) + ;; Bitvectors are addressed in + ;; 32-bit units. + 4 + (uniform-vector-element-size obj))))))) (else (error "don't know how to intern" obj)))) (cond @@ -709,7 +716,7 @@ returned instead." ;(define-tc7-macro-assembler br-if-weak-set 85) ;(define-tc7-macro-assembler br-if-weak-table 87) ;(define-tc7-macro-assembler br-if-array 93) -;(define-tc7-macro-assembler br-if-bitvector 95) +(define-tc7-macro-assembler br-if-bitvector 95) ;(define-tc7-macro-assembler br-if-port 125) ;(define-tc7-macro-assembler br-if-smob 127) @@ -901,6 +908,7 @@ should be .data or .rodata), and return the resulting linker object. (define tc7-ro-string (+ 21 #x200)) (define tc7-rtl-program 69) (define tc7-bytevector 77) + (define tc7-bitvector 95) (let ((word-size (asm-word-size asm)) (endianness (asm-endianness asm))) @@ -1023,18 +1031,26 @@ should be .data or .rodata), and return the resulting linker object. (write-immediate asm buf pos #f)) ((simple-uniform-vector? obj) - (let ((tag (logior tc7-bytevector - (ash (uniform-vector-element-type-code obj) 7)))) + (let ((tag (if (bitvector? obj) + tc7-bitvector + (let ((type-code (uniform-vector-element-type-code obj))) + (logior tc7-bytevector (ash type-code 7)))))) (case word-size ((4) (bytevector-u32-set! buf pos tag endianness) - (bytevector-u32-set! buf (+ pos 4) (bytevector-length obj) + (bytevector-u32-set! buf (+ pos 4) + (if (bitvector? obj) + (bitvector-length obj) + (bytevector-length obj)) endianness) ; length (bytevector-u32-set! buf (+ pos 8) 0 endianness) ; pointer (write-immediate asm buf (+ pos 12) #f)) ; owner ((8) (bytevector-u64-set! buf pos tag endianness) - (bytevector-u64-set! buf (+ pos 8) (bytevector-length obj) + (bytevector-u64-set! buf (+ pos 8) + (if (bitvector? obj) + (bitvector-length obj) + (bytevector-length obj)) endianness) ; length (bytevector-u64-set! buf (+ pos 16) 0 endianness) ; pointer (write-immediate asm buf (+ pos 24) #f)) ; owner @@ -1043,7 +1059,7 @@ should be .data or .rodata), and return the resulting linker object. ((uniform-vector-backing-store? obj) (let ((bv (uniform-vector-backing-store-bytes obj))) (bytevector-copy! bv 0 buf pos (bytevector-length bv)) - (unless (or (= 1 (uniform-vector-element-size bv)) + (unless (or (= 1 (uniform-vector-backing-store-element-size obj)) (eq? endianness (native-endianness))) ;; Need to swap units of element-size bytes (error "FIXME: Implement byte order swap")))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 82e0f4dc1..1683b685d 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -225,6 +225,7 @@ address of that offset." ((13) "vector?") ((15) "string?") ((77) "bytevector?") + ((95) "bitvector?") (else (number->string tc7))))) (if invert? (string-append "not " tag) tag)) (vector-ref labels (- (+ offset target) start)))) |