steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.*: Backend implementation of varargs 

It is turned off by default. Support for using it coming soon. :)
char-rename
Björn Lindqvist 2016-08-08 11:03:20 +02:00
parent ceb0f61c2b
commit 24a02a1c8f
11 changed files with 83 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
View File

@ -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

11
basis/compiler/cfg/builder/alien/alien-tests.factor
View File

@ -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

36
basis/compiler/cfg/builder/alien/alien.factor
View File

@ -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
<gc-map> ##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
<gc-map> ##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 ;

6
basis/compiler/cfg/instructions/instructions.factor
View File

@ -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 ;

2
basis/compiler/cfg/liveness/liveness-tests.factor
View File

@ -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 }

16
basis/cpu/architecture/architecture.factor
View File

@ -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 -- )

25
basis/cpu/ppc/ppc.factor
View File

@ -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 -- )

2
basis/cpu/x86/x86-tests.factor
View File

@ -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

26
basis/cpu/x86/x86.factor
View File

@ -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 ;
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 ;

2
basis/stack-checker/alien/alien-tests.factor
View File

@ -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

4
basis/stack-checker/alien/alien.factor
View File

@ -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