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
							parent
							
								
									7384793287
								
							
						
					
					
						commit
						b5fc39c198
					
				| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -54,8 +54,8 @@ IN: compiler.cfg.builder.alien
 | 
			
		|||
        (caller-parameters)
 | 
			
		||||
    ] with-param-regs* ;
 | 
			
		||||
 | 
			
		||||
: prepare-caller-return ( params -- reg-outputs )
 | 
			
		||||
    return>> [ { } ] [ base-type load-return ] if-void ;
 | 
			
		||||
: prepare-caller-return ( params -- reg-outputs dead-outputs )
 | 
			
		||||
    return>> [ { } ] [ base-type load-return ] if-void { } ;
 | 
			
		||||
 | 
			
		||||
: caller-stack-frame ( params -- cleanup stack-size )
 | 
			
		||||
    [ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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' )
 | 
			
		||||
    [ first live-vreg? ] filter ;
 | 
			
		||||
: filter-alien-outputs ( outputs -- live-outputs dead-outputs )
 | 
			
		||||
    [ 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 ] change-stack-outputs
 | 
			
		||||
    [ filter-alien-outputs drop ] change-reg-outputs
 | 
			
		||||
    [ filter-alien-outputs drop ] change-stack-outputs
 | 
			
		||||
    drop t ;
 | 
			
		||||
 | 
			
		||||
M: flushable-insn live-insn? defs-vregs [ live-vreg? ] any? ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 }
 | 
			
		||||
    }
 | 
			
		||||
] [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 -- )
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 -- )
 | 
			
		||||
    reg-inputs stack-inputs reg-outputs cleanup stack-size [
 | 
			
		||||
M:: x86 %alien-indirect ( src reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map -- )
 | 
			
		||||
    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 ( -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue