Ignore:
Timestamp:
May 27, 2005, 8:19:20 PM (14 years ago)
Author:
gb
Message:

Lots of word-size/tagging conditionalization.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/level-0/l0-pred.lisp

    r1558 r1596  
    7070;;; The functions have to exist SOMEWHERE ...
    7171(defun fixnump (x)
    72   (= (the fixnum (lisptag x)) ppc32::tag-fixnum))
     72  (= (the fixnum (lisptag x)) target::tag-fixnum))
    7373
    7474(defun bignump (x)
    75   (= (the fixnum (typecode x)) ppc32::subtag-bignum))
     75  (= (the fixnum (typecode x)) target::subtag-bignum))
    7676
    7777(defun integerp (x)
     
    7979  (let* ((typecode (typecode x)))
    8080    (declare (fixnum typecode))
    81     (or (= typecode ppc32::tag-fixnum)
    82         (= typecode ppc32::subtag-bignum))))
     81    (or (= typecode target::tag-fixnum)
     82        (= typecode target::subtag-bignum))))
    8383
    8484(defun ratiop (x)
    85   (= (the fixnum (typecode x)) ppc32::subtag-ratio))
     85  (= (the fixnum (typecode x)) target::subtag-ratio))
    8686
    8787
     
    9191      (let* ((typecode (typecode x)))
    9292        (declare (fixnum typecode))
     93        #+ppc32-target
    9394        (and (>= typecode ppc32::min-numeric-subtag)
    94              (<= typecode ppc32::max-rational-subtag)))))
    95 
    96 
     95             (<= typecode ppc32::max-rational-subtag))
     96        #+ppc64-target
     97        (cond ((= typecode ppc64::subtag-bignum) t)
     98              ((= typecode ppc64::subtag-ratio) t)))))
    9799
    98100(defun short-float-p (x)
    99   (= (the fixnum (typecode x)) ppc32::subtag-single-float))
     101  (= (the fixnum (typecode x)) target::subtag-single-float))
    100102
    101103
    102104(defun double-float-p (x)
    103   (= (the fixnum (typecode x)) ppc32::subtag-double-float))
     105  (= (the fixnum (typecode x)) target::subtag-double-float))
    104106
    105107(defun floatp (x)
     
    107109  (let* ((typecode (typecode x)))
    108110    (declare (fixnum typecode))
    109     (and (>= typecode ppc32::min-float-subtag)
    110          (<= typecode ppc32::max-float-subtag))))
     111    (or (= typecode target::subtag-single-float)
     112        (= typecode target::subtag-double-float))))
    111113
    112114(defun realp (x)
     
    114116  (let* ((typecode (typecode x)))
    115117    (declare (fixnum typecode))
     118    #+ppc32-target
    116119    (or (= typecode ppc32::tag-fixnum)
    117120        (and (>= typecode ppc32::min-numeric-subtag)
    118              (<= typecode ppc32::max-real-subtag)))))
     121             (<= typecode ppc32::max-real-subtag)))
     122    #+ppc64-target
     123    (cond ((= typecode ppc64::tag-fixnum) t)
     124          ((= typecode ppc64::subtag-single-float) t)
     125          ((= typecode ppc64::subtag-bignum) t)
     126          ((= typecode ppc64::subtag-double-float) t)
     127          ((= typecode ppc64::subtag-ratio) t))))
    119128
    120129(defun complexp (x)
    121130  "Return true if OBJECT is a COMPLEX, and NIL otherwise."
    122   (= (the fixnum (typecode x)) ppc32::subtag-complex))
     131  (= (the fixnum (typecode x)) target::subtag-complex))
    123132
    124133(defun numberp (x)
     
    126135  (let* ((typecode (typecode x)))
    127136    (declare (fixnum typecode))
     137    #+ppc32-target
    128138    (or (= typecode ppc32::tag-fixnum)
    129139        (and (>= typecode ppc32::min-numeric-subtag)
    130              (<= typecode ppc32::max-numeric-subtag)))))
     140             (<= typecode ppc32::max-numeric-subtag)))
     141    #+ppc64-target
     142    (cond ((= typecode ppc64::tag-fixnum) t)
     143          ((= typecode ppc64::subtag-single-float) t)
     144          ((= typecode ppc64::subtag-bignum) t)
     145          ((= typecode ppc64::subtag-double-float) t)
     146          ((= typecode ppc64::subtag-ratio) t)
     147          ((= typecode ppc64::subtag-complex t)))))
    131148
    132149(defun arrayp (x)
    133150  "Return true if OBJECT is an ARRAY, and NIL otherwise."
    134   (>= (the fixnum (typecode x)) ppc32::min-array-subtag))
     151  (>= (the fixnum (typecode x)) target::min-array-subtag))
    135152
    136153(defun vectorp (x)
    137154  "Return true if OBJECT is a VECTOR, and NIL otherwise."
    138   (>= (the fixnum (typecode x)) ppc32::min-vector-subtag))
     155  (>= (the fixnum (typecode x)) target::min-vector-subtag))
    139156
    140157
     
    143160  (let* ((typecode (typecode x)))
    144161    (declare (fixnum typecode))
    145     (if (= typecode ppc32::subtag-vectorH)
    146       (setq typecode (ldb ppc32::arrayH.flags-cell-subtag-byte (the fixnum (%svref x ppc32::arrayH.flags-cell)))))
    147     (= typecode ppc32::subtag-simple-base-string)))
     162    (if (= typecode target::subtag-vectorH)
     163      (setq typecode (ldb target::arrayH.flags-cell-subtag-byte (the fixnum (%svref x target::arrayH.flags-cell)))))
     164    (= typecode target::subtag-simple-base-string)))
    148165
    149166
    150167(defun simple-base-string-p (x)
    151   (= (the fixnum (typecode x)) ppc32::subtag-simple-base-string))
     168  (= (the fixnum (typecode x)) target::subtag-simple-base-string))
    152169
    153170(defun simple-string-p (x)
    154171  "Return true if OBJECT is a SIMPLE-STRING, and NIL otherwise."
    155   (= (the fixnum (typecode x)) ppc32::subtag-simple-base-string))
     172  (= (the fixnum (typecode x)) target::subtag-simple-base-string))
    156173
    157174(defun complex-array-p (x)
    158175  (let* ((typecode (typecode x)))
    159176    (declare (fixnum typecode))
    160     (if (or (= typecode ppc32::subtag-arrayH)
    161             (= typecode ppc32::subtag-vectorH))
     177    (if (or (= typecode target::subtag-arrayH)
     178            (= typecode target::subtag-vectorH))
    162179      (not (%array-header-simple-p x)))))
    163180
     
    169186  (let* ((typecode (typecode thing)))
    170187    (declare (fixnum typecode))
    171     (if (or (= typecode ppc32::subtag-arrayH)
    172             (= typecode ppc32::subtag-vectorH))
     188    (if (or (= typecode target::subtag-arrayH)
     189            (= typecode target::subtag-vectorH))
    173190      (%array-header-simple-p thing)
    174       (> typecode ppc32::subtag-vectorH))))
     191      (> typecode target::subtag-vectorH))))
    175192
    176193(defun macptrp (x)
    177   (= (the fixnum (typecode x)) ppc32::subtag-macptr))
     194  (= (the fixnum (typecode x)) target::subtag-macptr))
    178195
    179196
     
    181198;;; things that it wasn't true of on the 68K.
    182199(defun gvectorp (x)
    183   (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) ppc32::fulltag-nodeheader))
     200  #+ppc32-target
     201  (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) ppc32::fulltag-nodeheader)
     202  #+ppc64-target
     203  (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtag-nodeheader))
     204
    184205
    185206(setf (type-predicate 'gvector) 'gvectorp)
    186207
    187208(defun ivectorp (x)
    188   (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask))
    189      ppc32::fulltag-immheader))
     209  #+ppc32-target
     210    (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask))
     211       ppc32::fulltag-immheader)
     212  #+ppc64-target
     213  (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtag-immheader))
    190214
    191215(setf (type-predicate 'ivector) 'ivectorp)
     
    200224(defun simple-vector-p (x)
    201225  "Return true if OBJECT is a SIMPLE-VECTOR, and NIL otherwise."
    202   (= (the fixnum (typecode x)) ppc32::subtag-simple-vector))
     226  (= (the fixnum (typecode x)) target::subtag-simple-vector))
    203227
    204228(defun base-string-p (thing)
    205229  (let* ((typecode (typecode thing)))
    206230    (declare (fixnum typecode))
    207     (or (= typecode ppc32::subtag-simple-base-string)
    208         (and (= typecode ppc32::subtag-vectorh)
     231    (or (= typecode target::subtag-simple-base-string)
     232        (and (= typecode target::subtag-vectorh)
    209233             (= (the fixnum
    210                   (ldb ppc32::arrayH.flags-cell-subtag-byte (the fixnum (%svref thing ppc32::arrayH.flags-cell))))
    211                 ppc32::subtag-simple-base-string)))))
     234                  (ldb target::arrayH.flags-cell-subtag-byte (the fixnum (%svref thing target::arrayH.flags-cell))))
     235                target::subtag-simple-base-string)))))
    212236
    213237(defun simple-bit-vector-p (form)
    214238  "Return true if OBJECT is a SIMPLE-BIT-VECTOR, and NIL otherwise."
    215   (= (the fixnum (typecode form)) ppc32::subtag-bit-vector))
     239  (= (the fixnum (typecode form)) target::subtag-bit-vector))
    216240
    217241(defun bit-vector-p (thing)
     
    219243  (let* ((typecode (typecode thing)))
    220244    (declare (fixnum typecode))
    221     (or (= typecode ppc32::subtag-bit-vector)
    222         (and (= typecode ppc32::subtag-vectorh)
     245    (or (= typecode target::subtag-bit-vector)
     246        (and (= typecode target::subtag-vectorh)
    223247             (= (the fixnum
    224                   (ldb ppc32::arrayH.flags-cell-subtag-byte (the fixnum (%svref thing ppc32::arrayH.flags-cell))))
    225                 ppc32::subtag-bit-vector)))))
     248                  (ldb target::arrayH.flags-cell-subtag-byte (the fixnum (%svref thing target::arrayH.flags-cell))))
     249                target::subtag-bit-vector)))))
    226250
    227251(defun displaced-array-p (array)
    228252  (if (%array-is-header array)
    229     (do* ((disp (%svref array ppc32::arrayH.displacement-cell)
    230                 (+ disp (the fixnum (%svref target ppc32::arrayH.displacement-cell))))
    231           (target (%svref array ppc32::arrayH.data-vector-cell)
    232                   (%svref target ppc32::arrayH.data-vector-cell)))
     253    (do* ((disp (%svref array target::arrayH.displacement-cell)
     254                (+ disp (the fixnum (%svref target target::arrayH.displacement-cell))))
     255          (target (%svref array target::arrayH.data-vector-cell)
     256                  (%svref target target::arrayH.data-vector-cell)))
    233257         ((not (%array-is-header target))
    234258          (values target disp)))
     
    325349                                 (return))))))))))))
    326350
     351#+ppc32-target
    327352(defparameter *nodeheader-types*
    328353  #(bogus                               ; 0
     
    360385    ))
    361386
     387#+ppc32-target
    362388(defparameter *immheader-types*
    363389  #(bignum                              ; 0
     
    399425
    400426
    401 
     427#+ppc32-target
    402428(defun %type-of (thing)
    403429  (let* ((typecode (typecode thing)))
Note: See TracChangeset for help on using the changeset viewer.