Updated alien interface for x86
parent
531dab7806
commit
92db0f8343
|
@ -65,12 +65,6 @@ M: %alien-callback generate-node ( vop -- )
|
|||
3 0 input load-indirect
|
||||
"run_callback" f compile-c-call ;
|
||||
|
||||
: do-returns ( quot -- )
|
||||
{ T{ int-regs } T{ float-regs f 8 } }
|
||||
dup length [
|
||||
rot [ >r [ cell * ] keep rot r> call ] keep
|
||||
] 2each ;
|
||||
|
||||
: save-return 0 swap [ return-reg ] keep freg>stack ;
|
||||
: load-return 0 swap [ return-reg ] keep stack>freg ;
|
||||
|
||||
|
|
|
@ -4,22 +4,64 @@ IN: compiler-backend
|
|||
USING: alien assembler compiler inference kernel
|
||||
kernel-internals lists math memory namespaces words ;
|
||||
|
||||
GENERIC: push-reg ( reg-class -- )
|
||||
GENERIC: push-return-reg ( reg-class -- )
|
||||
GENERIC: pop-return-reg ( reg-class -- )
|
||||
|
||||
M: int-regs push-reg drop EAX PUSH ;
|
||||
M: int-regs push-return-reg drop EAX PUSH ;
|
||||
M: int-regs pop-return-reg drop EAX POP ;
|
||||
|
||||
M: float-regs push-reg
|
||||
ESP swap reg-size [ SUB { ESP } ] keep
|
||||
4 = [ FSTPS ] [ FSTPL ] if ;
|
||||
: FSTP 4 = [ FSTPS ] [ FSTPL ] if ;
|
||||
|
||||
M: float-regs push-return-reg
|
||||
ESP swap reg-size [ SUB { ESP } ] keep FSTP ;
|
||||
|
||||
: FLD 4 = [ FLDS ] [ FLDL ] if ;
|
||||
|
||||
M: float-regs pop-return-reg
|
||||
reg-size { ESP } over FLD ESP swap ADD ;
|
||||
|
||||
M: %unbox generate-node
|
||||
drop 2 input f compile-c-call 1 input push-reg ;
|
||||
drop 2 input f compile-c-call 1 input push-return-reg ;
|
||||
|
||||
M: %unbox-struct generate-node ( vop -- )
|
||||
drop
|
||||
! Increase stack size
|
||||
ESP 2 input SUB
|
||||
! Save destination address in EAX
|
||||
EAX ESP MOV
|
||||
! Load struct size
|
||||
2 input PUSH
|
||||
! Load destination address
|
||||
EAX PUSH
|
||||
! Copy the struct to the stack
|
||||
"unbox_value_struct" f compile-c-call
|
||||
! Clean up
|
||||
EAX POP
|
||||
ECX POP ;
|
||||
|
||||
M: %box generate-node
|
||||
drop
|
||||
0 input push-reg
|
||||
1 input push-return-reg
|
||||
2 input f compile-c-call
|
||||
ESP 1 input reg-size ADD ;
|
||||
|
||||
M: %alien-callback generate-node ( vop -- )
|
||||
drop
|
||||
EAX 0 input load-indirect
|
||||
EAX PUSH
|
||||
"run_callback" f compile-c-call
|
||||
EAX POP ;
|
||||
|
||||
M: %callback-value generate-node ( vop -- )
|
||||
drop
|
||||
! Call the unboxer
|
||||
1 input f compile-c-call
|
||||
ESP 0 input reg-size ADD ;
|
||||
! Save return register
|
||||
0 input push-return-reg
|
||||
! Restore data/callstacks
|
||||
"unnest_stacks" f compile-c-call
|
||||
! Restore return register
|
||||
0 input pop-return-reg ;
|
||||
|
||||
M: %cleanup generate-node
|
||||
drop 0 input dup zero? [ drop ] [ ESP swap ADD ] if ;
|
||||
|
|
|
@ -278,6 +278,10 @@ M: operand CMP OCT: 071 2-operand ;
|
|||
: FSTPS ( operand -- ) HEX: d9 assemble-1 (FSTP) ;
|
||||
: FSTPL ( operand -- ) HEX: dd assemble-1 (FSTP) ;
|
||||
|
||||
: (FLD) BIN: 100 f HEX: 04 1-operand ;
|
||||
: FLDS ( operand -- ) HEX: d9 assemble-1 (FLD) ;
|
||||
: FLDL ( operand -- ) HEX: dd assemble-1 (FLD) ;
|
||||
|
||||
( SSE multimedia instructions )
|
||||
|
||||
: 2-operand-sse ( dst src op1 op2 -- )
|
||||
|
|
Loading…
Reference in New Issue