1 ! Copyright (C) 2005, 2010 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.libraries
5 slots splitting assocs combinators fry locals compiler.constants
6 classes.struct compiler.codegen compiler.codegen.fixup
7 compiler.cfg.instructions compiler.cfg.builder
8 compiler.cfg.intrinsics compiler.cfg.stack-frame
9 cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
11 FROM: layouts => cell cells ;
14 : param-reg ( n -- reg ) int-regs cdecl param-regs at nth ;
16 : param-reg-0 ( -- reg ) 0 param-reg ; inline
17 : param-reg-1 ( -- reg ) 1 param-reg ; inline
18 : param-reg-2 ( -- reg ) 2 param-reg ; inline
19 : param-reg-3 ( -- reg ) 3 param-reg ; inline
21 M: x86.64 pic-tail-reg RBX ;
25 { int-regs { RAX EDX } }
26 { float-regs { XMM0 XMM1 } }
29 M: x86.64 ds-reg R14 ;
30 M: x86.64 rs-reg R15 ;
31 M: x86.64 stack-reg RSP ;
32 M: x86.64 frame-reg RBP ;
34 M: x86.64 machine-registers
36 { int-regs { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 } }
38 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
39 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15
43 : vm-reg ( -- reg ) R13 ; inline
44 : nv-reg ( -- reg ) RBX ; inline
46 M: x86.64 %mov-vm-ptr ( reg -- )
49 M: x86.64 %vm-field ( dst offset -- )
50 [ vm-reg ] dip [+] MOV ;
52 M:: x86.64 %load-vector ( dst val rep -- )
53 dst 0 [RIP+] rep copy-memory* val rc-relative rel-binary-literal ;
55 M: x86.64 %set-vm-field ( src offset -- )
56 [ vm-reg ] dip [+] swap MOV ;
58 M: x86.64 %vm-field-ptr ( dst offset -- )
59 [ vm-reg ] dip [+] LEA ;
61 M: x86.64 %prologue ( n -- )
65 stack-reg swap 3 cells - SUB ;
67 M: x86.64 %prepare-jump
68 pic-tail-reg xt-tail-pic-offset [RIP+] LEA ;
70 : load-cards-offset ( dst -- )
71 0 MOV rc-absolute-cell rel-cards-offset ;
75 [+] card-mark <byte> MOV ;
77 : load-decks-offset ( dst -- )
78 0 MOV rc-absolute-cell rel-decks-offset ;
82 [+] card-mark <byte> MOV ;
84 M:: x86.64 %dispatch ( src temp -- )
85 ! Load jump table base.
86 temp HEX: ffffffff MOV
87 building get length :> start
88 0 rc-absolute-cell rel-here
92 building get length :> end
93 ! Fix up the displacement above
95 [ end start - + building get dup pop* push ]
99 M:: x86.64 %load-reg-param ( dst reg rep -- )
102 M:: x86.64 %store-reg-param ( src reg rep -- )
105 M:: x86.64 %unbox ( dst src func rep -- )
106 param-reg-0 src tagged-rep %copy
107 param-reg-1 %mov-vm-ptr
109 dst rep %load-return ;
111 M:: x86.64 %box ( dst src func rep -- )
112 0 rep reg-class-of cdecl param-regs at nth src rep %copy
113 rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr
115 dst int-rep %load-return ;
117 M:: x86.64 %allot-byte-array ( dst size -- )
119 param-reg-1 %mov-vm-ptr
120 "allot_byte_array" f %alien-invoke
121 dst int-rep %load-return ;
123 M: x86.64 %alien-invoke
125 rc-absolute-cell rel-dlsym
128 M: x86.64 %begin-callback ( -- )
129 param-reg-0 %mov-vm-ptr
131 "begin_callback" f %alien-invoke ;
133 M: x86.64 %alien-callback ( quot -- )
134 [ param-reg-0 ] dip %load-reference
135 param-reg-0 quot-entry-point-offset [+] CALL ;
137 M: x86.64 %end-callback ( -- )
138 param-reg-0 %mov-vm-ptr
139 "end_callback" f %alien-invoke ;
141 : float-function-param ( i src -- )
142 [ float-regs cdecl param-regs at nth ] dip double-rep %copy ;
144 M:: x86.64 %unary-float-function ( dst src func -- )
145 0 src float-function-param
146 func "libm" load-library %alien-invoke
147 dst double-rep %load-return ;
149 M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
150 ! src1 might equal dst; otherwise it will be a spill slot
151 ! src2 is always a spill slot
152 0 src1 float-function-param
153 1 src2 float-function-param
154 func "libm" load-library %alien-invoke
155 dst double-rep %load-return ;
157 M: x86.64 long-long-on-stack? f ;
159 M: x86.64 float-on-stack? f ;
161 M: x86.64 struct-return-on-stack? f ;
163 ! The result of reading 4 bytes from memory is a fixnum on
165 enable-alien-4-intrinsics
170 { [ os unix? ] [ "cpu.x86.64.unix" require ] }
171 { [ os winnt? ] [ "cpu.x86.64.winnt" require ] }