cpu.x86.32: cleanups and fixes to make fastcall and thiscall callbacks work

diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor
index 7abf1673d46c4ef9fedececb3d347130a7e871e8..1aaf1bf2eaaec85a235741316b09cb60a9d3b359 100644 (file)
--- a/basis/cpu/architecture/architecture.factor
+++ b/basis/cpu/architecture/architecture.factor
@@ -595,6 +595,6 @@ HOOK: %end-callback cpu ( -- )
 
 HOOK: %end-callback-value cpu ( c-type -- )
 
-HOOK: callback-return-rewind cpu ( params -- n )
+HOOK: stack-cleanup cpu ( params -- n )
 
-M: object callback-return-rewind drop 0 ;
+M: object stack-cleanup drop 0 ;

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 37177abbcd89ba268707174cd9e07ada9af0c1ac..f08a03d8be32a25ad878b3c3344b6c55b4c7bfd9 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -129,8 +129,7 @@ M: stack-params copy-register*
         { [ 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 [ local@ ] 2dip %copy ;
 
 M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
 
@@ -139,7 +138,7 @@ M: x86.32 %load-param-reg [ swap local@ ] dip %copy ;
     #! are boxing a return value of a C function. If n is an
     #! integer, push [ESP+n] on the stack; we are boxing a
     #! parameter being passed to a callback from C.
-    over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
+    over [ [ local@ ] dip load-return-reg ] [ 2drop ] if ;
 
 M:: x86.32 %box ( n rep func -- )
     n rep (%box)
@@ -327,18 +326,20 @@ M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
         stack-params get
     ] with-param-regs ;
 
-M: x86.32 %cleanup ( params -- )
-    #! 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.
+M: x86.32 stack-cleanup ( params -- n )
+    #! a) Functions which are stdcall/fastcall/thiscall have to
+    #! clean up the caller's stack frame.
+    #! b) Functions returning large structs on MINGW have to
+    #! fix ESP.
     {
-        { [ dup abi>> callee-cleanup? ] [ stack-arg-size ESP swap SUB ] }
-        { [ dup funny-large-struct-return? ] [ drop EAX PUSH ] }
-        [ drop ]
+        { [ dup abi>> callee-cleanup? ] [ stack-arg-size ] }
+        { [ dup funny-large-struct-return? ] [ drop 4 ] }
+        [ drop 0 ]
     } cond ;
 
+M: x86.32 %cleanup ( params -- )
+    stack-cleanup [ ESP swap SUB ] unless-zero ;
+
 M:: x86.32 %call-gc ( gc-root-count temp -- )
     temp gc-root-base special@ LEA
     8 save-vm-ptr
@@ -352,17 +353,6 @@ M: x86.32 dummy-int-params? f ;
 
 M: x86.32 dummy-fp-params? f ;
 
-M: x86.32 callback-return-rewind ( params -- n )
-    #! a) If the callback is stdcall, we have to clean up the
-    #! caller's stack frame.
-    #! b) If the callback is returning a large struct, we have
-    #! to fix ESP.
-    {
-        { [ dup stdcall? ] [ <alien-stack-frame> [ params>> ] [ return>> ] bi + ] }
-        { [ dup funny-large-struct-return? ] [ drop 4 ] }
-        [ drop 0 ]
-    } cond ;
-
 ! Dreadful
 M: object flatten-value-type (flatten-stack-type) ;
 M: struct-c-type flatten-value-type (flatten-stack-type) ;

diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index b1866e110a096a1d53ab05a5f6272a42ee317c92..7accc4b1cbc0d30805250f5d270a7e252fc314d3 100644 (file)
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -66,9 +66,10 @@ big-endian off
 
     frame-reg POP
 
-    ! Callbacks which return structs, or use stdcall, need a
-    ! parameter here. See the comment in callback-return-rewind
-    ! in cpu.x86.32
+    ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
+    ! need a parameter here.
+
+    ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
     HEX: ffff RET rc-absolute-2 rt-untagged jit-rel
 ] callback-stub jit-define
 

diff --git a/basis/stack-checker/alien/alien.factor b/basis/stack-checker/alien/alien.factor
index 9039c5d3f0e4c59ac4773a49134520455778eaab..1c6b37b7dff2fe5521e00b14b9ca4dd085792ed6 100644 (file)
--- a/basis/stack-checker/alien/alien.factor
+++ b/basis/stack-checker/alien/alien.factor
@@ -107,8 +107,7 @@ TUPLE: alien-callback-params < alien-node-params quot xt ;
     [ callbacks get ] dip '[ _ <callback> ] cache ;
 
 : callback-bottom ( params -- )
-    [ xt>> ] [ callback-return-rewind ] bi
-    '[ _ _ callback-xt ] infer-quot-here ;
+    [ xt>> ] [ stack-cleanup ] bi '[ _ _ callback-xt ] infer-quot-here ;
 
 : infer-alien-callback ( -- )
     alien-callback-params new