1 ! Copyright (C) 2005, 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel math namespaces make sequences system
4 layouts alien alien.c-types alien.accessors alien.structs slots
5 splitting assocs combinators locals compiler.constants
6 compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
7 compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
8 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
11 M: x86.64 machine-registers
13 { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 } }
15 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
16 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
20 M: x86.64 ds-reg R14 ;
21 M: x86.64 rs-reg R15 ;
22 M: x86.64 stack-reg RSP ;
24 M:: x86.64 %dispatch ( src temp -- )
25 building get length :> start
26 ! Load jump table base.
27 temp HEX: ffffffff MOV
28 0 rc-absolute-cell rel-here
32 building get length :> end
33 ! Fix up the displacement above
35 [ end start - 2 - + building get dup pop* push ]
39 M: x86.64 param-reg-1 int-regs param-regs first ;
40 M: x86.64 param-reg-2 int-regs param-regs second ;
41 : param-reg-3 ( -- reg ) int-regs param-regs third ; inline
43 M: x86.64 pic-tail-reg RBX ;
45 M: int-regs return-reg drop RAX ;
46 M: float-regs return-reg drop XMM0 ;
48 M: x86.64 %prologue ( n -- )
49 temp-reg 0 MOV rc-absolute-cell rel-this
52 stack-reg swap 3 cells - SUB ;
54 M: stack-params copy-register*
57 { [ dup integer? ] [ R11 swap next-stack@ MOV R11 MOV ] }
58 { [ over integer? ] [ R11 swap MOV param@ R11 MOV ] }
61 M: x86 %save-param-reg [ param@ ] 2dip copy-register ;
63 M: x86 %load-param-reg [ swap param@ ] dip copy-register ;
65 : with-return-regs ( quot -- )
67 V{ RDX RAX } clone int-regs set
68 V{ XMM1 XMM0 } clone float-regs set
72 M: x86.64 %prepare-unbox ( -- )
73 ! First parameter is top of stack
74 param-reg-1 R14 [] MOV
77 M:: x86.64 %unbox ( n rep func -- )
80 ! Store the return value on the C stack if this is an
81 ! alien-invoke, otherwise leave it the return register if
82 ! this is the end of alien-callback
83 n [ n rep reg-class-of return-reg rep %save-param-reg ] when ;
85 M: x86.64 %unbox-long-long ( n func -- )
86 [ int-rep ] dip %unbox ;
88 : %unbox-struct-field ( c-type i -- )
89 ! Alien must be in param-reg-1.
90 R11 swap cells [+] swap rep>> reg-class-of {
91 { int-regs [ int-regs get pop swap MOV ] }
92 { float-regs [ float-regs get pop swap MOVSD ] }
95 M: x86.64 %unbox-small-struct ( c-type -- )
96 ! Alien must be in param-reg-1.
97 "alien_offset" f %alien-invoke
98 ! Move alien_offset() return value to R11 so that we don't
102 flatten-value-type [ %unbox-struct-field ] each-index
105 M: x86.64 %unbox-large-struct ( n c-type -- )
106 ! Source is in param-reg-1
108 ! Load destination address
109 param-reg-2 rot param@ LEA
110 ! Load structure size
112 ! Copy the struct to the C stack
113 "to_value_struct" f %alien-invoke ;
115 : load-return-value ( rep -- )
116 [ [ 0 ] dip reg-class-of param-reg ]
117 [ reg-class-of return-reg ]
121 M:: x86.64 %box ( n rep func -- )
124 0 rep reg-class-of param-reg
127 rep load-return-value
129 func f %alien-invoke ;
131 M: x86.64 %box-long-long ( n func -- )
132 [ int-rep ] dip %box ;
134 : box-struct-field@ ( i -- operand ) 1 + cells param@ ;
136 : %box-struct-field ( c-type i -- )
137 box-struct-field@ swap c-type-rep reg-class-of {
138 { int-regs [ int-regs get pop MOV ] }
139 { float-regs [ float-regs get pop MOVSD ] }
142 M: x86.64 %box-small-struct ( c-type -- )
143 #! Box a <= 16-byte struct.
145 [ flatten-value-type [ %box-struct-field ] each-index ]
146 [ param-reg-3 swap heap-size MOV ] bi
147 param-reg-1 0 box-struct-field@ MOV
148 param-reg-2 1 box-struct-field@ MOV
149 "box_small_struct" f %alien-invoke
152 : struct-return@ ( n -- operand )
153 [ stack-frame get params>> ] unless* param@ ;
155 M: x86.64 %box-large-struct ( n c-type -- )
156 ! Struct size is parameter 2
157 param-reg-2 swap heap-size MOV
158 ! Compute destination address
159 param-reg-1 swap struct-return@ LEA
160 ! Copy the struct from the C stack
161 "box_value_struct" f %alien-invoke ;
163 M: x86.64 %prepare-box-struct ( -- )
164 ! Compute target address for value struct return
165 RAX f struct-return@ LEA
166 ! Store it as the first parameter
169 M: x86.64 %prepare-var-args RAX RAX XOR ;
171 M: x86.64 %alien-invoke
173 rc-absolute-cell rel-dlsym
176 M: x86.64 %prepare-alien-indirect ( -- )
177 "unbox_alien" f %alien-invoke
180 M: x86.64 %alien-indirect ( -- )
183 M: x86.64 %alien-callback ( quot -- )
184 param-reg-1 swap %load-reference
185 "c_to_factor" f %alien-invoke ;
187 M: x86.64 %callback-value ( ctype -- )
188 ! Save top of data stack
190 ! Save top of data stack
193 ! Restore data/call/retain stacks
194 "unnest_stacks" f %alien-invoke
195 ! Put former top of data stack in param-reg-1
198 ! Unbox former top of data stack to return registers
201 ! The result of reading 4 bytes from memory is a fixnum on
203 enable-alien-4-intrinsics
205 ! SSE2 is always available on x86-64.
206 enable-float-intrinsics
211 { [ os unix? ] [ "cpu.x86.64.unix" require ] }
212 { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }