src/assembly/hppa/array.lisp

   1 (in-package "SB!VM")
   2
   3 ;;;; Hash primitives
   4
   5 ;;; FIXME: This looks kludgy bad and wrong.
   6 #+sb-assembling
   7 (defparameter *sxhash-simple-substring-entry* (gen-label))
   8
   9 (define-assembly-routine
  10     (sxhash-simple-string
  11      (:translate %sxhash-simple-string)
  12      (:policy :fast-safe)
  13      (:result-types positive-fixnum))
  14     ((:arg string descriptor-reg a0-offset)
  15      (:res result any-reg a0-offset)
  16
  17      (:temp length any-reg a1-offset)
  18      (:temp accum non-descriptor-reg nl0-offset)
  19      (:temp data non-descriptor-reg nl1-offset)
  20      (:temp offset non-descriptor-reg nl2-offset))
  21
  22   (declare (ignore result accum data offset))
  23
  24   ;; Save the return address.
  25   (inst b *sxhash-simple-substring-entry*)
  26   (loadw length string vector-length-slot other-pointer-lowtag))
  27
  28 (define-assembly-routine
  29     (sxhash-simple-substring
  30      (:translate %sxhash-simple-substring)
  31      (:policy :fast-safe)
  32      (:arg-types * positive-fixnum)
  33      (:result-types positive-fixnum))
  34
  35     ((:arg string descriptor-reg a0-offset)
  36      (:arg length any-reg a1-offset)
  37      (:res result any-reg a0-offset)
  38
  39      (:temp accum non-descriptor-reg nl0-offset)
  40      (:temp data non-descriptor-reg nl1-offset)
  41      (:temp offset non-descriptor-reg nl2-offset))
  42
  43   (emit-label *sxhash-simple-substring-entry*)
  44
  45   (inst li (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) offset)
  46   (inst b test)
  47   (move zero-tn accum)
  48
  49   LOOP
  50   (inst xor accum data accum)
  51   (inst shd accum accum 5 accum)
  52
  53   TEST
  54   (inst ldwx offset string data)
  55   (inst addib :>= (fixnumize -4) length loop)
  56   (inst addi (fixnumize 1) offset offset)
  57
  58   (inst addi (fixnumize 4) length length)
  59   (inst comb := zero-tn length done :nullify t)
  60   (inst sub zero-tn length length)
  61   (inst sll length 1 length)
  62   (inst mtctl length :sar)
  63   (inst shd zero-tn data :variable data)
  64   (inst xor accum data accum)
  65
  66   DONE
  67
  68   (inst sll accum 5 result)
  69   (inst srl result 3 result))