src/assembly/ppc/array.lisp

   1 (in-package "SB!VM")
   2
   3
   4 (define-assembly-routine (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 pa-flag non-descriptor-reg nl3-offset)
  17                           (:temp vector descriptor-reg a3-offset))
  18   (pseudo-atomic (pa-flag)
  19     (inst ori vector alloc-tn sb!vm:other-pointer-lowtag)
  20     (inst addi ndescr words (* (1+ sb!vm:vector-data-offset) sb!vm:n-word-bytes))
  21     (inst clrrwi ndescr ndescr n-lowtag-bits)
  22     (inst add alloc-tn alloc-tn ndescr)
  23     (inst srwi ndescr type sb!vm:word-shift)
  24     (storew ndescr vector 0 sb!vm:other-pointer-lowtag)
  25     (storew length vector sb!vm:vector-length-slot sb!vm:other-pointer-lowtag))
  26   (move result vector))
  27
  28
  29 \f
  30 ;;;; Hash primitives
  31
  32 #+sb-assembling
  33 (defparameter sxhash-simple-substring-entry (gen-label))
  34
  35 (define-assembly-routine (sxhash-simple-string
  36                           (:translate %sxhash-simple-string)
  37                           (:policy :fast-safe)
  38                           (:result-types positive-fixnum))
  39                          ((:arg string descriptor-reg a0-offset)
  40                           (:res result any-reg a0-offset)
  41
  42                           (:temp length any-reg a1-offset)
  43                           (:temp accum non-descriptor-reg nl0-offset)
  44                           (:temp data non-descriptor-reg nl1-offset)
  45                           (:temp temp non-descriptor-reg nl2-offset)
  46                           (:temp offset non-descriptor-reg nl3-offset))
  47
  48   (declare (ignore result accum data temp offset))
  49
  50   (loadw length string sb!vm:vector-length-slot sb!vm:other-pointer-lowtag)
  51   (inst b sxhash-simple-substring-entry))
  52
  53
  54 (define-assembly-routine (sxhash-simple-substring
  55                           (:translate %sxhash-simple-substring)
  56                           (:policy :fast-safe)
  57                           (:arg-types * positive-fixnum)
  58                           (:result-types positive-fixnum))
  59                          ((:arg string descriptor-reg a0-offset)
  60                           (:arg length any-reg a1-offset)
  61                           (:res result any-reg a0-offset)
  62
  63                           (:temp accum non-descriptor-reg nl0-offset)
  64                           (:temp data non-descriptor-reg nl1-offset)
  65                           (:temp temp non-descriptor-reg nl2-offset)
  66                           (:temp offset non-descriptor-reg nl3-offset))
  67   (emit-label sxhash-simple-substring-entry)
  68
  69   (inst li offset (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
  70   (move accum zero-tn)
  71   (inst b test)
  72
  73   LOOP
  74
  75   (inst xor accum accum data)
  76   (inst slwi temp accum 27)
  77   (inst srwi accum accum 5)
  78   (inst or accum accum temp)
  79   (inst addi offset offset 4)
  80
  81   TEST
  82
  83   (inst subic. length length (fixnumize 4))
  84   (inst lwzx data string offset)
  85   (inst bge loop)
  86
  87   (inst addic. length length (fixnumize 4))
  88   (inst neg length length)
  89   (inst beq done)
  90   (inst slwi length length 1)
  91   (inst srw data data length)
  92   (inst xor accum accum data)
  93
  94   DONE
  95
  96   (inst slwi result accum 5)
  97   (inst srwi result result 3))