src/assembly/alpha/array.lisp

   1 ;;;; support routines for arrays and vectors
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13
  14
  15 (define-assembly-routine (allocate-vector
  16                           (:policy :fast-safe)
  17                           (:translate allocate-vector)
  18                           (:arg-types positive-fixnum
  19                                       positive-fixnum
  20                                       positive-fixnum))
  21                          ((:arg type any-reg a0-offset)
  22                           (:arg length any-reg a1-offset)
  23                           (:arg words any-reg a2-offset)
  24                           (:res result descriptor-reg a0-offset)
  25
  26                           (:temp ndescr non-descriptor-reg nl0-offset))
  27   ;; This is kinda sleezy, changing words like this.  But we can because
  28   ;; the vop thinks it is temporary.
  29   (inst addq words (+ (1- (ash 1 lowtag-bits))
  30                       (* vector-data-offset word-bytes))
  31         words)
  32   (inst li (lognot lowtag-mask) ndescr)
  33   (inst and words ndescr words)
  34   (inst srl type word-shift ndescr)
  35
  36   (pseudo-atomic ()
  37     (inst bis alloc-tn other-pointer-type result)
  38     (inst addq alloc-tn words alloc-tn)
  39     (storew ndescr result 0 other-pointer-type)
  40     (storew length result vector-length-slot other-pointer-type)))
  41 \f
  42 ;;;; hash primitives
  43 #|
  44 (define-assembly-routine (sxhash-simple-string
  45                           (:translate %sxhash-simple-string)
  46                           (:policy :fast-safe)
  47                           (:result-types positive-fixnum))
  48                          ((:arg string descriptor-reg a0-offset)
  49                           (:res result any-reg a0-offset)
  50
  51                           (:temp length any-reg a1-offset)
  52
  53                           (:temp lip interior-reg lip-offset)
  54                           (:temp accum non-descriptor-reg nl0-offset)
  55                           (:temp data non-descriptor-reg nl1-offset)
  56                           (:temp byte non-descriptor-reg nl2-offset)
  57                           (:temp retaddr non-descriptor-reg nl3-offset)
  58                           (:temp temp1 non-descriptor-reg nl4-offset))
  59
  60   ;; These are needed after we jump into sxhash-simple-substring.
  61   (progn result lip accum data byte  retaddr)
  62
  63   (inst li (make-fixup 'sxhash-simple-substring :assembly-routine) temp1)
  64   (loadw length string vector-length-slot other-pointer-type)
  65   (inst jmp zero-tn temp1
  66         (make-fixup 'sxhash-simple-substring :assembly-routine)))
  67
  68 (define-assembly-routine (sxhash-simple-substring
  69                           (:translate %sxhash-simple-substring)
  70                           (:policy :fast-safe)
  71                           (:arg-types * positive-fixnum)
  72                           (:result-types positive-fixnum))
  73                          ((:arg string descriptor-reg a0-offset)
  74                           (:arg length any-reg a1-offset)
  75                           (:res result any-reg a0-offset)
  76
  77                           (:temp lip interior-reg lip-offset)
  78                           (:temp accum non-descriptor-reg nl0-offset)
  79                           (:temp data non-descriptor-reg nl1-offset)
  80                           (:temp byte non-descriptor-reg nl2-offset)
  81                           (:temp retaddr non-descriptor-reg nl3-offset))
  82
  83   ;; Save the return address
  84   (inst subq lip code-tn retaddr)
  85
  86   ;; Get a pointer to the data.
  87   (inst addq string
  88         (- (* vector-data-offset word-bytes) other-pointer-type)
  89         lip)
  90   (move zero-tn accum)
  91   (inst br zero-tn test)
  92
  93   loop
  94
  95   (inst and data #xff byte)
  96   (inst xor accum byte accum)
  97   (inst sll accum 5 byte)
  98   (inst srl accum 27 accum)
  99   (inst mskll accum 4 accum)
 100   (inst bis accum byte accum)
 101
 102   (inst srl data 8 byte)
 103   (inst and byte #xff byte)
 104   (inst xor accum byte accum)
 105   (inst sll accum 5 byte)
 106   (inst srl accum 27 accum)
 107   (inst mskll accum 4 accum)
 108   (inst bis accum byte accum)
 109
 110   (inst srl data 16 byte)
 111   (inst and byte #xff byte)
 112   (inst xor accum byte accum)
 113   (inst sll accum 5 byte)
 114   (inst srl accum 27 accum)
 115   (inst mskll accum 4 accum)
 116   (inst bis accum byte accum)
 117
 118   (inst srl data 24 byte)
 119   (inst xor accum byte accum)
 120   (inst sll accum 5 byte)
 121   (inst srl accum 27 accum)
 122   (inst mskll accum 4 accum)
 123   (inst bis accum byte accum)
 124
 125   (inst addq lip 4 lip)
 126
 127   test
 128
 129   (inst subq length (fixnum 4) length)
 130   (inst ldl data 0 lip)
 131   (inst bge length loop)
 132
 133   (inst addq length (fixnum 3) length)
 134   (inst beq length one-more)
 135   (inst subq length (fixnum 1) length)
 136   (inst beq length two-more)
 137   (inst bne length done)
 138
 139   (inst srl data 16 byte)
 140   (inst and byte #xff byte)
 141   (inst xor accum byte accum)
 142   (inst sll accum 5 byte)
 143   (inst srl accum 27 accum)
 144   (inst mskll accum 4 accum)
 145   (inst bis accum byte accum)
 146   (inst addq length (fixnum 1) length)
 147
 148   two-more
 149
 150   (inst subq length (fixnum 1) length)
 151   (inst srl data 8 byte)
 152   (inst and byte #xff byte)
 153   (inst xor accum byte accum)
 154   (inst sll accum 5 byte)
 155   (inst srl accum 27 accum)
 156   (inst mskll accum 4 accum)
 157   (inst bis accum byte accum)
 158   (inst addq length (fixnum 1) length)
 159
 160   one-more
 161
 162   (inst subq length (fixnum 1) length)
 163   (inst and data #xff byte)
 164   (inst xor accum byte accum)
 165   (inst sll accum 5 byte)
 166   (inst srl accum 27 accum)
 167   (inst mskll accum 4 accum)
 168   (inst bis accum byte accum)
 169
 170   done
 171
 172   (inst sll accum 5 result)
 173   (inst mskll result 4 result)
 174   (inst srl result 3 result)
 175
 176   ;; Restore the return address.
 177   (inst addq code-tn retaddr lip))
 178 |#