src/assembly/alpha/array.lisp

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