Changeset 15598 for release


Ignore:
Timestamp:
Jan 19, 2013, 3:31:43 AM (6 years ago)
Author:
gb
Message:

propagate r15597 to 1.8. Fix ticket:1054 in 1.8

File:
1 edited

Legend:

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

    r15093 r15598  
    290290    (if (and (>= x-type target::subtag-vectorH)
    291291             (>= y-type target::subtag-vectorH))
    292         (let* ((x-simple (if (= x-type target::subtag-vectorH)
    293                              (ldb target::arrayH.flags-cell-subtag-byte
    294                                   (the fixnum (%svref x target::arrayH.flags-cell)))
    295                              x-type))
    296                (y-simple (if (= y-type target::subtag-vectorH)
    297                              (ldb target::arrayH.flags-cell-subtag-byte
    298                                   (the fixnum (%svref y target::arrayH.flags-cell)))
    299                              y-type)))
    300           (declare (fixnum x-simple y-simple))
    301           (if (= x-simple target::subtag-simple-base-string)
    302               (if (= y-simple target::subtag-simple-base-string)
    303                   (locally
    304                       (declare (optimize (speed 3) (safety 0)))
    305                     (let* ((x-len (if (= x-type target::subtag-vectorH)
    306                                       (%svref x target::vectorH.logsize-cell)
    307                                       (uvsize x)))
    308                            (x-pos 0)
    309                            (y-len (if (= y-type target::subtag-vectorH)
    310                                       (%svref y target::vectorH.logsize-cell)
    311                                       (uvsize y)))
    312                            (y-pos 0))
    313                       (declare (fixnum x-len x-pos y-len y-pos))
    314                       (when (= x-type target::subtag-vectorH)
    315                         (multiple-value-setq (x x-pos) (array-data-and-offset x)))
    316                       (when (= y-type target::subtag-vectorH)
    317                         (multiple-value-setq (y y-pos) (array-data-and-offset y)))
    318                       (%simple-string= x y x-pos y-pos (the fixnum (+ x-pos x-len)) (the fixnum (+ y-pos y-len))))))
    319               ;;Bit-vector case or fail.
    320               (and (= x-simple target::subtag-bit-vector)
    321                    (= y-simple target::subtag-bit-vector)
    322                    (locally
    323                        (declare (optimize (speed 3) (safety 0)))
    324                      (let* ((x-len (if (= x-type target::subtag-vectorH)
    325                                        (%svref x target::vectorH.logsize-cell)
    326                                        (uvsize x)))
    327                             (x-pos 0)
    328                             (y-len (if (= y-type target::subtag-vectorH)
    329                                        (%svref y target::vectorH.logsize-cell)
    330                                        (uvsize y)))
    331                             (y-pos 0))
    332                        (declare (fixnum x-len x-pos y-len y-pos))
    333                        (when (= x-len y-len)
    334                         (when (= x-type target::subtag-vectorH)
    335                            (multiple-value-setq (x x-pos) (array-data-and-offset x)))
    336                         (when (= y-type target::subtag-vectorH)
    337                            (multiple-value-setq (y y-pos) (array-data-and-offset y)))
    338                         (do* ((i 0 (1+ i)))
    339                               ((= i x-len) t)
    340                            (declare (fixnum i))
    341                            (unless (= (the bit (sbit x x-pos)) (the bit (sbit y y-pos)))
    342                              (return))
    343                            (incf x-pos)
    344                            (incf y-pos))))))))
    345         (if (= x-type y-type)
    346             (if (= x-type target::subtag-istruct)
    347                 (and (let* ((structname (istruct-cell-name (%svref x 0))))
    348                        (and (eq structname (istruct-cell-name (%svref y 0)))
    349                             (or (eq structname 'pathname)
    350                                 (eq structname 'logical-pathname)))
    351                        (locally
    352                            (declare (optimize (speed 3) (safety 0)))
    353                          (let* ((x-size (uvsize x))
    354                                 (skip (if (eq structname 'pathname)
    355                                         %physical-pathname-version
    356                                         -1)))
    357                            (declare (fixnum x-size skip))
    358                            (when (= x-size (the fixnum (uvsize y)))
    359                              (if *case-sensitive-filesystem*
    360                                (do* ((i 1 (1+ i)))
    361                                     ((= i x-size) t)
    362                                  (declare (fixnum i))
    363                                  (unless (or (= i skip)
    364                                              (equal (%svref x i) (%svref y i)))
    365                                    (return)))
    366                                                               (do* ((i 1 (1+ i)))
    367                                     ((= i x-size) t)
    368                                  (declare (fixnum i))
    369                                  (unless (or (= i skip)
    370                                              (equalp (%svref x i) (%svref y i)))
    371                                    (return))))))))))))))
     292      (let* ((x-simple (if (= x-type target::subtag-vectorH)
     293                         (ldb target::arrayH.flags-cell-subtag-byte
     294                              (the fixnum (%svref x target::arrayH.flags-cell)))
     295                         x-type))
     296             (y-simple (if (= y-type target::subtag-vectorH)
     297                         (ldb target::arrayH.flags-cell-subtag-byte
     298                              (the fixnum (%svref y target::arrayH.flags-cell)))
     299                         y-type)))
     300        (declare (fixnum x-simple y-simple))
     301        (if (= x-simple target::subtag-simple-base-string)
     302          (if (= y-simple target::subtag-simple-base-string)
     303            (locally
     304                (declare (optimize (speed 3) (safety 0)))
     305              (let* ((x-len (if (= x-type target::subtag-vectorH)
     306                              (%svref x target::vectorH.logsize-cell)
     307                              (uvsize x)))
     308                     (x-pos 0)
     309                     (y-len (if (= y-type target::subtag-vectorH)
     310                              (%svref y target::vectorH.logsize-cell)
     311                              (uvsize y)))
     312                     (y-pos 0))
     313                (declare (fixnum x-len x-pos y-len y-pos))
     314                (when (= x-type target::subtag-vectorH)
     315                  (multiple-value-setq (x x-pos) (array-data-and-offset x)))
     316                (when (= y-type target::subtag-vectorH)
     317                  (multiple-value-setq (y y-pos) (array-data-and-offset y)))
     318                (%simple-string= x y x-pos y-pos (the fixnum (+ x-pos x-len)) (the fixnum (+ y-pos y-len))))))
     319          ;;Bit-vector case or fail.
     320          (and (= x-simple target::subtag-bit-vector)
     321               (= y-simple target::subtag-bit-vector)
     322               (locally
     323                   (declare (optimize (speed 3) (safety 0)))
     324                 (let* ((x-len (if (= x-type target::subtag-vectorH)
     325                                 (%svref x target::vectorH.logsize-cell)
     326                                 (uvsize x)))
     327                        (x-pos 0)
     328                        (y-len (if (= y-type target::subtag-vectorH)
     329                                 (%svref y target::vectorH.logsize-cell)
     330                                 (uvsize y)))
     331                        (y-pos 0))
     332                   (declare (fixnum x-len x-pos y-len y-pos))
     333                   (when (= x-len y-len)
     334                    (when (= x-type target::subtag-vectorH)
     335                       (multiple-value-setq (x x-pos) (array-data-and-offset x)))
     336                    (when (= y-type target::subtag-vectorH)
     337                       (multiple-value-setq (y y-pos) (array-data-and-offset y)))
     338                    (do* ((i 0 (1+ i)))
     339                          ((= i x-len) t)
     340                       (declare (fixnum i))
     341                       (unless (= (the bit (sbit x x-pos)) (the bit (sbit y y-pos)))
     342                         (return))
     343                       (incf x-pos)
     344                       (incf y-pos))))))))
     345      (if (= x-type y-type)
     346        (if (= x-type target::subtag-istruct)
     347          (and (let* ((structname (istruct-cell-name (%svref x 0))))
     348                 (and (eq structname (istruct-cell-name (%svref y 0)))
     349                      (or (eq structname 'pathname)
     350                          (eq structname 'logical-pathname))
     351                      (locally
     352                          (declare (optimize (speed 3) (safety 0)))
     353                        (let* ((x-size (uvsize x))
     354                               (skip (if (eq structname 'pathname)
     355                                       %physical-pathname-version
     356                                       -1)))
     357                          (declare (fixnum x-size skip))
     358                          (when (= x-size (the fixnum (uvsize y)))
     359                            (if *case-sensitive-filesystem*
     360                              (do* ((i 1 (1+ i)))
     361                                   ((= i x-size) t)
     362                                (declare (fixnum i))
     363                                (unless (or (= i skip)
     364                                            (equal (%svref x i) (%svref y i)))
     365                                  (return)))
     366                              (do* ((i 1 (1+ i)))
     367                                   ((= i x-size) t)
     368                                (declare (fixnum i))
     369                                (unless (or (= i skip)
     370                                            (equalp (%svref x i) (%svref y i)))
     371                                  (return)))))))))))))))
    372372
    373373#+(or ppc32-target arm-target)
Note: See TracChangeset for help on using the changeset viewer.