mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

Explode atomic box ops to new atomic instructions

Browse source 
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): Add C8_S24
  word type.
* libguile/vm-engine.c (UNPACK_8_24): New helper.
  (atomic-scm-ref/immediate, atomic-scm-set!/immediate)
  (atomic-swap-scm!/immediate, atomic-scm-compare-and-swap!/immediate):
  New instructions.
  (make-atomic-box, atomic-box-ref, atomic-box-set!, atomic-box-swap!)
  (atomic-box-compare-and-swap!): Disable these ops.
* module/language/bytecode.scm (compute-instruction-arity): Add C8_S24
  support.
* module/system/vm/assembler.scm: Add C8_S24 support.  Export assemblers
  for new opcodes.
* module/system/vm/disassembler.scm (disassembler): Support C8_S24.
* module/language/cps/compile-bytecode.scm (compile-function): Replace
  old atomic-box assemblers with the new instructions.
* module/language/cps/effects-analysis.scm (annotation->memory-kind):
* module/language/cps/types.scm (annotation->type): Add cases for atomic
  boxes.  Mark as all memory kinds because atomic ops serialize memory
  accesses.
* module/language/tree-il/compile-cps.scm (make-atomic-box):
  (ensure-atomic-box, atomic-box-ref, atomic-box-set!):
  (atomic-box-swap!, atomic-box-compare-and-swap!): Explode these ops to
  more basic instructions.
* module/system/base/types/internal.scm (%tc7-atomic-box): Add forgotten
  export.
This commit is contained in:
Andy Wingo 2018-04-12 18:14:00 +02:00
parent b32d3cc6f7
commit dff85f6f9f
10 changed files with 174 additions and 54 deletions
Download patch file Download diff file Expand all files Collapse all files

28
module/language/cps/compile-bytecode.scm
View file

@ -251,17 +251,18 @@
(emit-f64-ref asm (from-sp dst) (from-sp (slot ptr))
(from-sp (slot idx))))
(($ $primcall 'make-atomic-box #f (init))
(emit-make-atomic-box asm (from-sp dst) (from-sp (slot init))))
(($ $primcall 'atomic-box-ref #f (box))
(emit-atomic-box-ref asm (from-sp dst) (from-sp (slot box))))
(($ $primcall 'atomic-box-swap! #f (box val))
(emit-atomic-box-swap! asm (from-sp dst) (from-sp (slot box))
(from-sp (slot val))))
(($ $primcall 'atomic-box-compare-and-swap! #f (box expected desired))
(emit-atomic-box-compare-and-swap!
asm (from-sp dst) (from-sp (slot box))
(from-sp (slot expected)) (from-sp (slot desired))))
(($ $primcall 'atomic-scm-ref/immediate (annotation . idx) (obj))
(emit-atomic-scm-ref/immediate asm (from-sp dst) (from-sp (slot obj))
idx))
(($ $primcall 'atomic-scm-swap!/immediate (annotation . idx) (obj val))
(emit-atomic-scm-swap!/immediate asm (from-sp dst) (from-sp (slot obj))
idx (from-sp (slot val))))
(($ $primcall 'atomic-scm-compare-and-swap!/immediate (annotation . idx)
(obj expected desired))
(emit-atomic-scm-compare-and-swap!/immediate
asm (from-sp dst) (from-sp (slot obj)) idx (from-sp (slot expected))
(from-sp (slot desired))))
(($ $primcall 'untag-fixnum #f (src))
(emit-untag-fixnum asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'tag-fixnum #f (src))
@ -350,8 +351,9 @@
(emit-unwind asm))
(($ $primcall 'fluid-set! #f (fluid value))
(emit-fluid-set! asm (from-sp (slot fluid)) (from-sp (slot value))))
(($ $primcall 'atomic-box-set! #f (box val))
(emit-atomic-box-set! asm (from-sp (slot box)) (from-sp (slot val))))
(($ $primcall 'atomic-scm-set!/immediate (annotation . idx) (obj val))
(emit-atomic-scm-set!/immediate asm (from-sp (slot obj)) idx
(from-sp (slot val))))
(($ $primcall 'handle-interrupts #f ())
(emit-handle-interrupts asm))))