Fix dead code elimination with alien nodes

db4
U-SLAVA-DFB8FF805\Slava 2008-09-01 02:04:42 -05:00
parent 88aa1def35
commit 8fed0d29eb
2 changed files with 25 additions and 12 deletions

7
basis/compiler/tests/alien.factor Normal file → Executable file
View File

@ -84,6 +84,13 @@ FUNCTION: tiny ffi_test_17 int x ;
[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test
: indirect-test-1' ( ptr -- )
"int" { } "cdecl" alien-indirect drop ;
{ 1 0 } [ indirect-test-1' ] must-infer-as
[ ] [ "ffi_test_1" f dlsym indirect-test-1' ] unit-test
[ -1 indirect-test-1 ] must-fail
: indirect-test-2 ( x y ptr -- result )

30
basis/compiler/tree/dead-code/simple/simple.factor Normal file → Executable file
View File

@ -81,11 +81,19 @@ M: #alien-indirect compute-live-values* nip look-at-inputs ;
drop-values
] ;
: drop-dead-outputs ( node -- nodes )
: drop-dead-outputs ( node -- #shuffle )
dup out-d>> drop-dead-values tuck in-d>> >>out-d drop ;
: some-outputs-dead? ( #call -- ? )
out-d>> [ live-value? not ] contains? ;
: maybe-drop-dead-outputs ( node -- nodes )
dup some-outputs-dead? [
dup drop-dead-outputs 2array
] when ;
M: #introduce remove-dead-code* ( #introduce -- nodes )
dup drop-dead-outputs 2array ;
maybe-drop-dead-outputs ;
M: #>r remove-dead-code*
[ filter-live ] change-out-r
@ -110,17 +118,9 @@ M: #push remove-dead-code*
[ in-d>> #drop remove-dead-code* ]
bi ;
: some-outputs-dead? ( #call -- ? )
out-d>> [ live-value? not ] contains? ;
M: #call remove-dead-code*
dup dead-flushable-call? [
remove-flushable-call
] [
dup some-outputs-dead? [
dup drop-dead-outputs 2array
] when
] if ;
dup dead-flushable-call?
[ remove-flushable-call ] [ maybe-drop-dead-outputs ] if ;
M: #shuffle remove-dead-code*
[ filter-live ] change-in-d
@ -136,3 +136,9 @@ M: #copy remove-dead-code*
M: #terminate remove-dead-code*
[ filter-live ] change-in-d
[ filter-live ] change-in-r ;
M: #alien-invoke remove-dead-code*
maybe-drop-dead-outputs ;
M: #alien-indirect remove-dead-code*
maybe-drop-dead-outputs ;