mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-17 11:10:18 +02:00
Code Activity

Better compiler support for bytevector ops

Browse source 
* 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?.
This commit is contained in:
Andy Wingo 2013-10-31 11:39:43 +01:00
parent ecbef96687
commit becce37b58
4 changed files with 47 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/language/cps/compile-rtl.scm
View file

@ -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.