steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.stacks.*: create-locs, word for creating stack locations 

from a sequence
db4
Björn Lindqvist 2015-05-03 00:14:14 +02:00 committed by John Benediktsson
parent f2c67d6ab4
commit a195e361df
4 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/cfg/stacks/clearing/clearing-tests.factor
View File

@ -15,8 +15,8 @@ IN: compiler.cfg.stacks.clearing.tests
{
{
T{ ##replace-imm { src 17 } { loc D 0 } }
T{ ##replace-imm { src 17 } { loc D 1 } }
T{ ##replace-imm { src 17 } { loc D 0 } }
}
} [
{ { 2 { } } { 0 { } } } state>replaces
@ -25,8 +25,8 @@ IN: compiler.cfg.stacks.clearing.tests
{
V{
T{ ##inc { loc D 2 } { insn# 0 } }
T{ ##replace-imm { src 17 } { loc T{ ds-loc } } }
T{ ##replace-imm { src 17 } { loc T{ ds-loc { n 1 } } } }
T{ ##replace-imm { src 17 } { loc T{ ds-loc } } }
T{ ##peek { loc D 2 } { insn# 1 } }
}
} [

5
basis/compiler/cfg/stacks/clearing/clearing.factor
View File

@ -1,11 +1,10 @@
USING: accessors arrays assocs combinators.short-circuit
compiler.cfg.instructions compiler.cfg.registers compiler.cfg.rpo
compiler.cfg.stacks.map kernel math sequences ;
compiler.cfg.stacks compiler.cfg.stacks.map kernel math sequences ;
IN: compiler.cfg.stacks.clearing
: state>replaces ( state -- replaces )
[ stack>vacant ] map first2
[ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi* append
[ stack>vacant ] map { ds-loc rs-loc } [ swap create-locs ] 2map concat
[ 17 swap f ##replace-imm boa ] map ;
: dangerous-insn? ( state insn -- ? )

5
basis/compiler/cfg/stacks/stacks-tests.factor
View File

@ -12,6 +12,11 @@ IN: compiler.cfg.stacks.tests
height-state get
] cfg-unit-test
! stack-locs
{ { D 4 D 3 D 2 D 1 D 0 } } [
ds-loc 5 stack-locs >array
] unit-test
! load-vregs
{
{ 1 2 3 4 5 6 7 8 }

5
basis/compiler/cfg/stacks/stacks.factor
View File

@ -26,8 +26,11 @@ IN: compiler.cfg.stacks
finalize-stack-shuffling
} apply-passes ;
: create-locs ( loc-class seq -- locs )
[ swap new swap >>n ] with map <reversed> ;
: stack-locs ( loc-class n -- locs )
iota [ swap new swap >>n ] with map <reversed> ;
iota create-locs ;
: (load-vregs) ( n loc-class -- vregs )
swap stack-locs [ peek-loc ] map ;