factor/library/compiler/amd64/alien.factor

68 lines
1.7 KiB
Factor
Raw Normal View History

2006-01-24 19:56:08 -05:00
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: compiler
2006-01-24 19:56:08 -05:00
USING: alien arrays assembler kernel kernel-internals math
sequences ;
M: stack-params %stack>freg
drop >r R11 swap stack@ MOV r> stack@ R11 MOV ;
2006-01-25 01:18:12 -05:00
M: stack-params %freg>stack
>r stack-increment + cell + swap r> %stack>freg ;
2006-02-20 00:55:38 -05:00
2006-07-03 02:52:44 -04:00
: struct-ptr/size ( n size func -- )
2006-02-20 00:55:38 -05:00
! Load destination address
2006-05-14 20:05:57 -04:00
>r RDI RSP MOV
RDI rot ADD
2006-02-20 00:55:38 -05:00
! Load struct size
RSI swap MOV
2006-02-20 00:55:38 -05:00
! Copy the struct to the stack
2006-05-14 20:05:57 -04:00
r> f compile-c-call ;
2006-07-03 02:52:44 -04:00
: %unbox-struct ( n size -- )
2006-05-14 20:05:57 -04:00
"unbox_value_struct" struct-ptr/size ;
2006-02-20 00:55:38 -05:00
: %unbox ( n reg-class func -- )
2006-01-24 19:56:08 -05:00
! Call the unboxer
f compile-c-call
2006-01-24 19:56:08 -05:00
! Store the return value on the C stack
[ return-reg ] keep %freg>stack ;
2006-01-29 22:51:26 -05:00
2006-07-03 02:52:44 -04:00
: %box-struct ( n size -- )
2006-05-14 20:05:57 -04:00
"box_value_struct" struct-ptr/size ;
2006-01-24 20:20:20 -05:00
: load-return-value ( reg-class -- )
dup fastcall-regs first swap return-reg
2dup eq? [ 2drop ] [ MOV ] if ;
: %box ( n reg-class func -- )
rot [
2006-05-14 20:05:57 -04:00
rot [ fastcall-regs first ] keep %stack>freg
2006-02-20 00:55:38 -05:00
] [
2006-05-14 20:05:57 -04:00
swap load-return-value
2006-02-20 00:55:38 -05:00
] if*
f compile-c-call ;
: reset-sse RAX RAX XOR ;
: %alien-invoke ( symbol dll -- )
reset-sse compile-c-call ;
2006-02-20 00:55:38 -05:00
: %alien-callback ( quot -- )
2006-05-14 20:05:57 -04:00
RDI load-indirect "run_callback" f compile-c-call ;
2006-02-20 00:55:38 -05:00
: save-return 0 swap [ return-reg ] keep %freg>stack ;
: load-return 0 swap [ return-reg ] keep %stack>freg ;
2006-02-20 00:55:38 -05:00
: %callback-value ( reg-class func -- )
2006-02-20 00:55:38 -05:00
! Call the unboxer
f compile-c-call
2006-02-20 00:55:38 -05:00
! Save return register
dup save-return
2006-02-20 00:55:38 -05:00
! Restore data/callstacks
"unnest_stacks" f compile-c-call
! Restore return register
load-return ;
2006-05-14 20:05:57 -04:00
: %cleanup ( n -- ) drop ;