LINUX.ORG.RU

История изменений

Исправление den73, (текущая версия) :

Так сделано в SBCL 1.4.2:

(defun %sxhash-substring (string &optional (count (length string)))
  (declare (optimize (speed 3) (safety 0)))
  (declare (type string string))
  (declare (type index count))
  (macrolet ((set-result (form)
               `(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form))))
    (let ((result 0))
      (declare (type (unsigned-byte #.sb!vm:n-word-bits) result))
      (unless (typep string '(vector nil))
        (dotimes (i count)
          (declare (type index i))
          (set-result (+ result (char-code (aref string i))))
          (set-result (+ result (ash result 10)))
          (set-result (logxor result (ash result -6)))))
      (set-result (+ result (ash result 3)))
      (set-result (logxor result (ash result -11)))
      (set-result (logxor result (ash result 15)))
      (logand result most-positive-fixnum))))
;;; test:
;;;   (let ((ht (make-hash-table :test 'equal)))
;;;     (do-all-symbols (symbol)
;;;       (let* ((string (symbol-name symbol))
;;;           (hash (%sxhash-substring string)))
;;;      (if (gethash hash ht)
;;;          (unless (string= (gethash hash ht) string)
;;;            (format t "collision: ~S ~S~%" string (gethash hash ht)))
;;;          (setf (gethash hash ht) string))))
;;;     (format t "final count=~W~%" (hash-table-count ht)))

Но в Активном Обероне нет LOGXOR.

Исходная версия den73, :

Так сделано в SBCL 1.4.2:

(defun %sxhash-substring (string &optional (count (length string)))
  (declare (optimize (speed 3) (safety 0)))
  (declare (type string string))
  (declare (type index count))
  (macrolet ((set-result (form)
               `(setf result (ldb (byte #.sb!vm:n-word-bits 0) ,form))))
    (let ((result 0))
      (declare (type (unsigned-byte #.sb!vm:n-word-bits) result))
      (unless (typep string '(vector nil))
        (dotimes (i count)
          (declare (type index i))
          (set-result (+ result (char-code (aref string i))))
          (set-result (+ result (ash result 10)))
          (set-result (logxor result (ash result -6)))))
      (set-result (+ result (ash result 3)))
      (set-result (logxor result (ash result -11)))
      (set-result (logxor result (ash result 15)))
      (logand result most-positive-fixnum))))
;;; test:
;;;   (let ((ht (make-hash-table :test 'equal)))
;;;     (do-all-symbols (symbol)
;;;       (let* ((string (symbol-name symbol))
;;;           (hash (%sxhash-substring string)))
;;;      (if (gethash hash ht)
;;;          (unless (string= (gethash hash ht) string)
;;;            (format t "collision: ~S ~S~%" string (gethash hash ht)))
;;;          (setf (gethash hash ht) string))))
;;;     (format t "final count=~W~%" (hash-table-count ht)))