-
Notifications
You must be signed in to change notification settings - Fork 6
/
operand.lisp
211 lines (198 loc) · 7.54 KB
/
operand.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
(cl:in-package #:cluster)
(defclass operand () ())
(defclass sized-operand (operand)
((%size :initarg :size :reader size)))
(defclass register-operand (sized-operand)
((%code-number :initarg :code-number :reader code-number)))
(defclass gpr-operand (register-operand)
())
(defun make-gpr-operand (size code-number)
(make-instance 'gpr-operand
:size size
:code-number code-number))
(defclass mmx-register-operand (register-operand)
())
(defclass memory-operand (sized-operand)
(;; An integer or NIL.
(%base-register
:initform nil
:initarg :base-register
:reader base-register)
;; An integer or NIL.
(%index-register
:initform nil
:initarg :index-register
:reader index-register)
;; 1, 2, 4, 8, or NIL.
(%scale
:initform nil
:initarg :scale
:reader scale)
;; A signed integer or NIL.
(%displacement
:initform nil
:initarg :displacement
:reader displacement)))
(defun make-memory-operand
(size &key base-register index-register scale displacement)
(make-instance 'memory-operand
:size size
:base-register base-register
:index-register index-register
:scale scale
:displacement displacement))
;;; Always include the RXB bits of a potential REX byte.
(defun encode-memory-operand (memory-operand)
(with-accessors ((base-register base-register)
(index-register index-register)
(scale scale)
(displacement displacement))
memory-operand
(cond ((and (null base-register)
(null index-register))
;; We have only a displacement.
`(#b000
#b00000101 ; ModR/M byte.
;; SIB byte to encode only displacement using RIP-relative addressing.
#b00100101
,@(encode-integer displacement 4)))
((and (null index-register)
(null displacement))
;; We have only a base register.
(multiple-value-bind (rex.b r/m)
(floor base-register 8)
(cond
((= r/m 4)
`(,rex.b
#b00000100 ; ModR/M byte.
#b00100100)) ; SIB byte.
;; It is not possible to encode BP(5) or R13 as a base register
;; using the above method, as that encoding is used
;; for RIP relative addressing.
;; We must instead encode a displacement of 0.
((= r/m 5)
`(,rex.b
#b01000101 ; ModR/M byte
,@(encode-integer 0 1)))
(t
`(,rex.b
,r/m)))))
((and (null index-register)
(typep displacement '(signed-byte 8)))
;; We have a base register and an 8-bit displacement.
(multiple-value-bind (rex.b r/m)
(floor base-register 8)
(if (= r/m 4)
`(,rex.b
#b01000100 ; ModR/M byte.
#b00100100 ; SIB byte.
,@(encode-integer displacement 1))
`(,rex.b
,(+ #b01000000 r/m)
,@(encode-integer displacement 1)))))
((and (null index-register)
(typep displacement '(signed-byte 32)))
;; We have a base register and a 32-bit displacement.
(multiple-value-bind (rex.b r/m)
(floor base-register 8)
(if (= r/m 4)
`(,rex.b
#b10000100 ; ModR/M byte.
#b00100100 ; SIB byte.
,@(encode-integer displacement 4))
`(,rex.b
#b10000100 ; ModR/M byte.
,(+ #b00100000 r/m) ; SIB, only encode base register.
,@(encode-integer displacement 4)))))
((null base-register)
;; The only encoding provided when there is no base
;; register has a 32-bit displacement, so even if the
;; displacement is small or even 0, we must use this
;; encoding.
(multiple-value-bind (rex.x i)
(floor index-register 8)
`(,(ash rex.x 1)
#b00000101 ; ModR/M byte.
,(+ (ash (round (log scale 2)) 6)
(ash i 3)
#b101)
,@(encode-integer (or displacement 0) 4))))
((null displacement)
(multiple-value-bind (rex.b b)
(floor base-register 8)
(multiple-value-bind (rex.x i)
(floor index-register 8)
(if (= b 5)
;; If the base register is 5 (EBP) or 13, then we
;; have a problem, because there is no encoding for
;; that situation without a displacement. So we
;; use a displacement of 0.
`(,(+ (ash rex.x 1) rex.b)
#b01000100 ; ModR/M byte.
,(+ (ash (round (log scale 2)) 6)
(ash i 3)
b)
0)
`(,(+ (ash rex.x 1) rex.b)
#b00000100 ; ModR/M byte.
,(+ (ash (round (log scale 2)) 6)
(ash i 3)
b))))))
(t
(multiple-value-bind (rex.b b)
(floor base-register 8)
(multiple-value-bind (rex.x i)
(floor index-register 8)
(when (= index-register 4)
(error "You can't use the stack pointer
as the index register with a scale."))
(if (typep displacement '(signed-byte 8))
`(,(+ (ash rex.x 1) rex.b)
#b01000100 ; ModR/M byte.
,(+ (ash (round (log scale 2)) 6)
(ash i 3)
b)
,@(encode-integer displacement 1))
`(,(+ (ash rex.x 1) rex.b)
#b10000100 ; ModR/M byte.
,(+ (ash (round (log scale 2)) 6)
(ash i 3)
b)
,@(encode-integer displacement 4)))))))))
(defclass immediate-operand (operand)
(;; A signed integer.
(%value :initarg :value :reader value)))
(defun make-immediate-operand (value)
(make-instance 'immediate-operand
:value value))
(defun operand-matches-p (operand descriptor)
(ecase (car descriptor)
(gpr-a
(and (typep operand 'gpr-operand)
(= (code-number operand) 0)
(= (size operand) (cadr descriptor))))
(gpr-c
(and (typep operand 'gpr-operand)
(= (code-number operand) 2)
(= (size operand) (cadr descriptor))))
(gpr
(and (typep operand 'gpr-operand)
(= (size operand) (cadr descriptor))))
(memory
(and (typep operand 'memory-operand)
(= (size operand) (cadr descriptor))))
(simm
(and (typep operand 'immediate-operand)
(typep (value operand) `(signed-byte ,(cadr descriptor)))))
(imm
(and (typep operand 'immediate-operand)
(or (typep (value operand) `(signed-byte ,(cadr descriptor)))
(typep (value operand) `(unsigned-byte ,(cadr descriptor))))))
(label
;; We don't take into account the size of the label at this
;; point, because we do not yet know what the final size of the
;; label is going to be.
(typep operand 'label))))
(defun operands-match-p (operands descriptors)
(and (= (length operands) (length descriptors))
(every #'operand-matches-p operands descriptors)))