(in-package "SB!VM")

;;;; Hash primitives

;;; FIXME: This looks kludgy bad and wrong.
#+sb-assembling
(defparameter *sxhash-simple-substring-entry* (gen-label))

(define-assembly-routine
    (sxhash-simple-string
     (:translate %sxhash-simple-string)
     (:policy :fast-safe)
     (:result-types positive-fixnum))
    ((:arg string descriptor-reg a0-offset)
     (:res result any-reg a0-offset)

     (:temp length any-reg a1-offset)
     (:temp accum non-descriptor-reg nl0-offset)
     (:temp data non-descriptor-reg nl1-offset)
     (:temp offset non-descriptor-reg nl2-offset))

  (declare (ignore result accum data offset))

  ;; Save the return address.
  (inst b *sxhash-simple-substring-entry*)
  (loadw length string vector-length-slot other-pointer-lowtag))

(define-assembly-routine
    (sxhash-simple-substring
     (:translate %sxhash-simple-substring)
     (:policy :fast-safe)
     (:arg-types * positive-fixnum)
     (:result-types positive-fixnum))

    ((:arg string descriptor-reg a0-offset)
     (:arg length any-reg a1-offset)
     (:res result any-reg a0-offset)

     (:temp accum non-descriptor-reg nl0-offset)
     (:temp data non-descriptor-reg nl1-offset)
     (:temp offset non-descriptor-reg nl2-offset))

  (emit-label *sxhash-simple-substring-entry*)

  (inst li (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) offset)
  (inst b test)
  (move zero-tn accum)

  LOOP
  (inst xor accum data accum)
  (inst shd accum accum 5 accum)

  TEST
  (inst ldwx offset string data)
  (inst addib :>= (fixnumize -4) length loop)
  (inst addi (fixnumize 1) offset offset)

  (inst addi (fixnumize 4) length length)
  (inst comb := zero-tn length done :nullify t)
  (inst sub zero-tn length length)
  (inst sll length 1 length)
  (inst mtctl length :sar)
  (inst shd zero-tn data :variable data)
  (inst xor accum data accum)

  DONE

  (inst sll accum 5 result)
  (inst srl result 3 result))