Ignore:
Timestamp:
May 27, 2014, 8:43:57 PM (5 years ago)
Author:
gb
Message:

First attempt to merge acode-rewrite branch into trunk.

File:
1 edited

Legend:

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

    r15601 r16085  
    126126(defun complexp (x)
    127127  "Return true if OBJECT is a COMPLEX, and NIL otherwise."
    128   (= (the fixnum (typecode x)) target::subtag-complex))
     128  (let* ((code (typecode x)))
     129    (declare (type (unsigned-byte 8) code))
     130    (or
     131     (= code target::subtag-complex)
     132     (= code target::subtag-complex-single-float)
     133     (= code target::subtag-complex-double-float))))
     134
     135(defun complex-single-float-p (x)
     136  (eql (typecode x) target::subtag-complex-single-float))
     137
     138(defun complex-double-float-p (x)
     139  (eql (typecode x) target::subtag-complex-double-float))
    129140
    130141(defun numberp (x)
    131142  "Return true if OBJECT is a NUMBER, and NIL otherwise."
    132   (let* ((typecode (typecode x)))
    133     (declare (fixnum typecode))
    134     (and (< typecode (- target::nbits-in-word target::fixnumshift))
    135          (logbitp (the (integer 0 (#.(- target::nbits-in-word target::fixnumshift)))
    136                     typecode)
    137                   (logior (ash 1 target::tag-fixnum)
    138                           (ash 1 target::subtag-bignum)
    139                           (ash 1 target::subtag-single-float)
    140                           (ash 1 target::subtag-double-float)
    141                           (ash 1 target::subtag-ratio)
    142                           (ash 1 target::subtag-complex))))))
     143  (or (realp x) (complexp x)))
    143144
    144145(defun arrayp (x)
    145146  "Return true if OBJECT is an ARRAY, and NIL otherwise."
    146   (>= (the fixnum (typecode x)) target::min-array-subtag))
     147  (arrayp x))
    147148
    148149(defun vectorp (x)
    149150  "Return true if OBJECT is a VECTOR, and NIL otherwise."
    150   (>= (the fixnum (typecode x)) target::min-vector-subtag))
     151  (vectorp x))
    151152
    152153
     
    184185            (= typecode target::subtag-vectorH))
    185186      (%array-header-simple-p thing)
    186       (> typecode target::subtag-vectorH))))
     187      (or (= typecode target::subtag-simple-vector)
     188          (>= (the (unsigned-byte 8) (ivector-typecode-p typecode))
     189              target::min-cl-ivector-subtag)))))
    187190
    188191(defun macptrp (x)
     
    201204  (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtag-nodeheader)
    202205  #+x8664-target
    203   (let* ((fulltag (logand (the fixnum (typecode x)) x8664::fulltagmask)))
     206  (let* ((fulltag (fulltag x)))
    204207    (declare (fixnum fulltag))
    205     (or (= fulltag x8664::fulltag-nodeheader-0)
    206         (= fulltag x8664::fulltag-nodeheader-1)))
     208    (when (= fulltag x8664::fulltag-misc)
     209      (setq fulltag (logand (the (unsigned-byte 8) (typecode x)) x8664::fulltagmask))
     210      (or (= fulltag x8664::fulltag-nodeheader-0)
     211          (= fulltag x8664::fulltag-nodeheader-1))))
    207212  )
    208213
     
    309314         (y-type (typecode y)))
    310315    (declare (fixnum x-type y-type))
    311     (if (and (>= x-type target::subtag-vectorH)
    312              (>= y-type target::subtag-vectorH))
     316    (if (and (or (>= (the (unsigned-byte 8)
     317                       (gvector-typecode-p x-type))
     318                     target::subtag-vectorH)
     319                 (>= (the (unsigned-byte 8)
     320                       (ivector-typecode-p x-type))
     321                     target::min-cl-ivector-subtag))
     322             (or (>= (the (unsigned-byte 8)
     323                       (gvector-typecode-p y-type))
     324                     target::subtag-vectorH)
     325                 (>= (the (unsigned-byte 8)
     326                       (ivector-typecode-p y-type))
     327                     target::min-cl-ivector-subtag)))
    313328      (let* ((x-simple (if (= x-type target::subtag-vectorH)
    314329                         (ldb target::arrayH.flags-cell-subtag-byte
     
    395410    value-cell                          ; 17
    396411    xfunction                           ; 18
    397     array-header                        ; 19
    398     vector-header                       ; 20
    399     simple-vector                       ; 21
     412    bogus                               ; 19
     413    bogus                               ; 20
     414    bogus                               ; 21
    400415    bogus                               ; 22
    401416    bogus                               ; 23
     
    405420    bogus                               ; 27
    406421    bogus                               ; 28
    407     bogus                               ; 29
    408     bogus                               ; 30
    409     bogus                               ; 31
     422    array-header                        ; 29
     423    vector-header                       ; 30
     424    simple-vector                       ; 31
    410425    ))
    411426
     
    419434    code-vector                         ; 5
    420435    creole-object                       ; 6
    421     ;; 8-19 are unused
     436    ;; some are unused
    422437    xcode-vector                        ; 7
    423     bogus                               ; 8
    424     bogus                               ; 9
     438    (complex single-float)              ; 8
     439    (complex double-float)              ; 9
    425440    bogus                               ; 10
    426441    bogus                               ; 11
     
    432447    bogus                               ; 17
    433448    bogus                               ; 18
    434     bogus                               ; 19
    435     simple-short-float-vector           ; 20
    436     simple-unsigned-long-vector         ; 21
    437     simple-signed-long-vector           ; 22
    438     simple-fixnum-vector                ; 23
    439     simple-base-string                  ; 24
    440     simple-unsigned-byte-vector         ; 25
    441     simple-signed-byte-vector           ; 26
    442     bogus                               ; 27
    443     simple-unsigned-word-vector         ; 28
    444     simple-signed-word-vector           ; 29
    445     simple-double-float-vector          ; 30
     449    simple-short-float-vector           ; 19
     450    simple-unsigned-long-vector         ; 20
     451    simple-signed-long-vector           ; 21
     452    simple-fixnum-vector                ; 22
     453    simple-base-string                  ; 23
     454    simple-unsigned-byte-vector         ; 24
     455    simple-signed-byte-vector           ; 25
     456    simple-unsigned-word-vector         ; 26
     457    simple-signed-word-vector           ; 27
     458    simple-double-float-vector          ; 28
     459    simple-complex-single-float-vector  ; 29
     460    simple-complex-double-float-vector  ; 30
    446461    simple-bit-vector                   ; 31
    447462    ))
     
    514529    bogus
    515530    bogus
    516     bogus
    517     bogus
    518     bogus
    519     bogus
    520     bogus
     531    complex-single-float
     532    bogus
     533    bogus
     534    bogus
     535    complex-double-float
    521536    bogus
    522537    bogus
     
    541556    simple-unsigned-doubleword-vector
    542557    bogus
    543     bogus
     558    simple-complex-double-float-vector
    544559    simple-short-float-vector
    545560    simple-fixnum-vector
     
    551566    bogus
    552567    simple-base-string
    553     bogus
     568    simple-complex-single-float-vector
    554569    bogus
    555570    bogus
     
    694709    value-cell                          ; 17
    695710    xfunction                           ; 18
    696     array-header                        ; 19
    697     vector-header                       ; 20
    698     simple-vector                       ; 21
     711    nil                                 ; 19
     712    nil                                 ; 20
     713    nil                                 ; 21
    699714    bogus                               ; 22
    700715    bogus                               ; 23
     
    704719    bogus                               ; 27
    705720    bogus                               ; 28
    706     bogus                               ; 29
    707     bogus                               ; 30
    708     bogus                               ; 31
     721    array-header                        ; 29
     722    vector-header                       ; 30
     723    simple-vector                       ; 31
    709724    ))
    710725
     
    719734    creole-object                       ; 6
    720735    xcode-vector                        ; 7
    721     bogus                               ; 8
    722     bogus                               ; 9
     736    complex-single-float                ; 8
     737    complex-double-float                ; 9
    723738    bogus                               ; 10
    724739    bogus                               ; 11
     
    730745    bogus                               ; 17
    731746    bogus                               ; 18
    732     bogus                               ; 19
    733     simple-short-float-vector           ; 20
    734     simple-unsigned-long-vector         ; 21
    735     simple-signed-long-vector           ; 22
    736     simple-fixnum-vector                ; 23
    737     simple-base-string                  ; 24
    738     simple-unsigned-byte-vector         ; 25
    739     simple-signed-byte-vector           ; 26
    740     bogus                               ; 27
    741     simple-unsigned-word-vector         ; 28
    742     simple-signed-word-vector           ; 29
    743     simple-double-float-vector          ; 30
     747    simple-short-float-vector           ; 19
     748    simple-unsigned-long-vector         ; 20
     749    simple-signed-long-vector           ; 21
     750    simple-fixnum-vector                ; 22
     751    simple-base-string                  ; 23
     752    simple-unsigned-byte-vector         ; 24
     753    simple-signed-byte-vector           ; 25
     754    simple-unsigned-word-vector         ; 26
     755    simple-signed-word-vector           ; 27
     756    simple-double-float-vector          ; 28
     757    simple-complex-single-float-vector  ; 29
     758    simple-complex-double-float-vector  ; 30
    744759    simple-bit-vector                   ; 31
    745760    ))
     
    843858    bogus
    844859    bogus
    845     bogus
     860    simple-complex-double-float-vector
    846861    simple-signed-word-vector
    847862    simple-unsigned-word-vector
     
    856871    double-float
    857872    xcode-vector
    858     bogus
    859     bogus
     873    complex-single-float
     874    complex-double-float
    860875    bogus
    861876    bogus
     
    881896    bogus
    882897    bogus
    883     bogus
     898    simple-complex-single-float-vector
    884899    simple-fixnum-vector
    885900    simple-signed-doubleword-vector
     
    10451060;;; 1 if by land, 2 if by sea.
    10461061(defun sequence-type (x)
    1047   (unless (>= (the fixnum (typecode x)) target::min-vector-subtag)
    1048     (or (listp x)
    1049         (report-bad-arg x 'sequence))))
     1062  (let* ((typecode (typecode x)))
     1063    (declare (type (unsigned-byte 8) typecode))
     1064    (unless (or (= typecode target::subtag-vectorH)
     1065                (= typecode target::subtag-simple-vector)
     1066                (>= (the (unsigned-byte 8) (ivector-typecode-p typecode))
     1067                    target::min-cl-ivector-subtag))
     1068      (or (listp x)
     1069          (report-bad-arg x 'sequence)))))
    10501070
    10511071(defun uvectorp (x)
Note: See TracChangeset for help on using the changeset viewer.