Debugging optimizer
parent
2fa08c75b9
commit
9b6fb70eba
|
@ -80,9 +80,9 @@ nl
|
|||
malloc calloc free memcpy
|
||||
} compile-uncompiled
|
||||
|
||||
{
|
||||
build-tree optimize-tree
|
||||
} compile-uncompiled
|
||||
{ build-tree } compile-uncompiled
|
||||
|
||||
{ optimize-tree } compile-uncompiled
|
||||
|
||||
vocabs [ words compile-uncompiled "." write flush ] each
|
||||
|
||||
|
|
|
@ -92,7 +92,7 @@ M: node generate-node drop iterate-next ;
|
|||
%jump-label ;
|
||||
|
||||
: generate-call ( label -- next )
|
||||
dup maybe-compile
|
||||
! dup maybe-compile
|
||||
end-basic-block
|
||||
dup compiling-loops get at [
|
||||
%jump-label f
|
||||
|
@ -232,7 +232,7 @@ M: #dispatch generate-node
|
|||
] if ;
|
||||
|
||||
M: #call generate-node
|
||||
! dup node-input-infos [ class>> ] map set-operand-classes
|
||||
dup node-input-infos [ class>> ] map set-operand-classes
|
||||
dup find-if-intrinsic [
|
||||
do-if-intrinsic
|
||||
] [
|
||||
|
|
|
@ -20,47 +20,49 @@ M: #phi compute-live-values*
|
|||
[ [ out-r>> ] [ phi-in-r>> ] bi look-at-phi ]
|
||||
2bi ;
|
||||
|
||||
SYMBOL: if-node
|
||||
|
||||
M: #branch remove-dead-code*
|
||||
[ [ (remove-dead-code) ] map ] change-children ;
|
||||
[ [ [ (remove-dead-code) ] map ] change-children ]
|
||||
[ if-node set ]
|
||||
bi ;
|
||||
|
||||
: remove-phi-inputs ( #phi -- )
|
||||
dup [ out-d>> ] [ phi-in-d>> flip ] bi filter-corresponding flip >>phi-in-d
|
||||
dup [ out-r>> ] [ phi-in-r>> flip ] bi filter-corresponding flip >>phi-in-r
|
||||
drop ;
|
||||
|
||||
! SYMBOL: if-node
|
||||
!
|
||||
! : dead-value-indices ( values -- indices )
|
||||
! [ length ] keep live-values get
|
||||
! '[ , nth , key? not ] filter ; inline
|
||||
!
|
||||
! : drop-d-values ( values indices -- node )
|
||||
! [ drop filter-live ] [ nths filter-live ] 2bi
|
||||
! [ make-values ] keep
|
||||
! [ drop ] [ zip ] 2bi
|
||||
! #shuffle ;
|
||||
!
|
||||
! : drop-r-values ( values indices -- nodes )
|
||||
: live-value-indices ( values -- indices )
|
||||
[ length ] keep live-values get
|
||||
'[ , nth , key? ] filter ; inline
|
||||
|
||||
: drop-d-values ( values indices -- node )
|
||||
[ drop filter-live ] [ nths ] 2bi
|
||||
[ make-values ] keep
|
||||
[ drop ] [ zip ] 2bi
|
||||
#shuffle ;
|
||||
|
||||
: drop-r-values ( values indices -- nodes ) 2drop f ;
|
||||
! [ dup make-values [ #r> ] keep ] dip
|
||||
! drop-d-values dup out-d>> dup make-values #>r
|
||||
! 3array ;
|
||||
!
|
||||
! : insert-drops ( nodes d-values r-values d-indices r-indices -- nodes' )
|
||||
! '[
|
||||
! [ , drop-d-values 1array ]
|
||||
! [ , drop-r-values ]
|
||||
! bi* 3append
|
||||
! ] 3map ;
|
||||
!
|
||||
! : hoist-drops ( #phi -- )
|
||||
! if-node get swap
|
||||
! {
|
||||
! [ phi-in-d>> ]
|
||||
! [ phi-in-r>> ]
|
||||
! [ out-d>> dead-value-indices ]
|
||||
! [ out-r>> dead-value-indices ]
|
||||
! } cleave
|
||||
! '[ , , , , insert-drops ] change-children drop ;
|
||||
|
||||
: insert-drops ( nodes d-values r-values d-indices r-indices -- nodes' )
|
||||
'[
|
||||
[ , drop-d-values 1array ]
|
||||
[ , drop-r-values ]
|
||||
bi* 3append
|
||||
] 3map ;
|
||||
|
||||
: hoist-drops ( #phi -- )
|
||||
if-node get swap
|
||||
{
|
||||
[ phi-in-d>> ]
|
||||
[ phi-in-r>> ]
|
||||
[ out-d>> live-value-indices ]
|
||||
[ out-r>> live-value-indices ]
|
||||
} cleave
|
||||
'[ , , , , insert-drops ] change-children drop ;
|
||||
|
||||
: remove-phi-outputs ( #phi -- )
|
||||
[ filter-live ] change-out-d
|
||||
|
@ -69,7 +71,7 @@ M: #branch remove-dead-code*
|
|||
|
||||
M: #phi remove-dead-code*
|
||||
{
|
||||
! [ hoist-drops ]
|
||||
[ hoist-drops ]
|
||||
[ remove-phi-inputs ]
|
||||
[ remove-phi-outputs ]
|
||||
[ ]
|
||||
|
|
|
@ -4,7 +4,8 @@ compiler.tree.combinators compiler.tree.propagation
|
|||
compiler.tree.cleanup compiler.tree.escape-analysis
|
||||
compiler.tree.tuple-unboxing compiler.tree.debugger
|
||||
compiler.tree.normalization compiler.tree.checker tools.test
|
||||
kernel math stack-checker.state accessors combinators io ;
|
||||
kernel math stack-checker.state accessors combinators io
|
||||
prettyprint ;
|
||||
IN: compiler.tree.dead-code.tests
|
||||
|
||||
\ remove-dead-code must-infer
|
||||
|
@ -96,9 +97,4 @@ IN: compiler.tree.dead-code.tests
|
|||
|
||||
[ ] [ [ dup [ 3 throw ] [ ] if ] optimize-quot drop ] unit-test
|
||||
|
||||
: non-flushable-4 ( a -- b ) drop f ;
|
||||
|
||||
: recursive-test-1 ( a b -- )
|
||||
dup 10 < [
|
||||
>r drop 5 non-flushable-4 r> 1 + recursive-test-1
|
||||
] [ 2drop ] if ; inline recursive
|
||||
[ [ [ . ] [ drop ] if ] ] [ [ [ dup . ] [ ] if drop ] optimize-quot ] unit-test
|
||||
|
|
|
@ -6,7 +6,7 @@ compiler.tree.propagation compiler.tree.cleanup
|
|||
compiler.tree.combinators compiler.tree sequences math math.private
|
||||
kernel tools.test accessors slots.private quotations.private
|
||||
prettyprint classes.tuple.private classes classes.tuple
|
||||
compiler.tree.intrinsics ;
|
||||
compiler.tree.intrinsics namespaces ;
|
||||
|
||||
\ escape-analysis must-infer
|
||||
|
||||
|
@ -295,3 +295,13 @@ C: <ro-box> ro-box
|
|||
[ 1 ] [ [ 1 cons boa 2 cons boa car>> ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 0 ] [ [ 1 cons boa 2 cons boa dup . car>> ] count-unboxed-allocations ] unit-test
|
||||
|
||||
[ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test
|
||||
|
||||
: impeach-node ( quot: ( node -- ) -- )
|
||||
dup slip impeach-node ; inline recursive
|
||||
|
||||
: bleach-node ( quot: ( node -- ) -- )
|
||||
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
||||
|
||||
[ 2 ] [ [ [ ] bleach-node ] count-unboxed-allocations ] unit-test
|
||||
|
|
|
@ -59,10 +59,10 @@ M: #push escape-analysis*
|
|||
] [ 2drop f ] if ;
|
||||
|
||||
: record-slot-call ( #call -- )
|
||||
[ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri
|
||||
over [
|
||||
[ record-slot-access ] [ copy-slot-value ] 3bi
|
||||
] [ 2drop unknown-allocation ] if ;
|
||||
[ out-d>> first ] [ slot-offset ] [ in-d>> first ] tri over
|
||||
[ [ record-slot-access ] [ copy-slot-value ] 3bi ]
|
||||
[ [ unknown-allocation ] [ drop ] [ add-escaping-value ] tri* ]
|
||||
if ;
|
||||
|
||||
M: #call escape-analysis*
|
||||
dup word>> {
|
||||
|
@ -88,3 +88,5 @@ M: #alien-indirect escape-analysis*
|
|||
[ in-d>> add-escaping-values ]
|
||||
[ out-d>> unknown-allocations ]
|
||||
bi ;
|
||||
|
||||
M: #alien-callback escape-analysis* drop ;
|
||||
|
|
|
@ -21,10 +21,10 @@ IN: compiler.tree.optimizer
|
|||
detect-loops
|
||||
! invert-loops
|
||||
! fuse-branches
|
||||
! escape-analysis
|
||||
! unbox-tuples
|
||||
! compute-def-use
|
||||
! remove-dead-code
|
||||
escape-analysis
|
||||
unbox-tuples
|
||||
compute-def-use
|
||||
remove-dead-code
|
||||
! strength-reduce
|
||||
compute-def-use USE: kernel
|
||||
dup check-nodes ;
|
||||
|
|
|
@ -52,7 +52,6 @@ IN: compiler.tree.propagation.recursive
|
|||
3bi ;
|
||||
|
||||
M: #recursive propagate-around ( #recursive -- )
|
||||
"blah" USE: io print
|
||||
{ 0 } clone [ USE: math
|
||||
dup first 10 = [ "OOPS" throw ] [ dup first 1+ swap set-first ] if
|
||||
constraints [ clone ] change
|
||||
|
|
|
@ -37,3 +37,12 @@ TUPLE: empty-tuple ;
|
|||
[ [ <=> ] sort ]
|
||||
[ [ <=> ] with search ]
|
||||
} [ [ ] swap [ test-unboxing ] curry unit-test ] each
|
||||
|
||||
! A more complicated example
|
||||
: impeach-node ( quot: ( node -- ) -- )
|
||||
dup slip impeach-node ; inline recursive
|
||||
|
||||
: bleach-node ( quot: ( node -- ) -- )
|
||||
[ bleach-node ] curry [ ] compose impeach-node ; inline recursive
|
||||
|
||||
[ ] [ [ [ ] bleach-node ] test-unboxing ] unit-test
|
||||
|
|
|
@ -58,9 +58,11 @@ M: #push unbox-tuples* ( #push -- nodes )
|
|||
|
||||
: unbox-slot-access ( #call -- nodes )
|
||||
dup out-d>> first unboxed-slot-access? [
|
||||
[ in-d>> second 1array #drop ]
|
||||
[ prepare-slot-access slot-access-shuffle ]
|
||||
bi 2array
|
||||
! [ in-d>> second 1array #drop ]
|
||||
! [
|
||||
prepare-slot-access slot-access-shuffle
|
||||
! ]
|
||||
! bi 2array
|
||||
] when ;
|
||||
|
||||
M: #call unbox-tuples*
|
||||
|
@ -133,4 +135,6 @@ M: #alien-invoke unbox-tuples* dup in-d>> assert-not-unboxed ;
|
|||
|
||||
M: #alien-indirect unbox-tuples* dup in-d>> assert-not-unboxed ;
|
||||
|
||||
M: #alien-callback unbox-tuples* ;
|
||||
|
||||
: unbox-tuples ( nodes -- nodes ) [ unbox-tuples* ] map-nodes ;
|
||||
|
|
|
@ -20,3 +20,6 @@ M: thread error-in-thread ( error thread -- )
|
|||
error-thread get-global error-in-thread. print-error flush
|
||||
] bind
|
||||
] if ;
|
||||
|
||||
[ self error-in-thread stop ]
|
||||
thread-error-hook set-global
|
||||
|
|
|
@ -223,9 +223,6 @@ GENERIC: error-in-thread ( error thread -- )
|
|||
dup register-thread
|
||||
set-self ;
|
||||
|
||||
[ self error-in-thread stop ]
|
||||
thread-error-hook set-global
|
||||
|
||||
PRIVATE>
|
||||
|
||||
[ init-threads ] "threads" add-init-hook
|
||||
|
|
Loading…
Reference in New Issue