M: x86.32 pic-tail-reg EBX ;
-M: x86.32 reserved-area-size 0 ;
+M: x86.32 reserved-area-size 4 cells ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
-: push-vm-ptr ( -- )
- 0 PUSH 0 rc-absolute-cell rel-vm ; ! push the vm ptr as an argument
+: save-vm-ptr ( n -- )
+ stack@ 0 MOV 0 rc-absolute-cell rel-vm ;
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
and or ;
: struct-return@ ( n -- operand )
- [ next-stack@ ] [ stack-frame get params>> stack@ ] if* ;
+ [ next-stack@ ] [ stack-frame get params>> param@ ] if* ;
! On x86, parameters are never passed in registers.
M: int-regs return-reg drop EAX ;
M: int-regs param-regs drop { } ;
M: float-regs param-regs drop { } ;
-GENERIC: push-return-reg ( rep -- )
-GENERIC: load-return-reg ( n rep -- )
-GENERIC: store-return-reg ( n rep -- )
+GENERIC: load-return-reg ( src rep -- )
+GENERIC: store-return-reg ( dst rep -- )
-M: int-rep push-return-reg drop EAX PUSH ;
-M: int-rep load-return-reg drop EAX swap next-stack@ MOV ;
-M: int-rep store-return-reg drop stack@ EAX MOV ;
+M: int-rep load-return-reg drop EAX swap MOV ;
+M: int-rep store-return-reg drop EAX MOV ;
-M: float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
-M: float-rep load-return-reg drop next-stack@ FLDS ;
-M: float-rep store-return-reg drop stack@ FSTPS ;
+M: float-rep load-return-reg drop FLDS ;
+M: float-rep store-return-reg drop FSTPS ;
-M: double-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
-M: double-rep load-return-reg drop next-stack@ FLDL ;
-M: double-rep store-return-reg drop stack@ FSTPL ;
-
-: align-sub ( n -- )
- [ align-stack ] keep - decr-stack-reg ;
-
-: align-add ( n -- )
- align-stack incr-stack-reg ;
-
-: with-aligned-stack ( n quot -- )
- '[ align-sub @ ] [ align-add ] bi ; inline
+M: double-rep load-return-reg drop FLDL ;
+M: double-rep store-return-reg drop FSTPL ;
M: x86.32 %prologue ( n -- )
dup PUSH
0 PUSH rc-absolute-cell rel-this
3 cells - decr-stack-reg ;
-M: x86.32 %load-param-reg 3drop ;
+M: x86.32 %load-param-reg
+ stack-params assert=
+ [ [ EAX ] dip param@ MOV ] dip
+ stack@ EAX MOV ;
M: x86.32 %save-param-reg 3drop ;
#! 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 [ load-return-reg ] [ 2drop ] if ;
+ over [ [ next-stack@ ] dip load-return-reg ] [ 2drop ] if ;
M:: x86.32 %box ( n rep func -- )
n rep (%box)
- rep rep-size cell + [
- push-vm-ptr
- rep push-return-reg
- func f %alien-invoke
- ] with-aligned-stack ;
-
+ rep rep-size save-vm-ptr
+ 0 stack@ rep store-return-reg
+ func f %alien-invoke ;
+
: (%box-long-long) ( n -- )
[
EDX over next-stack@ MOV
M: x86.32 %box-long-long ( n func -- )
[ (%box-long-long) ] dip
- 12 [
- push-vm-ptr
- EDX PUSH
- EAX PUSH
- f %alien-invoke
- ] with-aligned-stack ;
+ 8 save-vm-ptr
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ f %alien-invoke ;
M:: x86.32 %box-large-struct ( n c-type -- )
- ! Compute destination address
EDX n struct-return@ LEA
- 12 [
- push-vm-ptr
- ! Push struct size
- c-type heap-size PUSH
- ! Push destination address
- EDX PUSH
- ! Copy the struct from the C stack
- "box_value_struct" f %alien-invoke
- ] with-aligned-stack ;
+ 8 save-vm-ptr
+ 4 stack@ c-type heap-size MOV
+ 0 stack@ EDX MOV
+ "box_value_struct" f %alien-invoke ;
M: x86.32 %prepare-box-struct ( -- )
! Compute target address for value struct return
EAX f struct-return@ LEA
! Store it as the first parameter
- 0 stack@ EAX MOV ;
+ 0 param@ EAX MOV ;
M: x86.32 %box-small-struct ( c-type -- )
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
- 16 [
- push-vm-ptr
- heap-size PUSH
- EDX PUSH
- EAX PUSH
- "box_small_struct" f %alien-invoke
- ] with-aligned-stack ;
+ 12 save-vm-ptr
+ 8 stack@ swap heap-size MOV
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ "box_small_struct" f %alien-invoke ;
M: x86.32 %prepare-unbox ( -- )
#! Move top of data stack to EAX.
ESI 4 SUB ;
: call-unbox-func ( func -- )
- 8 [
- ! push the vm ptr as an argument
- push-vm-ptr
- ! Push parameter
- EAX PUSH
- ! Call the unboxer
- f %alien-invoke
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ f %alien-invoke ;
M: x86.32 %unbox ( n rep func -- )
#! The value being unboxed must already be in EAX.
#! a parameter to a C function about to be called.
call-unbox-func
! Store the return value on the C stack
- over [ store-return-reg ] [ 2drop ] if ;
+ over [ [ param@ ] dip store-return-reg ] [ 2drop ] if ;
M: x86.32 %unbox-long-long ( n func -- )
call-unbox-func
! Store the return value on the C stack
[
- dup stack@ EAX MOV
- cell + stack@ EDX MOV
+ dup param@ EAX MOV
+ 4 + param@ EDX MOV
] when* ;
: %unbox-struct-1 ( -- )
#! Alien must be in EAX.
- 8 [
- push-vm-ptr
- EAX PUSH
- "alien_offset" f %alien-invoke
- ! Load first cell
- EAX EAX [] MOV
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "alien_offset" f %alien-invoke
+ ! Load first cell
+ EAX EAX [] MOV ;
: %unbox-struct-2 ( -- )
#! Alien must be in EAX.
- 8 [
- push-vm-ptr
- EAX PUSH
- "alien_offset" f %alien-invoke
- ! Load second cell
- EDX EAX 4 [+] MOV
- ! Load first cell
- EAX EAX [] MOV
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "alien_offset" f %alien-invoke
+ ! Load second cell
+ EDX EAX 4 [+] MOV
+ ! Load first cell
+ EAX EAX [] MOV ;
M: x86 %unbox-small-struct ( size -- )
#! Alien must be in EAX.
M:: x86.32 %unbox-large-struct ( n c-type -- )
! Alien must be in EAX.
! Compute destination address
- EDX n stack@ LEA
- 16 [
- push-vm-ptr
- ! Push struct size
- c-type heap-size PUSH
- ! Push destination address
- EDX PUSH
- ! Push source address
- EAX PUSH
- ! Copy the struct to the stack
- "to_value_struct" f %alien-invoke
- ] with-aligned-stack ;
+ EDX n param@ LEA
+ 12 save-vm-ptr
+ 8 stack@ c-type heap-size MOV
+ 4 stack@ EDX MOV
+ 0 stack@ EAX MOV
+ "to_value_struct" f %alien-invoke ;
M: x86.32 %nest-stacks ( -- )
! Save current frame. See comment in vm/contexts.hpp
EAX stack-reg stack-frame get total-size>> 3 cells - [+] LEA
- 8 [
- push-vm-ptr
- EAX PUSH
- "nest_stacks" f %alien-invoke
- ] with-aligned-stack ;
+ 4 save-vm-ptr
+ 0 stack@ EAX MOV
+ "nest_stacks" f %alien-invoke ;
M: x86.32 %unnest-stacks ( -- )
- 4 [
- push-vm-ptr
- "unnest_stacks" f %alien-invoke
- ] with-aligned-stack ;
+ 0 save-vm-ptr
+ "unnest_stacks" f %alien-invoke ;
M: x86.32 %prepare-alien-indirect ( -- )
- 4 [
- push-vm-ptr
- "unbox_alien" f %alien-invoke
- ] with-aligned-stack
+ 0 save-vm-ptr
+ "unbox_alien" f %alien-invoke
EBP EAX MOV ;
M: x86.32 %alien-indirect ( -- )
EBP CALL ;
M: x86.32 %alien-callback ( quot -- )
+ ! Fastcall
param-reg-1 swap %load-reference
param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ;
M: x86.32 %callback-value ( ctype -- )
- ! Align C stack
- ESP 12 SUB
! Save top of data stack in non-volatile register
%prepare-unbox
- EAX PUSH
- push-vm-ptr
+ 4 stack@ EAX MOV
+ 0 save-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
- ! Place top of data stack in EAX
- temp-reg POP
- EAX POP
- ! Restore C stack
- ESP 12 ADD
+ ! Place former top of data stack back in EAX
+ EAX 4 stack@ MOV
! Unbox EAX
unbox-return ;
M:: x86.32 %call-gc ( gc-root-count temp -- )
temp gc-root-base param@ LEA
- 12 [
- ! Pass the VM ptr as the third parameter
- push-vm-ptr
- ! Pass number of roots as second parameter
- gc-root-count PUSH
- ! Pass pointer to start of GC roots as first parameter
- temp PUSH
- ! Call GC
- "inline_gc" f %alien-invoke
- ] with-aligned-stack ;
+ 8 save-vm-ptr
+ 4 stack@ gc-root-count MOV
+ 0 stack@ temp MOV
+ "inline_gc" f %alien-invoke ;
M: x86.32 dummy-stack-params? f ;
M: x86.32 dummy-fp-params? f ;
+! Dreadful
+M: object flatten-value-type (flatten-int-type) ;
+
os windows? [
- cell "longlong" c-type (>>align)
- cell "ulonglong" c-type (>>align)
- 4 "double" c-type (>>align)
+ cell longlong c-type (>>align)
+ cell ulonglong c-type (>>align)
+ 4 double c-type (>>align)
] unless
check-sse