|
|
1
|
+;;; -*- Package: ARM64 -*-
|
|
|
2
|
+;;;
|
|
|
3
|
+;;; **********************************************************************
|
|
|
4
|
+;;; This code was written as part of the CMU Common Lisp project at
|
|
|
5
|
+;;; Carnegie Mellon University, and has been placed in the public domain.
|
|
|
6
|
+;;;
|
|
|
7
|
+(ext:file-comment
|
|
|
8
|
+ "$Header: src/compiler/arm64/cell.lisp $")
|
|
|
9
|
+;;;
|
|
|
10
|
+;;; **********************************************************************
|
|
|
11
|
+;;;
|
|
|
12
|
+;;; This file contains the VM definition of various primitive memory access
|
|
|
13
|
+;;; VOPs for ARM64.
|
|
|
14
|
+;;;
|
|
|
15
|
+;;; Originally written for SPARC by Rob MacLachlan, converted by William Lott.
|
|
|
16
|
+;;; Ported to ARM64.
|
|
|
17
|
+;;;
|
|
|
18
|
+
|
|
|
19
|
+(in-package "ARM64")
|
|
|
20
|
+(intl:textdomain "cmucl-arm64-vm")
|
|
|
21
|
+
|
|
|
22
|
+
|
|
|
23
|
+;;;; Data object ref/set stuff.
|
|
|
24
|
+
|
|
|
25
|
+(define-vop (slot)
|
|
|
26
|
+ (:args (object :scs (descriptor-reg)))
|
|
|
27
|
+ (:info name offset lowtag)
|
|
|
28
|
+ (:ignore name)
|
|
|
29
|
+ (:results (result :scs (descriptor-reg any-reg)))
|
|
|
30
|
+ (:generator 1
|
|
|
31
|
+ (emit-not-implemented)
|
|
|
32
|
+ (loadw result object offset lowtag)))
|
|
|
33
|
+
|
|
|
34
|
+(define-vop (set-slot)
|
|
|
35
|
+ (:args (object :scs (descriptor-reg))
|
|
|
36
|
+ (value :scs (descriptor-reg any-reg)))
|
|
|
37
|
+ (:info name offset lowtag)
|
|
|
38
|
+ (:ignore name)
|
|
|
39
|
+ (:results)
|
|
|
40
|
+ (:generator 1
|
|
|
41
|
+ (emit-not-implemented)
|
|
|
42
|
+ (storew value object offset lowtag)))
|
|
|
43
|
+
|
|
|
44
|
+
|
|
|
45
|
+
|
|
|
46
|
+;;;; Symbol hacking VOPs:
|
|
|
47
|
+
|
|
|
48
|
+;;; The compiler likes to be able to directly SET symbols.
|
|
|
49
|
+;;;
|
|
|
50
|
+(define-vop (set cell-set)
|
|
|
51
|
+ (:variant symbol-value-slot other-pointer-type))
|
|
|
52
|
+
|
|
|
53
|
+;;; Do a cell ref with an error check for being unbound.
|
|
|
54
|
+;;;
|
|
|
55
|
+(define-vop (checked-cell-ref)
|
|
|
56
|
+ (:args (object :scs (descriptor-reg) :target obj-temp))
|
|
|
57
|
+ (:results (value :scs (descriptor-reg any-reg)))
|
|
|
58
|
+ (:policy :fast-safe)
|
|
|
59
|
+ (:vop-var vop)
|
|
|
60
|
+ (:save-p :compute-only)
|
|
|
61
|
+ (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp))
|
|
|
62
|
+
|
|
|
63
|
+;;; With Symbol-Value, we check that the value isn't the trap object. So
|
|
|
64
|
+;;; Symbol-Value of NIL is NIL.
|
|
|
65
|
+;;;
|
|
|
66
|
+(define-vop (symbol-value checked-cell-ref)
|
|
|
67
|
+ (:translate symbol-value)
|
|
|
68
|
+ (:generator 9
|
|
|
69
|
+ (emit-not-implemented)
|
|
|
70
|
+ (move obj-temp object)
|
|
|
71
|
+ (loadw value obj-temp vm:symbol-value-slot vm:other-pointer-type)
|
|
|
72
|
+ (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp)))
|
|
|
73
|
+ ;; inst cmp: alias for SUBS with Rd=XZR.
|
|
|
74
|
+ ;; Defined in checkpoint as (define-instruction-macro cmp (rn src) `(inst subs null-tn ,rn ,src))
|
|
|
75
|
+ (inst cmp value vm:unbound-marker-type)
|
|
|
76
|
+ ;; inst b :eq label: conditional branch B.cond.
|
|
|
77
|
+ ;; Defined in checkpoint as (define-instruction b (segment cond-or-target &optional target))
|
|
|
78
|
+ (inst b :eq err-lab))))
|
|
|
79
|
+
|
|
|
80
|
+;;; Like CHECKED-CELL-REF, only we are a predicate to see if the cell is bound.
|
|
|
81
|
+(define-vop (boundp-frob)
|
|
|
82
|
+ (:args (object :scs (descriptor-reg)))
|
|
|
83
|
+ (:conditional)
|
|
|
84
|
+ (:info target not-p)
|
|
|
85
|
+ (:policy :fast-safe)
|
|
|
86
|
+ (:temporary (:scs (descriptor-reg)) value))
|
|
|
87
|
+
|
|
|
88
|
+(define-vop (boundp boundp-frob)
|
|
|
89
|
+ (:translate boundp)
|
|
|
90
|
+ (:generator 9
|
|
|
91
|
+ (emit-not-implemented)
|
|
|
92
|
+ (loadw value object vm:symbol-value-slot vm:other-pointer-type)
|
|
|
93
|
+ ;; inst cmp: SUBS XZR, value, unbound-marker-type
|
|
|
94
|
+ (inst cmp value vm:unbound-marker-type)
|
|
|
95
|
+ ;; inst b :eq/:ne target: B.cond conditional branch
|
|
|
96
|
+ (inst b (if not-p :eq :ne) target)))
|
|
|
97
|
+
|
|
|
98
|
+(define-vop (fast-symbol-value cell-ref)
|
|
|
99
|
+ (:variant vm:symbol-value-slot vm:other-pointer-type)
|
|
|
100
|
+ (:policy :fast)
|
|
|
101
|
+ (:translate symbol-value))
|
|
|
102
|
+
|
|
|
103
|
+(define-vop (symbol-hash)
|
|
|
104
|
+ (:policy :fast-safe)
|
|
|
105
|
+ (:translate symbol-hash)
|
|
|
106
|
+ (:args (symbol :scs (descriptor-reg null)))
|
|
|
107
|
+ (:results (res :scs (any-reg)))
|
|
|
108
|
+ (:result-types tagged-num)
|
|
|
109
|
+ (:generator 2
|
|
|
110
|
+ (emit-not-implemented)
|
|
|
111
|
+ ;; The symbol-hash slot of NIL holds NIL because it is also the cdr
|
|
|
112
|
+ ;; slot, so we strip the two low tag bits to ensure it is a fixnum.
|
|
|
113
|
+ (loadw res symbol symbol-hash-slot other-pointer-type)
|
|
|
114
|
+ ;; inst bic has NO immediate form (invertp=t excludes integer src types in checkpoint).
|
|
|
115
|
+ ;; Use inst and with the bitwise complement instead:
|
|
|
116
|
+ ;; AND res, res, (lognot fixnum-tag-mask) -- keeps all bits except the tag bits.
|
|
|
117
|
+ (inst and res res (lognot vm:fixnum-tag-mask))))
|
|
|
118
|
+
|
|
|
119
|
+(define-vop (%set-symbol-hash cell-set)
|
|
|
120
|
+ (:translate %set-symbol-hash)
|
|
|
121
|
+ (:variant symbol-hash-slot other-pointer-type))
|
|
|
122
|
+
|
|
|
123
|
+
|
|
|
124
|
+;;;; Fdefinition (fdefn) objects.
|
|
|
125
|
+
|
|
|
126
|
+(define-vop (fdefn-function cell-ref)
|
|
|
127
|
+ (:variant fdefn-function-slot other-pointer-type))
|
|
|
128
|
+
|
|
|
129
|
+(define-vop (safe-fdefn-function)
|
|
|
130
|
+ (:args (object :scs (descriptor-reg) :target obj-temp))
|
|
|
131
|
+ (:results (value :scs (descriptor-reg any-reg)))
|
|
|
132
|
+ (:vop-var vop)
|
|
|
133
|
+ (:save-p :compute-only)
|
|
|
134
|
+ (:temporary (:scs (descriptor-reg) :from (:argument 0)) obj-temp)
|
|
|
135
|
+ (:generator 10
|
|
|
136
|
+ (emit-not-implemented)
|
|
|
137
|
+ (move obj-temp object)
|
|
|
138
|
+ (loadw value obj-temp fdefn-function-slot other-pointer-type)
|
|
|
139
|
+ (let ((err-lab (generate-error-code vop undefined-symbol-error obj-temp)))
|
|
|
140
|
+ ;; inst cmp: SUBS XZR, value, null-tn
|
|
|
141
|
+ (inst cmp value null-tn)
|
|
|
142
|
+ ;; inst b :eq err-lab: B.EQ conditional branch
|
|
|
143
|
+ (inst b :eq err-lab))))
|
|
|
144
|
+
|
|
|
145
|
+(define-vop (set-fdefn-function)
|
|
|
146
|
+ (:policy :fast-safe)
|
|
|
147
|
+ (:translate (setf fdefn-function))
|
|
|
148
|
+ (:args (function :scs (descriptor-reg) :target result)
|
|
|
149
|
+ (fdefn :scs (descriptor-reg)))
|
|
|
150
|
+ (:temporary (:scs (descriptor-reg)) temp)
|
|
|
151
|
+ (:temporary (:scs (non-descriptor-reg)) type)
|
|
|
152
|
+ (:results (result :scs (descriptor-reg)))
|
|
|
153
|
+ (:generator 38
|
|
|
154
|
+ (emit-not-implemented)
|
|
|
155
|
+ (let ((normal-fn (gen-label)))
|
|
|
156
|
+ ;; load-type: defined in arm64-macros as (inst ldurb target source offset).
|
|
|
157
|
+ ;; Reads the low type byte of the object header word.
|
|
|
158
|
+ (load-type type function (- function-pointer-type))
|
|
|
159
|
+ ;; inst cmp: SUBS XZR, type, function-header-type
|
|
|
160
|
+ (inst cmp type function-header-type)
|
|
|
161
|
+ ;; inst mov: macro expanding to (inst orr rd null-tn src).
|
|
|
162
|
+ ;; Move function -> temp unconditionally before the branch (no delay slot on ARM64).
|
|
|
163
|
+ (inst mov temp function)
|
|
|
164
|
+ ;; inst b :eq normal-fn: skip closure-tramp load if already a plain function
|
|
|
165
|
+ (inst b :eq normal-fn)
|
|
|
166
|
+ ;; inst li: materialise an assembly-routine address into a register.
|
|
|
167
|
+ ;; Used throughout arm64-macros for loading fixup/immediate values.
|
|
|
168
|
+ (inst li temp (make-fixup 'closure-tramp :assembly-routine))
|
|
|
169
|
+ (emit-label normal-fn)
|
|
|
170
|
+ (storew function fdefn fdefn-function-slot other-pointer-type)
|
|
|
171
|
+ (storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
|
|
|
172
|
+ ;; inst mov: ORR result, XZR, function
|
|
|
173
|
+ (inst mov result function))))
|
|
|
174
|
+
|
|
|
175
|
+(define-vop (fdefn-makunbound)
|
|
|
176
|
+ (:policy :fast-safe)
|
|
|
177
|
+ (:translate fdefn-makunbound)
|
|
|
178
|
+ (:args (fdefn :scs (descriptor-reg) :target result))
|
|
|
179
|
+ (:temporary (:scs (non-descriptor-reg)) temp)
|
|
|
180
|
+ (:results (result :scs (descriptor-reg)))
|
|
|
181
|
+ (:generator 38
|
|
|
182
|
+ (emit-not-implemented)
|
|
|
183
|
+ (storew null-tn fdefn fdefn-function-slot other-pointer-type)
|
|
|
184
|
+ ;; inst li: load assembly-routine address (arm64-macros pattern)
|
|
|
185
|
+ (inst li temp (make-fixup 'undefined-tramp :assembly-routine))
|
|
|
186
|
+ (storew temp fdefn fdefn-raw-addr-slot other-pointer-type)
|
|
|
187
|
+ ;; inst mov: ORR result, XZR, fdefn
|
|
|
188
|
+ (inst mov result fdefn)))
|
|
|
189
|
+
|
|
|
190
|
+
|
|
|
191
|
+
|
|
|
192
|
+;;;; Binding and Unbinding.
|
|
|
193
|
+
|
|
|
194
|
+;;; BIND -- Establish VAL as a binding for SYMBOL. Save the old value and
|
|
|
195
|
+;;; the symbol on the binding stack and stuff the new value into the symbol.
|
|
|
196
|
+
|
|
|
197
|
+(define-vop (bind)
|
|
|
198
|
+ (:args (val :scs (any-reg descriptor-reg))
|
|
|
199
|
+ (symbol :scs (descriptor-reg)))
|
|
|
200
|
+ (:temporary (:scs (descriptor-reg)) temp)
|
|
|
201
|
+ (:generator 5
|
|
|
202
|
+ (emit-not-implemented)
|
|
|
203
|
+ (loadw temp symbol vm:symbol-value-slot vm:other-pointer-type)
|
|
|
204
|
+ ;; inst add: ADD bsp-tn, bsp-tn, #imm.
|
|
|
205
|
+ ;; Defined in checkpoint as (def add 1 0 0 nil t).
|
|
|
206
|
+ (inst add bsp-tn bsp-tn (* 2 vm:word-bytes))
|
|
|
207
|
+ (storew temp bsp-tn (- vm:binding-value-slot vm:binding-size))
|
|
|
208
|
+ (storew symbol bsp-tn (- vm:binding-symbol-slot vm:binding-size))
|
|
|
209
|
+ (storew val symbol vm:symbol-value-slot vm:other-pointer-type)))
|
|
|
210
|
+
|
|
|
211
|
+
|
|
|
212
|
+(define-vop (unbind)
|
|
|
213
|
+ (:temporary (:scs (descriptor-reg)) symbol value)
|
|
|
214
|
+ (:generator 0
|
|
|
215
|
+ (emit-not-implemented)
|
|
|
216
|
+ (loadw symbol bsp-tn (- vm:binding-symbol-slot vm:binding-size))
|
|
|
217
|
+ (loadw value bsp-tn (- vm:binding-value-slot vm:binding-size))
|
|
|
218
|
+ (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
|
|
|
219
|
+ ;; zero-tn: ARM64 XZR alias used throughout the backend
|
|
|
220
|
+ (storew zero-tn bsp-tn (- vm:binding-symbol-slot vm:binding-size))
|
|
|
221
|
+ ;; inst sub: SUB bsp-tn, bsp-tn, #imm.
|
|
|
222
|
+ ;; Defined in checkpoint as (def sub 1 1 0 neg t).
|
|
|
223
|
+ (inst sub bsp-tn bsp-tn (* 2 vm:word-bytes))))
|
|
|
224
|
+
|
|
|
225
|
+
|
|
|
226
|
+(define-vop (unbind-to-here)
|
|
|
227
|
+ (:args (arg :scs (descriptor-reg any-reg) :target where))
|
|
|
228
|
+ (:temporary (:scs (any-reg) :from (:argument 0)) where)
|
|
|
229
|
+ (:temporary (:scs (descriptor-reg)) symbol value)
|
|
|
230
|
+ (:generator 0
|
|
|
231
|
+ (emit-not-implemented)
|
|
|
232
|
+ (let ((loop (gen-label))
|
|
|
233
|
+ (skip (gen-label))
|
|
|
234
|
+ (done (gen-label)))
|
|
|
235
|
+ (move where arg)
|
|
|
236
|
+ ;; inst cmp: SUBS XZR, where, bsp-tn
|
|
|
237
|
+ (inst cmp where bsp-tn)
|
|
|
238
|
+ ;; inst b :eq done: skip loop body entirely if already at target
|
|
|
239
|
+ (inst b :eq done)
|
|
|
240
|
+
|
|
|
241
|
+ (emit-label loop)
|
|
|
242
|
+ (loadw symbol bsp-tn (- vm:binding-symbol-slot vm:binding-size))
|
|
|
243
|
+ ;; inst cbz symbol skip: Compare and Branch if Zero.
|
|
|
244
|
+ ;; Defined in checkpoint as format-compare-branch with op=0 (CBZ).
|
|
|
245
|
+ ;; Replaces the SPARC (inst cmp symbol) + (inst b :eq skip) pair.
|
|
|
246
|
+ (inst cbz symbol skip)
|
|
|
247
|
+ (loadw value bsp-tn (- vm:binding-value-slot vm:binding-size))
|
|
|
248
|
+ (storew value symbol vm:symbol-value-slot vm:other-pointer-type)
|
|
|
249
|
+ (storew zero-tn bsp-tn (- vm:binding-symbol-slot vm:binding-size))
|
|
|
250
|
+
|
|
|
251
|
+ (emit-label skip)
|
|
|
252
|
+ ;; inst sub: SUB bsp-tn, bsp-tn, #imm
|
|
|
253
|
+ (inst sub bsp-tn bsp-tn (* 2 vm:word-bytes))
|
|
|
254
|
+ ;; inst cmp + inst b :ne loop: loop until where == bsp-tn
|
|
|
255
|
+ (inst cmp where bsp-tn)
|
|
|
256
|
+ (inst b :ne loop)
|
|
|
257
|
+
|
|
|
258
|
+ (emit-label done))))
|
|
|
259
|
+
|
|
|
260
|
+
|
|
|
261
|
+
|
|
|
262
|
+;;;; Closure indexing.
|
|
|
263
|
+
|
|
|
264
|
+(define-vop (closure-index-ref word64-index-ref)
|
|
|
265
|
+ (:variant vm:closure-info-offset vm:function-pointer-type)
|
|
|
266
|
+ (:translate %closure-index-ref))
|
|
|
267
|
+
|
|
|
268
|
+(define-vop (funcallable-instance-info word64-index-ref)
|
|
|
269
|
+ (:variant funcallable-instance-info-offset vm:function-pointer-type)
|
|
|
270
|
+ (:translate %funcallable-instance-info))
|
|
|
271
|
+
|
|
|
272
|
+(define-vop (set-funcallable-instance-info word64-index-set)
|
|
|
273
|
+ (:variant funcallable-instance-info-offset function-pointer-type)
|
|
|
274
|
+ (:translate %set-funcallable-instance-info))
|
|
|
275
|
+
|
|
|
276
|
+(define-vop (funcallable-instance-lexenv cell-ref)
|
|
|
277
|
+ (:variant funcallable-instance-lexenv-slot function-pointer-type))
|
|
|
278
|
+
|
|
|
279
|
+
|
|
|
280
|
+(define-vop (closure-ref slot-ref)
|
|
|
281
|
+ (:variant closure-info-offset function-pointer-type))
|
|
|
282
|
+
|
|
|
283
|
+(define-vop (closure-init slot-set)
|
|
|
284
|
+ (:variant closure-info-offset function-pointer-type))
|
|
|
285
|
+
|
|
|
286
|
+
|
|
|
287
|
+;;;; Value Cell hackery.
|
|
|
288
|
+
|
|
|
289
|
+(define-vop (value-cell-ref cell-ref)
|
|
|
290
|
+ (:variant value-cell-value-slot other-pointer-type))
|
|
|
291
|
+
|
|
|
292
|
+(define-vop (value-cell-set cell-set)
|
|
|
293
|
+ (:variant value-cell-value-slot other-pointer-type))
|
|
|
294
|
+
|
|
|
295
|
+
|
|
|
296
|
+
|
|
|
297
|
+;;;; Instance hackery:
|
|
|
298
|
+
|
|
|
299
|
+(define-vop (instance-length)
|
|
|
300
|
+ (:policy :fast-safe)
|
|
|
301
|
+ (:translate %instance-length)
|
|
|
302
|
+ (:args (struct :scs (descriptor-reg)))
|
|
|
303
|
+ (:temporary (:scs (non-descriptor-reg)) temp)
|
|
|
304
|
+ (:results (res :scs (unsigned-reg)))
|
|
|
305
|
+ (:result-types positive-fixnum)
|
|
|
306
|
+ (:generator 4
|
|
|
307
|
+ (emit-not-implemented)
|
|
|
308
|
+ (loadw temp struct 0 instance-pointer-type)
|
|
|
309
|
+ ;; inst lsr: Logical Shift Right.
|
|
|
310
|
+ ;; Defined in checkpoint as (def lsr 1 63) with (segment rd rn shift).
|
|
|
311
|
+ ;; LSR rd, temp, vm:type-bits -- shifts header word right to extract length field.
|
|
|
312
|
+ (inst lsr res temp vm:type-bits)))
|
|
|
313
|
+
|
|
|
314
|
+(define-vop (instance-ref slot-ref)
|
|
|
315
|
+ (:variant instance-slots-offset instance-pointer-type)
|
|
|
316
|
+ (:policy :fast-safe)
|
|
|
317
|
+ (:translate %instance-ref)
|
|
|
318
|
+ (:arg-types instance (:constant index)))
|
|
|
319
|
+
|
|
|
320
|
+(define-vop (instance-set slot-set)
|
|
|
321
|
+ (:policy :fast-safe)
|
|
|
322
|
+ ;; This translation is disabled because %instance-set needs a return value
|
|
|
323
|
+ ;; and this VOP doesn't return anything. See SPARC notes for context.
|
|
|
324
|
+ ;;(:translate %instance-set)
|
|
|
325
|
+ (:variant instance-slots-offset instance-pointer-type)
|
|
|
326
|
+ (:arg-types instance (:constant index) *))
|
|
|
327
|
+
|
|
|
328
|
+(define-vop (instance-index-ref word64-index-ref)
|
|
|
329
|
+ (:policy :fast-safe)
|
|
|
330
|
+ (:translate %instance-ref)
|
|
|
331
|
+ (:variant instance-slots-offset instance-pointer-type)
|
|
|
332
|
+ (:arg-types instance positive-fixnum))
|
|
|
333
|
+
|
|
|
334
|
+(define-vop (instance-index-set word64-index-set)
|
|
|
335
|
+ (:policy :fast-safe)
|
|
|
336
|
+ (:translate %instance-set)
|
|
|
337
|
+ (:variant instance-slots-offset instance-pointer-type)
|
|
|
338
|
+ (:arg-types instance positive-fixnum *))
|
|
|
339
|
+
|
|
|
340
|
+
|
|
|
341
|
+
|
|
|
342
|
+;;;; Code object frobbing.
|
|
|
343
|
+
|
|
|
344
|
+(define-vop (code-header-ref word64-index-ref)
|
|
|
345
|
+ (:translate code-header-ref)
|
|
|
346
|
+ (:policy :fast-safe)
|
|
|
347
|
+ (:variant 0 other-pointer-type))
|
|
|
348
|
+
|
|
|
349
|
+(define-vop (code-header-set word64-index-set)
|
|
|
350
|
+ (:translate code-header-set)
|
|
|
351
|
+ (:policy :fast-safe)
|
|
|
352
|
+ (:variant 0 other-pointer-type)) |