Merge remote branch 'origin/abi-symbols' into fastcall-madness

[factor.git] / basis / cpu / x86 / 32 / 32.factor

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 10b49f5e978804a24e8a735278531faff4781fcd..37177abbcd89ba268707174cd9e07ada9af0c1ac 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -1,15 +1,16 @@
 ! Copyright (C) 2005, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: locals alien.c-types alien.libraries alien.syntax arrays
-kernel fry math namespaces sequences system layouts io
-vocabs.loader accessors init combinators command-line make
-compiler compiler.units compiler.constants compiler.alien
+USING: locals alien alien.c-types alien.libraries alien.syntax
+arrays kernel fry math namespaces sequences system layouts io
+vocabs.loader accessors init classes.struct combinators command-line
+make compiler compiler.units compiler.constants compiler.alien
 compiler.codegen compiler.codegen.fixup
 compiler.cfg.instructions compiler.cfg.builder
 compiler.cfg.intrinsics compiler.cfg.stack-frame
 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
 cpu.architecture vm ;
 FROM: layouts => cell ;
+FROM: alien.private => fastcall ;
 IN: cpu.x86.32
 
 M: x86.32 machine-registers
@@ -69,7 +70,7 @@ M:: x86.32 %dispatch ( src temp -- )
 
 M: x86.32 pic-tail-reg EDX ;
 
-M: x86.32 reserved-stack-space 4 cells ;
+M: x86.32 reserved-stack-space 0 ;
 
 M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
 
@@ -86,14 +87,24 @@ M: x86.32 return-struct-in-registers? ( c-type -- ? )
 : struct-return@ ( n -- operand )
     [ next-stack@ ] [ stack-frame get params>> local@ ] if* ;
 
-! On x86, parameters are never passed in registers.
+! On x86, parameters are usually never passed in registers, except with Microsoft's
+! "thiscall" and "fastcall" abis
 M: int-regs return-reg drop EAX ;
-M: int-regs param-regs drop { } ;
-M: float-regs param-regs drop { } ;
+M: float-regs param-regs 2drop { } ;
+
+M: int-regs param-regs
+    nip {
+        { thiscall [ { ECX     } ] }
+        { fastcall [ { ECX EDX } ] }
+        [ drop { } ]
+    } case ;
 
 GENERIC: load-return-reg ( src rep -- )
 GENERIC: store-return-reg ( dst rep -- )
 
+M: stack-params load-return-reg drop EAX swap MOV ;
+M: stack-params store-return-reg drop EAX MOV ;
+
 M: int-rep load-return-reg drop EAX swap MOV ;
 M: int-rep store-return-reg drop EAX MOV ;
 
@@ -111,12 +122,17 @@ M: x86.32 %prologue ( n -- )
 M: x86.32 %prepare-jump
     pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here ;
 
-M: x86.32 %load-param-reg
-    stack-params assert=
-    [ [ EAX ] dip local@ MOV ] dip
-    stack@ EAX MOV ;
+M: stack-params copy-register*
+    drop
+    {
+        { [ dup  integer? ] [ EAX swap next-stack@ MOV  EAX MOV ] }
+        { [ over integer? ] [ EAX swap MOV              param@ EAX MOV ] }
+    } cond ;
+
+M: x86.32 %save-param-reg
+    dup stack-params? [ 3drop ] [ [ param@ ] 2dip %copy ] if ;
 
-M: x86.32 %save-param-reg 3drop ;
+M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
 
 : (%box) ( n rep -- )
     #! If n is f, push the return register onto the stack; we
@@ -295,23 +311,30 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
     func "libm" load-library %alien-invoke
     dst float-function-return ;
 
-: stdcall? ( params -- ? )
-    abi>> "stdcall" = ;
-
 : funny-large-struct-return? ( params -- ? )
     #! MINGW ABI incompatibility disaster
     [ return>> large-struct? ]
-    [ abi>> "mingw" = os windows? not or ]
+    [ abi>> mingw = os windows? not or ]
     bi and ;
 
+: callee-cleanup? ( abi -- ? )
+    { stdcall fastcall thiscall } member? ;
+
+: stack-arg-size ( params -- n )
+    dup abi>> '[
+        alien-parameters flatten-value-types
+        [ _ alloc-parameter 2drop ] each
+        stack-params get
+    ] with-param-regs ;
+
 M: x86.32 %cleanup ( params -- )
-    #! a) If we just called an stdcall function in Windows, it
+    #! a) If we just called a stdcall function in Windows, it
     #! cleaned up the stack frame for us. But we don't want that
     #! so we 'undo' the cleanup since we do that in %epilogue.
     #! b) If we just called a function returning a struct, we
     #! have to fix ESP.
     {
-        { [ dup stdcall? ] [ drop ESP stack-frame get params>> SUB ] }
+        { [ dup abi>> callee-cleanup? ] [ stack-arg-size ESP swap SUB ] }
         { [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
         [ drop ]
     } cond ;
@@ -341,6 +364,12 @@ M: x86.32 callback-return-rewind ( params -- n )
     } cond ;
 
 ! Dreadful
-M: object flatten-value-type (flatten-int-type) ;
+M: object flatten-value-type (flatten-stack-type) ;
+M: struct-c-type flatten-value-type (flatten-stack-type) ;
+M: long-long-type flatten-value-type (flatten-stack-type) ;
+M: c-type flatten-value-type
+    dup rep>> int-rep? [ (flatten-int-type) ] [ (flatten-stack-type) ] if ;
+
+M: x86.32 struct-return-pointer-type (stack-value) ;
 
 check-sse