compiler.cfg: Reading the return value of a float-returning function on x86-32 had a side effect of popping the x87 stack, so it was not correct for DCE to just eliminate this if the return value was not used. Fix this by adding a new dead-outputs slot to alien-call-insns and having DCE move dead returns there

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -294,14 +294,14 @@ IN: compiler.cfg.alias-analysis.tests
     V{
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     }
 ] [
     V{
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     } test-alias-analysis
 ] unit-test
@@ -311,7 +311,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 0 D 0 }
         T{ ##peek f 1 D 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     }
 ] [
@@ -319,7 +319,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 0 D 0 }
         T{ ##peek f 1 D 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##slot-imm f 2 0 1 0 }
     } test-alias-analysis
 ] unit-test
@@ -330,7 +330,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 1 D 1 }
         T{ ##peek f 2 D 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }
     }
 ] [
@@ -339,7 +339,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 1 D 1 }
         T{ ##peek f 2 D 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 2 0 1 0 }
     } test-alias-analysis
 ] unit-test
@@ -348,14 +348,14 @@ IN: compiler.cfg.alias-analysis.tests
     V{
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 1 0 1 0 }
     }
 ] [
     V{
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
-        T{ ##alien-invoke f { } { } { } 0 0 "free" }
+        T{ ##alien-invoke f { } { } { } { } 0 0 "free" }
         T{ ##set-slot-imm f 1 0 1 0 }
     } test-alias-analysis
 ] unit-test

basis/compiler/cfg/builder/alien/alien.factor

@@ -54,8 +54,8 @@ IN: compiler.cfg.builder.alien
         (caller-parameters)
     ] with-param-regs* ;
 
-: prepare-caller-return ( params -- reg-outputs )
+: prepare-caller-return ( params -- reg-outputs dead-outputs )
-    return>> [ { } ] [ base-type load-return ] if-void ;
+    return>> [ { } ] [ base-type load-return ] if-void { } ;
 
 : caller-stack-frame ( params -- cleanup stack-size )
     [ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup

basis/compiler/cfg/dce/dce.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
+! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel namespaces sequences
+USING: accessors arrays assocs kernel namespaces sequences
 compiler.cfg.instructions compiler.cfg.def-use
 compiler.cfg.rpo compiler.cfg.predecessors hash-sets sets ;
 FROM: namespaces => set ;
@@ -99,16 +99,17 @@ M: ##write-barrier live-insn? src>> live-vreg? ;
 
 M: ##write-barrier-imm live-insn? src>> live-vreg? ;
 
-: filter-alien-outputs ( triples -- triples' )
+: filter-alien-outputs ( outputs -- live-outputs dead-outputs )
-    [ first live-vreg? ] filter ;
+    [ first live-vreg? ] partition
+    [ first3 2array nip ] map ;
 
 M: alien-call-insn live-insn?
-    [ filter-alien-outputs ] change-reg-outputs
+    dup reg-outputs>> filter-alien-outputs [ >>reg-outputs ] [ >>dead-outputs ] bi*
     drop t ;
 
 M: ##callback-inputs live-insn?
-    [ filter-alien-outputs ] change-reg-outputs
+    [ filter-alien-outputs drop ] change-reg-outputs
-    [ filter-alien-outputs ] change-stack-outputs
+    [ filter-alien-outputs drop ] change-stack-outputs
     drop t ;
 
 M: flushable-insn live-insn? defs-vregs [ live-vreg? ] any? ;

basis/compiler/cfg/gc-checks/gc-checks-tests.factor

@@ -277,7 +277,7 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##alien-invoke f "malloc" f T{ gc-map } }
+    T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
     T{ ##allot f 1 64 byte-array }
     T{ ##branch }
 } 1 test-bb
@@ -299,7 +299,7 @@ V{
 ! The GC check should come after the alien-invoke
 [
     V{
-        T{ ##alien-invoke f "malloc" f T{ gc-map } }
+        T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
         T{ ##check-nursery-branch f 64 cc<= 3 4 }
     }
 ] [ 0 get successors>> first instructions>> ] unit-test
@@ -311,9 +311,9 @@ V{
 } 0 test-bb
 
 V{
-    T{ ##alien-invoke f "malloc" f T{ gc-map } }
+    T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
     T{ ##allot f 1 64 byte-array }
-    T{ ##alien-invoke f "malloc" f T{ gc-map } }
+    T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
     T{ ##allot f 2 64 byte-array }
     T{ ##branch }
 } 1 test-bb
@@ -334,7 +334,7 @@ V{
 
 [
     V{
-        T{ ##alien-invoke f "malloc" f T{ gc-map } }
+        T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
         T{ ##check-nursery-branch f 64 cc<= 3 4 }
     }
 ] [
@@ -346,7 +346,7 @@ V{
 [
     V{
         T{ ##allot f 1 64 byte-array }
-        T{ ##alien-invoke f "malloc" f T{ gc-map } }
+        T{ ##alien-invoke f "malloc" f f f f f T{ gc-map } }
         T{ ##check-nursery-branch f 64 cc<= 5 6 }
     }
 ] [

basis/compiler/cfg/instructions/instructions.factor

@@ -673,14 +673,14 @@ literal: boxer gc-map ;
 ! { vreg rep stack#/reg }
 
 VREG-INSN: ##alien-invoke
-literal: reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map ;
+literal: reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map ;
 
 VREG-INSN: ##alien-indirect
 use: src/int-rep
-literal: reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map ;
+literal: reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map ;
 
 VREG-INSN: ##alien-assembly
-literal: reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map ;
+literal: reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot gc-map ;
 
 VREG-INSN: ##callback-inputs
 literal: reg-outputs stack-outputs ;

basis/compiler/cfg/liveness/liveness-tests.factor

@@ -127,7 +127,7 @@ V{
     T{ ##unbox f 37 29 "alien_offset" int-rep }
     T{ ##unbox f 38 28 "to_double" double-rep }
     T{ ##unbox f 39 36 "to_cell" int-rep }
-    T{ ##alien-invoke f V{ } V{ { 37 int-rep 0 } { 38 double-rep 4 } { 39 int-rep 12 } } { { 40 int-rep EAX } } 0 16 "CFRunLoopRunInMode" f T{ gc-map } }
+    T{ ##alien-invoke f V{ } V{ { 37 int-rep 0 } { 38 double-rep 4 } { 39 int-rep 12 } } { { 40 int-rep EAX } } { } 0 16 "CFRunLoopRunInMode" f T{ gc-map } }
     T{ ##box f 41 40 "from_signed_cell" int-rep T{ gc-map } }
     T{ ##replace f 41 D 0 }
     T{ ##branch }

basis/cpu/architecture/architecture.factor

@@ -602,11 +602,11 @@ HOOK: %save-context cpu ( temp1 temp2 -- )
 
 HOOK: %c-invoke cpu ( symbols dll gc-map -- )
 
-HOOK: %alien-invoke cpu ( reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map -- )
+HOOK: %alien-invoke cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map -- )
 
-HOOK: %alien-indirect cpu ( src reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map -- )
+HOOK: %alien-indirect cpu ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- )
 
-HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map -- )
+HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot gc-map -- )
 
 HOOK: %callback-inputs cpu ( reg-outputs stack-outputs -- )
 

basis/cpu/x86/32/32.factor

@@ -148,6 +148,13 @@ M: x86.32 %store-reg-param ( vreg rep reg -- )
         { double-rep [ drop \ FLDL double-rep store-float-return ] }
     } case ;
 
+M: x86.32 %discard-reg-param ( rep reg -- )
+    drop {
+        { int-rep [ ] }
+        { float-rep [ ST0 FSTP ] }
+        { double-rep [ ST0 FSTP ] }
+    } case ;
+
 :: call-unbox-func ( src func -- )
     EAX src tagged-rep %copy
     4 save-vm-ptr

basis/cpu/x86/64/64.factor

@@ -95,6 +95,9 @@ M:: x86.64 %load-reg-param ( vreg rep reg -- )
 M:: x86.64 %store-reg-param ( vreg rep reg -- )
     reg vreg rep %copy ;
 
+M: x86.32 %discard-reg-param ( rep reg -- )
+    2drop ;
+
 M:: x86.64 %unbox ( dst src func rep -- )
     param-reg-0 src tagged-rep %copy
     param-reg-1 %mov-vm-ptr

basis/cpu/x86/x86.factor

@@ -631,6 +631,8 @@ HOOK: %load-reg-param cpu ( vreg rep reg -- )
 
 HOOK: %store-reg-param cpu ( vreg rep reg -- )
 
+HOOK: %discard-reg-param cpu ( rep reg -- )
+
 : %load-return ( dst rep -- )
     dup return-reg %load-reg-param ;
 
@@ -641,24 +643,25 @@ HOOK: %prepare-var-args cpu ( -- )
 
 HOOK: %cleanup cpu ( n -- )
 
-:: emit-alien-insn ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot -- )
+:: emit-alien-insn ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- )
     stack-inputs [ first3 %store-stack-param ] each
     reg-inputs [ first3 %store-reg-param ] each
     %prepare-var-args
     quot call
     cleanup %cleanup
-    reg-outputs [ first3 %load-reg-param ] each ; inline
+    reg-outputs [ first3 %load-reg-param ] each
+    dead-outputs [ first2 %discard-reg-param ] each ; inline
 
-M: x86 %alien-invoke ( reg-inputs stack-inputs reg-outputs cleanup stack-size symbols dll gc-map -- )
+M: x86 %alien-invoke ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map -- )
     '[ _ _ _ %c-invoke ] emit-alien-insn ;
 
-M:: x86 %alien-indirect ( src reg-inputs stack-inputs reg-outputs cleanup stack-size gc-map -- )
+M:: x86 %alien-indirect ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- )
-    reg-inputs stack-inputs reg-outputs cleanup stack-size [
+    reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size [
         src ?spill-slot CALL
         gc-map gc-map-here
     ] emit-alien-insn ;
 
-M: x86 %alien-assembly ( reg-inputs stack-inputs reg-outputs cleanup stack-size quot gc-map -- )
+M: x86 %alien-assembly ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot gc-map -- )
     '[ _ _ gc-map set call( -- ) ] emit-alien-insn ;
 
 HOOK: %begin-callback cpu ( -- )