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