src/assembly/hppa/array.lisp

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