Ignore:
Timestamp:
Aug 5, 2010, 7:33:28 AM (9 years ago)
Author:
gb
Message:

Changes from ARM branch. Need testing ...

File:
1 edited

Legend:

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

    r13067 r14119  
    9090      (let* ((typecode (typecode x)))
    9191        (declare (fixnum typecode))
    92         #+(or ppc32-target x8632-target)
     92        #+(or ppc32-target x8632-target arm-target)
    9393        (and (>= typecode target::min-numeric-subtag)
    9494             (<= typecode target::max-rational-subtag))
     
    115115  (let* ((typecode (typecode x)))
    116116    (declare (fixnum typecode))
    117     #+(or ppc32-target x8632-target)
    118     (or (= typecode target::tag-fixnum)
    119         (and (>= typecode target::min-numeric-subtag)
    120              (<= typecode target::max-real-subtag)))
    121     #+ppc64-target
    122     (if (<= typecode ppc64::subtag-double-float)
    123       (logbitp (the (integer 0 #.ppc64::subtag-double-float) typecode)
    124                (logior (ash 1 ppc64::tag-fixnum)
    125                        (ash 1 ppc64::subtag-single-float)
    126                        (ash 1 ppc64::subtag-double-float)
    127                        (ash 1 ppc64::subtag-bignum)
    128                        (ash 1 ppc64::subtag-ratio))))
    129     #+x8664-target
    130     (if (<= typecode x8664::subtag-double-float)
    131       (logbitp (the (integer 0 #.x8664::subtag-double-float) typecode)
    132                (logior (ash 1 x8664::tag-fixnum)
    133                        (ash 1 x8664::subtag-bignum)
    134                        (ash 1 x8664::tag-single-float)
    135                        (ash 1 x8664::subtag-double-float)
    136                        (ash 1 x8664::subtag-ratio))))))
     117    (and (<= typecode target::max-real-subtag)
     118         (logbitp (the (integer 0 #.target::max-real-subtag)
     119                    typecode)
     120                  (logior (ash 1 target::tag-fixnum)
     121                          (ash 1 target::subtag-single-float)
     122                          (ash 1 target::subtag-double-float)
     123                          (ash 1 target::subtag-bignum)
     124                          (ash 1 target::subtag-ratio))))))
     125
    137126
    138127(defun complexp (x)
     
    144133  (let* ((typecode (typecode x)))
    145134    (declare (fixnum typecode))
    146     #+(or ppc32-target x8632-target)
    147     (or (= typecode target::tag-fixnum)
    148         (and (>= typecode target::min-numeric-subtag)
    149              (<= typecode target::max-numeric-subtag)))
    150     #+ppc64-target
    151     (if (<= typecode ppc64::subtag-double-float)
    152       (logbitp (the (integer 0 #.ppc64::subtag-double-float) typecode)
    153                (logior (ash 1 ppc64::tag-fixnum)
    154                        (ash 1 ppc64::subtag-bignum)
    155                        (ash 1 ppc64::subtag-single-float)
    156                        (ash 1 ppc64::subtag-double-float)
    157                        (ash 1 ppc64::subtag-ratio)
    158                        (ash 1 ppc64::subtag-complex))))
    159     #+x8664-target
    160     (if (< typecode x8664::nbits-in-word)
    161       (logbitp (the (integer 0 #.x8664::subtag-double-float) typecode)
    162                (logior (ash 1 x8664::tag-fixnum)
    163                        (ash 1 x8664::subtag-bignum)
    164                        (ash 1 x8664::tag-single-float)
    165                        (ash 1 x8664::subtag-double-float)
    166                        (ash 1 x8664::subtag-ratio)
    167                        (ash 1 x8664::subtag-complex))))
    168    
    169     ))
     135    (and (<= typecode target::max-numeric-subtag)
     136         (logbitp (the (integer 0 #.target::max-numeric-subtag)
     137                    typecode)
     138                  (logior (ash 1 target::tag-fixnum)
     139                          (ash 1 target::subtag-bignum)
     140                          (ash 1 target::subtag-single-float)
     141                          (ash 1 target::subtag-double-float)
     142                          (ash 1 target::subtag-ratio)
     143                          (ash 1 target::subtag-complex))))))
    170144
    171145(defun arrayp (x)
     
    223197;;; things that it wasn't true of on the 68K.
    224198(defun gvectorp (x)
    225   #+(or ppc32-target x8632-target)
     199  #+(or ppc32-target x8632-target arm-target)
    226200  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask)) target::fulltag-nodeheader)
    227201  #+ppc64-target
     
    238212
    239213(defun ivectorp (x)
    240   #+(or ppc32-target x8632-target)
     214  #+(or ppc32-target x8632-target arm-target)
    241215  (= (the fixnum (logand (the fixnum (typecode x)) target::fulltagmask))
    242216     target::fulltag-immheader)
     
    254228
    255229(defun miscobjp (x)
    256   #+(or ppc32-target x8632-target x8664-target)
     230  #+(or ppc32-target x8632-target x8664-target arm-target)
    257231  (= (the fixnum (lisptag x)) target::tag-misc)
    258232  #+ppc64-target
     
    398372                                   (return))))))))))))))
    399373
    400 #+ppc32-target
     374#+(or ppc32-target arm-target)
    401375(progn
    402376(defparameter *nodeheader-types*
     
    475449  (let* ((typecode (typecode thing)))
    476450    (declare (fixnum typecode))
    477     (if (= typecode ppc32::tag-fixnum)
     451    (if (= typecode target::tag-fixnum)
    478452      'fixnum
    479       (if (= typecode ppc32::tag-list)
     453      (if (= typecode target::tag-list)
    480454        (if thing 'cons 'null)
    481         (if (= typecode ppc32::tag-imm)
     455        (if (= typecode target::tag-imm)
    482456          (if (base-char-p thing)
    483457            'base-char
    484458            'immediate)
    485           (if (= typecode ppc32::subtag-macptr)
     459          (if (= typecode target::subtag-macptr)
    486460            (if (classp thing)
    487461              (class-name thing)
    488462              'macptr)
    489             (let* ((tag-type (logand typecode ppc32::full-tag-mask))
    490                    (tag-val (ash typecode (- ppc32::ntagbits))))
     463            (let* ((tag-type (logand typecode target::full-tag-mask))
     464                   (tag-val (ash typecode (- target::ntagbits))))
    491465              (declare (fixnum tag-type tag-val))
    492               (if (/= tag-type ppc32::fulltag-nodeheader)
     466              (if (/= tag-type target::fulltag-nodeheader)
    493467                (%svref *immheader-types* tag-val)
    494468                (let ((type (%svref *nodeheader-types* tag-val)))
     
    512486                          'compiled-function)))
    513487                    (if (eq type 'lock)
    514                       (or (uvref thing ppc32::lock.kind-cell)
     488                      (or (uvref thing target::lock.kind-cell)
    515489                          type)
    516490                      type)))))))))))
    517491
    518 );#+ppc32-target
     492);#+(or ppc32-target arm-target)
    519493
    520494#+ppc64-target
     
    1014988(defun structure-typep (thing type)
    1015989  (if (= (the fixnum (typecode thing)) target::subtag-struct)
    1016     (let* ((types (%svref thing 0)))
    1017       (if (typep type 'symbol)
    1018         (dolist (x types)
    1019           (when (eq (class-cell-name x) type)
    1020             (return t)))
    1021         (dolist (x types)
    1022           (when (eq x type)
    1023             (return t)))))))
     990    (dolist (x (%svref thing 0))
     991      (when (eq x type)
     992        (return t)))))
    1024993
    1025994
     
    10531022(defun symbolp (thing)
    10541023  "Return true if OBJECT is a SYMBOL, and NIL otherwise."
    1055   #+(or ppc32-target x8632-target)
     1024  #+(or ppc32-target x8632-target arm-target)
    10561025  (if thing
    10571026    (= (the fixnum (typecode thing)) target::subtag-symbol)
Note: See TracChangeset for help on using the changeset viewer.