src/assembly/mips/array.lisp

   1 (in-package "SB!VM")
   2
   3 (define-assembly-routine (allocate-vector
   4                           (:policy :fast-safe)
   5                           (:translate allocate-vector)
   6                           (:arg-types positive-fixnum
   7                                       positive-fixnum
   8                                       positive-fixnum))
   9                          ((:arg type any-reg a0-offset)
  10                           (:arg length any-reg a1-offset)
  11                           (:arg words any-reg a2-offset)
  12                           (:res result descriptor-reg a0-offset)
  13
  14                           (:temp ndescr non-descriptor-reg nl0-offset)
  15                           (:temp pa-flag non-descriptor-reg nl4-offset))
  16   ;; This is kinda sleezy, changing words like this.  But we can because
  17   ;; the vop thinks it is temporary.
  18   (inst addu words (+ (1- (ash 1 n-lowtag-bits))
  19                       (* vector-data-offset n-word-bytes)))
  20   (inst li ndescr (lognot lowtag-mask))
  21   (inst and words ndescr)
  22   (inst srl ndescr type word-shift)
  23
  24   (pseudo-atomic (pa-flag)
  25     (inst or result alloc-tn other-pointer-lowtag)
  26     (inst addu alloc-tn words)
  27     (storew ndescr result 0 other-pointer-lowtag)
  28     (storew length result vector-length-slot other-pointer-lowtag)))
  29
  30 \f
  31 ;;;; Hash primitives
  32
  33 (define-assembly-routine (sxhash-simple-string
  34                           (:translate %sxhash-simple-string)
  35                           (:policy :fast-safe)
  36                           (:result-types positive-fixnum))
  37                          ((:arg string descriptor-reg a0-offset)
  38                           (:res result any-reg a0-offset)
  39
  40                           (:temp length any-reg a1-offset)
  41
  42                           (:temp lip interior-reg lip-offset)
  43                           (:temp accum non-descriptor-reg nl0-offset)
  44                           (:temp data non-descriptor-reg nl1-offset)
  45                           (:temp byte non-descriptor-reg nl2-offset)
  46                           (:temp retaddr non-descriptor-reg nl3-offset))
  47
  48   ;; These are needed after we jump into sxhash-simple-substring.
  49   ;;
  50   ;; FIXME: *BOGGLE* -- CSR, 2002-08-22
  51   (progn result lip accum data byte retaddr)
  52
  53   (inst j (make-fixup 'sxhash-simple-substring :assembly-routine))
  54   (loadw length string vector-length-slot other-pointer-lowtag))
  55
  56 (define-assembly-routine (sxhash-simple-substring
  57                           (:translate %sxhash-simple-substring)
  58                           (:policy :fast-safe)
  59                           (:arg-types * positive-fixnum)
  60                           (:result-types positive-fixnum))
  61                          ((:arg string descriptor-reg a0-offset)
  62                           (:arg length any-reg a1-offset)
  63                           (:res result any-reg a0-offset)
  64
  65                           (:temp lip interior-reg lip-offset)
  66                           (:temp accum non-descriptor-reg nl0-offset)
  67                           (:temp data non-descriptor-reg nl1-offset)
  68                           (:temp byte non-descriptor-reg nl2-offset)
  69                           (:temp retaddr non-descriptor-reg nl3-offset))
  70
  71   ;; Save the return address
  72   (inst subu retaddr lip code-tn)
  73
  74   ;; Get a pointer to the data.
  75   (inst addu lip string
  76         (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
  77   (inst b test)
  78   (move accum zero-tn)
  79
  80   loop
  81
  82   (inst and byte data #xff)
  83   (inst xor accum accum byte)
  84   (inst sll byte accum 5)
  85   (inst srl accum accum 27)
  86   (inst or accum accum byte)
  87
  88   (inst srl byte data 8)
  89   (inst and byte byte #xff)
  90   (inst xor accum accum byte)
  91   (inst sll byte accum 5)
  92   (inst srl accum accum 27)
  93   (inst or accum accum byte)
  94
  95   (inst srl byte data 16)
  96   (inst and byte byte #xff)
  97   (inst xor accum accum byte)
  98   (inst sll byte accum 5)
  99   (inst srl accum accum 27)
 100   (inst or accum accum byte)
 101
 102   (inst srl byte data 24)
 103   (inst xor accum accum byte)
 104   (inst sll byte accum 5)
 105   (inst srl accum accum 27)
 106   (inst or accum accum byte)
 107
 108   (inst addu lip lip 4)
 109
 110   test
 111
 112   (inst addu length length (fixnumize -4))
 113   (inst lw data lip 0)
 114   (inst bgez length loop)
 115   (inst nop)
 116
 117   (inst addu length length (fixnumize 3))
 118   (inst beq length zero-tn one-more)
 119   (inst addu length length (fixnumize -1))
 120   (inst beq length zero-tn two-more)
 121   (inst addu length length (fixnumize -1))
 122   (inst bne length zero-tn done)
 123   (inst nop)
 124
 125   (ecase *backend-byte-order*
 126     (:big-endian (inst srl byte data 8))
 127     (:little-endian (inst srl byte data 16)))
 128   (inst and byte byte #xff)
 129   (inst xor accum accum byte)
 130   (inst sll byte accum 5)
 131   (inst srl accum accum 27)
 132   (inst or accum accum byte)
 133
 134   two-more
 135
 136   (ecase *backend-byte-order*
 137     (:big-endian (inst srl byte data 16))
 138     (:little-endian (inst srl byte data 8)))
 139   (inst and byte byte #xff)
 140   (inst xor accum accum byte)
 141   (inst sll byte accum 5)
 142   (inst srl accum accum 27)
 143   (inst or accum accum byte)
 144
 145   one-more
 146
 147   (when (eq *backend-byte-order* :big-endian)
 148     (inst srl data data 24))
 149   (inst and byte data #xff)
 150   (inst xor accum accum byte)
 151   (inst sll byte accum 5)
 152   (inst srl accum accum 27)
 153   (inst or accum accum byte)
 154
 155   done
 156
 157   (inst sll result accum 5)
 158   (inst srl result result 3)
 159
 160   ;; Restore the return address.
 161   (inst addu lip code-tn retaddr))