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

Emit constant-vector-ref, constant-vector-set! for known small indices

Browse source 
* libguile/vm-engine.c (rtl_vm_engine): Add constant-vector-set!
  instruction and renumber.

* module/language/cps/compile-rtl.scm (emit-rtl-sequence): Emit
  constant-vector-ref and constant-vector-set! as appropriate.

* module/language/cps/dfg.scm (constant-needs-allocation?): In some
  cases, vector-ref and vector-set! don't need to allocate their index.
This commit is contained in:
Andy Wingo 2013-10-26 21:30:37 +02:00
parent fa3b6e57c2
commit 8ba3f20c47
3 changed files with 77 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -186,6 +186,14 @@
(emit-resolve asm dst (constant bound?) (slot name)))
(($ $primcall 'free-ref (closure idx))
(emit-free-ref asm dst (slot closure) (constant idx)))
(($ $primcall 'vector-ref (vector index))
(call-with-values (lambda ()
(lookup-maybe-constant-value index allocation))
(lambda (has-const? index-val)
(if (and has-const? (integer? index-val) (exact? index-val)
(<= 0 index-val 255))
(emit-constant-vector-ref asm dst (slot vector) index-val)
(emit-vector-ref asm dst (slot vector) (slot index))))))
(($ $primcall name args)
;; FIXME: Inline all the cases.
(let ((inst (prim-rtl-instruction name)))
@ -217,7 +225,15 @@
(($ $primcall 'struct-set! (struct index value))
(emit-struct-set! asm (slot struct) (slot index) (slot value)))
(($ $primcall 'vector-set! (vector index value))
(emit-vector-set! asm (slot vector) (slot index) (slot value)))
(call-with-values (lambda ()
(lookup-maybe-constant-value index allocation))
(lambda (has-const? index-val)
(if (and has-const? (integer? index-val) (exact? index-val)
(<= 0 index-val 255))
(emit-constant-vector-set! asm (slot vector) index-val
(slot value))
(emit-vector-set! asm (slot vector) (slot index)
(slot value))))))
(($ $primcall 'variable-set! (var val))
(emit-box-set! asm (slot var) (slot val)))
(($ $primcall 'set-car! (pair value))