Changeset 7874


Ignore:
Timestamp:
Dec 11, 2007, 1:05:57 AM (12 years ago)
Author:
rme
Message:

Changes for x8632.

(There are numerous #+(or ppc32-target x8632-target) read-time
conditionals. It might make sense to say #+32-bit-target instead. It
seems unlikely that a port to a new 32 bit target would use a
radically different tagging scheme, but I suppose you never know.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/level-0/l0-pred.lisp

    r7666 r7874  
    9292      (let* ((typecode (typecode x)))
    9393        (declare (fixnum typecode))
    94         #+ppc32-target
    95         (and (>= typecode ppc32::min-numeric-subtag)
    96              (<= typecode ppc32::max-rational-subtag))
     94        #+(or ppc32-target x8632-target)
     95        (and (>= typecode target::min-numeric-subtag)
     96             (<= typecode target::max-rational-subtag))
    9797        #+(or ppc64-target x8664-target)
    9898        (cond ((= typecode target::subtag-bignum) t)
     
    117117  (let* ((typecode (typecode x)))
    118118    (declare (fixnum typecode))
    119     #+ppc32-target
    120     (or (= typecode ppc32::tag-fixnum)
    121         (and (>= typecode ppc32::min-numeric-subtag)
    122              (<= typecode ppc32::max-real-subtag)))
     119    #+(or ppc32-target x8632-target)
     120    (or (= typecode target::tag-fixnum)
     121        (and (>= typecode target::min-numeric-subtag)
     122             (<= typecode target::max-real-subtag)))
    123123    #+ppc64-target
    124124    (if (<= typecode ppc64::subtag-double-float)
     
    146146  (let* ((typecode (typecode x)))
    147147    (declare (fixnum typecode))
    148     #+ppc32-target
    149     (or (= typecode ppc32::tag-fixnum)
    150         (and (>= typecode ppc32::min-numeric-subtag)
    151              (<= typecode ppc32::max-numeric-subtag)))
     148    #+(or ppc32-target x8632-target)
     149    (or (= typecode target::tag-fixnum)
     150        (and (>= typecode target::min-numeric-subtag)
     151             (<= typecode target::max-numeric-subtag)))
    152152    #+ppc64-target
    153153    (if (<= typecode ppc64::subtag-double-float)
     
    225225;;; things that it wasn't true of on the 68K.
    226226(defun gvectorp (x)
    227   #+ppc32-target
    228   (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) ppc32::fulltag-nodeheader)
     227  #+(or ppc32-target x8632-target)
     228  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask)) target::fulltag-nodeheader)
    229229  #+ppc64-target
    230230  (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtag-nodeheader)
     
    240240
    241241(defun ivectorp (x)
    242   #+ppc32-target
    243     (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask))
    244        ppc32::fulltag-immheader)
     242  #+(or ppc32-target x8632-target)
     243  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask))
     244     target::fulltag-immheader)
    245245  #+ppc64-target
    246246  (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtag-immheader)
     
    256256
    257257(defun miscobjp (x)
    258   #+(or ppc32-target x8664-target)
     258  #+(or ppc32-target x8632-target x8664-target)
    259259  (= (the fixnum (lisptag x)) target::tag-misc)
    260260  #+ppc64-target
     
    691691
    692692
     693#+x8632-target
     694(progn
     695(defparameter *nodeheader-types*
     696  #(bogus                               ; 0
     697    ratio                               ; 1
     698    bogus                               ; 2
     699    complex                             ; 3
     700    catch-frame                         ; 4
     701    function                            ; 5
     702    lisp-thread                         ; 6 (basic-stream?)
     703    symbol                              ; 7
     704    lock                                ; 8
     705    hash-table-vector                   ; 9
     706    pool                                ; 10
     707    population                          ; 11 (weak?)
     708    package                             ; 12
     709    slot-vector                         ; 13
     710    standard-instance                   ; 14
     711    structure                           ; 15
     712    internal-structure                  ; 16
     713    value-cell                          ; 17
     714    xfunction                           ; 18
     715    array-header                        ; 19
     716    vector-header                       ; 20
     717    simple-vector                       ; 21
     718    bogus                               ; 22
     719    bogus                               ; 23
     720    bogus                               ; 24
     721    bogus                               ; 25
     722    bogus                               ; 26
     723    bogus                               ; 27
     724    bogus                               ; 28
     725    bogus                               ; 29
     726    bogus                               ; 30
     727    bogus                               ; 31
     728    ))
     729
     730
     731(defparameter *immheader-types*
     732  #(bignum                              ; 0
     733    short-float                         ; 1
     734    double-float                        ; 2
     735    macptr                              ; 3
     736    dead-macptr                         ; 4
     737    code-vector                         ; 5
     738    creole-object                       ; 6
     739    ;; 8-19 are unused
     740    xcode-vector                        ; 7
     741    bogus                               ; 8
     742    bogus                               ; 9
     743    bogus                               ; 10
     744    bogus                               ; 11
     745    bogus                               ; 12
     746    bogus                               ; 13
     747    bogus                               ; 14
     748    bogus                               ; 15
     749    bogus                               ; 16
     750    bogus                               ; 17
     751    bogus                               ; 18
     752    bogus                               ; 19
     753    simple-short-float-vector           ; 20
     754    simple-unsigned-long-vector         ; 21
     755    simple-signed-long-vector           ; 22
     756    simple-fixnum-vector                ; 23
     757    simple-base-string                  ; 24
     758    simple-unsigned-byte-vector         ; 25
     759    simple-signed-byte-vector           ; 26
     760    bogus                               ; 27
     761    simple-unsigned-word-vector         ; 28
     762    simple-signed-word-vector           ; 29
     763    simple-double-float-vector          ; 30
     764    simple-bit-vector                   ; 31
     765    ))
     766
     767(defun %type-of (thing)
     768  (let* ((typecode (typecode thing)))
     769    (declare (fixnum typecode))
     770    (if (= typecode x8632::tag-fixnum)
     771      'fixnum
     772      (if (= typecode x8632::tag-list)  ;a misnomer on x8632...
     773        (if (= typecode x8632::fulltag-cons)
     774          (if thing 'cons 'null)
     775          'tagged-return-address)
     776        (if (= typecode x8632::tag-imm)
     777          (if (base-char-p thing)
     778            'base-char
     779            'immediate)
     780          (if (= typecode x8632::subtag-macptr)
     781            (if (classp thing)
     782              (class-name thing)
     783              'macptr)
     784            (let* ((tag-type (logand typecode x8632::fulltagmask))
     785                   (tag-val (ash typecode (- x8632::ntagbits))))
     786              (declare (fixnum tag-type tag-val))
     787              (if (/= tag-type x8632::fulltag-nodeheader)
     788                (%svref *immheader-types* tag-val)
     789                (let ((type (%svref *nodeheader-types* tag-val)))
     790                  (if (eq type 'function)
     791                    (let ((bits (lfun-bits thing)))
     792                      (declare (fixnum bits))
     793                      (if (logbitp $lfbits-trampoline-bit bits)
     794                        (let ((inner-fn (closure-function thing)))
     795                          (if (neq inner-fn thing)
     796                            (let ((inner-bits (lfun-bits inner-fn)))
     797                              (if (logbitp $lfbits-method-bit inner-bits)
     798                                'compiled-lexical-closure
     799                                (if (logbitp $lfbits-gfn-bit inner-bits)
     800                                  'standard-generic-function ; not precisely - see class-of
     801                                  (if (logbitp  $lfbits-cm-bit inner-bits)
     802                                    'combined-method
     803                                    'compiled-lexical-closure))))
     804                            'compiled-lexical-closure))
     805                        (if (logbitp  $lfbits-method-bit bits)
     806                          'method-function         
     807                          'compiled-function)))
     808                    (if (eq type 'lock)
     809                      (or (uvref thing x8632::lock.kind-cell)
     810                          type)
     811                      type)))))))))))
     812
     813) ;x8632-target
    693814
    694815#+x8664-target
     
    8941015(defun symbolp (thing)
    8951016  "Return true if OBJECT is a SYMBOL, and NIL otherwise."
    896   #+ppc32-target
     1017  #+(or ppc32-target x8632-target)
    8971018  (if thing
    898     (= (the fixnum (typecode thing)) ppc32::subtag-symbol)
     1019    (= (the fixnum (typecode thing)) target::subtag-symbol)
    8991020    t)
    9001021  #+ppc64-target
Note: See TracChangeset for help on using the changeset viewer.