2006-04-28 19:23:50 -04:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2006-04-03 02:18:56 -04:00
|
|
|
IN: compiler
|
|
|
|
USING: alien arrays assembler inference kernel
|
2006-05-15 01:01:47 -04:00
|
|
|
kernel-internals math memory namespaces words ;
|
2005-04-23 19:34:06 -04:00
|
|
|
|
2006-04-29 17:32:15 -04:00
|
|
|
: %unbox ( n reg-class func -- )
|
|
|
|
f %alien-invoke push-return-reg drop ;
|
2006-02-15 00:20:35 -05:00
|
|
|
|
2006-04-28 19:23:50 -04:00
|
|
|
: struct-ptr/size ( size func -- )
|
2006-02-15 00:20:35 -05:00
|
|
|
! Load struct size
|
2006-04-28 19:23:50 -04:00
|
|
|
swap PUSH
|
2006-02-15 00:20:35 -05:00
|
|
|
! Load destination address
|
|
|
|
EAX PUSH
|
|
|
|
! Copy the struct to the stack
|
2006-04-28 19:23:50 -04:00
|
|
|
f %alien-invoke
|
2006-02-15 00:20:35 -05:00
|
|
|
! Clean up
|
|
|
|
EAX POP
|
|
|
|
ECX POP ;
|
2005-05-04 22:34:55 -04:00
|
|
|
|
2006-07-03 02:52:44 -04:00
|
|
|
: %unbox-struct ( n size -- )
|
|
|
|
nip
|
2006-03-28 23:25:52 -05:00
|
|
|
! Increase stack size
|
2006-04-28 19:23:50 -04:00
|
|
|
ESP over SUB
|
2006-03-28 23:25:52 -05:00
|
|
|
! Save destination address in EAX
|
|
|
|
EAX ESP MOV
|
|
|
|
"unbox_value_struct" struct-ptr/size ;
|
2006-03-28 21:18:09 -05:00
|
|
|
|
2006-07-03 02:52:44 -04:00
|
|
|
: %box-struct ( n size -- )
|
|
|
|
nip
|
2006-03-28 23:25:52 -05:00
|
|
|
! Compute source address in EAX
|
|
|
|
EAX ESP MOV
|
|
|
|
EAX 4 ADD
|
2006-04-28 19:23:50 -04:00
|
|
|
"box_value_struct" struct-ptr/size ;
|
|
|
|
|
|
|
|
: %box ( n reg-class func -- )
|
|
|
|
rot [ 4 + pick load-return-reg ] when*
|
|
|
|
over push-return-reg
|
|
|
|
f %alien-invoke
|
|
|
|
drop-return-reg ;
|
|
|
|
|
|
|
|
: %alien-callback ( quot -- )
|
2006-05-04 18:08:52 -04:00
|
|
|
0 <int-vreg> load-literal
|
2006-02-15 00:20:35 -05:00
|
|
|
EAX PUSH
|
2006-04-28 19:23:50 -04:00
|
|
|
"run_callback" f %alien-invoke
|
2006-02-15 00:20:35 -05:00
|
|
|
EAX POP ;
|
|
|
|
|
2006-04-28 19:23:50 -04:00
|
|
|
: %callback-value ( reg-class func -- )
|
2006-02-15 00:20:35 -05:00
|
|
|
! Call the unboxer
|
2006-04-28 19:23:50 -04:00
|
|
|
f %alien-invoke
|
2006-02-15 00:20:35 -05:00
|
|
|
! Save return register
|
2006-04-28 19:23:50 -04:00
|
|
|
dup push-return-reg
|
2006-02-15 00:20:35 -05:00
|
|
|
! Restore data/callstacks
|
2006-04-28 19:23:50 -04:00
|
|
|
"unnest_stacks" f %alien-invoke
|
2006-02-15 00:20:35 -05:00
|
|
|
! Restore return register
|
2006-04-29 18:33:05 -04:00
|
|
|
pop-return-reg ;
|
2005-04-23 19:34:06 -04:00
|
|
|
|
2006-04-28 19:23:50 -04:00
|
|
|
: %cleanup ( n -- ) dup zero? [ drop ] [ ESP swap ADD ] if ;
|