source: branches/working-0711/ccl/compiler/X86/X8632/x8632-arch.lisp @ 11089

Last change on this file since 11089 was 11089, checked in by gz, 13 years ago

Merge/bootstrap assorted low level stuff from trunk - kernel, syscall stuff, lowmem-bias, formatting tweaks, a few bug fixes included

File size: 43.0 KB
Line 
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 (+ #x7fff x8632::misc-dfloat-offset) -3))
364(defconstant max-32-bit-constant-index (ash (+ #x7fff x8632::misc-data-offset) -2))
365(defconstant max-16-bit-constant-index (ash (+ #x7fff x8632::misc-data-offset) -1))
366(defconstant max-8-bit-constant-index (+ #x7fff x8632::misc-data-offset))
367(defconstant max-1-bit-constant-index (ash (+ #x7fff x8632::misc-data-offset) 5))
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)
629
630(defconstant interrupt-level-binding-index (ash 1 fixnumshift))
631
632(define-storage-layout lockptr 0
633  avail
634  owner
635  count
636  signal
637  waiting
638  malloced-ptr
639  spinlock)
640
641(define-storage-layout rwlock 0
642  spin
643  state
644  blocked-writers
645  blocked-readers
646  writer
647  reader-signal
648  writer-signal
649  malloced-ptr
650  )
651
652(defmacro define-header (name element-count subtag)
653  `(defconstant ,name (logior (ash ,element-count num-subtag-bits) ,subtag)))
654
655(define-header single-float-header single-float.element-count subtag-single-float)
656(define-header double-float-header double-float.element-count subtag-double-float)
657
658;;; We could possibly have a one-digit bignum header when dealing
659;;; with "small bignums" in some bignum code.  Like other cases of
660;;; non-normalized bignums, they should never escape from the lab.
661(define-header one-digit-bignum-header 1 subtag-bignum)
662(define-header two-digit-bignum-header 2 subtag-bignum)
663(define-header three-digit-bignum-header 3 subtag-bignum)
664(define-header symbol-header symbol.element-count subtag-symbol)
665(define-header value-cell-header value-cell.element-count subtag-value-cell)
666(define-header macptr-header macptr.element-count subtag-macptr)
667
668;;; see x86-clos.lisp
669(defconstant gf-code-size 30)
670
671(defun %kernel-global (sym)
672  (let* ((pos (position sym x86::*x86-kernel-globals* :test #'string=)))
673    (if pos
674      (- (+ fulltag-cons (* (1+ pos) node-size)))
675      (error "Unknown kernel global : ~s ." sym))))
676
677(defmacro kernel-global (sym)
678  (let* ((pos (position sym x86::*x86-kernel-globals* :test #'string=)))
679    (if pos
680      (- (+ fulltag-cons (* (1+ pos) node-size)))
681      (error "Unknown kernel global : ~s ." sym))))
682
683(ccl::defenum (:prefix "KERNEL-IMPORT-" :start 0 :step node-size)
684  fd-setsize-bytes
685  do-fd-set
686  do-fd-clr
687  do-fd-is-set
688  do-fd-zero
689  MakeDataExecutable
690  GetSharedLibrary
691  FindSymbol
692  malloc
693  free
694  allocate_tstack
695  allocate_vstack
696  register_cstack
697  raise-thread-interrupt
698  get-r-debug
699  restore-soft-stack-limit
700  egc-control
701  lisp-bug
702  NewThread
703  YieldToThread
704  DisposeThread
705  ThreadCurrentStackSpace
706  usage-exit
707  save-fp-context
708  restore-fp-context
709  put-altivec-registers                 ;is there any
710  get-altivec-registers                 ;point to these on x86?
711  new-semaphore
712  wait-on-semaphore
713  signal-semaphore
714  destroy-semaphore
715  new-recursive-lock
716  lock-recursive-lock
717  unlock-recursive-lock
718  destroy-recursive-lock
719  suspend-other-threads
720  resume-other-threads
721  suspend-tcr
722  resume-tcr
723  rwlock-new
724  rwlock-destroy
725  rwlock-rlock
726  rwlock-wlock
727  rwlock-unlock
728  recursive-lock-trylock
729  foreign-name-and-offset
730  lisp-read
731  lisp-write
732  lisp-open
733  lisp-fchmod
734  lisp-lseek
735  lisp-close
736  lisp-ftruncate
737  lisp-stat
738  lisp-fstat
739  lisp-futex
740  lisp-opendir
741  lisp-readdir
742  lisp-closedir
743  lisp-pipe
744  lisp-gettimeofday
745)
746
747(defmacro nrs-offset (name)
748  (let* ((pos (position name x86::*x86-nilreg-relative-symbols* :test #'eq)))
749    (if pos (* (1- pos) symbol.size))))
750
751(defmacro with-stack-short-floats (specs &body body)
752  (ccl::collect ((binds)
753                 (inits)
754                 (names))
755                (dolist (spec specs)
756                  (let ((name (first spec)))
757                    (binds `(,name (ccl::%make-sfloat)))
758                    (names name)
759                    (let ((init (second spec)))
760                      (when init
761                        (inits `(ccl::%short-float ,init ,name))))))
762                `(let* ,(binds)
763                  (declare (dynamic-extent ,@(names))
764                           (short-float ,@(names)))
765                  ,@(inits)
766                  ,@body)))
767
768(defparameter *x8632-target-uvector-subtags*
769  `((:bignum . ,subtag-bignum)
770    (:ratio . ,subtag-ratio)
771    (:single-float . ,subtag-single-float)
772    (:double-float . ,subtag-double-float)
773    (:complex . ,subtag-complex  )
774    (:symbol . ,subtag-symbol)
775    (:function . ,subtag-function )
776    (:xcode-vector . ,subtag-xcode-vector)
777    (:macptr . ,subtag-macptr )
778    (:catch-frame . ,subtag-catch-frame)
779    (:struct . ,subtag-struct )   
780    (:istruct . ,subtag-istruct )
781    (:pool . ,subtag-pool )
782    (:population . ,subtag-weak )
783    (:hash-vector . ,subtag-hash-vector )
784    (:package . ,subtag-package )
785    (:value-cell . ,subtag-value-cell)
786    (:instance . ,subtag-instance )
787    (:lock . ,subtag-lock )
788    (:slot-vector . ,subtag-slot-vector)
789    (:basic-stream . ,subtag-basic-stream)
790    (:simple-string . ,subtag-simple-base-string )
791    (:bit-vector . ,subtag-bit-vector )
792    (:signed-8-bit-vector . ,subtag-s8-vector )
793    (:unsigned-8-bit-vector . ,subtag-u8-vector )
794    (:signed-16-bit-vector . ,subtag-s16-vector )
795    (:unsigned-16-bit-vector . ,subtag-u16-vector )
796    (:signed-32-bit-vector . ,subtag-s32-vector )
797    (:fixnum-vector . ,subtag-fixnum-vector)
798    (:unsigned-32-bit-vector . ,subtag-u32-vector )
799    (:single-float-vector . ,subtag-single-float-vector)
800    (:double-float-vector . ,subtag-double-float-vector )
801    (:simple-vector . ,subtag-simple-vector )
802    (:vector-header . ,subtag-vectorH)
803    (:array-header . ,subtag-arrayH)))
804
805;;; This should return NIL unless it's sure of how the indicated
806;;; type would be represented (in particular, it should return
807;;; NIL if the element type is unknown or unspecified at compile-time.
808(defun x8632-array-type-name-from-ctype (ctype)
809  (when (typep ctype 'ccl::array-ctype)
810    (let* ((element-type (ccl::array-ctype-element-type ctype)))
811      (typecase element-type
812        (ccl::class-ctype
813         (let* ((class (ccl::class-ctype-class element-type)))
814           (if (or (eq class ccl::*character-class*)
815                   (eq class ccl::*base-char-class*)
816                   (eq class ccl::*standard-char-class*))
817             :simple-string
818             :simple-vector)))
819        (ccl::numeric-ctype
820         (if (eq (ccl::numeric-ctype-complexp element-type) :complex)
821           :simple-vector
822           (case (ccl::numeric-ctype-class element-type)
823             (integer
824              (let* ((low (ccl::numeric-ctype-low element-type))
825                     (high (ccl::numeric-ctype-high element-type)))
826                (cond ((or (null low) (null high)) :simple-vector)
827                      ((and (>= low 0) (<= high 1) :bit-vector))
828                      ((and (>= low 0) (<= high 255)) :unsigned-8-bit-vector)
829                      ((and (>= low 0) (<= high 65535)) :unsigned-16-bit-vector)
830                      ((and (>= low 0) (<= high #xffffffff) :unsigned-32-bit-vector))
831                      ((and (>= low -128) (<= high 127)) :signed-8-bit-vector)
832                      ((and (>= low -32768) (<= high 32767) :signed-16-bit-vector))
833                      ((and (>= low target-most-negative-fixnum)
834                            (<= high target-most-positive-fixnum))
835                       :fixnum-vector)
836                      ((and (>= low (ash -1 31)) (<= high (1- (ash 1 31))))
837                       :signed-32-bit-vector)
838                      (t :simple-vector))))
839             (float
840              (case (ccl::numeric-ctype-format element-type)
841                ((double-float long-float) :double-float-vector)
842                ((single-float short-float) :single-float-vector)
843                (t :simple-vector)))
844             (t :simple-vector))))
845        (ccl::unknown-ctype)
846        (ccl::named-ctype
847         (if (eq element-type ccl::*universal-type*)
848           :simple-vector))
849        (t nil)))))
850
851(defun x8632-misc-byte-count (subtag element-count)
852  (declare (fixnum subtag))
853  (if (or (= fulltag-nodeheader (logand subtag fulltagmask))
854          (<= subtag max-32-bit-ivector-subtag))
855    (ash element-count 2)
856    (if (<= subtag max-8-bit-ivector-subtag)
857      element-count
858      (if (<= subtag max-16-bit-ivector-subtag)
859        (ash element-count 1)
860        (if (= subtag subtag-bit-vector)
861          (ash (+ element-count 7) -3)
862          (+ 4 (ash element-count 3)))))))
863
864(defparameter *x8632-subprims-shift* 2)
865(defconstant x8632-subprims-base #x15000)
866
867(declaim (special *x8632-subprims*))
868
869(let* ((origin x8632-subprims-base)
870       (step (ash 1 *x8632-subprims-shift*)))
871  (flet ((define-x8632-subprim (name)
872           (ccl::make-subprimitive-info :name (string name)
873                                        :offset (prog1 origin
874                                                  (incf origin step)))))
875    (macrolet ((defx8632subprim (name)
876                 `(define-x8632-subprim ',name)))
877      (defparameter *x8632-subprims*
878        (vector
879         (defx8632subprim .SPjmpsym)
880         (defx8632subprim .SPjmpnfn)
881         (defx8632subprim .SPfuncall)
882         (defx8632subprim .SPmkcatch1v)
883         (defx8632subprim .SPmkunwind)
884         (defx8632subprim .SPmkcatchmv)
885         (defx8632subprim .SPthrow)
886         (defx8632subprim .SPnthrowvalues)
887         (defx8632subprim .SPnthrow1value)
888         (defx8632subprim .SPbind)
889         (defx8632subprim .SPbind-self)
890         (defx8632subprim .SPbind-nil)
891         (defx8632subprim .SPbind-self-boundp-check)
892         (defx8632subprim .SPrplaca)
893         (defx8632subprim .SPrplacd)
894         (defx8632subprim .SPconslist)
895         (defx8632subprim .SPconslist-star)
896         (defx8632subprim .SPstkconslist)
897         (defx8632subprim .SPstkconslist-star)
898         (defx8632subprim .SPmkstackv)
899         (defx8632subprim .SPsubtag-misc-ref)
900         (defx8632subprim .SPsetqsym)
901         (defx8632subprim .SPprogvsave)
902         (defx8632subprim .SPstack-misc-alloc)
903         (defx8632subprim .SPgvector)
904         (defx8632subprim .SPnvalret)
905         (defx8632subprim .SPmvpass)
906         (defx8632subprim .SPrecover-values-for-mvcall)
907         (defx8632subprim .SPnthvalue)
908         (defx8632subprim .SPvalues)
909         (defx8632subprim .SPdefault-optional-args)
910         (defx8632subprim .SPopt-supplied-p)
911         (defx8632subprim .SPheap-rest-arg)
912         (defx8632subprim .SPreq-heap-rest-arg)
913         (defx8632subprim .SPheap-cons-rest-arg)
914         (defx8632subprim .SPsimple-keywords)
915         (defx8632subprim .SPkeyword-args)
916         (defx8632subprim .SPkeyword-bind)
917         (defx8632subprim .SPffcall)
918         (defx8632subprim .SParef2)
919         (defx8632subprim .SPksignalerr)
920         (defx8632subprim .SPstack-rest-arg)
921         (defx8632subprim .SPreq-stack-rest-arg)
922         (defx8632subprim .SPstack-cons-rest-arg)
923         (defx8632subprim .SPpoweropen-callbackX) ;needed on x86?
924         (defx8632subprim .SPcall-closure)
925         (defx8632subprim .SPgetXlong)
926         (defx8632subprim .SPspreadargz)
927         (defx8632subprim .SPtfuncallgen)
928         (defx8632subprim .SPtfuncallslide)
929         (defx8632subprim .SPtfuncallvsp)
930         (defx8632subprim .SPtcallsymgen)
931         (defx8632subprim .SPtcallsymslide)
932         (defx8632subprim .SPtcallsymvsp)
933         (defx8632subprim .SPtcallnfngen)
934         (defx8632subprim .SPtcallnfnslide)
935         (defx8632subprim .SPtcallnfnvsp)
936         (defx8632subprim .SPmisc-ref)
937         (defx8632subprim .SPmisc-set)
938         (defx8632subprim .SPstkconsyz)
939         (defx8632subprim .SPstkvcell0)
940         (defx8632subprim .SPstkvcellvsp)
941         (defx8632subprim .SPmakestackblock)
942         (defx8632subprim .SPmakestackblock0)
943         (defx8632subprim .SPmakestacklist)
944         (defx8632subprim .SPstkgvector)
945         (defx8632subprim .SPmisc-alloc)
946         (defx8632subprim .SPpoweropen-ffcallX) ;needed on x86?
947         (defx8632subprim .SPgvset)
948         (defx8632subprim .SPmacro-bind)
949         (defx8632subprim .SPdestructuring-bind)
950         (defx8632subprim .SPdestructuring-bind-inner)
951         (defx8632subprim .SPrecover-values)
952         (defx8632subprim .SPvpopargregs)
953         (defx8632subprim .SPinteger-sign)
954         (defx8632subprim .SPsubtag-misc-set)
955         (defx8632subprim .SPspread-lexpr-z)
956         (defx8632subprim .SPstore-node-conditional)
957         (defx8632subprim .SPreset)
958         (defx8632subprim .SPmvslide)
959         (defx8632subprim .SPsave-values)
960         (defx8632subprim .SPadd-values)
961         (defx8632subprim .SPcallback)
962         (defx8632subprim .SPmisc-alloc-init)
963         (defx8632subprim .SPstack-misc-alloc-init)
964         (defx8632subprim .SPset-hash-key)
965         (defx8632subprim .SPaset2)
966         (defx8632subprim .SPcallbuiltin)
967         (defx8632subprim .SPcallbuiltin0)
968         (defx8632subprim .SPcallbuiltin1)
969         (defx8632subprim .SPcallbuiltin2)
970         (defx8632subprim .SPcallbuiltin3)
971         (defx8632subprim .SPpopj)
972         (defx8632subprim .SPrestorefullcontext)
973         (defx8632subprim .SPsavecontextvsp)
974         (defx8632subprim .SPsavecontext0)
975         (defx8632subprim .SPrestorecontext)
976         (defx8632subprim .SPlexpr-entry)
977         (defx8632subprim .SPsyscall2)
978         (defx8632subprim .SPbuiltin-plus)
979         (defx8632subprim .SPbuiltin-minus)
980         (defx8632subprim .SPbuiltin-times)
981         (defx8632subprim .SPbuiltin-div)
982         (defx8632subprim .SPbuiltin-eq)
983         (defx8632subprim .SPbuiltin-ne)
984         (defx8632subprim .SPbuiltin-gt)
985         (defx8632subprim .SPbuiltin-ge)
986         (defx8632subprim .SPbuiltin-lt)
987         (defx8632subprim .SPbuiltin-le)
988         (defx8632subprim .SPbuiltin-eql)
989         (defx8632subprim .SPbuiltin-length)
990         (defx8632subprim .SPbuiltin-seqtype)
991         (defx8632subprim .SPbuiltin-assq)
992         (defx8632subprim .SPbuiltin-memq)
993         (defx8632subprim .SPbuiltin-logbitp)
994         (defx8632subprim .SPbuiltin-logior)
995         (defx8632subprim .SPbuiltin-logand)
996         (defx8632subprim .SPbuiltin-ash)
997         (defx8632subprim .SPbuiltin-negate)
998         (defx8632subprim .SPbuiltin-logxor)
999         (defx8632subprim .SPbuiltin-aref1)
1000         (defx8632subprim .SPbuiltin-aset1)
1001         (defx8632subprim .SPbreakpoint)
1002         (defx8632subprim .SPeabi-ff-call)
1003         (defx8632subprim .SPeabi-callback)
1004         (defx8632subprim .SPsyscall)
1005         (defx8632subprim .SPgetu64)
1006         (defx8632subprim .SPgets64)
1007         (defx8632subprim .SPmakeu64)
1008         (defx8632subprim .SPmakes64)
1009         (defx8632subprim .SPspecref)
1010         (defx8632subprim .SPspecset)
1011         (defx8632subprim .SPspecrefcheck)
1012         (defx8632subprim .SPrestoreintlevel)
1013         (defx8632subprim .SPmakes32)
1014         (defx8632subprim .SPmakeu32)
1015         (defx8632subprim .SPgets32)
1016         (defx8632subprim .SPgetu32)
1017         (defx8632subprim .SPfix-overflow)
1018         (defx8632subprim .SPmvpasssym)
1019         (defx8632subprim .SParef3)
1020         (defx8632subprim .SPaset3)
1021         (defx8632subprim .SPffcall-return-registers)
1022         (defx8632subprim .SPaset1)
1023         (defx8632subprim .SPset-hash-key-conditional)
1024         (defx8632subprim .SPunbind-interrupt-level)
1025         (defx8632subprim .SPunbind)
1026         (defx8632subprim .SPunbind-n)
1027         (defx8632subprim .SPunbind-to)
1028         (defx8632subprim .SPbind-interrupt-level-m1)
1029         (defx8632subprim .SPbind-interrupt-level)
1030         (defx8632subprim .SPbind-interrupt-level-0)
1031         (defx8632subprim .SPprogvrestore)
1032         (defx8632subprim .SPnmkunwind)
1033         )))))
1034
1035
1036
1037(defparameter *x8632-target-arch*
1038  (arch::make-target-arch :name :x8632
1039                          :lisp-node-size node-size
1040                          :nil-value canonical-nil-value
1041                          :fixnum-shift fixnumshift
1042                          :most-positive-fixnum target-most-positive-fixnum
1043                          :most-negative-fixnum target-most-negative-fixnum
1044                          :misc-data-offset misc-data-offset
1045                          :misc-dfloat-offset misc-dfloat-offset
1046                          :nbits-in-word nbits-in-word
1047                          :ntagbits ntagbits
1048                          :nlisptagbits nlisptagbits
1049                          :uvector-subtags *x8632-target-uvector-subtags*
1050                          :max-64-bit-constant-index max-64-bit-constant-index
1051                          :max-32-bit-constant-index max-32-bit-constant-index
1052                          :max-16-bit-constant-index max-16-bit-constant-index
1053                          :max-8-bit-constant-index max-8-bit-constant-index
1054                          :max-1-bit-constant-index max-1-bit-constant-index
1055                          :word-shift word-shift
1056                          :code-vector-prefix ()
1057                          :gvector-types '(:ratio :complex :symbol :function
1058                                           :catch-frame :struct :istruct
1059                                           :pool :population :hash-vector
1060                                           :package :value-cell :instance
1061                                           :lock :slot-vector
1062                                           :simple-vector)
1063                          :1-bit-ivector-types '(:bit-vector)
1064                          :8-bit-ivector-types '(:signed-8-bit-vector
1065                                                 :unsigned-8-bit-vector)
1066                          :16-bit-ivector-types '(:signed-16-bit-vector
1067                                                  :unsigned-16-bit-vector)
1068                          :32-bit-ivector-types '(:signed-32-bit-vector
1069                                                  :unsigned-32-bit-vector
1070                                                  :single-float-vector
1071                                                  :fixnum-vector
1072                                                  :single-float
1073                                                  :double-float
1074                                                  :bignum
1075                                                  :simple-string)
1076                          :64-bit-ivector-types '(:double-float-vector)
1077                          :array-type-name-from-ctype-function
1078                          #'x8632-array-type-name-from-ctype
1079                          :package-name "X8632"
1080                          :t-offset t-offset
1081                          :array-data-size-function #'x8632-misc-byte-count
1082                          :numeric-type-name-to-typecode-function
1083                          #'(lambda (type-name)
1084                              (ecase type-name
1085                                (fixnum tag-fixnum)
1086                                (bignum subtag-bignum)
1087                                ((short-float single-float) subtag-single-float)
1088                                ((long-float double-float) subtag-double-float)
1089                                (ratio subtag-ratio)
1090                                (complex subtag-complex)))
1091                          :subprims-base x8632-subprims-base
1092                          :subprims-shift x8632::*x8632-subprims-shift*
1093                          :subprims-table x8632::*x8632-subprims*
1094                          :primitive->subprims `(((0 . 23) . ,(ccl::%subprim-name->offset '.SPbuiltin-plus x8632::*x8632-subprims*)))
1095                          :unbound-marker-value unbound-marker
1096                          :slot-unbound-marker-value slot-unbound-marker
1097                          :fixnum-tag tag-fixnum
1098                          :single-float-tag subtag-single-float
1099                          :single-float-tag-is-subtag t
1100                          :double-float-tag subtag-double-float
1101                          :cons-tag fulltag-cons
1102                          :null-tag fulltag-cons
1103                          :symbol-tag subtag-symbol
1104                          :symbol-tag-is-subtag t
1105                          :function-tag subtag-function
1106                          :function-tag-is-subtag t
1107                          :big-endian nil
1108                          :misc-subtag-offset misc-subtag-offset
1109                          :car-offset cons.car
1110                          :cdr-offset cons.cdr
1111                          :subtag-char subtag-character
1112                          :charcode-shift charcode-shift
1113                          :fulltagmask fulltagmask
1114                          :fulltag-misc fulltag-misc
1115                          :char-code-limit #x110000
1116                          ))
1117
1118;; arch macros
1119
1120(defmacro defx8632archmacro (name lambda-list &body body)
1121  `(arch::defarchmacro :x8632 ,name ,lambda-list ,@body))
1122
1123(defx8632archmacro ccl::%make-sfloat ()
1124  `(ccl::%alloc-misc x8632::single-float.element-count x8632::subtag-single-float))
1125
1126(defx8632archmacro ccl::%make-dfloat ()
1127  `(ccl::%alloc-misc x8632::double-float.element-count x8632::subtag-double-float))
1128
1129(defx8632archmacro ccl::%numerator (x)
1130  `(ccl::%svref ,x x8632::ratio.numer-cell))
1131
1132(defx8632archmacro ccl::%denominator (x)
1133  `(ccl::%svref ,x x8632::ratio.denom-cell))
1134
1135(defx8632archmacro ccl::%realpart (x)
1136  `(ccl::%svref ,x x8632::complex.realpart-cell))
1137                   
1138(defx8632archmacro ccl::%imagpart (x)
1139  `(ccl::%svref ,x x8632::complex.imagpart-cell))
1140
1141;;;
1142(defx8632archmacro ccl::%get-single-float-from-double-ptr (ptr offset)
1143 `(ccl::%double-float->short-float (ccl::%get-double-float ,ptr ,offset)
1144   (ccl::%alloc-misc 1 x8632::subtag-single-float)))
1145
1146(defx8632archmacro ccl::codevec-header-p (word)
1147  (declare (ignore word))
1148  (error "~s makes no sense on :X8632" 'ccl::codevec-header-p))
1149
1150(defx8632archmacro ccl::immediate-p-macro (thing)
1151  (let* ((tag (gensym)))
1152    `(let* ((,tag (ccl::lisptag ,thing)))
1153       (declare (fixnum ,tag))
1154       (or (= ,tag x8632::tag-fixnum)
1155           (= ,tag x8632::tag-imm)))))
1156
1157(defx8632archmacro ccl::hashed-by-identity (thing)
1158  (let* ((typecode (gensym)))
1159    `(let* ((,typecode (ccl::typecode ,thing)))
1160       (declare (fixnum ,typecode))
1161       (or
1162        (= ,typecode x8632::tag-fixnum)
1163        (= ,typecode x8632::tag-imm)
1164        (= ,typecode x8632::subtag-symbol)
1165        (= ,typecode x8632::subtag-instance)))))
1166
1167;;;
1168(defx8632archmacro ccl::%get-kernel-global (name)
1169  `(ccl::%fixnum-ref 0 (+ ,(ccl::target-nil-value)
1170                        ,(%kernel-global
1171                          (if (ccl::quoted-form-p name)
1172                            (cadr name)
1173                            name)))))
1174
1175(defx8632archmacro ccl::%get-kernel-global-ptr (name dest)
1176  `(ccl::%setf-macptr
1177    ,dest
1178    (ccl::%fixnum-ref-macptr 0 (+ ,(ccl::target-nil-value)
1179                                  ,(%kernel-global
1180                                    (if (ccl::quoted-form-p name)
1181                                      (cadr name)
1182                                      name))))))
1183
1184(defx8632archmacro ccl::%target-kernel-global (name)
1185  `(x8632::%kernel-global ,name))
1186
1187(defx8632archmacro ccl::lfun-vector (fun)
1188  fun)
1189
1190(defx8632archmacro ccl::lfun-vector-lfun (lfv)
1191  lfv)
1192
1193(defx8632archmacro ccl::area-code ()
1194  area.code)
1195
1196(defx8632archmacro ccl::area-succ ()
1197  area.succ)
1198
1199(defx8632archmacro ccl::nth-immediate (f i)
1200  `(ccl::%nth-immediate ,f (the fixnum (- (the fixnum ,i) 1))))
1201
1202(defx8632archmacro ccl::set-nth-immediate (f i new)
1203  `(ccl::%set-nth-immediate ,f (the fixnum (- (the fixnum ,i) 1)) ,new))
1204
1205(defx8632archmacro ccl::symptr->symvector (s)
1206  s)
1207
1208(defx8632archmacro ccl::symvector->symptr (s)
1209  s)
1210
1211(defx8632archmacro ccl::function-to-function-vector (f)
1212  f)
1213
1214(defx8632archmacro ccl::function-vector-to-function (v)
1215  v)
1216
1217(defx8632archmacro ccl::with-ffcall-results ((buf) &body body)
1218  ;; Reserve space for eax,edx,st0 only.
1219  (let* ((size (+ (* 2 4) (* 1 8))))
1220    `(ccl::%stack-block ((,buf ,size :clear t))
1221      ,@body)))
1222
1223;;; When found at a tagged return address, the instruction
1224;;; (movl ($ imm32) (% fn))
1225;;; lets the runtime easily map a return address to the containing
1226;;; function.
1227;;;
1228;;; The notation ($ :self) is used in the assembler to mean "a 32-bit
1229;;; immediate whose offset will be remembered in a table at the end of
1230;;; the function object."
1231;;;
1232;;; Before the function is made executable (or when the GC moves the
1233;;; function), these :self immediates are filled in with the actual
1234;;; address of the function.
1235
1236(defconstant recover-fn-opcode-byte #b10111111) ;when %fn is %edi
1237(defconstant recover-fn-address-offset 1)
1238
1239;;; For backtrace: the relative PC of an argument-check trap
1240;;; must be less than or equal to this value.  (Because of
1241;;; the way that we do "anchored" UUOs, it should always be =.)
1242;;; (maybe not = on x8632)
1243(defconstant arg-check-trap-pc-limit 7)
1244
1245(provide "X8632-ARCH")
Note: See TracBrowser for help on using the repository browser.