diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor index 901fa909b7..e2481dc201 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor @@ -436,13 +436,13 @@ IN: compiler.cfg.alias-analysis.tests { V{ T{ ##allot f 0 } - T{ ##alien-indirect f { } { } { { 2 double-rep 0 } } { } 0 0 "free" } + T{ ##alien-indirect f f { } { } { { 2 double-rep 0 } } { } 0 0 "free" } T{ ##set-slot-imm f 2 0 1 0 } } } [ V{ T{ ##allot f 0 } - T{ ##alien-indirect f { } { } { { 2 double-rep 0 } } { } 0 0 "free" } + T{ ##alien-indirect f f { } { } { { 2 double-rep 0 } } { } 0 0 "free" } T{ ##set-slot-imm f 2 0 1 0 } } test-alias-analysis ] unit-test diff --git a/basis/compiler/cfg/builder/alien/alien-tests.factor b/basis/compiler/cfg/builder/alien/alien-tests.factor index cdc80868a1..df0517f864 100644 --- a/basis/compiler/cfg/builder/alien/alien-tests.factor +++ b/basis/compiler/cfg/builder/alien/alien-tests.factor @@ -61,11 +61,20 @@ cpu x86.64? [ ] if V{ } } [ - void { int float double char } cdecl f "func" + void { int float double char } cdecl f f "func" alien-invoke-params boa caller-parameters ] cfg-unit-test ] when +! prepare-caller-return +${ + cpu x86.32? { { 1 int-rep EAX } } { { 1 int-rep RAX } } ? + cpu x86.32? { { 2 double-rep ST0 } } { { 2 double-rep XMM0 } } ? +} [ + T{ alien-invoke-params { return int } } prepare-caller-return + T{ alien-invoke-params { return double } } prepare-caller-return +] cfg-unit-test + ! unbox-parameters ! unboxing ints is only needed on 32bit archs diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 2f7a0f2664..921cce3cba 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -51,8 +51,8 @@ IN: compiler.cfg.builder.alien (caller-parameters) ] with-param-regs ; -: prepare-caller-return ( params -- reg-outputs dead-outputs ) - return>> [ { } ] [ base-type load-return ] if-void { } ; +: prepare-caller-return ( params -- reg-outputs ) + return>> [ { } ] [ base-type load-return ] if-void ; : caller-stack-frame ( params -- cleanup stack-size ) [ stack-params get ] dip [ return>> ] [ abi>> ] bi stack-cleanup @@ -83,15 +83,22 @@ IN: compiler.cfg.builder.alien base-type box-return ds-push ] if-void ; +: params>alien-insn-params ( params -- + varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size ) + { + [ varargs?>> ] + [ caller-parameters ] + [ prepare-caller-return { } ] + [ caller-stack-frame ] + } cleave ; + M: #alien-invoke emit-node ( block node -- block' ) params>> [ - { - [ caller-parameters ] - [ prepare-caller-return ] - [ caller-stack-frame ] - [ caller-linkage ] - } cleave + [ params>alien-insn-params ] + [ caller-linkage ] bi ##alien-invoke, ] [ caller-return ] bi ; @@ -100,9 +107,7 @@ M: #alien-indirect emit-node ( block node -- block' ) params>> [ [ ds-pop ^^unbox-any-c-ptr ] dip - [ caller-parameters ] - [ prepare-caller-return ] - [ caller-stack-frame ] tri + params>alien-insn-params ##alien-indirect, ] [ caller-return ] bi ; @@ -110,12 +115,9 @@ M: #alien-indirect emit-node ( block node -- block' ) M: #alien-assembly emit-node ( block node -- block' ) params>> [ - { - [ caller-parameters ] - [ prepare-caller-return ] - [ caller-stack-frame ] - [ quot>> ] - } cleave ##alien-assembly, + [ params>alien-insn-params ] + [ quot>> ] bi + ##alien-assembly, ] [ caller-return ] bi ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index b95d4953b0..ff58ae0431 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -669,14 +669,14 @@ literal: boxer gc-map ; ! { vreg rep stack#/reg } VREG-INSN: ##alien-invoke -literal: reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size symbols dll gc-map ; +literal: varargs? 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 dead-outputs cleanup stack-size gc-map ; +literal: varargs? reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size gc-map ; VREG-INSN: ##alien-assembly -literal: reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot ; +literal: varargs? reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot ; 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 2385bd93a0..70bd19d8a7 100644 --- a/basis/compiler/cfg/liveness/liveness-tests.factor +++ b/basis/compiler/cfg/liveness/liveness-tests.factor @@ -278,7 +278,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 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 e440925820..66dddc453a 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -580,11 +580,21 @@ HOOK: %save-context cpu ( temp1 temp2 -- ) HOOK: %c-invoke cpu ( 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-invoke cpu ( varargs? 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 dead-outputs cleanup stack-size gc-map -- ) +HOOK: %alien-indirect cpu ( src + varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size + gc-map -- ) -HOOK: %alien-assembly cpu ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- ) +HOOK: %alien-assembly cpu ( varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size + quot -- ) HOOK: %callback-inputs cpu ( reg-outputs stack-outputs -- ) diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 04a05897f2..80e54f606d 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -450,7 +450,10 @@ M:: ppc %c-invoke ( name dll gc-map -- ) } case rep scratch-reg-class rep vreg %spill ; -:: emit-alien-insn ( reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size quot -- ) +:: emit-alien-insn ( varargs? 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 quot call @@ -458,14 +461,17 @@ M:: ppc %c-invoke ( name dll gc-map -- ) dead-outputs [ first2 discard-reg-param ] each ; inline -M: ppc %alien-invoke ( reg-inputs stack-inputs reg-outputs - dead-outputs cleanup stack-size +M: ppc %alien-invoke ( varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size symbols dll gc-map -- ) '[ _ _ _ %c-invoke ] emit-alien-insn ; -M:: ppc %alien-indirect ( src reg-inputs stack-inputs - reg-outputs dead-outputs cleanup - stack-size gc-map -- ) +M:: ppc %alien-indirect ( src + varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size + gc-map -- ) reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size [ has-toc [ 11 src load-param @@ -479,9 +485,10 @@ M:: ppc %alien-indirect ( src reg-inputs stack-inputs gc-map gc-map-here ] emit-alien-insn ; -M: ppc %alien-assembly ( reg-inputs stack-inputs reg-outputs - dead-outputs cleanup stack-size quot - -- ) +M: ppc %alien-assembly ( varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size + quot -- ) '[ _ call( -- ) ] emit-alien-insn ; M: ppc %callback-inputs ( reg-outputs stack-outputs -- ) diff --git a/basis/cpu/x86/x86-tests.factor b/basis/cpu/x86/x86-tests.factor index be9cecd2a7..7b5175d19f 100644 --- a/basis/cpu/x86/x86-tests.factor +++ b/basis/cpu/x86/x86-tests.factor @@ -41,7 +41,7 @@ cpu x86.64? [ ! %alien-invoke { 1 } [ init-relocation init-gc-maps [ - { } { } { } { } 0 0 { } "dll" T{ gc-map { scrub-d V{ 0 } } } %alien-invoke + f { } { } { } { } 0 0 { } "dll" T{ gc-map { scrub-d V{ 0 } } } %alien-invoke ] B{ } make drop gc-maps get length ] unit-test diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index a3fa514049..54059236fe 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -649,32 +649,32 @@ HOOK: %prepare-var-args cpu ( reg-inputs -- ) HOOK: %cleanup cpu ( n -- ) -M:: x86 %alien-assembly ( reg-inputs - stack-inputs - reg-outputs - dead-outputs - cleanup - stack-size +M:: x86 %alien-assembly ( varargs? 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 ] bi + reg-inputs [ first3 %store-reg-param ] each + varargs? [ reg-inputs %prepare-var-args ] when quot call( -- ) cleanup %cleanup reg-outputs [ first3 %load-reg-param ] each dead-outputs [ first2 %discard-reg-param ] each ; -M: x86 %alien-invoke ( reg-inputs stack-inputs +M: x86 %alien-invoke ( varargs? reg-inputs stack-inputs reg-outputs dead-outputs - cleanup - stack-size + cleanup stack-size symbols dll gc-map -- ) - '[ _ _ _ %c-invoke ] %alien-assembly ; + '[ _ _ _ %c-invoke ] %alien-assembly ; M:: x86 %alien-indirect ( src - reg-inputs stack-inputs + varargs? reg-inputs stack-inputs reg-outputs dead-outputs - cleanup stack-size gc-map -- ) - reg-inputs stack-inputs reg-outputs dead-outputs cleanup stack-size [ + cleanup stack-size + gc-map -- ) + varargs? reg-inputs stack-inputs + reg-outputs dead-outputs + cleanup stack-size [ src ?spill-slot CALL gc-map gc-map-here ] %alien-assembly ; diff --git a/basis/stack-checker/alien/alien-tests.factor b/basis/stack-checker/alien/alien-tests.factor index 5116aad9a9..91234632d6 100644 --- a/basis/stack-checker/alien/alien-tests.factor +++ b/basis/stack-checker/alien/alien-tests.factor @@ -53,6 +53,6 @@ ${ ] do-callback ] ? } [ - int { int int } cdecl alien-node-params boa + int { int int } cdecl f alien-node-params boa [ "hello" ] wrap-callback-quot ] unit-test diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor index 3588a0074a..aa78632e0b 100644 --- a/basis/stack-checker/alien/alien.factor +++ b/basis/stack-checker/alien/alien.factor @@ -8,7 +8,9 @@ stack-checker.visitor strings words ; FROM: kernel.private => declare ; IN: stack-checker.alien -TUPLE: alien-node-params return parameters { abi abi initial: cdecl } ; +TUPLE: alien-node-params + return parameters + { abi abi initial: cdecl } varargs? ; TUPLE: alien-invoke-params < alien-node-params library