1 ! Copyright (C) 2005, 2006 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien arrays assembler generic kernel kernel-internals
4 math memory namespaces sequences words ;
7 : code-format 1 ; inline
9 ! x86 register assignments
10 ! EAX, ECX, EDX integer vregs
11 ! XMM0 - XMM7 float vregs
15 ! AMD64 redefines a lot of words in this file
19 : allot-tmp-reg EBX ; inline
20 : stack-reg ESP ; inline
21 : stack@ stack-reg swap [+] ;
23 : reg-stack ( n reg -- op ) swap cells neg [+] ;
25 M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
26 M: cs-loc v>operand cs-loc-n cs-reg reg-stack ;
28 : %alien-invoke ( symbol dll -- ) (CALL) rel-dlsym ;
30 : alien-temp ( quot -- )
31 0 [] swap call "alien_temp" f rel-absolute rel-dlsym ;
34 : %prepare-alien-indirect ( -- )
35 "unbox_alien" f %alien-invoke
36 [ T{ int-regs } return-reg MOV ] alien-temp ;
38 : %alien-indirect ( -- )
41 GENERIC: push-return-reg ( reg-class -- )
42 GENERIC: pop-return-reg ( reg-class -- )
43 GENERIC: load-return-reg ( stack@ reg-class -- )
44 GENERIC: store-return-reg ( stack@ reg-class -- )
46 ! On x86, parameters are never passed in registers.
47 M: int-regs return-reg drop EAX ;
48 M: int-regs fastcall-regs drop { } ;
49 M: int-regs vregs drop { EAX ECX EDX } ;
50 M: int-regs %freg>stack drop >r stack@ r> MOV ;
51 M: int-regs %stack>freg drop swap stack@ MOV ;
52 M: int-regs push-return-reg return-reg PUSH ;
53 M: int-regs pop-return-reg return-reg POP ;
54 : load/store-int-return return-reg stack-reg rot [+] ;
55 M: int-regs load-return-reg load/store-int-return MOV ;
56 M: int-regs store-return-reg load/store-int-return swap MOV ;
58 : MOVSS/D float-regs-size 4 = [ MOVSS ] [ MOVSD ] if ;
60 M: float-regs fastcall-regs drop { } ;
61 M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
62 M: float-regs %freg>stack >r >r stack@ r> r> MOVSS/D ;
63 M: float-regs %stack>freg >r swap stack@ r> MOVSS/D ;
65 : FSTP 4 = [ FSTPS ] [ FSTPL ] if ;
67 M: float-regs push-return-reg
68 stack-reg swap reg-size [ SUB stack-reg [] ] keep FSTP ;
70 : FLD 4 = [ FLDS ] [ FLDL ] if ;
72 : drop-return-reg stack-reg swap reg-size ADD ;
74 M: float-regs pop-return-reg
75 stack-reg [] over reg-size FLD drop-return-reg ;
77 : load/store-float-return reg-size >r stack-reg swap [+] r> ;
78 M: float-regs load-return-reg load/store-float-return FLD ;
79 M: float-regs store-return-reg load/store-float-return FSTP ;
81 : address-operand ( address -- operand )
82 #! On x86, we can always use an address as an operand
86 : fixnum>slot@ 1 SHR ; inline
88 : prepare-division CDQ ; inline
90 M: immediate load-literal
91 v>operand swap v>operand MOV ;
93 : load-indirect ( literal reg -- )
94 0 [] MOV rel-absolute-cell rel-literal ;
96 M: object load-literal
97 v>operand load-indirect ;
107 : (%call) ( label -- label )
108 dup (compile) dup primitive? [ address-operand ] when ;
110 : %call ( label -- ) (%call) CALL ;
112 : %jump ( label -- ) %epilogue (%call) JMP ;
114 : %jump-label ( label -- ) JMP ;
116 : %jump-t ( label -- ) "flag" operand f v>operand CMP JNE ;
118 : compile-aligned ( -- )
119 compiled-offset [ 8 align ] keep - 0 <array> % ;
122 #! Compile a piece of code that jumps to an offset in a
123 #! jump table indexed by the fixnum at the top of the stack.
124 #! The jump table must immediately follow this macro.
126 ! Untag and multiply to get a jump table offset
128 "n" operand fixnum>slot@
129 ! Add to jump table base. We use a temporary register
130 ! since on AMD64 we have to load a 64-bit immediate. On
131 ! x86, this is redundant.
132 "scratch" operand HEX: ffffffff MOV
133 "end" get rel-absolute-cell rel-label
134 "n" operand "scratch" operand ADD
135 ! Jump to jump table entry
137 ! Align for better performance
139 ! Fix up jump table pointer
142 { +input+ { { f "n" } } }
143 { +scratch+ { { f "scratch" } } }
146 : %target ( label -- ) 0 cell, rel-absolute-cell rel-label ;
148 : %return ( -- ) %epilogue RET ;
150 : %move-int>int ( dst src -- )
151 [ v>operand ] 2apply MOV ;
153 : %move-int>float ( dst src -- )
154 [ v>operand ] 2apply float-offset [+] MOVSD ;
156 M: int-regs (%peek) drop %move-int>int ;
158 M: int-regs (%replace) drop swap %move-int>int ;
160 : (%inc) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
162 : %inc-d ( n -- ) ds-reg (%inc) ;
164 : %inc-r ( n -- ) cs-reg (%inc) ;
166 M: object %stack>freg 3drop ;
168 M: object %freg>stack 3drop ;