diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor index dc6ba4ad39..adf5d61a25 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor +++ b/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 diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 094b2e898b..d5502ab3ba 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/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 ) - 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 diff --git a/basis/compiler/cfg/dce/dce.factor b/basis/compiler/cfg/dce/dce.factor index 657bb9d603..db41b0c18d 100644 --- a/basis/compiler/cfg/dce/dce.factor +++ b/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' ) - [ 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? ; diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor index a047fc4c9d..44ede70c97 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor +++ b/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 } } ] [ diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index bfffec0aef..78cacf9d17 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/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 ; diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor index b86f04b8b0..7099d3a06e 100644 --- a/basis/compiler/cfg/liveness/liveness-tests.factor +++ b/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 } diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 96ca9d0b32..6cf4a11e22 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/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 -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 79dd9e743d..2b667ef7f9 100755 --- a/basis/cpu/x86/32/32.factor +++ b/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 diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index f12dc0a15c..3c96f2a2b0 100644 --- a/basis/cpu/x86/64/64.factor +++ b/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 diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 6442044d35..a13b44197d 100644 --- a/basis/cpu/x86/x86.factor +++ b/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 -- ) - 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 ( -- )