summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/cps/compile-rtl.scm37
-rw-r--r--module/language/cps/primitives.scm1
-rw-r--r--module/system/vm/assembler.scm10
-rw-r--r--module/system/vm/disassembler.scm1
4 files changed, 47 insertions, 2 deletions
diff --git a/module/language/cps/compile-rtl.scm b/module/language/cps/compile-rtl.scm
index 6a136946b..2f0716b77 100644
--- a/module/language/cps/compile-rtl.scm
+++ b/module/language/cps/compile-rtl.scm
@@ -215,6 +215,24 @@
(emit-vector-ref asm dst (slot vector) (slot index)))))
(($ $primcall 'builtin-ref (name))
(emit-builtin-ref asm dst (constant name)))
+ (($ $primcall 'bv-u8-ref (bv idx))
+ (emit-bv-u8-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-u16-ref (bv idx))
+ (emit-bv-u16-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-s16-ref (bv idx))
+ (emit-bv-s16-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-u32-ref (bv idx val))
+ (emit-bv-u32-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-s32-ref (bv idx val))
+ (emit-bv-s32-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-u64-ref (bv idx val))
+ (emit-bv-u64-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-s64-ref (bv idx val))
+ (emit-bv-s64-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-f32-ref (bv idx val))
+ (emit-bv-f32-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-f64-ref (bv idx val))
+ (emit-bv-f64-ref asm dst (slot bv) (slot idx)))
(($ $primcall name args)
;; FIXME: Inline all the cases.
(let ((inst (prim-rtl-instruction name)))
@@ -269,6 +287,24 @@
(emit-pop-fluid asm))
(($ $primcall 'wind (winder unwinder))
(emit-wind asm (slot winder) (slot unwinder)))
+ (($ $primcall 'bv-u8-set! (bv idx val))
+ (emit-bv-u8-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-u16-set! (bv idx val))
+ (emit-bv-u16-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-s16-set! (bv idx val))
+ (emit-bv-s16-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-u32-set! (bv idx val))
+ (emit-bv-u32-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-s32-set! (bv idx val))
+ (emit-bv-s32-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-u64-set! (bv idx val))
+ (emit-bv-u64-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-s64-set! (bv idx val))
+ (emit-bv-s64-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-f32-set! (bv idx val))
+ (emit-bv-f32-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-f64-set! (bv idx val))
+ (emit-bv-f64-set! asm (slot bv) (slot idx) (slot val)))
(($ $primcall 'unwind ())
(emit-unwind asm))
(($ $primcall name args)
@@ -319,6 +355,7 @@
(($ $primcall 'variable? (a)) (unary emit-br-if-variable a))
(($ $primcall 'vector? (a)) (unary emit-br-if-vector a))
(($ $primcall 'string? (a)) (unary emit-br-if-string a))
+ (($ $primcall 'bytevector? (a)) (unary emit-br-if-bytevector a))
;; Add more TC7 tests here. Keep in sync with
;; *branching-primcall-arities* in (language cps primitives) and
;; the set of macro-instructions in assembly.scm.
diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm
index c25855371..570150294 100644
--- a/module/language/cps/primitives.scm
+++ b/module/language/cps/primitives.scm
@@ -56,6 +56,7 @@
(vector? . (1 . 1))
(symbol? . (1 . 1))
(variable? . (1 . 1))
+ (bytevector? . (1 . 1))
(char? . (1 . 1))
(eq? . (1 . 2))
(eqv? . (1 . 2))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index fbdf13f92..bee62571e 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -659,7 +659,13 @@ returned instead."
(emit-br-if-tc7 asm slot invert? tc7 label)))
;; Keep in sync with tags.h. Part of Guile's ABI. Currently unused
-;; macro assemblers are commented out.
+;; macro assemblers are commented out. See also
+;; *branching-primcall-arities* in (language cps primitives), the set of
+;; macro-instructions in assembly.scm, and
+;; disassembler.scm:code-annotation.
+;;
+;; FIXME: Define all tc7 values in Scheme in one place, derived from
+;; tags.h.
(define-tc7-macro-assembler br-if-symbol 5)
(define-tc7-macro-assembler br-if-variable 7)
(define-tc7-macro-assembler br-if-vector 13)
@@ -667,7 +673,7 @@ returned instead."
(define-tc7-macro-assembler br-if-string 21)
;(define-tc7-macro-assembler br-if-heap-number 23)
;(define-tc7-macro-assembler br-if-stringbuf 39)
-;(define-tc7-macro-assembler br-if-bytevector 77)
+(define-tc7-macro-assembler br-if-bytevector 77)
;(define-tc7-macro-assembler br-if-pointer 31)
;(define-tc7-macro-assembler br-if-hashtable 29)
;(define-tc7-macro-assembler br-if-fluid 37)
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 2ae35b06a..82e0f4dc1 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -224,6 +224,7 @@ address of that offset."
((7) "variable?")
((13) "vector?")
((15) "string?")
+ ((77) "bytevector?")
(else (number->string tc7)))))
(if invert? (string-append "not " tag) tag))
(vector-ref labels (- (+ offset target) start))))