jak-project/goal_src/jak1/pc/util/hash.gc

;;;;;;;;;;;;;;;;;;;;;;
;; Hashing Functions
;;;;;;;;;;;;;;;;;;;;;;

(defconstant CRC_POLY #x04c11db7)
;; Could predefine this and only allocate memory when init is called
(define *crc-table* (new 'global 'boxed-array uint32 #x100))
(defun crc32-init ()
  "Initialize the CRC32 table"
  (dotimes (i #x100)
    (let ((n (the uint32 (shl i 24))))
      (dotimes (j 8)
        (set! n (if (!= 0 (logand n #x80000000)) (logxor (shl n 1) CRC_POLY) (shl n 1))))
      (set! (-> *crc-table* i) n))
    )
  )

(defun crc32 ((data (pointer uint8)) (size int))
  "Take the CRC32 hash of some data"
  (let ((crc (the uint32 0)))
    (dotimes (i size)
      (set! crc (logxor (-> *crc-table* (shr crc 24)) (logior (shl crc 8) (-> data 0))))
      (&+! data 1))
    crc)
  )

(defmacro murmur-32-scramble (k-in)
  `(let ((k ,k-in))
     (*! k #xcc9e2d51)
     (set! k (logior (shl k 15) (shr k 17)))
     (*! k #x1b873593)
     k)
  )

(defun murmur3-32 ((key (pointer uint8)) (len int) (seed uint))
  "Take the murmur3-32 hash of some data. The seed allows for a different hash set given the same input.
   https://en.wikipedia.org/wiki/MurmurHash#Algorithm"
  (let ((h seed)
        (k (the uint32 0))
        (i (shr len 2)) ;; Initialized to number of remaining 4-byte chunks
        )

    ;; Read each 4-byte chunk
    (while (!= i 0) (1-! i)
      ;; Copy this 4 byte chunk into a 32-bit int
      (logior! k (shl (-> key 3) 24))
      (logior! k (shl (-> key 2) 16))
      (logior! k (shl (-> key 1)  8))
      (logior! k (-> key))

      ;; Move our data forward to the next 4-byte chunk
      (&+! key (the uint (size-of uint32)))

      ;; Scramble and shift
      (logxor! h (murmur-32-scramble k))
      (set! h (logior (shl h 13) (shr h 19)))
      (set! h (+ (* h 5) #xe6546b64))
      )

    ;; Read the rest
    (set! k (the uint32 0))
    (set! i (logand len 3))
    (while (!= i 0)
      (set! k (shl k 8))
      (logior! k (-> key (- i 1)))
      (1-! i)
      )

    ;; Final scramble and shift
    (logxor! h (murmur-32-scramble k))
    (logxor! h len)
    (logxor! h (shr h 16))
    (*! h #x85ebca6b)
    (logxor! h (shr h 13))
    (*! h #xc2b2ae35)
    (logxor! h (shr h 16))
    h)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Hash Table Implementation
;;
;; This is a naive hash table
;; - assumes the key has a data field to hash, would need to add a hash method to types
;; - static size after initialization
;; - no collision resolution; it will overwrite
;; - assumes key size of 8 unless specified to avoid calculating
;; size and 8 works well with murmur3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro hash-truncate (value &key (size 8) &key (seed (the uint 62)))
  "Take the murmur3-32 hash and truncate. Intended to keep the backing array of a hash table small.
   Note that this increases the chance of collision."
  `(logand (murmur3-32 ,value ,size ,seed) #xFF)
  )

(defmacro new-hash-table (&key (type basic) &key (size 66))
  "This is just an alias for a boxed array of the given type with a default type and size"
  `(new 'global 'boxed-array ,type ,size)
  )

(defmacro get-hash (table key &key (key-size 8) &key (seed (the uint 62)))
  `(-> ,table (hash-truncate (-> ,key data) :size ,key-size :seed ,seed))
  )

(defmacro set-hash! (table key &key (key-size 8) &key (seed (the uint 62)) value)
  `(set! (-> ,table (hash-truncate (-> ,key data) :size ,key-size :seed ,seed)) ,value)
  )


;;;;;;;;;;;;;;;;;;
;; Example usage
;;;;;;;;;;;;;;;;;;
;; (let ((table (new-hash-table)))
;;   (set-hash! table "banana" "cat")
;;   (set-hash! table "apple" "dog")

;;   ;; prints "banana: cat, apple: dog"
;;   (format #t "banana: ~S, apple: ~S\n" (get-hash table "banana") (get-hash table "apple"))
;;   )
;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Jump Table Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This is intended to replace (case)
;; when the keys are all integers. It trades
;; memory based on the highest key and in return
;; it avoids all of the branch comparisons
(defmacro defjumptable (table &rest cases)
  "Builds a boxed-array of lambdas at startup where the size is the highest key and the index is the key for use as a jump table.
   Note: The keys must all be integers."
  `(begin
    (let ((highest-value -9999))
      ,@(apply (lambda (case)
                 `(when (>= ,(car case) highest-value)
                    (when (= ,(car case) highest-value)
                      (format #t "[WARNING] Duplicate case in jump-table!\n")
                      )
                    (set! highest-value ,(car case))))
               cases)
      (define ,table (new 'global 'boxed-array function highest-value))
      ,@(apply (lambda (case)
                 `(set! (-> ,table ,(car case)) (lambda (,@(cadr case)) ,@(cddr case))))
               cases))
    )
  )

(defmacro jump-to (table key &key (typespec ()) &rest args)
  "Calls the lambda stored in the jump-table at the given key with the provided arguments"
  `((the (function ,@typespec none) (-> ,table ,key)) ,@args)
  )

;;;;;;;;;;;;;;;;;;
;; Example usage
;;;;;;;;;;;;;;;;;;
;; (defjumptable *test-table*
;;   (0 ((value int))
;;      (format #t "case 0, value ~D\n" value)
;;      )
;;   (1 ((value int))
;;      (format #t "case 1, value: ~D\n" value)
;;      )
;;   )
;;
;; prints "case 1, value: 32"
;; (jump-to *test-table* 1 :typespec (int) 32)
;;;;;;;;;;;;;;;;;;

;; This is intended to improve the performance
;; of large (case) statements of symbols, like
;; might be used in process :event hooks

;; It uses additional memory and must compute
;; the hash, but scales O(1) with the number of cases
;;
;; It is naive and assumes no collisions.
;; If keys collide, it will warn and a
;; different seed should be provided. This
;; could be improved to recompute automatically
;;
;; It assumes a static symbol length of 8 for
;; performance with murmur3 so that it fits within 2 chunks
;; and doesn't have to calculate the symbol length
;;
;; It truncates the hash to 3 bytes to minimize memory use,
;; but this increases the chance of collision
;;
;; In my testing, this starts to outperform (case) when > ~20 cases

(defmacro defjumptablesymb (table &rest cases)
  "Builds a global boxed-array of lambdas at compile time where the size is the highest value provided, and the index is the switch-case key for use as a jump table"
  `(begin
    (let ((highest-value -9999))
      ,@(apply (lambda (case)
                 `(let ((hash (the int (hash-truncate (-> (symbol->string ,(car case)) data))))
                        )
                    (when (>= hash highest-value)
                      (when (= hash highest-value)
                        (format #t "[WARNING] Hash collision generating jump table!\n"))
                      (set! highest-value hash)
                      )
                    )
                 )
               cases)
      (define ,table (new 'global 'boxed-array function highest-value))
      ,@(apply (lambda (case)
                 ;; Converts the symbol to a string by adding the string offset and then
                 `(set! (-> ,table (hash-truncate (-> (symbol->string ,(car case)) data)))
                        (lambda (,@(cadr case)) ,@(cddr case)))
                 )
               cases)
      )
    )
  )

(defmacro jump-to-sym (table key &key (typespec ()) &rest args)
  "Calls the lambda stored in the jump-table at the hash of the given key
   with provided typespec and arguments"
  `((the (function ,@typespec none) (-> ,table (hash-truncate (-> (symbol->string ,key) data)))) ,@args)
  )

;;;;;;;;;;;;;;;;;;
;; Example usage
;;;;;;;;;;;;;;;;;;
;; (defjumptablesymb *test-symbol-table*
;;   ('jump ((value int))
;;      (format #t "jumpin, value ~D\n" value)
;;      )
;;   ('flop ((value int))
;;      (format #t "floppin, value: ~D\n" value)
;;      )
;;   )
;;
;; prints "floppin, value: 32"
;; (jump-to-sym *test-symbol-table* 'flop :typespec (int) 32)
;;;;;;;;;;;;;;;;;;