summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-11-03 21:45:34 +0100
committerAndy Wingo <wingo@pobox.com>2013-11-03 21:48:48 +0100
commitd65514a2de2ef922d3613f0e35dea27a88313392 (patch)
tree7019c09ba8b323b0de16c0871a4b1b1373eb2226 /module
parent9ae9debbd35505ef4040c1a876f7bd64434d6d14 (diff)
downloadguile-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.scm1
-rw-r--r--module/system/vm/assembler.scm34
-rw-r--r--module/system/vm/disassembler.scm1
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))))