From 4edf4f15190e2020220e04d674d8e81e4e700a56 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 10 Apr 2010 16:54:17 -0700 Subject: [PATCH] cpu.x86.32: cleanups and fixes to make fastcall and thiscall callbacks work --- basis/cpu/architecture/architecture.factor | 4 +-- basis/cpu/x86/32/32.factor | 36 ++++++++-------------- basis/cpu/x86/bootstrap.factor | 7 +++-- basis/stack-checker/alien/alien.factor | 3 +- 4 files changed, 20 insertions(+), 30 deletions(-) diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 7abf1673d4..1aaf1bf2ea 100644 --- 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 37177abbcd..f08a03d8be 100755 --- 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? ] [ [ 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 b1866e110a..7accc4b1cb 100644 --- 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 9039c5d3f0..1c6b37b7df 100644 --- 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 '[ _ ] 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