compiler.codegen: need to do name decoration with fastcall as well
parent
becb7c78b7
commit
67e24b1d2a
|
@ -18,6 +18,7 @@ compiler.cfg.builder
|
||||||
compiler.codegen.fixup
|
compiler.codegen.fixup
|
||||||
compiler.utilities ;
|
compiler.utilities ;
|
||||||
FROM: namespaces => set ;
|
FROM: namespaces => set ;
|
||||||
|
FROM: compiler.errors => no-such-symbol ;
|
||||||
IN: compiler.codegen
|
IN: compiler.codegen
|
||||||
|
|
||||||
SYMBOL: insn-counts
|
SYMBOL: insn-counts
|
||||||
|
@ -415,13 +416,18 @@ M: array dlsym-valid? '[ _ dlsym ] any? ;
|
||||||
dll-path compiling-word get no-such-library drop
|
dll-path compiling-word get no-such-library drop
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: stdcall-mangle ( params -- symbols )
|
: decorated-symbol ( params -- symbols )
|
||||||
[ function>> ] [ parameters>> parameter-offsets drop number>string ] bi
|
[ function>> ] [ parameters>> parameter-offsets drop number>string ] bi
|
||||||
[ drop ] [ "@" glue ] [ "@" glue "_" prepend ] 2tri
|
{
|
||||||
3array ;
|
[ drop ]
|
||||||
|
[ "@" glue ]
|
||||||
|
[ "@" glue "_" prepend ]
|
||||||
|
[ "@" glue "@" prepend ]
|
||||||
|
} 2cleave
|
||||||
|
4array ;
|
||||||
|
|
||||||
: alien-invoke-dlsym ( params -- symbols dll )
|
: alien-invoke-dlsym ( params -- symbols dll )
|
||||||
[ dup abi>> stdcall = [ stdcall-mangle ] [ function>> ] if ]
|
[ dup abi>> callee-cleanup? [ decorated-symbol ] [ function>> ] if ]
|
||||||
[ library>> load-library ]
|
[ library>> load-library ]
|
||||||
bi 2dup check-dlsym ;
|
bi 2dup check-dlsym ;
|
||||||
|
|
||||||
|
|
|
@ -315,9 +315,6 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
|
||||||
[ abi>> mingw = os windows? not or ]
|
[ abi>> mingw = os windows? not or ]
|
||||||
bi and ;
|
bi and ;
|
||||||
|
|
||||||
: callee-cleanup? ( abi -- ? )
|
|
||||||
{ stdcall fastcall thiscall } member? ;
|
|
||||||
|
|
||||||
: stack-arg-size ( params -- n )
|
: stack-arg-size ( params -- n )
|
||||||
dup abi>> '[
|
dup abi>> '[
|
||||||
alien-parameters flatten-value-types
|
alien-parameters flatten-value-types
|
||||||
|
|
|
@ -68,6 +68,9 @@ SINGLETONS: stdcall thiscall fastcall cdecl mingw ;
|
||||||
|
|
||||||
UNION: abi stdcall thiscall fastcall cdecl mingw ;
|
UNION: abi stdcall thiscall fastcall cdecl mingw ;
|
||||||
|
|
||||||
|
: callee-cleanup? ( abi -- ? )
|
||||||
|
{ stdcall fastcall thiscall } member? ;
|
||||||
|
|
||||||
ERROR: alien-callback-error ;
|
ERROR: alien-callback-error ;
|
||||||
|
|
||||||
: alien-callback ( return parameters abi quot -- alien )
|
: alien-callback ( return parameters abi quot -- alien )
|
||||||
|
|
Loading…
Reference in New Issue