1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel math namespaces make sequences
4 system layouts alien alien.c-types alien.accessors alien.structs
5 slots splitting assocs combinators make locals cpu.x86.assembler
6 cpu.x86 cpu.architecture compiler.constants
7 compiler.codegen compiler.codegen.fixup
8 compiler.cfg.instructions compiler.cfg.builder
9 compiler.cfg.intrinsics ;
12 M: x86.64 machine-registers
14 { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
16 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
17 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
21 M: x86.64 ds-reg R14 ;
22 M: x86.64 rs-reg R15 ;
23 M: x86.64 stack-reg RSP ;
25 M:: x86.64 %dispatch ( src temp offset -- )
26 ! Load jump table base.
27 temp HEX: ffffffff MOV
28 offset cells rc-absolute-cell rel-here
32 ! Fix up the displacement above
34 [ 15 + building get dup pop* push ]
38 M: x86.64 param-reg-1 int-regs param-regs first ;
39 M: x86.64 param-reg-2 int-regs param-regs second ;
40 : param-reg-3 ( -- reg ) int-regs param-regs third ; inline
42 M: int-regs return-reg drop RAX ;
43 M: float-regs return-reg drop XMM0 ;
45 M: x86.64 %prologue ( n -- )
46 temp-reg-1 0 MOV rc-absolute-cell rel-this
49 stack-reg swap 3 cells - SUB ;
51 M: stack-params %load-param-reg
53 [ R11 swap param@ MOV ] dip
56 M: stack-params %save-param-reg
58 R11 swap next-stack@ MOV
61 : with-return-regs ( quot -- )
63 V{ RDX RAX } clone int-regs set
64 V{ XMM1 XMM0 } clone float-regs set
68 M: x86.64 %prepare-unbox ( -- )
69 ! First parameter is top of stack
70 param-reg-1 R14 [] MOV
73 M: x86.64 %unbox ( n reg-class func -- )
76 ! Store the return value on the C stack
77 over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
79 M: x86.64 %unbox-long-long ( n func -- )
80 int-regs swap %unbox ;
82 : %unbox-struct-field ( c-type i -- )
83 ! Alien must be in param-reg-1.
84 R11 swap cells [+] swap reg-class>> {
85 { int-regs [ int-regs get pop swap MOV ] }
86 { double-float-regs [ float-regs get pop swap MOVSD ] }
89 M: x86.64 %unbox-small-struct ( c-type -- )
90 ! Alien must be in param-reg-1.
91 "alien_offset" f %alien-invoke
92 ! Move alien_offset() return value to R11 so that we don't
96 flatten-value-type [ %unbox-struct-field ] each-index
99 M: x86.64 %unbox-large-struct ( n c-type -- )
100 ! Source is in param-reg-1
102 ! Load destination address
103 param-reg-2 rot param@ LEA
104 ! Load structure size
106 ! Copy the struct to the C stack
107 "to_value_struct" f %alien-invoke ;
109 : load-return-value ( reg-class -- )
110 0 over param-reg swap return-reg
111 2dup eq? [ 2drop ] [ MOV ] if ;
113 M: x86.64 %box ( n reg-class func -- )
115 rot [ 0 swap param-reg ] keep %load-param-reg
117 swap load-return-value
121 M: x86.64 %box-long-long ( n func -- )
124 : box-struct-field@ ( i -- operand ) 1+ cells param@ ;
126 : %box-struct-field ( c-type i -- )
127 box-struct-field@ swap reg-class>> {
128 { int-regs [ int-regs get pop MOV ] }
129 { double-float-regs [ float-regs get pop MOVSD ] }
132 M: x86.64 %box-small-struct ( c-type -- )
133 #! Box a <= 16-byte struct.
135 [ flatten-value-type [ %box-struct-field ] each-index ]
136 [ param-reg-3 swap heap-size MOV ] bi
137 param-reg-1 0 box-struct-field@ MOV
138 param-reg-2 1 box-struct-field@ MOV
139 "box_small_struct" f %alien-invoke
142 : struct-return@ ( n -- operand )
143 [ stack-frame get params>> ] unless* param@ ;
145 M: x86.64 %box-large-struct ( n c-type -- )
146 ! Struct size is parameter 2
147 param-reg-2 swap heap-size MOV
148 ! Compute destination address
149 param-reg-1 swap struct-return@ LEA
150 ! Copy the struct from the C stack
151 "box_value_struct" f %alien-invoke ;
153 M: x86.64 %prepare-box-struct ( -- )
154 ! Compute target address for value struct return
155 RAX f struct-return@ LEA
156 ! Store it as the first parameter
159 M: x86.64 %prepare-var-args RAX RAX XOR ;
161 M: x86.64 %alien-invoke
163 rc-absolute-cell rel-dlsym
166 M: x86.64 %alien-invoke-tail
168 rc-absolute-cell rel-dlsym
171 M: x86.64 %prepare-alien-indirect ( -- )
172 "unbox_alien" f %alien-invoke
175 M: x86.64 %alien-indirect ( -- )
178 M: x86.64 %alien-callback ( quot -- )
179 param-reg-1 swap %load-indirect
180 "c_to_factor" f %alien-invoke ;
182 M: x86.64 %callback-value ( ctype -- )
183 ! Save top of data stack
185 ! Save top of data stack
188 ! Restore data/call/retain stacks
189 "unnest_stacks" f %alien-invoke
190 ! Put former top of data stack in param-reg-1
193 ! Unbox former top of data stack to return registers
196 ! The result of reading 4 bytes from memory is a fixnum on
198 enable-alien-4-intrinsics
200 ! SSE2 is always available on x86-64.
201 enable-float-intrinsics
206 { [ os unix? ] [ "cpu.x86.64.unix" require ] }
207 { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }