Changeset 13462


Ignore:
Timestamp:
Feb 25, 2010, 9:30:42 PM (10 years ago)
Author:
gb
Message:

Try to speed up PARSE-[UN]SIGNED-INTEGER: strip leading sign bytes,
predict whether result will be a fixnum or bignum, set bignum contents
directly.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/misc.lisp

    r13459 r13462  
    12451245           (fixnum start end)
    12461246           (optimize (speed 3) (safety 0)))
    1247   (let* ((count (- end start)))
    1248     (declare (fixnum count))
    1249     (cond
    1250       ((and (> count 4) (<= count 8))
    1251        (%stack-block ((buf 8))
    1252          (unless (= count 8) (setf (%%get-unsigned-longlong buf 0) 0))
    1253          (dotimes (i count (%%get-unsigned-longlong buf 0))
    1254            (decf end)
    1255            (setf (%get-unsigned-byte buf
    1256                                      #+little-endian-target i
    1257                                      #+big-endian-target (the fixnum (- 7 i)))
    1258                  (aref vector end)))))
    1259       ((= count 4)
    1260        (%stack-block ((buf 4))
    1261          (dotimes (i count (%get-unsigned-long buf))
    1262            (decf end)
    1263            (setf (%get-unsigned-byte buf
    1264                                      #+little-endian-target i
    1265                                      #+big-endian-target (the fixnum (- 3 i)))
    1266                  (aref vector end)))))
    1267       ((= count 2) (logior (the fixnum (ash (the (unsigned-byte 8) (aref vector start)) 8)) (the (unsigned-byte 8) (aref vector (the fixnum (1+ start))))))
    1268       ((= count 0) 0)
    1269       ((= count 1) (aref vector start))
    1270 
    1271       ((= count 3) (logior (the fixnum (ash (the (unsigned-byte 8) (aref vector start)) 16))
    1272                            (the fixnum (logior (the fixnum (ash (the (unsigned-byte 8) (aref vector (the fixnum (1+ start)))) 8))
    1273                                                (aref vector (the fixnum (+ start 2)))))))
    1274       (t
    1275        (let* ((result 0))
    1276          (do* ((shift (ash (1- count) 8) (- shift 8))
    1277                (i start (1+ i)))
    1278               ((= i end) result)
    1279            (declare (fixnum i shift))
    1280            (setq result (logior result (ash (aref vector i) shift)))))))))
     1247  (let* ((count (- end start))
     1248         (msb 0))
     1249    (declare (fixnum count) ((unsigned-byte 8) msb))
     1250    (or
     1251     (do* ((i start (1+ i)))
     1252          ((>= i end) 0)
     1253       (declare (fixnum i))
     1254       (let* ((b (aref vector i)))
     1255         (declare ((unsigned-byte 8) b))
     1256         (cond ((zerop b) (incf start) (decf count))
     1257               (t (setq msb b) (return)))))
     1258     (cond
     1259       ((or (< count #+64-bit-target 8 #+32-bit-target 4)
     1260            (and (= count #+64-bit-target 8 #+32-bit-target 4)
     1261                 (< msb #+64-bit-target 16 #+32-bit-target 32)))
     1262        ;; Result will be a fixnum.
     1263        (do* ((result 0)
     1264              (shift 0 (+ shift 8))
     1265              (i (1- end) (1- i)))
     1266             ((< i start) result)
     1267          (declare (fixnum result shift i))
     1268          (setq result (logior result (the fixnum (%ilsl shift (aref vector i)))))))
     1269       (t
     1270        ;; Result will be a bignum.  If COUNT is a multiple of 4
     1271        ;; and the most significant bit is set, need to add an
     1272        ;; extra word of zero-extension.
     1273        (let* ((result (allocate-typed-vector :bignum
     1274                                              (if (and (logbitp 7 msb)
     1275                                                       (zerop (the fixnum (logand count 3))))
     1276                                                (the fixnum (1+ (the fixnum (ash count -2))))
     1277                                                (the fixnum (ash (the fixnum (+ count 3)) -2))))))
     1278          (declare ((simple-array (unsigned-byte 8) (*)) result)) ; lie
     1279          (dotimes (i count result)
     1280            (decf end)
     1281            (setf (aref result
     1282                        #+little-endian-target i
     1283                        #+big-endian-target (the fixnum (logxor i 3)))
     1284                  (aref vector end)))))))))
     1285
    12811286 
    12821287;;; Octets between START and N encode an unsigned integer in big-endian
     
    13031308    (if (zerop count)
    13041309      0
    1305       (let* ((sign-byte (aref vector start))
    1306              (negative (logbitp 7 sign-byte)))
     1310      (let* ((sign-byte (aref vector start)))
    13071311        (declare (fixnum sign-byte))
    1308         (if (> sign-byte 127)
    1309           (decf sign-byte 256))
    1310         (cond
    1311           ((and (> count 4) (<= count 8))
    1312            (%stack-block ((buf 8))
    1313              (unless (= 8 count)
    1314                (setf (%%get-signed-longlong buf 0)
    1315                      (if negative -1 0)))
    1316              (dotimes (i count (%%get-signed-longlong buf 0))
    1317                (decf end)
    1318                (setf (%get-unsigned-byte buf
    1319                                          #+little-endian-target i
    1320                                          #+big-endian-target (the fixnum (- 7 i)))
    1321                      (aref vector end)))))
    1322           ((= count 4)
    1323            (%stack-block ((buf 4))
    1324              (dotimes (i count (%get-signed-long buf))
    1325                (decf end)
    1326                (setf (%get-unsigned-byte buf
    1327                                          #+little-endian-target i
    1328                                          #+big-endian-target (the fixnum (- 3 i)))
    1329                      (aref vector end)))))             
    1330           ((= count 1) sign-byte)
    1331           ((= count 2) (logior (the fixnum (ash sign-byte 8))
    1332                                (the (unsigned-byte 8) (aref vector (the fixnum (1+ start))))))
    1333           ((= count 3)
    1334            (logior
    1335             (the fixnum (ash sign-byte 16))
    1336             (the fixnum (logior (the fixnum (ash (the (unsigned-byte 8) (aref vector (the fixnum (1+ start)))) 8))
    1337                                 (the (unsigned-byte 8)
    1338                                   (aref vector (the fixnum (+ start 2))))))))
    1339           (t
    1340            (decf count)
    1341            (incf start)
    1342            (let* ((result (ash sign-byte (ash count 8))))
    1343              (do* ((shift (ash (1- count) 8) (- shift 8))
    1344                    (i start (1+ i)))
    1345                   ((= i end) result)
    1346                (declare (fixnum i shift))
    1347                (setq result (logior result (ash (aref vector i) shift)))))))))))
     1312        (if (< sign-byte 128)
     1313          (%parse-unsigned-integer vector start end)
     1314          (progn
     1315            (decf sign-byte 256)
     1316            (or
     1317             (do* ()
     1318                  ((= count 1) sign-byte)
     1319               (unless (= sign-byte -1)
     1320                 (return))
     1321               (let* ((next (1+ start))
     1322                      (nextb (aref vector next)))
     1323                 (declare (fixnum next nextb))
     1324                 (if (not (logbitp 7 nextb))
     1325                   (return))
     1326                 (setq sign-byte (- nextb 256)
     1327                       start next
     1328                       count (1- count))))
     1329             (cond ((or (< count #+64-bit-target 8 #+32-bit-target 4)
     1330                        (and (= count #+64-bit-target 8 #+32-bit-target 4)
     1331                             (>= sign-byte
     1332                                 #+64-bit-target -16
     1333                                 #+32-bit-target -32)))
     1334                    ;; Result will be a fixnum
     1335                    (do* ((result 0)
     1336                          (shift 0 (+ shift 8))
     1337                          (i (1- end) (1- i)))
     1338                         ((= i start) (logior result (the fixnum (%ilsl shift sign-byte))))
     1339                      (declare (fixnum result shift i))
     1340                      (setq result (logior result (the fixnum (%ilsl shift (aref vector i)))))))
     1341                   (t
     1342                    (let* ((result (allocate-typed-vector :bignum (the fixnum (ash (the fixnum (+ count 3)) -2)))))
     1343          (declare ((simple-array (unsigned-byte 8) (*)) result)) ; lie
     1344          (dotimes (i count (do* ((i count (1+ i)))
     1345                                 ((= 0 (the fixnum (logand i 3)))
     1346                                  result)
     1347                              (declare (fixnum i))
     1348                              (setf (aref result
     1349                                          #+little-endian-target i
     1350                                          #+big-endian-target (the fixnum (logxor i 3))) #xff)))
     1351            (decf end)
     1352            (setf (aref result
     1353                        #+little-endian-target i
     1354                        #+big-endian-target (the fixnum (logxor i 3)))
     1355                  (aref vector end)))))))))))))
    13481356
    13491357(defun parse-signed-integer (vector &optional (start 0) end)
Note: See TracChangeset for help on using the changeset viewer.