Ignore:
Timestamp:
Jan 3, 2004, 7:50:33 PM (16 years ago)
Author:
gb
Message:

Try to be less ppc32-specific.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/arch.lisp

    r81 r189  
    2121
    2222
    23 (defmacro define-storage-layout (name origin &rest cells)
    24   `(progn
    25      (ccl::defenum (:start ,origin :step 4)
    26        ,@(mapcar #'(lambda (cell) (ccl::form-symbol name "." cell)) cells))
    27      (defconstant ,(ccl::form-symbol name ".SIZE") ,(* (length cells) 4))))
    28  
    29 (defmacro define-lisp-object (name tagname &rest cells)
    30   `(define-storage-layout ,name ,(- (symbol-value tagname)) ,@cells))
    31 
    32 (defmacro define-subtag (name tag subtag)
    33   `(defconstant ,(ccl::form-symbol "SUBTAG-" name) (logior ,tag (ash ,subtag ntagbits))))
    34 
    35 
    36 (defmacro define-imm-subtag (name subtag)
    37   `(define-subtag ,name fulltag-immheader ,subtag))
    38 
    39 (defmacro define-node-subtag (name subtag)
    40   `(define-subtag ,name fulltag-nodeheader ,subtag))
    41 
    42 (defmacro define-fixedsized-object (name  &rest non-header-cells)
    43   `(progn
    44      (define-lisp-object ,name fulltag-misc header ,@non-header-cells)
    45      (ccl::defenum ()
    46        ,@(mapcar #'(lambda (cell) (ccl::form-symbol name "." cell "-CELL")) non-header-cells))
    47      (defconstant ,(ccl::form-symbol name ".ELEMENT-COUNT") ,(length non-header-cells))))
    48 
    49 
    5023
    5124;; PPC-32 stuff and tags.
    5225(eval-when (:compile-toplevel :load-toplevel :execute)
    53 (defconstant nbits-in-word 32)
    54 (defconstant least-significant-bit 31)
    55 (defconstant nbits-in-byte 8)
    56 (defconstant ntagbits 3)                ; But non-header objects only use 2
    57 (defconstant nlisptagbits 2)
    58 (defconstant nfixnumtagbits 2)          ; See ?
    59 (defconstant num-subtag-bits 8)         ; tag part of header is 8 bits wide
    60 (defconstant fixnumshift nfixnumtagbits)
    61 (defconstant fixnum-shift fixnumshift)          ; A pet name for it.
    62 (defconstant fulltagmask (1- (ash 1 ntagbits)))         ; Only needed by GC/very low-level code
    63 (defconstant full-tag-mask fulltagmask)
    64 (defconstant tagmask (1- (ash 1 nlisptagbits)))
    65 (defconstant tag-mask tagmask)
    66 (defconstant fixnummask (1- (ash 1 nfixnumtagbits)))
    67 (defconstant fixnum-mask fixnummask)
    68 (defconstant subtag-mask (1- (ash 1 num-subtag-bits)))
    69 (defconstant ncharcodebits 16)
    70 (defconstant charcode-shift (- nbits-in-word ncharcodebits))
    71 (defconstant word-shift 2)
    72 
    73 
    74 ;; Tags.
    75 ;; There are two-bit tags and three-bit tags.
    76 ;; A FULLTAG is the value of the low three bits of a tagged object.
    77 ;; A TAG is the value of the low two bits of a tagged object.
    78 ;; A TYPECODE is either a TAG or the value of a "tag-misc" object's header-byte.
    79 
    80 ;; There are 4 primary TAG values.  Any object which lisp can "see" can be classified
    81 ;; by its TAG.  (Some headers have FULLTAGS that are congruent modulo 4 with the
    82 ;; TAGS of other objects, but lisp can't "see" headers.)
    83 (ccl::defenum ()
    84   tag-fixnum                            ; All fixnums, whether odd or even
    85   tag-list                              ; Conses and NIL
    86   tag-misc                              ; Heap-consed objects other than lists: vectors, symbols, functions, floats ...
    87   tag-imm                               ; Immediate-objects: characters, UNBOUND, other markers.
    88 )
    89 
    90 ;; And there are 8 FULLTAG values.  Note that NIL has its own FULLTAG (congruent mod 4 to tag-list),
    91 ;; that FULLTAG-MISC is > 4 (so that code-vector entry-points can be branched to, since the low
    92 ;; two bits of the PC are ignored) and that both FULLTAG-MISC and FULLTAG-IMM have header fulltags
    93 ;; that share the same TAG.
    94 ;; Things that walk memory (and the stack) have to be careful to look at the FULLTAG of each
    95 ;; object that they see.
    96 (ccl::defenum ()
    97   fulltag-even-fixnum                   ; I suppose EVENP/ODDP might care; nothing else does.
    98   fulltag-cons                          ; a real (non-null) cons.  Shares TAG with fulltag-nil.
    99   fulltag-nodeheader                    ; Header of heap-allocated object that contains lisp-object pointers
    100   fulltag-imm                           ; a "real" immediate object.  Shares TAG with fulltag-immheader.
    101   fulltag-odd-fixnum                    ;
    102   fulltag-nil                           ; NIL and nothing but.  (Note that there's still a hidden NILSYM.)
    103   fulltag-misc                          ; Pointer "real" tag-misc object.  Shares TAG with fulltag-nodeheader.
    104   fulltag-immheader                     ; Header of heap-allocated object that contains unboxed data.
    105 )
    106 
    107 
    108 
    109 ; Order of CAR and CDR doesn't seem to matter much - there aren't
    110 ; too many tricks to be played with predecrement/preincrement addressing.
    111 ; Keep them in the confusing MCL 3.0 order, to avoid confusion.
    112 (define-lisp-object cons tag-list
    113   cdr
    114   car)
    115 
    116 
    117 (defconstant misc-header-offset (- fulltag-misc))
    118 (defconstant misc-subtag-offset (+ misc-header-offset 3))
    119 (defconstant misc-data-offset (+ misc-header-offset 4))
    120 (defconstant misc-dfloat-offset (+ misc-header-offset 8))
    121 
    122 
    123 
    124 ; T is almost adjacent to NIL: since NIL is a misaligned CONS, it spans
    125 ; two doublewords.  The arithmetic difference between T and NIL is
    126 ; such that the least-significant bit and exactly one other bit is
    127 ; set in the result.
    128 
    129 (defconstant t-offset (+ 8 (- 8 fulltag-nil) fulltag-misc))
    130 (assert (and (logbitp 0 t-offset) (= (logcount t-offset) 2)))
    131 
    132 
    133 ; The order in which various header values are defined is significant in several ways:
    134 ; 1) Numeric subtags precede non-numeric ones; there are further orderings among numeric subtags.
    135 ; 2) All subtags which denote CL arrays are preceded by those that don't,
    136 ;    with a further ordering which requires that (< header-arrayH header-vectorH ,@all-other-CL-vector-types)
    137 ; 3) The element-size of ivectors is determined by the ordering of ivector subtags.
    138 ; 4) All subtags are >= fulltag-immheader .
    139 
    140 
    141 ; Numeric subtags.
    142 (define-imm-subtag bignum 0)
    143 (defconstant min-numeric-subtag subtag-bignum)
    144 (define-node-subtag ratio 1)
    145 (defconstant max-rational-subtag subtag-ratio)
    146 
    147 (define-imm-subtag single-float 1)          ; "SINGLE" float, aka short-float in the new order.
    148 (define-imm-subtag double-float 2)
    149 (defconstant min-float-subtag subtag-single-float)
    150 (defconstant max-float-subtag subtag-double-float)
    151 (defconstant max-real-subtag subtag-double-float)
    152 
    153 (define-node-subtag complex 3)
    154 (defconstant max-numeric-subtag subtag-complex)
    155 
    156 ; CL array types.  There are more immediate types than node types; all CL array subtags must be > than
    157 ; all non-CL-array subtags.  So we start by defining the immediate subtags in decreasing order, starting
    158 ; with that subtag whose element size isn't an integral number of bits and ending with those whose
    159 ; element size - like all non-CL-array fulltag-immheader types - is 32 bits.
    160 (define-imm-subtag bit-vector 31)
    161 (define-imm-subtag double-float-vector 30)
    162 (define-imm-subtag s16-vector 29)
    163 (define-imm-subtag u16-vector 28)
    164 (define-imm-subtag simple-general-string 27)
    165 (defconstant min-16-bit-ivector-subtag subtag-simple-general-string)
    166 (defconstant max-16-bit-ivector-subtag subtag-s16-vector)
    167 (defconstant max-string-subtag subtag-simple-general-string)
    168 
    169 (define-imm-subtag simple-base-string 26)
    170 (define-imm-subtag s8-vector 25)
    171 (define-imm-subtag u8-vector 24)
    172 (defconstant min-8-bit-ivector-subtag subtag-u8-vector)
    173 (defconstant max-8-bit-ivector-subtag subtag-simple-base-string)
    174 (defconstant min-string-subtag subtag-simple-base-string)
    175 
    176 (define-imm-subtag s32-vector 23)
    177 (define-imm-subtag u32-vector 22)
    178 (define-imm-subtag single-float-vector 21)
    179 (defconstant max-32-bit-ivector-subtag subtag-s32-vector)
    180 (defconstant min-cl-ivector-subtag subtag-single-float-vector)
    181 
    182 (define-node-subtag vectorH 21)
    183 (define-node-subtag arrayH 20)
    184 (assert (< subtag-arrayH subtag-vectorH min-cl-ivector-subtag))
    185 (define-node-subtag simple-vector 22)   ; Only one such subtag
    186 (assert (< subtag-arrayH subtag-vectorH subtag-simple-vector))
    187 (defconstant min-vector-subtag subtag-vectorH)
    188 (defconstant min-array-subtag subtag-arrayH)
    189 
    190 ; So, we get the remaining subtags (n: (n > max-numeric-subtag) & (n < min-array-subtag))
    191 ; for various immediate/node object types.
    192 
    193 (define-imm-subtag macptr 3)
    194 (defconstant min-non-numeric-imm-subtag subtag-macptr)
    195 (assert (> min-non-numeric-imm-subtag max-numeric-subtag))
    196 (define-imm-subtag dead-macptr 4)
    197 (define-imm-subtag code-vector 5)
    198 (define-imm-subtag creole-object 6)
    199 (define-imm-subtag xcode-vector 7)  ; code-vector for cross-development
    200 
    201 (defconstant max-non-array-imm-subtag (logior (ash 19 ntagbits) fulltag-immheader))
    202 
    203 (define-node-subtag catch-frame 4)
    204 (defconstant min-non-numeric-node-subtag subtag-catch-frame)
    205 (assert (> min-non-numeric-node-subtag max-numeric-subtag))
    206 (define-node-subtag function 5)
    207 (define-node-subtag lisp-thread 6)
    208 (define-node-subtag symbol 7)
    209 (define-node-subtag lock 8)
    210 (define-node-subtag hash-vector 9)
    211 (define-node-subtag pool 10)
    212 (define-node-subtag weak 11)
    213 (define-node-subtag package 12)
    214 (define-node-subtag slot-vector 13)
    215 (define-node-subtag instance 14)
    216 (define-node-subtag struct 15)
    217 (define-node-subtag istruct 16)
    218 (define-node-subtag value-cell 17)
    219 (define-node-subtag xfunction 18)       ; Function for cross-development
    220 (define-node-subtag svar 19)
    221 (defconstant max-non-array-node-subtag (logior (ash 19 ntagbits) fulltag-nodeheader))
     26
     27
     28
     29
     30
     31
     32
    22233
    22334
    22435; The objects themselves look something like this:
    22536
    226 (define-fixedsized-object ratio
    227   numer
    228   denom)
    229 
    230 (define-fixedsized-object single-float
    231   value)
    232 
    233 (define-fixedsized-object double-float
    234   pad
    235   value
    236   val-low)
    237 
    238 (define-fixedsized-object complex
    239   realpart
    240   imagpart
    241 )
    242 
    243 
    244 ; There are two kinds of macptr; use the length field of the header if you
    245 ; need to distinguish between them
    246 (define-fixedsized-object macptr
    247   address
    248   domain
    249   type
    250 )
    251 
    252 (define-fixedsized-object xmacptr
    253   address
    254   domain
    255   type
    256   flags
    257   link
    258 )
    259 
    260 ; Catch frames go on the tstack; they point to a minimal lisp-frame
    261 ; on the cstack.  (The catch/unwind-protect PC is on the cstack, where
    262 ; the GC expects to find it.)
    263 (define-fixedsized-object catch-frame
    264   catch-tag                             ; #<unbound> -> unwind-protect, else catch
    265   link                                  ; tagged pointer to next older catch frame
    266   mvflag                                ; 0 if single-value, 1 if uwp or multiple-value
    267   csp                                   ; pointer to control stack
    268   db-link                               ; value of dynamic-binding link on thread entry.
    269   save-save7                            ; saved registers
    270   save-save6
    271   save-save5
    272   save-save4
    273   save-save3
    274   save-save2
    275   save-save1
    276   save-save0
    277   xframe                                ; exception-frame link
    278   tsp-segment                           ; mostly padding, for now.
    279 )
    28037
    28138
    28239
    28340 
    284 (define-fixedsized-object lock
    285   _value                                ;finalizable pointer to kernel object
    286   kind                                  ; '0 = recursive-lock, '1 = rwlock
    287   writer                                ;tcr of owning thread or 0
    288   name
    289   )
    290 
    291 (define-fixedsized-object lisp-thread
    292   tcr
    293   name
    294   cs-size
    295   vs-size
    296   ts-size
    297   initial-function.args
    298   interrupt-functions
    299   interrupt-lock
    300   startup-function
    301   state
    302   state-change-lock
    303 )
    304 
    305 (define-fixedsized-object symbol
    306   pname
    307   vcell
    308   fcell
    309   package-plist
    310   flags
    311 )
    312 
    313 
    314 (defconstant nilsym-offset (+ t-offset symbol.size))
    315 
    316 
    317 (define-fixedsized-object vectorH
    318   logsize                               ; fillpointer if it has one, physsize otherwise
    319   physsize                              ; total size of (possibly displaced) data vector
    320   data-vector                           ; object this header describes
    321   displacement                          ; true displacement or 0
    322   flags                                 ; has-fill-pointer,displaced-to,adjustable bits; subtype of underlying simple vector.
    323 )
    324 
    325 (define-lisp-object arrayH fulltag-misc
    326   header                                ; subtag = subtag-arrayH
    327   rank                                  ; NEVER 1
    328   physsize                              ; total size of (possibly displaced) data vector
    329   data-vector                           ; object this header describes
    330   displacement                          ; true displacement or 0 
    331   flags                                 ; has-fill-pointer,displaced-to,adjustable bits; subtype of underlying simple vector.
    332  ;; Dimensions follow
    333 )
    334 
    335 (defconstant arrayH.rank-cell 0)
    336 (defconstant arrayH.physsize-cell 1)
    337 (defconstant arrayH.data-vector-cell 2)
    338 (defconstant arrayH.displacement-cell 3)
    339 (defconstant arrayH.flags-cell 4)
    340 (defconstant arrayH.dim0-cell 5)
    341 
    342 (defconstant arrayH.flags-cell-bits-byte (byte 8 0))
    343 (defconstant arrayH.flags-cell-subtag-byte (byte 8 8))
    344 
    345 
    346 (define-fixedsized-object value-cell
    347   value)
    348 
    349 (define-fixedsized-object svar
    350   symbol
    351   idx)
    352 
    353 ;;; The kernel uses these (rather generically named) structures
    354 ;;; to keep track of various memory regions it (or the lisp) is
    355 ;;; interested in.
    356 ;;; The gc-area record definition in "ccl:interfaces;mcl-records.lisp"
    357 ;;; matches this.
    358 (define-storage-layout area 0
    359   pred                                  ; pointer to preceding area in DLL
    360   succ                                  ; pointer to next area in DLL
    361   low                                   ; low bound on area addresses
    362   high                                  ; high bound on area addresses.
    363   active                                ; low limit on stacks, high limit on heaps
    364   softlimit                             ; overflow bound
    365   hardlimit                             ; another one
    366   code                                  ; an area-code; see below
    367   markbits                              ; bit vector for GC
    368   ndwords                               ; "active" size of dynamic area or stack
    369   older                                 ; in EGC sense
    370   younger                               ; also for EGC
    371   h                                     ; Handle or null pointer
    372   softprot                              ; protected_area structure pointer
    373   hardprot                              ; another one.
    374   owner                                 ; fragment (library) which "owns" the area
    375   refbits                               ; bitvector for intergenerational refernces
    376   threshold                             ; for egc
    377   gc-count                              ; generational gc count.
    378 )
    379 
    380 (define-storage-layout tcr 0
    381   prev                                  ; in doubly-linked list
    382   next                                  ; in doubly-linked list
    383   lisp-fpscr-high
    384   lisp-fpscr-low
    385   db-link                               ; special binding chain head
    386   catch-top                             ; top catch frame
    387   save-vsp                              ; VSP when in foreign code
    388   save-tsp                              ; TSP when in foreign code
    389   cs-area                               ; cstack area pointer
    390   vs-area                               ; vstack area pointer
    391   ts-area                               ; tstack area pointer
    392   cs-limit                              ; cstack overflow limit
    393   total-bytes-allocated-high
    394   total-bytes-allocated-low
    395   interrupt-level                       ; fixnum
    396   interrupt-pending                     ; fixnum
    397   xframe                                ; exception frame linked list
    398   errno-loc                             ; thread-private, maybe
    399   ffi-exception                         ; fpscr bits from ff-call.
    400   osid                                  ; OS thread id
    401   valence                               ; odd when in foreign code
    402   foreign-exception-status
    403   native-thread-info
    404   native-thread-id
    405   last-allocptr
    406   save-allocptr
    407   save-allocbase
    408   reset-completion
    409   activate
    410   suspend-count
    411   suspend-context
    412   pending-exception-context
    413   suspend                               ; semaphore for suspension notify
    414   resume                                ; sempahore for resumption notify
    415   flags                                 ; foreign, being reset, ...
    416   gc-context
    417   suspend-total
    418   suspend-total-on-exception-entry
    419   tlb-limit
    420   tlb-pointer
    421 )
     41
    42242
    42343(defconstant tcr-flag-bit-foreign 0)
    42444(defconstant tcr-flag-bit-awaiting-preset 1)
    42545
    426 (define-storage-layout lockptr 0
    427   avail
    428   owner
    429   count
    430   signal
    431   waiting
    432   malloced-ptr)
    433 
    434 
    435 
    436 (ccl::defenum (:prefix "AREA-")
    437   void                                  ; list header
    438   cstack                                ; a control stack
    439   vstack                                ; a value stack
    440   tstack                                ; (dynamic-extent) temp stack
    441   readonly                              ; readonly section
    442   staticlib                             ; static data in library
    443   static                                ; static data in application
    444   dynamic                               ; dynmaic (heap) data in application
    445 )
    446 
    447 (define-storage-layout protected-area 0
    448   next
    449   start                                 ; first byte (page-aligned) that might be protected
    450   end                                   ; last byte (page-aligned) that could be protected
    451   nprot                                 ; Might be 0
    452   protsize                              ; number of bytes to protect
    453   why)
    454 
    455 ; areas are sorted such that (in the "succ" direction) codes are >=.
    456 ; If you think that you're looking for a stack (instead of a heap), look
    457 ; in the "pred" direction from the all-areas header.
    458 (defconstant max-stack-area-code area-tstack)
    459 (defconstant min-heap-area-code area-readonly)
    460 
    461 (define-subtag unbound fulltag-imm 6)
    462 (defconstant unbound-marker subtag-unbound)
    463 (defconstant undefined unbound-marker)
    464 
    465 (define-subtag character fulltag-imm 9)
    466 (define-subtag vsp-protect fulltag-imm 7)
    467 (define-subtag slot-unbound fulltag-imm 10)
    468 (defconstant slot-unbound-marker subtag-slot-unbound)
    469 (define-subtag illegal fulltag-imm 11)
    470 (defconstant illegal-marker subtag-illegal)
    471 (define-subtag go-tag fulltag-imm 12)
    472 (define-subtag block-tag fulltag-imm 24)
    473 (define-subtag no-thread-local-binding fulltag-imm 30)
     46
     47
     48
     49
     50
     51
     52
     53
     54
    47455)
    47556
Note: See TracChangeset for help on using the changeset viewer.