1 ! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel words math accessors sequences namespaces
4 assocs layouts cpu.x86.assembler.syntax ;
5 IN: cpu.x86.assembler.operands
7 REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ;
9 HI-REGISTERS: 8 AH CH DH BH ;
11 REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ;
13 REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ;
15 REGISTERS: 64 RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ;
18 XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7
19 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ;
21 REGISTERS: 80 ST0 ST1 ST2 ST3 ST4 ST5 ST6 ST7 ;
23 : shuffle-down ( STn -- STn+1 )
24 "register" word-prop 1 + 80 registers get at nth ;
26 PREDICATE: register < word
27 "register" word-prop ;
31 PREDICATE: register-8 < register
32 "register-size" word-prop 8 = ;
34 PREDICATE: register-16 < register
35 "register-size" word-prop 16 = ;
37 PREDICATE: register-32 < register
38 "register-size" word-prop 32 = ;
40 PREDICATE: register-64 < register
41 "register-size" word-prop 64 = ;
43 PREDICATE: register-128 < register
44 "register-size" word-prop 128 = ;
46 GENERIC: extended? ( op -- ? )
48 M: object extended? drop f ;
50 M: register extended? "register" word-prop 7 > ;
53 TUPLE: indirect base index scale displacement ;
55 M: indirect extended? base>> extended? ;
57 : canonicalize-displacement ( indirect -- indirect )
58 dup [ base>> ] [ displacement>> 0 = ] bi and
59 [ f >>displacement ] when ;
61 : canonicalize-EBP ( indirect -- indirect )
62 #! { EBP } ==> { EBP 0 }
63 dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and
64 [ 0 >>displacement ] when ;
66 ERROR: bad-index indirect ;
68 : check-ESP ( indirect -- indirect )
69 dup index>> { ESP RSP } member-eq? [ throw-bad-index ] when ;
71 : canonicalize ( indirect -- indirect )
72 #! Modify the indirect to work around certain addressing mode
74 canonicalize-displacement canonicalize-EBP check-ESP ;
77 UNION: operand register indirect ;
79 GENERIC: operand-64? ( operand -- ? )
81 M: indirect operand-64?
82 [ base>> ] [ index>> ] bi [ operand-64? ] either? ;
84 M: register-64 operand-64? drop t ;
86 M: object operand-64? drop f ;
90 : <indirect> ( base index scale displacement -- indirect )
91 indirect boa canonicalize ;
93 : [] ( base/displacement -- indirect )
95 [ [ f f bootstrap-cell 8 = 0 f ? ] dip <indirect> ]
99 : [RIP+] ( displacement -- indirect )
100 [ f f f ] dip <indirect> ;
102 : [+] ( base index/displacement -- indirect )
108 : [++] ( base index displacement -- indirect )
109 [ f ] dip <indirect> ;
111 : [+*2+] ( base index displacement -- indirect )
112 [ 1 ] dip <indirect> ;
114 : [+*4+] ( base index displacement -- indirect )
115 [ 2 ] dip <indirect> ;
117 : [+*8+] ( base index displacement -- indirect )
118 [ 3 ] dip <indirect> ;
124 : extended-8-bit-register? ( register -- ? )
125 { SPL BPL SIL DIL } member-eq? ;
127 : n-bit-version-of ( register n -- register' )
128 ! Certain 8-bit registers don't exist in 32-bit mode...
129 [ "register" word-prop ] dip registers get at nth
130 dup extended-8-bit-register? cell 4 = and
133 : 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ;
134 : 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ;
135 : 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ;
136 : 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ;
137 : native-version-of ( register -- register' ) cell-bits n-bit-version-of ;