-USING: compiler.cfg.parallel-copy tools.test make arrays
+USING: compiler.cfg.parallel-copy tools.test arrays
compiler.cfg.registers namespaces compiler.cfg.instructions
cpu.architecture ;
IN: compiler.cfg.parallel-copy.tests
SYMBOL: temp
: test-parallel-copy ( mapping -- seq )
- 3 vreg-counter set-global
- [ parallel-copy ] { } make ;
+ 3 vreg-counter set-global parallel-copy ;
+
+{
+ { }
+} [
+ H{ } test-parallel-copy
+] unit-test
[
{
{ 1 3 }
{ 4 3 }
} test-parallel-copy
-] unit-test
\ No newline at end of file
+] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: assocs compiler.cfg.instructions compiler.cfg.registers
compiler.cfg.ssa.destruction.leaders cpu.architecture deques
-dlists fry kernel locals namespaces sequences ;
+dlists fry kernel locals make namespaces sequences ;
FROM: sets => conjoin ;
IN: compiler.cfg.parallel-copy
PRIVATE>
:: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
- ! mapping is a list of { dst src } pairs
[
mapping init
to-do get [
] slurp-deque
] with-scope ; inline
-: parallel-copy ( mapping -- )
- next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ;
+: parallel-copy ( mapping -- insns )
+ [ next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ] { } make ;
<PRIVATE
PRIVATE>
-: parallel-copy-rep ( mapping -- )
- ! mapping is a list of { dst src } pairs
- H{ } clone temp-vregs set
- [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping ;
+: parallel-copy-rep ( mapping -- insns )
+ [
+ H{ } clone temp-vregs set
+ [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping
+ ] { } make ;
M: ##parallel-copy cleanup-insn
values>>
[ first2 leaders 2array ] map [ first2 eq? not ] filter
- [ parallel-copy-rep ] unless-empty ;
+ [ parallel-copy-rep % ] unless-empty ;
M: ##tagged>integer cleanup-insn
dup useful-copy? [ , ] [ drop ] if ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs combinators compiler.cfg
+USING: accessors arrays assocs combinators compiler.cfg
compiler.cfg.instructions compiler.cfg.parallel-copy
compiler.cfg.registers compiler.cfg.stacks.height kernel make
math math.order namespaces sequences sets ;
M: ds-loc translate-local-loc n>> current-height get d>> - <ds-loc> ;
M: rs-loc translate-local-loc n>> current-height get r>> - <rs-loc> ;
-: emit-stack-changes ( -- )
- replace-mapping get dup assoc-empty? [ drop ] [
- [ [ loc>vreg ] dip ] assoc-map parallel-copy
- ] if ;
+: stack-changes ( replace-mapping -- insns )
+ [ [ loc>vreg ] dip ] assoc-map parallel-copy ;
-: emit-height-changes ( -- )
- current-height get
- [ emit-d>> dup 0 = [ drop ] [ ##inc-d, ] if ]
- [ emit-r>> dup 0 = [ drop ] [ ##inc-r, ] if ] bi ;
+: height-changes ( current-height -- insns )
+ [ emit-d>> ] [ emit-r>> ] bi 2array
+ { ##inc-d ##inc-r } [ new swap >>n ] 2map [ n>> 0 = not ] filter ;
: emit-changes ( -- )
- ! Insert height and stack changes prior to the last instruction
building get pop
- emit-stack-changes
- emit-height-changes
+ replace-mapping get stack-changes %
+ current-height get height-changes %
, ;
! inc-d/inc-r: these emit ##inc-d/##inc-r to change the stack height later