1 ! Copyright (C) 2005, 2007 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types arrays cpu.x86.assembler
4 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.sse2
5 cpu.x86.allot cpu.architecture kernel kernel.private math
6 namespaces sequences generator.registers generator.fixup system
7 layouts alien alien.accessors alien.compiler alien.structs slots
11 M: x86.64 ds-reg R14 ;
12 M: x86.64 rs-reg R15 ;
13 M: x86.64 stack-reg RSP ;
14 M: x86.64 stack-save-reg RSI ;
15 M: x86.64 temp-reg-1 RAX ;
16 M: x86.64 temp-reg-2 RCX ;
18 M: temp-reg v>operand drop RBX ;
20 M: int-regs return-reg drop RAX ;
21 M: int-regs vregs drop { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } ;
22 M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ;
24 M: float-regs return-reg drop XMM0 ;
28 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
29 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
32 M: float-regs param-regs
33 drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
35 M: x86.64 address-operand ( address -- operand )
36 #! On AMD64, we have to load 64-bit addresses into a
37 #! scratch register first. The usage of R11 here is a hack.
38 #! This word can only be called right before a subroutine
39 #! call, where all vregs have been flushed anyway.
40 temp-reg v>operand [ swap MOV ] keep ;
42 M: x86.64 fixnum>slot@ drop ;
44 M: x86.64 prepare-division CQO ;
46 M: x86.64 load-indirect ( literal reg -- )
47 0 [] MOV rc-relative rel-literal ;
49 M: stack-params %load-param-reg
51 >r temp-reg v>operand swap stack@ MOV
52 r> stack@ temp-reg v>operand MOV ;
54 M: stack-params %save-param-reg
55 >r stack-frame* + cell + swap r> %load-param-reg ;
57 M: x86.64 %prepare-unbox ( -- )
58 ! First parameter is top of stack
62 M: x86.64 %unbox ( n reg-class func -- )
65 ! Store the return value on the C stack
66 over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
68 M: x86.64 %unbox-long-long ( n func -- )
69 int-regs swap %unbox ;
71 M: x86.64 %unbox-struct-1 ( -- )
72 #! Alien must be in RDI.
73 "alien_offset" f %alien-invoke
77 M: x86.64 %unbox-struct-2 ( -- )
78 #! Alien must be in RDI.
79 "alien_offset" f %alien-invoke
85 M: x86.64 %unbox-large-struct ( n size -- )
87 ! Load destination address
91 ! Copy the struct to the C stack
92 "to_value_struct" f %alien-invoke ;
94 : load-return-value ( reg-class -- )
95 0 over param-reg swap return-reg
96 2dup eq? [ 2drop ] [ MOV ] if ;
98 M: x86.64 %box ( n reg-class func -- )
100 rot [ 0 swap param-reg ] keep %load-param-reg
102 swap load-return-value
106 M: x86.64 %box-long-long ( n func -- )
109 M: x86.64 struct-small-enough? ( size -- ? ) 2 cells <= ;
111 M: x86.64 %box-small-struct ( size -- )
112 #! Box a <= 16-byte struct returned in RAX:RDX.
116 "box_small_struct" f %alien-invoke ;
118 M: x86.64 %box-large-struct ( n size -- )
119 ! Struct size is parameter 2
121 ! Compute destination address
122 swap struct-return@ RDI RSP rot [+] LEA
123 ! Copy the struct from the C stack
124 "box_value_struct" f %alien-invoke ;
126 M: x86.64 %prepare-box-struct ( size -- )
127 ! Compute target address for value struct return
128 RAX RSP rot f struct-return@ [+] LEA
131 M: x86.64 %prepare-var-args RAX RAX XOR ;
133 M: x86.64 %alien-global
134 [ 0 MOV rc-absolute-cell rel-dlsym ] [ dup [] MOV ] bi ;
136 M: x86.64 %alien-invoke
137 0 address-operand >r rc-absolute-cell rel-dlsym r> CALL ;
139 M: x86.64 %prepare-alien-indirect ( -- )
140 "unbox_alien" f %alien-invoke
143 M: x86.64 %alien-indirect ( -- )
146 M: x86.64 %alien-callback ( quot -- )
147 RDI load-indirect "c_to_factor" f %alien-invoke ;
149 M: x86.64 %callback-value ( ctype -- )
150 ! Save top of data stack
152 ! Put former top of data stack in RDI
154 ! Restore data/call/retain stacks
155 "unnest_stacks" f %alien-invoke
156 ! Put former top of data stack in RDI
158 ! Unbox former top of data stack to return registers
161 M: x86.64 %cleanup ( alien-node -- ) drop ;
163 M: x86.64 %unwind ( n -- ) drop %epilogue-later 0 RET ;
165 USE: cpu.x86.intrinsics
167 ! On 64-bit systems, the result of reading 4 bytes from memory
169 \ alien-unsigned-4 small-reg-32 define-unsigned-getter
170 \ set-alien-unsigned-4 small-reg-32 define-setter
172 \ alien-signed-4 small-reg-32 define-signed-getter
173 \ set-alien-signed-4 small-reg-32 define-setter
175 ! The ABI for passing structs by value is pretty messed up
176 << "void*" c-type clone "__stack_value" define-primitive-type
177 stack-params "__stack_value" c-type set-c-type-reg-class >>
179 : struct-types&offset ( struct-type -- pairs )
181 [ class>> ] [ offset>> ] bi 2array
184 : split-struct ( pairs -- seq )
186 [ 8 mod zero? [ t , ] when , ] assoc-each
187 ] { } make { t } split harvest ;
189 : flatten-large-struct ( type -- )
191 cell /i "__stack_value" c-type <repetition> % ;
193 M: struct-type flatten-value-type ( type -- seq )
197 struct-types&offset split-struct [
198 [ c-type c-type-reg-class ] map
199 int-regs swap member?
200 "void*" "double" ? c-type ,