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

compiler.cfg.builder: simplification of the shuffling logic

char-rename
Björn Lindqvist 2016-09-04 06:22:54 +02:00
parent 61bbb9be06
commit 367bff6339
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
basis/compiler/cfg/builder/builder.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2004, 2010 Slava Pestov. ! Copyright (C) 2004, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.cfg USING: accessors arrays assocs combinators compiler.cfg
compiler.cfg.builder.blocks compiler.cfg.comparisons compiler.cfg.builder.blocks compiler.cfg.comparisons compiler.cfg.hats
compiler.cfg.hats compiler.cfg.instructions compiler.cfg.instructions compiler.cfg.intrinsics compiler.cfg.registers
compiler.cfg.intrinsics compiler.cfg.registers
compiler.cfg.stacks compiler.cfg.stacks.local compiler.tree compiler.cfg.stacks compiler.cfg.stacks.local compiler.tree
compiler.cfg.utilities cpu.architecture fry kernel locals make math compiler.cfg.utilities cpu.architecture fry kernel locals make math
namespaces sequences words ; namespaces sequences words ;
@ -131,7 +130,7 @@ M: #call emit-node ( block node -- block' )
M: #call-recursive emit-node ( block node -- block' ) M: #call-recursive emit-node ( block node -- block' )
[ label>> id>> ] [ call-height ] bi emit-call ; [ label>> id>> ] [ call-height ] bi emit-call ;
M: #push emit-node ( block node -- block' ) M: #push emit-node ( block node -- block )
literal>> ^^load-literal ds-push ; literal>> ^^load-literal ds-push ;
! #shuffle ! #shuffle
@ -145,22 +144,22 @@ M: #push emit-node ( block node -- block' )
[ over length stack-locs zip ] 2bi@ append ; [ over length stack-locs zip ] 2bi@ append ;
: height-changes ( #shuffle -- height-changes ) : height-changes ( #shuffle -- height-changes )
{ [ out-d>> ] [ in-d>> ] [ out-r>> ] [ in-r>> ] } cleave { [ out-d>> ] [ in-d>> ] [ out-r>> ] [ in-r>> ] } cleave 4array
4array [ length ] map first4 [ - ] 2bi@ 2array ; [ length ] map first4 [ - ] 2bi@ 2array ;
: store-height-changes ( #shuffle -- ) : store-height-changes ( #shuffle -- )
height-changes { ds-loc rs-loc } [ new swap >>n inc-stack ] 2each ; height-changes { ds-loc rs-loc } [ new swap >>n inc-stack ] 2each ;
: extract-outputs ( #shuffle -- seq ) : extract-outputs ( #shuffle -- pair )
[ out-d>> ds-loc 2array ] [ out-r>> rs-loc 2array ] bi 2array ; [ out-d>> ] [ out-r>> ] bi 2array ;
: out-vregs/stack ( #shuffle -- seq ) : out-vregs/stack ( #shuffle -- pair )
[ make-input-map ] [ mapping>> ] [ extract-outputs ] tri [ make-input-map ] [ mapping>> ] [ extract-outputs ] tri
[ first2 [ [ of of peek-loc ] 2with map ] dip 2array ] 2with map ; [ [ of of peek-loc ] 2with map ] 2with map ;
M: #shuffle emit-node ( block node -- block ) M: #shuffle emit-node ( block node -- block )
[ out-vregs/stack ] keep store-height-changes [ out-vregs/stack ] keep store-height-changes
[ first2 store-vregs ] each ; first2 [ ds-loc store-vregs ] [ rs-loc store-vregs ] bi* ;
! #return ! #return
: end-word ( block -- block' ) : end-word ( block -- block' )