1 | ;;;-*- Mode: Lisp; Package: (X8664 :use CL) -*- |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2005, Clozure Associates and contributors. |
---|
4 | ;;; This file is part of OpenMCL. |
---|
5 | ;;; |
---|
6 | ;;; OpenMCL is licensed under the terms of the Lisp Lesser GNU Public |
---|
7 | ;;; License , known as the LLGPL and distributed with OpenMCL as the |
---|
8 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
9 | ;;; which is distributed with OpenMCL as the file "LGPL". Where these |
---|
10 | ;;; conflict, the preamble takes precedence. |
---|
11 | ;;; |
---|
12 | ;;; OpenMCL is referenced in the preamble as the "LIBRARY." |
---|
13 | ;;; |
---|
14 | ;;; The LLGPL is also available online at |
---|
15 | ;;; http://opensource.franz.com/preamble.html |
---|
16 | |
---|
17 | (defpackage "X8664" |
---|
18 | (:use "CL") |
---|
19 | #+x8664-target |
---|
20 | (:nicknames "TARGET")) |
---|
21 | |
---|
22 | (in-package "X8664") |
---|
23 | |
---|
24 | (eval-when (:compile-toplevel :load-toplevel :execute) |
---|
25 | (require "X86-ARCH") |
---|
26 | (require "X86-LAP") |
---|
27 | |
---|
28 | (defparameter *x8664-symbolic-register-names* |
---|
29 | (make-hash-table :test #'equal) |
---|
30 | "For the disassembler, mostly") |
---|
31 | |
---|
32 | ;;; define integer constants which map to |
---|
33 | ;;; indices in the X86::*X8664-REGISTER-ENTRIES* array. |
---|
34 | (ccl::defenum () |
---|
35 | rax |
---|
36 | rcx |
---|
37 | rdx |
---|
38 | rbx |
---|
39 | rsp |
---|
40 | rbp |
---|
41 | rsi |
---|
42 | rdi |
---|
43 | r8 |
---|
44 | r9 |
---|
45 | r10 |
---|
46 | r11 |
---|
47 | r12 |
---|
48 | r13 |
---|
49 | r14 |
---|
50 | r15 |
---|
51 | ;; 32-bit registers |
---|
52 | eax |
---|
53 | ecx |
---|
54 | edx |
---|
55 | ebx |
---|
56 | esp |
---|
57 | ebp |
---|
58 | esi |
---|
59 | edi |
---|
60 | r8d |
---|
61 | r9d |
---|
62 | r10d |
---|
63 | r11d |
---|
64 | r12d |
---|
65 | r13d |
---|
66 | r14d |
---|
67 | r15d |
---|
68 | ;; 16-bit-registers |
---|
69 | ax |
---|
70 | cx |
---|
71 | dx |
---|
72 | bx |
---|
73 | sp |
---|
74 | bp |
---|
75 | si |
---|
76 | di |
---|
77 | r8w |
---|
78 | r9w |
---|
79 | r10w |
---|
80 | r11w |
---|
81 | r12w |
---|
82 | r13w |
---|
83 | r14w |
---|
84 | r15w |
---|
85 | ;; 8-bit registers |
---|
86 | al |
---|
87 | cl |
---|
88 | dl |
---|
89 | bl |
---|
90 | spl |
---|
91 | bpl |
---|
92 | sil |
---|
93 | dil |
---|
94 | r8b |
---|
95 | r9b |
---|
96 | r10b |
---|
97 | r11b |
---|
98 | r12b |
---|
99 | r13b |
---|
100 | r14b |
---|
101 | r15b |
---|
102 | ;;; xmm registers |
---|
103 | xmm0 |
---|
104 | xmm1 |
---|
105 | xmm2 |
---|
106 | xmm3 |
---|
107 | xmm4 |
---|
108 | xmm5 |
---|
109 | xmm6 |
---|
110 | xmm7 |
---|
111 | xmm8 |
---|
112 | xmm9 |
---|
113 | xmm10 |
---|
114 | xmm11 |
---|
115 | xmm12 |
---|
116 | xmm13 |
---|
117 | xmm14 |
---|
118 | xmm15 |
---|
119 | ;; MMX registers |
---|
120 | mm0 |
---|
121 | mm1 |
---|
122 | mm2 |
---|
123 | mm3 |
---|
124 | mm4 |
---|
125 | mm5 |
---|
126 | mm6 |
---|
127 | mm7 |
---|
128 | ;; x87 FP regs. May or may not be useful. |
---|
129 | st[0] |
---|
130 | st[1] |
---|
131 | st[2] |
---|
132 | st[3] |
---|
133 | st[4] |
---|
134 | st[5] |
---|
135 | st[6] |
---|
136 | st[7] |
---|
137 | ;; Segment registers |
---|
138 | cs |
---|
139 | ds |
---|
140 | ss |
---|
141 | es |
---|
142 | fs |
---|
143 | gs |
---|
144 | rip |
---|
145 | ) |
---|
146 | |
---|
147 | (defmacro defx86reg (alias known) |
---|
148 | (let* ((known-entry (gensym))) |
---|
149 | `(let* ((,known-entry (gethash ,(string known) x86::*x8664-registers*))) |
---|
150 | (unless ,known-entry |
---|
151 | (error "register ~a not defined" ',known)) |
---|
152 | (setf (gethash ,(string alias) x86::*x8664-registers*) ,known-entry) |
---|
153 | (unless (gethash ,(string-downcase (string known)) *x8664-symbolic-register-names*) |
---|
154 | (setf (gethash ,(string-downcase (string known)) *x8664-symbolic-register-names*) |
---|
155 | (string-downcase ,(string alias)))) |
---|
156 | (defconstant ,alias ,known)))) |
---|
157 | |
---|
158 | (defx86reg imm0 rax) |
---|
159 | (defx86reg imm0.l eax) |
---|
160 | (defx86reg imm0.w ax) |
---|
161 | (defx86reg imm0.b al) |
---|
162 | |
---|
163 | (defx86reg temp0 rbx) |
---|
164 | (defx86reg temp0.l ebx) |
---|
165 | (defx86reg temp0.w bx) |
---|
166 | (defx86reg temp0.b bl) |
---|
167 | |
---|
168 | (defx86reg imm2 rcx) |
---|
169 | (defx86reg nargs ecx) |
---|
170 | (defx86reg imm2.l ecx) |
---|
171 | (defx86reg nargs.w cx) |
---|
172 | (defx86reg nargs.q rcx) |
---|
173 | (defx86reg imm2.w cx) |
---|
174 | (defx86reg imm2.b cl) |
---|
175 | (defx86reg shift cl) |
---|
176 | |
---|
177 | (defx86reg imm1 rdx) |
---|
178 | (defx86reg imm1.l edx) |
---|
179 | (defx86reg imm1.w dx) |
---|
180 | (defx86reg imm1.b dl) |
---|
181 | |
---|
182 | (defx86reg arg_z rsi) |
---|
183 | (defx86reg arg_z.l esi) |
---|
184 | (defx86reg arg_z.w si) |
---|
185 | (defx86reg arg_z.b sil) |
---|
186 | |
---|
187 | (defx86reg arg_y rdi) |
---|
188 | (defx86reg arg_y.l edi) |
---|
189 | (defx86reg arg_y.w di) |
---|
190 | (defx86reg arg_y.b dil) |
---|
191 | |
---|
192 | (defx86reg arg_x r8) |
---|
193 | (defx86reg arg_x.l r8d) |
---|
194 | (defx86reg arg_x.w r8w) |
---|
195 | (defx86reg arg_x.b r8b) |
---|
196 | |
---|
197 | (defx86reg temp1 r9) |
---|
198 | (defx86reg temp1.l r9d) |
---|
199 | (defx86reg temp1.w r9w) |
---|
200 | (defx86reg temp1.b r9b) |
---|
201 | |
---|
202 | (defx86reg ra0 r10) |
---|
203 | (defx86reg ra0.l r10d) |
---|
204 | (defx86reg ra0.w r10w) |
---|
205 | (defx86reg ra0.b r10b) |
---|
206 | |
---|
207 | (defx86reg temp2 r10) |
---|
208 | (defx86reg temp2.l r10d) |
---|
209 | (defx86reg temp2.w r10w) |
---|
210 | (defx86reg temp2.b r10b) |
---|
211 | |
---|
212 | |
---|
213 | (defx86reg save3 r11) |
---|
214 | (defx86reg save3.l r11d) |
---|
215 | (defx86reg save3.w r11w) |
---|
216 | (defx86reg save3.b r11b) |
---|
217 | |
---|
218 | (defx86reg save2 r12) |
---|
219 | (defx86reg save2.l r12d) |
---|
220 | (defx86reg save2.w r12w) |
---|
221 | (defx86reg save2.b r12b) |
---|
222 | |
---|
223 | (defx86reg fn r13) |
---|
224 | (defx86reg fn.l r13d) |
---|
225 | (defx86reg fn.w r13w) |
---|
226 | (defx86reg fn.b r13b) |
---|
227 | |
---|
228 | (defx86reg save1 r14) |
---|
229 | (defx86reg save1.l r14d) |
---|
230 | (defx86reg save1.w r14w) |
---|
231 | (defx86reg save1.b r14b) |
---|
232 | |
---|
233 | (defx86reg save0 r15) |
---|
234 | (defx86reg save0.l r15d) |
---|
235 | (defx86reg save0.w r15w) |
---|
236 | (defx86reg save0.b r15b) |
---|
237 | |
---|
238 | ;;; Use xmm regs for floating-point. (They can also hold integer values.) |
---|
239 | (defx86reg fp0 xmm0) |
---|
240 | (defx86reg fp1 xmm1) |
---|
241 | (defx86reg fp2 xmm2) |
---|
242 | (defx86reg fp3 xmm3) |
---|
243 | (defx86reg fp4 xmm4) |
---|
244 | (defx86reg fp5 xmm5) |
---|
245 | (defx86reg fp6 xmm6) |
---|
246 | (defx86reg fp7 xmm7) |
---|
247 | (defx86reg fp8 xmm8) |
---|
248 | (defx86reg fp9 xmm9) |
---|
249 | (defx86reg fp10 xmm10) |
---|
250 | (defx86reg fp11 xmm11) |
---|
251 | (defx86reg fp12 xmm12) |
---|
252 | (defx86reg fp13 xmm13) |
---|
253 | (defx86reg fp14 xmm14) |
---|
254 | (defx86reg fpzero xmm15) |
---|
255 | (defx86reg fp15 xmm15) |
---|
256 | |
---|
257 | ;;; There are only 8 mmx registers, and they overlap the x87 FPU. |
---|
258 | (defx86reg stack-temp mm7) |
---|
259 | |
---|
260 | |
---|
261 | ;;; NEXT-METHOD-CONTEXT is passed from gf-dispatch code to the method |
---|
262 | ;;; functions that it funcalls. FNAME is only meaningful when calling |
---|
263 | ;;; globally named functions through the function cell of a symbol. |
---|
264 | ;;; It appears that they're never live at the same time. |
---|
265 | ;;; (We can also consider passing next-method context on the stack.) |
---|
266 | |
---|
267 | (defx86reg fname temp0) |
---|
268 | (defx86reg next-method-context temp0) |
---|
269 | ;;; We rely one at least one of %ra0/%fn pointing to the current function |
---|
270 | ;;; (or to a TRA that references the function) at all times. When we |
---|
271 | ;;; tail call something, we want %RA0 to point to our caller's TRA and |
---|
272 | ;;; %FN to point to the new function. Unless we go out of line to |
---|
273 | ;;; do tail calls, we need some register not involved in the calling |
---|
274 | ;;; sequence to hold the current function, since it might get GCed otherwise. |
---|
275 | ;;; (The odds of this happening are low, but non-zero.) |
---|
276 | (defx86reg xfn temp1) |
---|
277 | |
---|
278 | (defx86reg ra1 fn) |
---|
279 | |
---|
280 | (defx86reg allocptr temp0) |
---|
281 | |
---|
282 | |
---|
283 | (defconstant nbits-in-word 64) |
---|
284 | (defconstant nbits-in-byte 8) |
---|
285 | (defconstant ntagbits 4) |
---|
286 | (defconstant nlisptagbits 3) |
---|
287 | (defconstant nfixnumtagbits 3) |
---|
288 | (defconstant num-subtag-bits 8) |
---|
289 | (defconstant fixnumshift 3) |
---|
290 | (defconstant fixnum-shift 3) |
---|
291 | (defconstant fulltagmask 15) |
---|
292 | (defconstant tagmask 7) |
---|
293 | (defconstant fixnummask 7) |
---|
294 | (defconstant ncharcodebits 8) |
---|
295 | (defconstant charcode-shift 8) |
---|
296 | (defconstant word-shift 3) |
---|
297 | (defconstant word-size-in-bytes 8) |
---|
298 | (defconstant node-size word-size-in-bytes) |
---|
299 | (defconstant dnode-size 16) |
---|
300 | (defconstant dnode-align-bits 4) |
---|
301 | (defconstant dnode-shift dnode-align-bits) |
---|
302 | (defconstant bitmap-shift 6) |
---|
303 | |
---|
304 | (defconstant fixnumone (ash 1 fixnumshift)) |
---|
305 | (defconstant fixnum-one fixnumone) |
---|
306 | (defconstant fixnum1 fixnumone) |
---|
307 | |
---|
308 | (defconstant target-most-negative-fixnum (ash -1 (1- (- nbits-in-word nfixnumtagbits)))) |
---|
309 | (defconstant target-most-positive-fixnum (1- (ash 1 (1- (- nbits-in-word nfixnumtagbits))))) |
---|
310 | |
---|
311 | ;;; 3-bit "lisptag" values |
---|
312 | |
---|
313 | (defconstant tag-fixnum 0) |
---|
314 | (defconstant tag-imm-0 1) ;subtag-single-float ONLY |
---|
315 | (defconstant tag-imm-1 2) ;subtag-character, internal markers |
---|
316 | (defconstant tag-list 3) ;fulltag-cons or NIL |
---|
317 | (defconstant tag-tra 4) ;tagged return-address |
---|
318 | (defconstant tag-misc 5) ;random uvector |
---|
319 | (defconstant tag-symbol 6) ;non-null symbol |
---|
320 | (defconstant tag-function 7) ;function entry point |
---|
321 | |
---|
322 | (defconstant tag-single-float tag-imm-0) |
---|
323 | |
---|
324 | ;;; 4-bit "fulltag" values |
---|
325 | (defconstant fulltag-even-fixnum 0) |
---|
326 | (defconstant fulltag-imm-0 1) ;subtag-single-float ONLY |
---|
327 | (defconstant fulltag-imm-1 2) ;characters, markers |
---|
328 | (defconstant fulltag-cons 3) |
---|
329 | (defconstant fulltag-tra-0 4) ;tagged return address |
---|
330 | (defconstant fulltag-nodeheader-0 5) |
---|
331 | (defconstant fulltag-nodeheader-1 6) |
---|
332 | (defconstant fulltag-immheader-0 7) |
---|
333 | (defconstant fulltag-odd-fixnum 8) |
---|
334 | (defconstant fulltag-immheader-1 9) |
---|
335 | (defconstant fulltag-immheader-2 10) |
---|
336 | (defconstant fulltag-nil 11) |
---|
337 | (defconstant fulltag-tra-1 12) |
---|
338 | (defconstant fulltag-misc 13) |
---|
339 | (defconstant fulltag-symbol 14) |
---|
340 | (defconstant fulltag-function 15) |
---|
341 | |
---|
342 | (defconstant fulltag-single-float fulltag-imm-0) |
---|
343 | |
---|
344 | (defmacro define-subtag (name tag value) |
---|
345 | `(defconstant ,(ccl::form-symbol "SUBTAG-" name) (logior ,tag (ash ,value ntagbits)))) |
---|
346 | |
---|
347 | |
---|
348 | (define-subtag arrayH fulltag-nodeheader-0 10) |
---|
349 | (define-subtag vectorH fulltag-nodeheader-1 10) |
---|
350 | (define-subtag simple-vector fulltag-nodeheader-1 11) |
---|
351 | (defconstant min-vector-subtag subtag-vectorH) |
---|
352 | (defconstant min-array-subtag subtag-arrayH) |
---|
353 | |
---|
354 | (defconstant ivector-class-64-bit fulltag-immheader-2) |
---|
355 | (defconstant ivector-class-32-bit fulltag-immheader-1) |
---|
356 | (defconstant ivector-class-other-bit fulltag-immheader-0) |
---|
357 | |
---|
358 | (define-subtag fixnum-vector ivector-class-64-bit 12) |
---|
359 | (define-subtag s64-vector ivector-class-64-bit 13) |
---|
360 | (define-subtag u64-vector ivector-class-64-bit 14) |
---|
361 | (define-subtag double-float-vector ivector-class-64-bit 15) |
---|
362 | |
---|
363 | (define-subtag simple-base-string ivector-class-32-bit 12) |
---|
364 | (define-subtag s32-vector ivector-class-32-bit 13) |
---|
365 | (define-subtag u32-vector ivector-class-32-bit 14) |
---|
366 | (define-subtag single-float-vector ivector-class-32-bit 15) |
---|
367 | |
---|
368 | (define-subtag s16-vector ivector-class-other-bit 10) |
---|
369 | (define-subtag u16-vector ivector-class-other-bit 11) |
---|
370 | |
---|
371 | (define-subtag s8-vector ivector-class-other-bit 13) |
---|
372 | (define-subtag u8-vector ivector-class-other-bit 14) |
---|
373 | (defconstant min-8-bit-ivector-subtag subtag-s8-vector) |
---|
374 | (defconstant max-8-bit-ivector-subtag subtag-u8-vector) |
---|
375 | (define-subtag bit-vector ivector-class-other-bit 15) |
---|
376 | |
---|
377 | |
---|
378 | ;;; There's some room for expansion in non-array ivector space. |
---|
379 | (define-subtag macptr ivector-class-64-bit 1) |
---|
380 | (define-subtag dead-macptr ivector-class-64-bit 2) |
---|
381 | (define-subtag bignum ivector-class-32-bit 1) |
---|
382 | (define-subtag double-float ivector-class-32-bit 2) |
---|
383 | (define-subtag xcode-vector ivector-class-32-bit 3) |
---|
384 | |
---|
385 | |
---|
386 | |
---|
387 | ;;; Note the difference between (e.g) fulltag-function - which |
---|
388 | ;;; defines what the low 4 bytes of a function pointer look like - |
---|
389 | ;;; and subtag-function - which describes what the subtag byte |
---|
390 | ;;; in a function header looks like. (Likewise for fulltag-symbol |
---|
391 | ;;; and subtag-symbol) |
---|
392 | |
---|
393 | ;;; don't use nodheader/0, since that would conflict with tag-misc |
---|
394 | (define-subtag symbol fulltag-nodeheader-0 1) |
---|
395 | (define-subtag catch-frame fulltag-nodeheader-0 2) |
---|
396 | (define-subtag hash-vector fulltag-nodeheader-0 3) |
---|
397 | (define-subtag pool fulltag-nodeheader-0 4) |
---|
398 | (define-subtag weak fulltag-nodeheader-0 5) |
---|
399 | (define-subtag package fulltag-nodeheader-0 6) |
---|
400 | (define-subtag slot-vector fulltag-nodeheader-0 7) |
---|
401 | (define-subtag basic-stream fulltag-nodeheader-0 8) |
---|
402 | (define-subtag function fulltag-nodeheader-0 9) |
---|
403 | |
---|
404 | (define-subtag ratio fulltag-nodeheader-1 1) |
---|
405 | (define-subtag complex fulltag-nodeheader-1 2) |
---|
406 | (define-subtag struct fulltag-nodeheader-1 3) |
---|
407 | (define-subtag istruct fulltag-nodeheader-1 4) |
---|
408 | (define-subtag value-cell fulltag-nodeheader-1 5) |
---|
409 | (define-subtag xfunction fulltag-nodeheader-1 6) |
---|
410 | (define-subtag lock fulltag-nodeheader-1 7) |
---|
411 | (define-subtag instance fulltag-nodeheader-1 8) |
---|
412 | |
---|
413 | |
---|
414 | (defconstant canonical-nil-value (+ #x13000 fulltag-nil)) |
---|
415 | (defconstant canonical-t-value (+ #x13020 fulltag-symbol)) |
---|
416 | (defconstant misc-bias fulltag-misc) |
---|
417 | (defconstant cons-bias fulltag-cons) |
---|
418 | (defconstant t-offset (- canonical-t-value canonical-nil-value)) |
---|
419 | |
---|
420 | |
---|
421 | (defconstant misc-header-offset (- fulltag-misc)) |
---|
422 | (defconstant misc-data-offset (+ misc-header-offset node-size)) |
---|
423 | (defconstant misc-subtag-offset misc-header-offset) |
---|
424 | (defconstant misc-dfloat-offset misc-data-offset) |
---|
425 | (defconstant misc-symbol-offset (- node-size fulltag-symbol)) |
---|
426 | (defconstant misc-function-offset (- node-size fulltag-function)) |
---|
427 | |
---|
428 | (define-subtag single-float fulltag-imm-0 0) |
---|
429 | |
---|
430 | (define-subtag character fulltag-imm-1 0) |
---|
431 | |
---|
432 | (define-subtag unbound fulltag-imm-1 1) |
---|
433 | (defconstant unbound-marker subtag-unbound) |
---|
434 | (defconstant undefined unbound-marker) |
---|
435 | (define-subtag slot-unbound fulltag-imm-1 2) |
---|
436 | (defconstant slot-unbound-marker subtag-slot-unbound) |
---|
437 | (define-subtag illegal fulltag-imm-1 3) |
---|
438 | (defconstant illegal-marker subtag-illegal) |
---|
439 | (define-subtag no-thread-local-binding fulltag-imm-1 4) |
---|
440 | (defconstant no-thread-local-binding-marker subtag-no-thread-local-binding) |
---|
441 | (define-subtag reserved-frame fulltag-imm-1 5) |
---|
442 | (defconstant reserved-frame-marker subtag-reserved-frame) |
---|
443 | |
---|
444 | ;;; This has two functions: it tells the link-inverting marker where the |
---|
445 | ;;; code ends and the constants start, and it ensures that the 0th constant |
---|
446 | ;;; will never be in the same memozized dnode as some (unboxed) word of |
---|
447 | ;;; machine code. I'm not sure if there's a better way to do either of those |
---|
448 | ;;; things. |
---|
449 | ;;; Depending on how you look at it, we either lose 8 bytes per function, or gain |
---|
450 | ;;; 7 bytes of otherwise unused space for debugging info. |
---|
451 | (define-subtag function-boundary-marker fulltag-imm-1 15) |
---|
452 | (defconstant function-boundary-marker subtag-function-boundary-marker) |
---|
453 | |
---|
454 | (defconstant max-64-bit-constant-index (ash (+ #x7fffffff x8664::misc-dfloat-offset) -3)) |
---|
455 | (defconstant max-32-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) -2)) |
---|
456 | (defconstant max-16-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) -1)) |
---|
457 | (defconstant max-8-bit-constant-index (+ #x7fffffff x8664::misc-data-offset)) |
---|
458 | (defconstant max-1-bit-constant-index (ash (+ #x7fffffff x8664::misc-data-offset) 5)) |
---|
459 | |
---|
460 | ) |
---|
461 | (defmacro define-storage-layout (name origin &rest cells) |
---|
462 | `(progn |
---|
463 | (ccl::defenum (:start ,origin :step 8) |
---|
464 | ,@(mapcar #'(lambda (cell) (ccl::form-symbol name "." cell)) cells)) |
---|
465 | (defconstant ,(ccl::form-symbol name ".SIZE") ,(* (length cells) |
---|
466 | 8)))) |
---|
467 | |
---|
468 | (defmacro define-lisp-object (name tagname &rest cells) |
---|
469 | `(define-storage-layout ,name ,(- (symbol-value tagname)) ,@cells)) |
---|
470 | |
---|
471 | (defmacro define-fixedsized-object (name (&optional (fulltag 'fulltag-misc)) |
---|
472 | &rest non-header-cells) |
---|
473 | `(progn |
---|
474 | (define-lisp-object ,name ,fulltag header ,@non-header-cells) |
---|
475 | (ccl::defenum () |
---|
476 | ,@(mapcar #'(lambda (cell) (ccl::form-symbol name "." cell "-CELL")) non-header-cells)) |
---|
477 | (defconstant ,(ccl::form-symbol name ".ELEMENT-COUNT") ,(length non-header-cells)))) |
---|
478 | |
---|
479 | ;;; Order of CAR and CDR doesn't seem to matter much - there aren't |
---|
480 | ;;; too many tricks to be played with predecrement/preincrement addressing. |
---|
481 | ;;; Keep them in the confusing MCL 3.0 order, to avoid confusion. |
---|
482 | (define-lisp-object cons fulltag-cons |
---|
483 | cdr |
---|
484 | car) |
---|
485 | |
---|
486 | (define-fixedsized-object ratio () |
---|
487 | numer |
---|
488 | denom) |
---|
489 | |
---|
490 | ;;; It's slightly easier (for bootstrapping reasons) |
---|
491 | ;;; to view a DOUBLE-FLOAT as being UVECTOR with 2 32-bit elements |
---|
492 | ;;; (rather than 1 64-bit element). |
---|
493 | |
---|
494 | (defconstant double-float.value misc-data-offset) |
---|
495 | (defconstant double-float.value-cell 0) |
---|
496 | (defconstant double-float.val-low double-float.value) |
---|
497 | (defconstant double-float.val-low-cell 0) |
---|
498 | (defconstant double-float.val-high (+ double-float.value 4)) |
---|
499 | (defconstant double-float.val-high-cell 1) |
---|
500 | (defconstant double-float.element-count 2) |
---|
501 | (defconstant double-float.size 16) |
---|
502 | |
---|
503 | (define-fixedsized-object complex () |
---|
504 | realpart |
---|
505 | imagpart |
---|
506 | ) |
---|
507 | |
---|
508 | ;;; There are two kinds of macptr; use the length field of the header if you |
---|
509 | ;;; need to distinguish between them |
---|
510 | (define-fixedsized-object macptr () |
---|
511 | address |
---|
512 | domain |
---|
513 | type |
---|
514 | ) |
---|
515 | |
---|
516 | (define-fixedsized-object xmacptr () |
---|
517 | address |
---|
518 | domain |
---|
519 | type |
---|
520 | flags |
---|
521 | link |
---|
522 | ) |
---|
523 | |
---|
524 | |
---|
525 | ;;; Need to think about catch frames on x8664. |
---|
526 | (define-fixedsized-object catch-frame () |
---|
527 | catch-tag ; #<unbound> -> unwind-protect, else catch |
---|
528 | link ; tagged pointer to next older catch frame |
---|
529 | mvflag ; 0 if single-value, 1 if uwp or multiple-value |
---|
530 | rsp ; |
---|
531 | rbp |
---|
532 | foreign-sp |
---|
533 | db-link ; value of dynamic-binding link on thread entry. |
---|
534 | save-save3 ; saved nvrs |
---|
535 | save-save2 |
---|
536 | save-save1 |
---|
537 | save-save0 |
---|
538 | xframe ; exception-frame link |
---|
539 | pc ; tra of catch exit/unwind cleanup |
---|
540 | ) |
---|
541 | |
---|
542 | (define-fixedsized-object lock () |
---|
543 | _value ;finalizable pointer to kernel object |
---|
544 | kind ; '0 = recursive-lock, '1 = rwlock |
---|
545 | writer ;tcr of owning thread or 0 |
---|
546 | name |
---|
547 | whostate |
---|
548 | whostate-2 |
---|
549 | ) |
---|
550 | |
---|
551 | |
---|
552 | |
---|
553 | ;;; If we're pointing at the "symbol-vector", we can use these |
---|
554 | (define-fixedsized-object symptr () |
---|
555 | pname |
---|
556 | vcell |
---|
557 | fcell |
---|
558 | package-predicate |
---|
559 | flags |
---|
560 | plist |
---|
561 | binding-index |
---|
562 | ) |
---|
563 | |
---|
564 | (define-fixedsized-object symbol (fulltag-symbol) |
---|
565 | pname |
---|
566 | vcell |
---|
567 | fcell |
---|
568 | package-predicate |
---|
569 | flags |
---|
570 | plist |
---|
571 | binding-index |
---|
572 | ) |
---|
573 | |
---|
574 | (defconstant nilsym-offset (+ t-offset symbol.size)) |
---|
575 | |
---|
576 | |
---|
577 | (define-fixedsized-object vectorH () |
---|
578 | logsize ; fillpointer if it has one, physsize otherwise |
---|
579 | physsize ; total size of (possibly displaced) data vector |
---|
580 | data-vector ; object this header describes |
---|
581 | displacement ; true displacement or 0 |
---|
582 | flags ; has-fill-pointer,displaced-to,adjustable bits; subtype of underlying simple vector. |
---|
583 | ) |
---|
584 | |
---|
585 | (define-lisp-object arrayH fulltag-misc |
---|
586 | header ; subtag = subtag-arrayH |
---|
587 | rank ; NEVER 1 |
---|
588 | physsize ; total size of (possibly displaced) data vector |
---|
589 | data-vector ; object this header describes |
---|
590 | displacement ; true displacement or 0 |
---|
591 | flags ; has-fill-pointer,displaced-to,adjustable bits; subtype of underlying simple vector. |
---|
592 | ;; Dimensions follow |
---|
593 | ) |
---|
594 | |
---|
595 | (defconstant arrayH.rank-cell 0) |
---|
596 | (defconstant arrayH.physsize-cell 1) |
---|
597 | (defconstant arrayH.data-vector-cell 2) |
---|
598 | (defconstant arrayH.displacement-cell 3) |
---|
599 | (defconstant arrayH.flags-cell 4) |
---|
600 | (defconstant arrayH.dim0-cell 5) |
---|
601 | |
---|
602 | (defconstant arrayH.flags-cell-bits-byte (byte 8 0)) |
---|
603 | (defconstant arrayH.flags-cell-subtag-byte (byte 8 8)) |
---|
604 | |
---|
605 | (define-fixedsized-object value-cell () |
---|
606 | value) |
---|
607 | |
---|
608 | |
---|
609 | (define-storage-layout lisp-frame 0 |
---|
610 | backptr |
---|
611 | return-address |
---|
612 | xtra) |
---|
613 | |
---|
614 | (define-storage-layout tsp-frame 0 |
---|
615 | backptr |
---|
616 | rbp) |
---|
617 | |
---|
618 | (define-storage-layout csp-frame 0 |
---|
619 | backptr |
---|
620 | rbp) |
---|
621 | |
---|
622 | |
---|
623 | (define-storage-layout xcf 0 ;"exception callback frame" |
---|
624 | backptr |
---|
625 | return-address ; always 0 |
---|
626 | nominal-function |
---|
627 | relative-pc |
---|
628 | containing-object |
---|
629 | xp |
---|
630 | ra0 |
---|
631 | foreign-sp ; value of tcr.foreign_sp |
---|
632 | prev-xframe ; tcr.xframe before exception |
---|
633 | ; (last 2 needed by apply-in-frame) |
---|
634 | ) |
---|
635 | |
---|
636 | ;;; The kernel uses these (rather generically named) structures |
---|
637 | ;;; to keep track of various memory regions it (or the lisp) is |
---|
638 | ;;; interested in. |
---|
639 | |
---|
640 | |
---|
641 | (define-storage-layout area 0 |
---|
642 | pred ; pointer to preceding area in DLL |
---|
643 | succ ; pointer to next area in DLL |
---|
644 | low ; low bound on area addresses |
---|
645 | high ; high bound on area addresses. |
---|
646 | active ; low limit on stacks, high limit on heaps |
---|
647 | softlimit ; overflow bound |
---|
648 | hardlimit ; another one |
---|
649 | code ; an area-code; see below |
---|
650 | markbits ; bit vector for GC |
---|
651 | ndwords ; "active" size of dynamic area or stack |
---|
652 | older ; in EGC sense |
---|
653 | younger ; also for EGC |
---|
654 | h ; Handle or null pointer |
---|
655 | softprot ; protected_area structure pointer |
---|
656 | hardprot ; another one. |
---|
657 | owner ; fragment (library) which "owns" the area |
---|
658 | refbits ; bitvector for intergenerational refernces |
---|
659 | threshold ; for egc |
---|
660 | gc-count ; generational gc count. |
---|
661 | static-dnodes ; for honsing. etc |
---|
662 | static-used ; bitvector |
---|
663 | ) |
---|
664 | |
---|
665 | |
---|
666 | (define-storage-layout protected-area 0 |
---|
667 | next |
---|
668 | start ; first byte (page-aligned) that might be protected |
---|
669 | end ; last byte (page-aligned) that could be protected |
---|
670 | nprot ; Might be 0 |
---|
671 | protsize ; number of bytes to protect |
---|
672 | why) |
---|
673 | |
---|
674 | (eval-when (:compile-toplevel :load-toplevel :execute) |
---|
675 | (defconstant tcr-bias 0) |
---|
676 | ) |
---|
677 | |
---|
678 | (define-storage-layout tcr (- tcr-bias) |
---|
679 | prev ; in doubly-linked list |
---|
680 | next ; in doubly-linked list |
---|
681 | single-float-convert ; faster to box/unbox through memory |
---|
682 | linear |
---|
683 | save-rbp ; lisp frame ptr for foreign code |
---|
684 | lisp-fpscr-high |
---|
685 | db-link ; special binding chain head |
---|
686 | catch-top ; top catch frame |
---|
687 | save-vsp ; SP when in foreign code |
---|
688 | save-tsp ; TSP, at all times |
---|
689 | foreign-sp ; SP when in lisp code |
---|
690 | cs-area ; cstack area pointer |
---|
691 | vs-area ; vstack area pointer |
---|
692 | ts-area ; tstack area pointer |
---|
693 | cs-limit ; cstack overflow limit |
---|
694 | total-bytes-allocated |
---|
695 | log2-allocation-quantum ; unboxed |
---|
696 | interrupt-pending ; fixnum |
---|
697 | xframe ; exception frame linked list |
---|
698 | errno-loc ; thread-private, maybe |
---|
699 | ffi-exception ; fpscr bits from ff-call. |
---|
700 | osid ; OS thread id |
---|
701 | valence ; odd when in foreign code |
---|
702 | foreign-exception-status |
---|
703 | native-thread-info |
---|
704 | native-thread-id |
---|
705 | last-allocptr |
---|
706 | save-allocptr |
---|
707 | save-allocbase |
---|
708 | reset-completion |
---|
709 | activate |
---|
710 | suspend-count |
---|
711 | suspend-context |
---|
712 | pending-exception-context |
---|
713 | suspend ; semaphore for suspension notify |
---|
714 | resume ; sempahore for resumption notify |
---|
715 | flags ; foreign, being reset, ... |
---|
716 | gc-context |
---|
717 | termination-semaphore |
---|
718 | unwinding |
---|
719 | tlb-limit |
---|
720 | tlb-pointer |
---|
721 | shutdown-count |
---|
722 | next-tsp |
---|
723 | safe-ref-address |
---|
724 | pending-io-info |
---|
725 | io-datum |
---|
726 | ) |
---|
727 | |
---|
728 | (defconstant tcr.single-float-convert.value (+ 4 tcr.single-float-convert)) |
---|
729 | |
---|
730 | |
---|
731 | (defconstant interrupt-level-binding-index (ash 1 fixnumshift)) |
---|
732 | |
---|
733 | (define-storage-layout lockptr 0 |
---|
734 | avail |
---|
735 | owner |
---|
736 | count |
---|
737 | signal |
---|
738 | waiting |
---|
739 | malloced-ptr |
---|
740 | spinlock) |
---|
741 | |
---|
742 | (define-storage-layout rwlock 0 |
---|
743 | spin |
---|
744 | state |
---|
745 | blocked-writers |
---|
746 | blocked-readers |
---|
747 | writer |
---|
748 | reader-signal |
---|
749 | writer-signal |
---|
750 | malloced-ptr |
---|
751 | ) |
---|
752 | |
---|
753 | (defmacro define-header (name element-count subtag) |
---|
754 | `(defconstant ,name (logior (ash ,element-count num-subtag-bits) ,subtag))) |
---|
755 | |
---|
756 | (define-header double-float-header double-float.element-count subtag-double-float) |
---|
757 | |
---|
758 | ;;; We could possibly have a one-digit bignum header when dealing |
---|
759 | ;;; with "small bignums" in some bignum code. Like other cases of |
---|
760 | ;;; non-normalized bignums, they should never escape from the lab. |
---|
761 | (define-header one-digit-bignum-header 1 subtag-bignum) |
---|
762 | (define-header two-digit-bignum-header 2 subtag-bignum) |
---|
763 | (define-header three-digit-bignum-header 3 subtag-bignum) |
---|
764 | (define-header four-digit-bignum-header 4 subtag-bignum) |
---|
765 | (define-header five-digit-bignum-header 5 subtag-bignum) |
---|
766 | (define-header symbol-header symbol.element-count subtag-symbol) |
---|
767 | (define-header value-cell-header value-cell.element-count subtag-value-cell) |
---|
768 | (define-header macptr-header macptr.element-count subtag-macptr) |
---|
769 | |
---|
770 | |
---|
771 | (defconstant gf-code-size 18) |
---|
772 | |
---|
773 | (defun %kernel-global (sym) |
---|
774 | (let* ((pos (position sym x86::*x86-kernel-globals* :test #'string=))) |
---|
775 | (if pos |
---|
776 | (- (+ fulltag-nil (* (1+ pos) node-size))) |
---|
777 | (error "Unknown kernel global : ~s ." sym)))) |
---|
778 | |
---|
779 | (defmacro kernel-global (sym) |
---|
780 | (let* ((pos (position sym x86::*x86-kernel-globals* :test #'string=))) |
---|
781 | (if pos |
---|
782 | (- (+ fulltag-nil (* (1+ pos) node-size))) |
---|
783 | (error "Unknown kernel global : ~s ." sym)))) |
---|
784 | |
---|
785 | (ccl::defenum (:prefix "KERNEL-IMPORT-" :start 0 :step node-size) |
---|
786 | fd-setsize-bytes |
---|
787 | do-fd-set |
---|
788 | do-fd-clr |
---|
789 | do-fd-is-set |
---|
790 | do-fd-zero |
---|
791 | MakeDataExecutable |
---|
792 | GetSharedLibrary |
---|
793 | FindSymbol |
---|
794 | malloc |
---|
795 | free |
---|
796 | jvm-init |
---|
797 | allocate_vstack |
---|
798 | register_cstack |
---|
799 | raise-thread-interrupt |
---|
800 | get-r-debug |
---|
801 | restore-soft-stack-limit |
---|
802 | egc-control |
---|
803 | lisp-bug |
---|
804 | NewThread |
---|
805 | YieldToThread |
---|
806 | DisposeThread |
---|
807 | ThreadCurrentStackSpace |
---|
808 | usage-exit |
---|
809 | save-fp-context |
---|
810 | restore-fp-context |
---|
811 | put-altivec-registers |
---|
812 | get-altivec-registers |
---|
813 | new-semaphore |
---|
814 | wait-on-semaphore |
---|
815 | signal-semaphore |
---|
816 | destroy-semaphore |
---|
817 | new-recursive-lock |
---|
818 | lock-recursive-lock |
---|
819 | unlock-recursive-lock |
---|
820 | destroy-recursive-lock |
---|
821 | suspend-other-threads |
---|
822 | resume-other-threads |
---|
823 | suspend-tcr |
---|
824 | resume-tcr |
---|
825 | rwlock-new |
---|
826 | rwlock-destroy |
---|
827 | rwlock-rlock |
---|
828 | rwlock-wlock |
---|
829 | rwlock-unlock |
---|
830 | recursive-lock-trylock |
---|
831 | foreign-name-and-offset |
---|
832 | lisp-read |
---|
833 | lisp-write |
---|
834 | lisp-open |
---|
835 | lisp-fchmod |
---|
836 | lisp-lseek |
---|
837 | lisp-close |
---|
838 | lisp-ftruncate |
---|
839 | lisp-stat |
---|
840 | lisp-fstat |
---|
841 | lisp-futex |
---|
842 | lisp-opendir |
---|
843 | lisp-readdir |
---|
844 | lisp-closedir |
---|
845 | lisp-pipe |
---|
846 | lisp-gettimeofday |
---|
847 | lisp-sigexit |
---|
848 | ) |
---|
849 | |
---|
850 | (defmacro nrs-offset (name) |
---|
851 | (let* ((pos (position name x86::*x86-nilreg-relative-symbols* :test #'eq))) |
---|
852 | (if pos (* (1- pos) symbol.size)))) |
---|
853 | |
---|
854 | (defparameter *x8664-target-uvector-subtags* |
---|
855 | `((:bignum . ,subtag-bignum) |
---|
856 | (:ratio . ,subtag-ratio) |
---|
857 | (:single-float . ,subtag-single-float) |
---|
858 | (:double-float . ,subtag-double-float) |
---|
859 | (:complex . ,subtag-complex ) |
---|
860 | (:symbol . ,subtag-symbol) |
---|
861 | (:function . ,subtag-function ) |
---|
862 | (:xcode-vector . ,subtag-xcode-vector) |
---|
863 | (:macptr . ,subtag-macptr ) |
---|
864 | (:catch-frame . ,subtag-catch-frame) |
---|
865 | (:struct . ,subtag-struct ) |
---|
866 | (:istruct . ,subtag-istruct ) |
---|
867 | (:pool . ,subtag-pool ) |
---|
868 | (:population . ,subtag-weak ) |
---|
869 | (:hash-vector . ,subtag-hash-vector ) |
---|
870 | (:package . ,subtag-package ) |
---|
871 | (:value-cell . ,subtag-value-cell) |
---|
872 | (:instance . ,subtag-instance ) |
---|
873 | (:lock . ,subtag-lock ) |
---|
874 | (:basic-stream . ,subtag-basic-stream) |
---|
875 | (:slot-vector . ,subtag-slot-vector) |
---|
876 | (:simple-string . ,subtag-simple-base-string ) |
---|
877 | (:bit-vector . ,subtag-bit-vector ) |
---|
878 | (:signed-8-bit-vector . ,subtag-s8-vector ) |
---|
879 | (:unsigned-8-bit-vector . ,subtag-u8-vector ) |
---|
880 | (:signed-16-bit-vector . ,subtag-s16-vector ) |
---|
881 | (:unsigned-16-bit-vector . ,subtag-u16-vector ) |
---|
882 | (:signed-32-bit-vector . ,subtag-s32-vector ) |
---|
883 | (:unsigned-32-bit-vector . ,subtag-u32-vector ) |
---|
884 | (:signed-64-bit-vector . ,subtag-s64-vector) |
---|
885 | (:fixnum-vector . ,subtag-fixnum-vector) |
---|
886 | (:unsigned-64-bit-vector . ,subtag-u64-vector) |
---|
887 | (:single-float-vector . ,subtag-single-float-vector) |
---|
888 | (:double-float-vector . ,subtag-double-float-vector ) |
---|
889 | (:simple-vector . ,subtag-simple-vector ) |
---|
890 | (:vector-header . ,subtag-vectorH) |
---|
891 | (:array-header . ,subtag-arrayH))) |
---|
892 | |
---|
893 | ;;; This should return NIL unless it's sure of how the indicated |
---|
894 | ;;; type would be represented (in particular, it should return |
---|
895 | ;;; NIL if the element type is unknown or unspecified at compile-time. |
---|
896 | (defun x8664-array-type-name-from-ctype (ctype) |
---|
897 | (when (typep ctype 'ccl::array-ctype) |
---|
898 | (let* ((element-type (ccl::array-ctype-element-type ctype))) |
---|
899 | (typecase element-type |
---|
900 | (ccl::class-ctype |
---|
901 | (let* ((class (ccl::class-ctype-class element-type))) |
---|
902 | (if (or (eq class ccl::*character-class*) |
---|
903 | (eq class ccl::*base-char-class*) |
---|
904 | (eq class ccl::*standard-char-class*)) |
---|
905 | :simple-string |
---|
906 | :simple-vector))) |
---|
907 | (ccl::numeric-ctype |
---|
908 | (if (eq (ccl::numeric-ctype-complexp element-type) :complex) |
---|
909 | :simple-vector |
---|
910 | (case (ccl::numeric-ctype-class element-type) |
---|
911 | (integer |
---|
912 | (let* ((low (ccl::numeric-ctype-low element-type)) |
---|
913 | (high (ccl::numeric-ctype-high element-type))) |
---|
914 | (cond ((or (null low) (null high)) |
---|
915 | :simple-vector) |
---|
916 | ((and (>= low 0) (<= high 1)) |
---|
917 | :bit-vector) |
---|
918 | ((and (>= low 0) (<= high 255)) |
---|
919 | :unsigned-8-bit-vector) |
---|
920 | ((and (>= low 0) (<= high 65535)) |
---|
921 | :unsigned-16-bit-vector) |
---|
922 | ((and (>= low 0) (<= high #xffffffff)) |
---|
923 | :unsigned-32-bit-vector) |
---|
924 | ((and (>= low 0) (<= high #xffffffffffffffff)) |
---|
925 | :unsigned-64-bit-vector) |
---|
926 | ((and (>= low -128) (<= high 127)) |
---|
927 | :signed-8-bit-vector) |
---|
928 | ((and (>= low -32768) (<= high 32767)) |
---|
929 | :signed-16-bit-vector) |
---|
930 | ((and (>= low (ash -1 31)) (<= high (1- (ash 1 31)))) |
---|
931 | :signed-32-bit-vector) |
---|
932 | ((and (>= low target-most-negative-fixnum) |
---|
933 | (<= high target-most-positive-fixnum)) |
---|
934 | :fixnum-vector) |
---|
935 | ((and (>= low (ash -1 63)) (<= high (1- (ash 1 63)))) |
---|
936 | :signed-64-bit-vector) |
---|
937 | (t :simple-vector)))) |
---|
938 | (float |
---|
939 | (case (ccl::numeric-ctype-format element-type) |
---|
940 | ((double-float long-float) :double-float-vector) |
---|
941 | ((single-float short-float) :single-float-vector) |
---|
942 | (t :simple-vector))) |
---|
943 | (t :simple-vector)))) |
---|
944 | (ccl::unknown-ctype) |
---|
945 | (ccl::named-ctype |
---|
946 | (if (eq element-type ccl::*universal-type*) |
---|
947 | :simple-vector)) |
---|
948 | (t))))) |
---|
949 | |
---|
950 | (defun x8664-misc-byte-count (subtag element-count) |
---|
951 | (declare (fixnum subtag)) |
---|
952 | (if (logbitp (logand subtag fulltagmask) |
---|
953 | (logior (ash 1 fulltag-nodeheader-0) |
---|
954 | (ash 1 fulltag-nodeheader-1))) |
---|
955 | (ash element-count 3) |
---|
956 | (case (logand subtag fulltagmask) |
---|
957 | (#.ivector-class-64-bit (ash element-count 3)) |
---|
958 | (#.ivector-class-32-bit (ash element-count 2)) |
---|
959 | (t |
---|
960 | (if (= subtag subtag-bit-vector) |
---|
961 | (ash (+ 7 element-count) -3) |
---|
962 | (if (>= subtag min-8-bit-ivector-subtag) |
---|
963 | element-count |
---|
964 | (ash element-count 1))))))) |
---|
965 | |
---|
966 | (defparameter *x8664-subprims-shift* 3) |
---|
967 | (defconstant x8664-subprims-base #x15000) |
---|
968 | |
---|
969 | |
---|
970 | (declaim (special *x8664-subprims*)) |
---|
971 | |
---|
972 | ;;; For now, nothing's nailed down and we don't say anything about |
---|
973 | ;;; registers clobbered. |
---|
974 | (let* ((origin x8664-subprims-base) |
---|
975 | (step (ash 1 *x8664-subprims-shift*))) |
---|
976 | (flet ((define-x8664-subprim (name) |
---|
977 | (ccl::make-subprimitive-info :name (string name) |
---|
978 | :offset (prog1 origin |
---|
979 | (incf origin step))))) |
---|
980 | (macrolet ((defx8664subprim (name) |
---|
981 | `(define-x8664-subprim ',name))) |
---|
982 | (defparameter *x8664-subprims* |
---|
983 | (vector |
---|
984 | (defx8664subprim .SPjmpsym) |
---|
985 | (defx8664subprim .SPjmpnfn) |
---|
986 | (defx8664subprim .SPfuncall) |
---|
987 | (defx8664subprim .SPmkcatch1v) |
---|
988 | (defx8664subprim .SPmkunwind) |
---|
989 | (defx8664subprim .SPmkcatchmv) |
---|
990 | (defx8664subprim .SPthrow) |
---|
991 | (defx8664subprim .SPnthrowvalues) |
---|
992 | (defx8664subprim .SPnthrow1value) |
---|
993 | (defx8664subprim .SPbind) |
---|
994 | (defx8664subprim .SPbind-self) |
---|
995 | (defx8664subprim .SPbind-nil) |
---|
996 | (defx8664subprim .SPbind-self-boundp-check) |
---|
997 | (defx8664subprim .SPrplaca) |
---|
998 | (defx8664subprim .SPrplacd) |
---|
999 | (defx8664subprim .SPconslist) |
---|
1000 | (defx8664subprim .SPconslist-star) |
---|
1001 | (defx8664subprim .SPstkconslist) |
---|
1002 | (defx8664subprim .SPstkconslist-star) |
---|
1003 | (defx8664subprim .SPmkstackv) |
---|
1004 | (defx8664subprim .SPsubtag-misc-ref) |
---|
1005 | (defx8664subprim .SPsetqsym) |
---|
1006 | (defx8664subprim .SPprogvsave) |
---|
1007 | (defx8664subprim .SPstack-misc-alloc) |
---|
1008 | (defx8664subprim .SPgvector) |
---|
1009 | (defx8664subprim .SPnvalret) |
---|
1010 | (defx8664subprim .SPmvpass) |
---|
1011 | (defx8664subprim .SPrecover-values-for-mvcall) |
---|
1012 | (defx8664subprim .SPnthvalue) |
---|
1013 | (defx8664subprim .SPvalues) |
---|
1014 | (defx8664subprim .SPdefault-optional-args) |
---|
1015 | (defx8664subprim .SPopt-supplied-p) |
---|
1016 | (defx8664subprim .SPheap-rest-arg) |
---|
1017 | (defx8664subprim .SPreq-heap-rest-arg) |
---|
1018 | (defx8664subprim .SPheap-cons-rest-arg) |
---|
1019 | (defx8664subprim .SPsimple-keywords) |
---|
1020 | (defx8664subprim .SPkeyword-args) |
---|
1021 | (defx8664subprim .SPkeyword-bind) |
---|
1022 | (defx8664subprim .SPffcall) |
---|
1023 | (defx8664subprim .SParef2) |
---|
1024 | (defx8664subprim .SPksignalerr) |
---|
1025 | (defx8664subprim .SPstack-rest-arg) |
---|
1026 | (defx8664subprim .SPreq-stack-rest-arg) |
---|
1027 | (defx8664subprim .SPstack-cons-rest-arg) |
---|
1028 | (defx8664subprim .SPpoweropen-callbackX) |
---|
1029 | (defx8664subprim .SPcall-closure) |
---|
1030 | (defx8664subprim .SPgetXlong) |
---|
1031 | (defx8664subprim .SPspreadargz) |
---|
1032 | (defx8664subprim .SPtfuncallgen) |
---|
1033 | (defx8664subprim .SPtfuncallslide) |
---|
1034 | (defx8664subprim .SPtfuncallvsp) |
---|
1035 | (defx8664subprim .SPtcallsymgen) |
---|
1036 | (defx8664subprim .SPtcallsymslide) |
---|
1037 | (defx8664subprim .SPtcallsymvsp) |
---|
1038 | (defx8664subprim .SPtcallnfngen) |
---|
1039 | (defx8664subprim .SPtcallnfnslide) |
---|
1040 | (defx8664subprim .SPtcallnfnvsp) |
---|
1041 | (defx8664subprim .SPmisc-ref) |
---|
1042 | (defx8664subprim .SPmisc-set) |
---|
1043 | (defx8664subprim .SPstkconsyz) |
---|
1044 | (defx8664subprim .SPstkvcell0) |
---|
1045 | (defx8664subprim .SPstkvcellvsp) |
---|
1046 | (defx8664subprim .SPmakestackblock) |
---|
1047 | (defx8664subprim .SPmakestackblock0) |
---|
1048 | (defx8664subprim .SPmakestacklist) |
---|
1049 | (defx8664subprim .SPstkgvector) |
---|
1050 | (defx8664subprim .SPmisc-alloc) |
---|
1051 | (defx8664subprim .SPpoweropen-ffcallX) |
---|
1052 | (defx8664subprim .SPgvset) |
---|
1053 | (defx8664subprim .SPmacro-bind) |
---|
1054 | (defx8664subprim .SPdestructuring-bind) |
---|
1055 | (defx8664subprim .SPdestructuring-bind-inner) |
---|
1056 | (defx8664subprim .SPrecover-values) |
---|
1057 | (defx8664subprim .SPvpopargregs) |
---|
1058 | (defx8664subprim .SPinteger-sign) |
---|
1059 | (defx8664subprim .SPsubtag-misc-set) |
---|
1060 | (defx8664subprim .SPspread-lexpr-z) |
---|
1061 | (defx8664subprim .SPstore-node-conditional) |
---|
1062 | (defx8664subprim .SPreset) |
---|
1063 | (defx8664subprim .SPmvslide) |
---|
1064 | (defx8664subprim .SPsave-values) |
---|
1065 | (defx8664subprim .SPadd-values) |
---|
1066 | (defx8664subprim .SPcallback) |
---|
1067 | (defx8664subprim .SPmisc-alloc-init) |
---|
1068 | (defx8664subprim .SPstack-misc-alloc-init) |
---|
1069 | (defx8664subprim .SPset-hash-key) |
---|
1070 | (defx8664subprim .SPaset2) |
---|
1071 | (defx8664subprim .SPcallbuiltin) |
---|
1072 | (defx8664subprim .SPcallbuiltin0) |
---|
1073 | (defx8664subprim .SPcallbuiltin1) |
---|
1074 | (defx8664subprim .SPcallbuiltin2) |
---|
1075 | (defx8664subprim .SPcallbuiltin3) |
---|
1076 | (defx8664subprim .SPpopj) |
---|
1077 | (defx8664subprim .SPrestorefullcontext) |
---|
1078 | (defx8664subprim .SPsavecontextvsp) |
---|
1079 | (defx8664subprim .SPsavecontext0) |
---|
1080 | (defx8664subprim .SPrestorecontext) |
---|
1081 | (defx8664subprim .SPlexpr-entry) |
---|
1082 | (defx8664subprim .SPpoweropen-syscall) |
---|
1083 | (defx8664subprim .SPbuiltin-plus) |
---|
1084 | (defx8664subprim .SPbuiltin-minus) |
---|
1085 | (defx8664subprim .SPbuiltin-times) |
---|
1086 | (defx8664subprim .SPbuiltin-div) |
---|
1087 | (defx8664subprim .SPbuiltin-eq) |
---|
1088 | (defx8664subprim .SPbuiltin-ne) |
---|
1089 | (defx8664subprim .SPbuiltin-gt) |
---|
1090 | (defx8664subprim .SPbuiltin-ge) |
---|
1091 | (defx8664subprim .SPbuiltin-lt) |
---|
1092 | (defx8664subprim .SPbuiltin-le) |
---|
1093 | (defx8664subprim .SPbuiltin-eql) |
---|
1094 | (defx8664subprim .SPbuiltin-length) |
---|
1095 | (defx8664subprim .SPbuiltin-seqtype) |
---|
1096 | (defx8664subprim .SPbuiltin-assq) |
---|
1097 | (defx8664subprim .SPbuiltin-memq) |
---|
1098 | (defx8664subprim .SPbuiltin-logbitp) |
---|
1099 | (defx8664subprim .SPbuiltin-logior) |
---|
1100 | (defx8664subprim .SPbuiltin-logand) |
---|
1101 | (defx8664subprim .SPbuiltin-ash) |
---|
1102 | (defx8664subprim .SPbuiltin-negate) |
---|
1103 | (defx8664subprim .SPbuiltin-logxor) |
---|
1104 | (defx8664subprim .SPbuiltin-aref1) |
---|
1105 | (defx8664subprim .SPbuiltin-aset1) |
---|
1106 | (defx8664subprim .SPbreakpoint) |
---|
1107 | (defx8664subprim .SPeabi-ff-call) |
---|
1108 | (defx8664subprim .SPeabi-callback) |
---|
1109 | (defx8664subprim .SPsyscall) |
---|
1110 | (defx8664subprim .SPgetu64) |
---|
1111 | (defx8664subprim .SPgets64) |
---|
1112 | (defx8664subprim .SPmakeu64) |
---|
1113 | (defx8664subprim .SPmakes64) |
---|
1114 | (defx8664subprim .SPspecref) |
---|
1115 | (defx8664subprim .SPspecset) |
---|
1116 | (defx8664subprim .SPspecrefcheck) |
---|
1117 | (defx8664subprim .SPrestoreintlevel) |
---|
1118 | (defx8664subprim .SPmakes32) |
---|
1119 | (defx8664subprim .SPmakeu32) |
---|
1120 | (defx8664subprim .SPgets32) |
---|
1121 | (defx8664subprim .SPgetu32) |
---|
1122 | (defx8664subprim .SPfix-overflow) |
---|
1123 | (defx8664subprim .SPmvpasssym) |
---|
1124 | (defx8664subprim .SParef3) |
---|
1125 | (defx8664subprim .SPaset3) |
---|
1126 | (defx8664subprim .SPffcall-return-registers) |
---|
1127 | (defx8664subprim .SPunused-5) |
---|
1128 | (defx8664subprim .SPset-hash-key-conditional) |
---|
1129 | (defx8664subprim .SPunbind-interrupt-level) |
---|
1130 | (defx8664subprim .SPunbind) |
---|
1131 | (defx8664subprim .SPunbind-n) |
---|
1132 | (defx8664subprim .SPunbind-to) |
---|
1133 | (defx8664subprim .SPbind-interrupt-level-m1) |
---|
1134 | (defx8664subprim .SPbind-interrupt-level) |
---|
1135 | (defx8664subprim .SPbind-interrupt-level-0) |
---|
1136 | (defx8664subprim .SPprogvrestore) |
---|
1137 | (defx8664subprim .SPnmkunwind) |
---|
1138 | |
---|
1139 | ))))) |
---|
1140 | |
---|
1141 | (defparameter *x8664-target-arch* |
---|
1142 | (arch::make-target-arch :name :x8664 |
---|
1143 | :lisp-node-size 8 |
---|
1144 | :nil-value canonical-nil-value |
---|
1145 | :fixnum-shift fixnumshift |
---|
1146 | :most-positive-fixnum (1- (ash 1 (1- (- 64 fixnumshift)))) |
---|
1147 | :most-negative-fixnum (- (ash 1 (1- (- 64 fixnumshift)))) |
---|
1148 | :misc-data-offset misc-data-offset |
---|
1149 | :misc-dfloat-offset misc-dfloat-offset |
---|
1150 | :nbits-in-word 64 |
---|
1151 | :ntagbits 4 |
---|
1152 | :nlisptagbits 3 |
---|
1153 | :uvector-subtags *x8664-target-uvector-subtags* |
---|
1154 | :max-64-bit-constant-index max-64-bit-constant-index |
---|
1155 | :max-32-bit-constant-index max-32-bit-constant-index |
---|
1156 | :max-16-bit-constant-index max-16-bit-constant-index |
---|
1157 | :max-8-bit-constant-index max-8-bit-constant-index |
---|
1158 | :max-1-bit-constant-index max-1-bit-constant-index |
---|
1159 | :word-shift 3 |
---|
1160 | :code-vector-prefix nil |
---|
1161 | :gvector-types '(:ratio :complex :symbol :function |
---|
1162 | :catch-frame :struct :istruct |
---|
1163 | :pool :population :hash-vector |
---|
1164 | :package :value-cell :instance |
---|
1165 | :lock :slot-vector |
---|
1166 | :simple-vector) |
---|
1167 | :1-bit-ivector-types '(:bit-vector) |
---|
1168 | :8-bit-ivector-types '(:signed-8-bit-vector |
---|
1169 | :unsigned-8-bit-vector) |
---|
1170 | :16-bit-ivector-types '(:signed-16-bit-vector |
---|
1171 | :unsigned-16-bit-vector) |
---|
1172 | :32-bit-ivector-types '(:signed-32-bit-vector |
---|
1173 | :unsigned-32-bit-vector |
---|
1174 | :single-float-vector |
---|
1175 | :double-float |
---|
1176 | :bignum |
---|
1177 | :simple-string) |
---|
1178 | :64-bit-ivector-types '(:double-float-vector |
---|
1179 | :unsigned-64-bit-vector |
---|
1180 | :signed-64-bit-vector |
---|
1181 | :fixnum-vector) |
---|
1182 | :array-type-name-from-ctype-function |
---|
1183 | #'x8664-array-type-name-from-ctype |
---|
1184 | :package-name "X8664" |
---|
1185 | :t-offset t-offset |
---|
1186 | :array-data-size-function #'x8664-misc-byte-count |
---|
1187 | :numeric-type-name-to-typecode-function |
---|
1188 | #'(lambda (type-name) |
---|
1189 | (ecase type-name |
---|
1190 | (fixnum tag-fixnum) |
---|
1191 | (bignum subtag-bignum) |
---|
1192 | ((short-float single-float) subtag-single-float) |
---|
1193 | ((long-float double-float) subtag-double-float) |
---|
1194 | (ratio subtag-ratio) |
---|
1195 | (complex subtag-complex))) |
---|
1196 | :subprims-base x8664-subprims-base |
---|
1197 | :subprims-shift x8664::*x8664-subprims-shift* |
---|
1198 | :subprims-table x8664::*x8664-subprims* |
---|
1199 | :primitive->subprims `(((0 . 23) . ,(ccl::%subprim-name->offset '.SPbuiltin-plus x8664::*x8664-subprims*))) |
---|
1200 | :unbound-marker-value unbound-marker |
---|
1201 | :slot-unbound-marker-value slot-unbound-marker |
---|
1202 | :fixnum-tag tag-fixnum |
---|
1203 | :single-float-tag subtag-single-float |
---|
1204 | :single-float-tag-is-subtag nil |
---|
1205 | :double-float-tag subtag-double-float |
---|
1206 | :cons-tag fulltag-cons |
---|
1207 | :null-tag fulltag-nil |
---|
1208 | :symbol-tag fulltag-symbol |
---|
1209 | :symbol-tag-is-subtag nil |
---|
1210 | :function-tag fulltag-function |
---|
1211 | :function-tag-is-subtag nil |
---|
1212 | :big-endian nil |
---|
1213 | :misc-subtag-offset misc-subtag-offset |
---|
1214 | :car-offset cons.car |
---|
1215 | :cdr-offset cons.cdr |
---|
1216 | :subtag-char subtag-character |
---|
1217 | :charcode-shift charcode-shift |
---|
1218 | :fulltagmask fulltagmask |
---|
1219 | :fulltag-misc fulltag-misc |
---|
1220 | :char-code-limit #x110000 |
---|
1221 | )) |
---|
1222 | |
---|
1223 | ;;; arch macros |
---|
1224 | (defmacro defx8664archmacro (name lambda-list &body body) |
---|
1225 | `(arch::defarchmacro :x8664 ,name ,lambda-list ,@body)) |
---|
1226 | |
---|
1227 | (defx8664archmacro ccl::%make-sfloat () |
---|
1228 | (error "~s shouldn't be used in code targeting :X8664" 'ccl::%make-sfloat)) |
---|
1229 | |
---|
1230 | (defx8664archmacro ccl::%make-dfloat () |
---|
1231 | `(ccl::%alloc-misc x8664::double-float.element-count x8664::subtag-double-float)) |
---|
1232 | |
---|
1233 | (defx8664archmacro ccl::%numerator (x) |
---|
1234 | `(ccl::%svref ,x x8664::ratio.numer-cell)) |
---|
1235 | |
---|
1236 | (defx8664archmacro ccl::%denominator (x) |
---|
1237 | `(ccl::%svref ,x x8664::ratio.denom-cell)) |
---|
1238 | |
---|
1239 | (defx8664archmacro ccl::%realpart (x) |
---|
1240 | `(ccl::%svref ,x x8664::complex.realpart-cell)) |
---|
1241 | |
---|
1242 | (defx8664archmacro ccl::%imagpart (x) |
---|
1243 | `(ccl::%svref ,x x8664::complex.imagpart-cell)) |
---|
1244 | |
---|
1245 | ;;; |
---|
1246 | (defx8664archmacro ccl::%get-single-float-from-double-ptr (ptr offset) |
---|
1247 | `(ccl::%double-float->short-float (ccl::%get-double-float ,ptr ,offset))) |
---|
1248 | |
---|
1249 | (defx8664archmacro ccl::codevec-header-p (word) |
---|
1250 | (declare (ignore word)) |
---|
1251 | (error "~s makes no sense on :X8664" 'ccl::codevec-header-p)) |
---|
1252 | |
---|
1253 | ;;; |
---|
1254 | |
---|
1255 | (defx8664archmacro ccl::immediate-p-macro (thing) |
---|
1256 | (let* ((tag (gensym))) |
---|
1257 | `(let* ((,tag (ccl::lisptag ,thing))) |
---|
1258 | (declare (type (unsigned-byte 3) ,tag)) |
---|
1259 | (logbitp ,tag (logior (ash 1 x8664::tag-fixnum) |
---|
1260 | (ash 1 x8664::tag-imm-0) |
---|
1261 | (ash 1 x8664::tag-imm-1)))))) |
---|
1262 | |
---|
1263 | (defx8664archmacro ccl::hashed-by-identity (thing) |
---|
1264 | (let* ((typecode (gensym))) |
---|
1265 | `(let* ((,typecode (ccl::typecode ,thing))) |
---|
1266 | (declare (fixnum ,typecode)) |
---|
1267 | (or (= ,typecode x8664::subtag-instance) |
---|
1268 | (and (<= ,typecode x8664::fulltag-symbol) |
---|
1269 | (logbitp (the (integer 0 #.x8664::fulltag-symbol) ,typecode) |
---|
1270 | (logior (ash 1 x8664::tag-fixnum) |
---|
1271 | (ash 1 x8664::tag-imm-0) |
---|
1272 | (ash 1 x8664::tag-imm-1) |
---|
1273 | (ash 1 x8664::fulltag-symbol)))))))) |
---|
1274 | |
---|
1275 | ;;; |
---|
1276 | (defx8664archmacro ccl::%get-kernel-global (name) |
---|
1277 | `(ccl::%fixnum-ref 0 (+ ,(ccl::target-nil-value) |
---|
1278 | ,(%kernel-global |
---|
1279 | (if (ccl::quoted-form-p name) |
---|
1280 | (cadr name) |
---|
1281 | name))))) |
---|
1282 | |
---|
1283 | (defx8664archmacro ccl::%get-kernel-global-ptr (name dest) |
---|
1284 | `(ccl::%setf-macptr |
---|
1285 | ,dest |
---|
1286 | (ccl::%int-to-ptr (ccl::%fixnum-ref-natural 0 (+ ,(ccl::target-nil-value) |
---|
1287 | ,(%kernel-global |
---|
1288 | (if (ccl::quoted-form-p name) |
---|
1289 | (cadr name) |
---|
1290 | name))))))) |
---|
1291 | |
---|
1292 | (defx8664archmacro ccl::%target-kernel-global (name) |
---|
1293 | `(x8664::%kernel-global ,name)) |
---|
1294 | |
---|
1295 | (defx8664archmacro ccl::lfun-vector (fun) |
---|
1296 | `(ccl::%function-to-function-vector ,fun)) |
---|
1297 | |
---|
1298 | (defx8664archmacro ccl::lfun-vector-lfun (lfv) |
---|
1299 | `(ccl::%function-vector-to-function ,lfv)) |
---|
1300 | |
---|
1301 | (defx8664archmacro ccl::area-code () |
---|
1302 | area.code) |
---|
1303 | |
---|
1304 | (defx8664archmacro ccl::area-succ () |
---|
1305 | area.succ) |
---|
1306 | |
---|
1307 | (defx8664archmacro ccl::nth-immediate (f i) |
---|
1308 | `(ccl::%nth-immediate ,f (the fixnum (- (the fixnum ,i) 1)))) |
---|
1309 | |
---|
1310 | (defx8664archmacro ccl::set-nth-immediate (f i new) |
---|
1311 | `(ccl::%set-nth-immediate ,f (the fixnum (- (the fixnum ,i) 1)) ,new)) |
---|
1312 | |
---|
1313 | (defx8664archmacro ccl::symptr->symvector (s) |
---|
1314 | `(ccl::%symptr->symvector ,s)) |
---|
1315 | |
---|
1316 | (defx8664archmacro ccl::symvector->symptr (s) |
---|
1317 | `(ccl::%symvector->symptr ,s)) |
---|
1318 | |
---|
1319 | (defx8664archmacro ccl::function-to-function-vector (f) |
---|
1320 | `(ccl::%function-to-function-vector ,f)) |
---|
1321 | |
---|
1322 | (defx8664archmacro ccl::function-vector-to-function (v) |
---|
1323 | `(ccl::%function-vector-to-function ,v)) |
---|
1324 | |
---|
1325 | (defx8664archmacro ccl::with-ffcall-results ((buf) &body body) |
---|
1326 | ;; Reserve space for rax,rdx,xmm0,xmm1 only. |
---|
1327 | (let* ((size (+ (* 2 8) (* 2 8)))) |
---|
1328 | `(ccl::%stack-block ((,buf ,size :clear t)) |
---|
1329 | ,@body))) |
---|
1330 | |
---|
1331 | ;;; an (lea (@ disp (% rip)) (% fn)) instruction following a tagged |
---|
1332 | ;;; return address helps the runtime map from the return address to |
---|
1333 | ;;; the containing function. That instuction is 7 bytes long: 3 |
---|
1334 | ;;; bytes of code followed by 4 bytes of displacement. The constant |
---|
1335 | ;;; part of that - assuming that FN is R13 - looks like #x4c #x8d #x2d. |
---|
1336 | |
---|
1337 | (defconstant recover-fn-from-rip-length 7) |
---|
1338 | (defconstant recover-fn-from-rip-disp-offset 3) |
---|
1339 | (defconstant recover-fn-from-rip-word0 #x8d4c) |
---|
1340 | (defconstant recover-fn-from-rip-byte2 #x2d) |
---|
1341 | |
---|
1342 | ;;; For backtrace: the relative PC of an argument-check trap |
---|
1343 | ;;; must be less than or equal to this value. (Because of |
---|
1344 | ;;; the way that we do "anchored" UUOs, it should always be =.) |
---|
1345 | |
---|
1346 | (defconstant arg-check-trap-pc-limit 7) |
---|
1347 | |
---|
1348 | (provide "X8664-ARCH") |
---|