From 8fed0d29eb4b03c0942e02a199c5f6df1f770797 Mon Sep 17 00:00:00 2001
From: "U-SLAVA-DFB8FF805\\Slava" <Slava@slava-dfb8ff805.(none)>
Date: Mon, 1 Sep 2008 02:04:42 -0500
Subject: [PATCH] Fix dead code elimination with alien nodes

---
 basis/compiler/tests/alien.factor             |  7 +++++
 .../tree/dead-code/simple/simple.factor       | 30 +++++++++++--------
 2 files changed, 25 insertions(+), 12 deletions(-)
 mode change 100644 => 100755 basis/compiler/tests/alien.factor
 mode change 100644 => 100755 basis/compiler/tree/dead-code/simple/simple.factor

diff --git a/basis/compiler/tests/alien.factor b/basis/compiler/tests/alien.factor
old mode 100644
new mode 100755
index 9d2b43c1df..f2a2255949
--- a/basis/compiler/tests/alien.factor
+++ b/basis/compiler/tests/alien.factor
@@ -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 )
diff --git a/basis/compiler/tree/dead-code/simple/simple.factor b/basis/compiler/tree/dead-code/simple/simple.factor
old mode 100644
new mode 100755
index 3ea9139e5f..9ebf064f79
--- a/basis/compiler/tree/dead-code/simple/simple.factor
+++ b/basis/compiler/tree/dead-code/simple/simple.factor
@@ -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 ;