Changeset 12170


Ignore:
Timestamp:
Jun 1, 2009, 7:44:42 AM (10 years ago)
Author:
gb
Message:

Set the size of Boyer-Moore jump vectors to (1+ the maximum char-code
in the search string) instead of to CHAR-CODE-LIMIT; makes the image
~50MB smaller.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/search1.lisp

    r12143 r12170  
    9696    (funcall expert direction pattern result-search-pattern)))
    9797
    98 ;;;; stuff to allocate and de-allocate simple-vectors search-char-code-limit
    99 ;;;; in length.
    100 
    101 (defvar *spare-search-vectors* ())
     98(defun new-search-vector (vec access-fn)
     99  (let* ((max 0))
     100    (declare (fixnum max))
     101    (dotimes (i (length vec))
     102      (let* ((code (funcall access-fn vec i)))
     103        (when (> code max)
     104          (setq max code))))
     105    (make-array (the fixnum (1+ max)))))
     106
    102107(eval-when (:compile-toplevel :execute)
    103 (defmacro new-search-vector ()
    104   `(if *spare-search-vectors*
    105        (pop *spare-search-vectors*)
    106        (make-array search-char-code-limit)))
    107108
    108109(defmacro dispose-search-vector (vec)
    109   `(push ,vec *spare-search-vectors*))
     110  vec)
    110111); eval-when (:compile-toplevel :execute)
    111112
     
    186187(defmacro sensitive-string-search-macro (string start length pattern patlen
    187188                                                last jumps +/- -/+)
     189  (let* ((jumpslen (gensym))
     190         (charcode (gensym)))
    188191  `(do ((scan (,+/- ,start ,last))
     192        (,jumpslen (length ,jumps))
    189193        (patp ,last))
    190194       (,(if length `(>= scan ,length) '(minusp scan)))
     
    198202        (t
    199203         ;; If mismatch consult jump table to find amount to skip.
    200          (let ((jump (svref ,jumps (search-char-code char))))
     204         (let* ((,charcode (search-char-code char))
     205                (jump (if (< ,charcode ,jumpslen)
     206                        (svref ,jumps ,charcode)
     207                        ,patlen)))
    201208           (declare (fixnum jump))
    202209           (if (> jump (- ,patlen patp))
    203210               (setq scan (,+/- scan jump))
    204211               (setq scan (,+/- scan (- ,patlen patp)))))
    205          (setq patp ,last))))))
     212         (setq patp ,last)))))))
    206213
    207214
     
    216223                                                  folded-string patlen last
    217224                                                  jumps  +/- -/+)
    218   `(do ((scan (,+/- ,start ,last))
    219         (patp ,last))
    220        (,(if length `(>= scan ,length) '(minusp scan)))
    221      (declare (fixnum scan patp))
    222      (let ((hash (search-hash-code (schar ,string scan))))
    223        (declare (fixnum hash))
    224        (cond
    225         ((= hash (the fixnum (svref ,pattern patp)))
    226          (if (zerop patp)
     225  (let* ((jumpslen (gensym)))
     226    `(do ((scan (,+/- ,start ,last))
     227          (,jumpslen (length ,jumps))
     228          (patp ,last))
     229      (,(if length `(>= scan ,length) '(minusp scan)))
     230      (declare (fixnum scan patp))
     231      (let ((hash (search-hash-code (schar ,string scan))))
     232        (declare (fixnum hash))
     233        (cond
     234          ((= hash (the fixnum (svref ,pattern patp)))
     235           (if (zerop patp)
    227236             (if (do ((i ,last (1- i)))
    228237                     (())
     
    232241                     (return nil))
    233242                   (when (zerop i) (return t)))
    234                 (return scan)
    235                 (setq scan (,+/- scan ,patlen)  patp ,last))
     243              (return scan)
     244              (setq scan (,+/- scan ,patlen)  patp ,last))
    236245             (setq scan (,-/+ scan 1)  patp (1- patp))))
    237         (t
    238          ;; If mismatch consult jump table to find amount to skip.
    239          (let ((jump (svref ,jumps hash)))
    240            (declare (fixnum jump))
    241            (if (> jump (- ,patlen patp))
     246          (t
     247           ;; If mismatch consult jump table to find amount to skip.
     248           (let ((jump (if (< hash ,jumpslen)
     249                         (svref ,jumps hash)
     250                         ,patlen)))
     251             (declare (fixnum jump))
     252             (if (> jump (- ,patlen patp))
    242253               (setq scan (,+/- scan jump))
    243254               (setq scan (,+/- scan (- ,patlen patp)))))
    244          (setq patp ,last))))))
     255           (setq patp ,last)))))))
    245256
    246257
     
    366377(defun compute-boyer-moore-jumps (vec access-fun)
    367378  (declare (simple-vector vec))
    368   (let ((jumps (new-search-vector))
     379  (let ((jumps (new-search-vector vec access-fun))
    369380        (len (length vec)))
    370381    (declare (simple-vector jumps))
    371382    (when (zerop len) (editor-error "Zero length search string not allowed."))
    372383    ;; The default jump is the length of the search string.
    373     (dotimes (i search-char-code-limit)
     384    (dotimes (i len)
    374385      (setf (aref jumps i) len))
    375386    ;; For chars in the string the jump is the distance from the end.
Note: See TracChangeset for help on using the changeset viewer.