Small shuffle optimization cleanup

release
slava 2006-04-07 00:46:31 +00:00
parent 940d3307f5
commit ec1890b2b3
2 changed files with 29 additions and 25 deletions

View File

@ -102,35 +102,18 @@ M: #call linearize* ( node -- next )
M: #call-label linearize* ( node -- next ) M: #call-label linearize* ( node -- next )
node-param renamed-label linearize-call ; node-param renamed-label linearize-call ;
SYMBOL: live-d
SYMBOL: live-r
: value-dropped? ( value -- ? )
dup value?
over live-d get member? not
rot live-r get member? not and
or ;
: filter-dropped ( seq -- seq )
[ dup value-dropped? [ drop f ] when ] map ;
: prepare-inputs ( values -- values templates ) : prepare-inputs ( values -- values templates )
filter-dropped dup [ any-reg swap 2array ] map ; dup [ any-reg swap 2array ] map ;
: do-inputs ( node -- ) : do-inputs ( shuffle -- )
dup node-in-d prepare-inputs rot node-in-r prepare-inputs dup shuffle-in-d prepare-inputs
rot shuffle-in-r prepare-inputs
template-inputs ; template-inputs ;
: live-stores ( instack outstack -- stack )
#! Avoid storing a value into its former position.
dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
M: #shuffle linearize* ( #shuffle -- ) M: #shuffle linearize* ( #shuffle -- )
0 vreg-allocator set 0 vreg-allocator set
dup node-in-d over node-out-d live-stores live-d set node-shuffle dup do-inputs
dup node-in-r over node-out-r live-stores live-r set dup shuffle-out-d swap shuffle-out-r template-outputs
do-inputs
live-d get live-r get template-outputs
iterate-next ; iterate-next ;
: ?static-branch ( node -- n ) : ?static-branch ( node -- n )

View File

@ -3,8 +3,6 @@ USING: hashtables kernel math namespaces sequences ;
TUPLE: shuffle in-d in-r out-d out-r ; TUPLE: shuffle in-d in-r out-d out-r ;
: empty-shuffle { } { } { } { } <shuffle> ;
: load-shuffle ( d r shuffle -- ) : load-shuffle ( d r shuffle -- )
tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ; tuck shuffle-in-r [ set ] 2each shuffle-in-d [ set ] 2each ;
@ -59,3 +57,26 @@ M: shuffle clone ( shuffle -- shuffle )
[ shuffle-out-d clone ] keep [ shuffle-out-d clone ] keep
shuffle-out-r clone shuffle-out-r clone
<shuffle> ; <shuffle> ;
SYMBOL: live-d
SYMBOL: live-r
: value-dropped? ( value -- ? )
dup value?
over live-d get member? not
rot live-r get member? not and
or ;
: filter-dropped ( seq -- seq )
[ dup value-dropped? [ drop f ] when ] map ;
: live-stores ( instack outstack -- stack )
#! Avoid storing a value into its former position.
dup length [ pick ?nth dupd eq? [ drop f ] when ] 2map nip ;
: trim-shuffle ( shuffle -- shuffle )
dup shuffle-in-d over shuffle-out-d live-stores live-d set
dup shuffle-in-r over shuffle-out-r live-stores live-r set
dup shuffle-in-d filter-dropped
swap shuffle-in-r filter-dropped
live-d get live-r get <shuffle> ;