1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types arrays cpu.x86.assembler
4 cpu.x86.assembler.private cpu.architecture kernel kernel.private
5 math memory namespaces sequences words compiler.generator
6 compiler.generator.registers compiler.generator.fixup system
7 layouts combinators compiler.constants math.order ;
8 IN: cpu.x86.architecture
10 HOOK: ds-reg cpu ( -- reg )
11 HOOK: rs-reg cpu ( -- reg )
12 HOOK: stack-reg cpu ( -- reg )
13 HOOK: stack-save-reg cpu ( -- reg )
15 : stack@ ( n -- op ) stack-reg swap [+] ;
17 : reg-stack ( n reg -- op ) swap cells neg [+] ;
19 M: ds-loc v>operand n>> ds-reg reg-stack ;
20 M: rs-loc v>operand n>> rs-reg reg-stack ;
22 M: int-regs %save-param-reg drop >r stack@ r> MOV ;
23 M: int-regs %load-param-reg drop swap stack@ MOV ;
25 GENERIC: MOVSS/D ( dst src reg-class -- )
27 M: single-float-regs MOVSS/D drop MOVSS ;
29 M: double-float-regs MOVSS/D drop MOVSD ;
31 M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ;
32 M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ;
34 GENERIC: push-return-reg ( reg-class -- )
35 GENERIC: load-return-reg ( stack@ reg-class -- )
36 GENERIC: store-return-reg ( stack@ reg-class -- )
38 ! Only used by inline allocation
39 HOOK: temp-reg-1 cpu ( -- reg )
40 HOOK: temp-reg-2 cpu ( -- reg )
42 HOOK: address-operand cpu ( address -- operand )
44 HOOK: fixnum>slot@ cpu ( op -- )
46 HOOK: prepare-division cpu ( -- )
48 M: immediate load-literal v>operand swap v>operand MOV ;
50 M: x86 stack-frame ( n -- i )
51 3 cells + 16 align cell - ;
53 M: x86 %save-word-xt ( -- )
54 temp-reg v>operand 0 MOV rc-absolute-cell rel-this ;
56 : factor-area-size ( -- n ) 4 cells ;
58 M: x86 %prologue ( n -- )
60 temp-reg v>operand PUSH
61 stack-reg swap 2 cells - SUB ;
63 M: x86 %epilogue ( n -- )
66 HOOK: %alien-global cpu ( symbol dll register -- )
68 M: x86 %prepare-alien-invoke
69 #! Save Factor stack pointers in case the C code calls a
70 #! callback which does a GC, which must reliably trace
72 "stack_chain" f temp-reg v>operand %alien-global
73 temp-reg v>operand [] stack-reg MOV
74 temp-reg v>operand [] cell SUB
75 temp-reg v>operand 2 cells [+] ds-reg MOV
76 temp-reg v>operand 3 cells [+] rs-reg MOV ;
78 M: x86 %call ( label -- ) CALL ;
80 M: x86 %jump-label ( label -- ) JMP ;
82 M: x86 %jump-f ( label -- )
83 "flag" operand f v>operand CMP JE ;
85 : code-alignment ( -- n )
86 building get length dup cell align swap - ;
91 M: x86 %dispatch ( -- )
94 ! Load jump table base. We use a temporary register
95 ! since on AMD64 we have to load a 64-bit immediate. On
96 ! x86, this is redundant.
97 ! Untag and multiply to get a jump table offset
98 "n" operand fixnum>slot@
100 "offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
101 "n" operand "offset" operand ADD
102 "n" operand HEX: 7f [+] JMP
103 ! Fix up the displacement above
104 code-alignment dup bootstrap-cell 8 = 15 9 ? +
105 building get dup pop* push
108 { +input+ { { f "n" } } }
109 { +scratch+ { { f "offset" } } }
110 { +clobber+ { "n" } }
113 M: x86 %dispatch-label ( word -- )
114 0 cell, rc-absolute-cell rel-word ;
116 M: x86 %unbox-float ( dst src -- )
117 [ v>operand ] bi@ float-offset [+] MOVSD ;
119 M: x86 %peek [ v>operand ] bi@ MOV ;
121 M: x86 %replace swap %peek ;
123 : (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
125 M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
127 M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
129 M: x86 fp-shadows-int? ( -- ? ) f ;
131 M: x86 value-structs? t ;
133 M: x86 small-enough? ( n -- ? )
134 HEX: -80000000 HEX: 7fffffff between? ;
136 : %untag ( reg -- ) tag-mask get bitnot AND ;
138 : %untag-fixnum ( reg -- ) tag-bits get SAR ;
140 : %tag-fixnum ( reg -- ) tag-bits get SHL ;
142 : temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
144 : struct-return@ ( size n -- n )
146 stack-frame* cell + +
148 \ stack-frame get swap -
151 HOOK: %unbox-struct-1 cpu ( -- )
153 HOOK: %unbox-struct-2 cpu ( -- )
155 M: x86 %unbox-small-struct ( size -- )
156 #! Alien must be in EAX.
158 { 1 [ %unbox-struct-1 ] }
159 { 2 [ %unbox-struct-2 ] }
162 M: x86 struct-small-enough? ( size -- ? )
164 os { linux netbsd solaris } member? not and ;
166 M: x86 %return ( -- ) 0 %unwind ;
169 M: x86 %unbox-byte-array ( dst src -- )
170 [ v>operand ] bi@ byte-array-offset [+] LEA ;
172 M: x86 %unbox-alien ( dst src -- )
173 [ v>operand ] bi@ alien-offset [+] MOV ;
175 M: x86 %unbox-f ( dst src -- )
176 drop v>operand 0 MOV ;
178 M: x86 %unbox-any-c-ptr ( dst src -- )
179 { "is-byte-array" "end" "start" } [ define-label ] each
180 ! Address is computed in ds-reg
183 ! Object is stored in ds-reg
185 rs-reg swap v>operand MOV
186 ! We come back here with displaced aliens
187 "start" resolve-label
189 rs-reg f v>operand CMP
191 ! Is the object an alien?
192 rs-reg header-offset [+] alien type-number tag-fixnum CMP
193 "is-byte-array" get JNE
194 ! If so, load the offset and add it to the address
195 ds-reg rs-reg alien-offset [+] ADD
196 ! Now recurse on the underlying alien
197 rs-reg rs-reg underlying-alien-offset [+] MOV
199 "is-byte-array" resolve-label
200 ! Add byte array address to address being computed
202 ! Add an offset to start of byte array's data
203 ds-reg byte-array-offset ADD
205 ! Done, store address in destination register