From becce37b5835720857068c4865f1cd48275133d1 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 31 Oct 2013 11:39:43 +0100 Subject: [PATCH] Better compiler support for bytevector ops * module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add emitters for bytevector ops. Add br-if-bytevector emitter. * module/language/cps/primitives.scm (*branching-primcall-arities*): Mark bytevector? as a branching primitive. * module/system/vm/assembler.scm (br-if-bytevector): New instruction * module/system/vm/disassembler.scm (code-annotation): Add support for bytevector?. --- module/language/cps/compile-rtl.scm | 37 +++++++++++++++++++++++++++++ module/language/cps/primitives.scm | 1 + module/system/vm/assembler.scm | 10 ++++++-- module/system/vm/disassembler.scm | 1 + 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))))