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