src/assembly/sparc/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 (define-assembly-routine (allocate-vector
  15                           (:policy :fast-safe)
  16                           (:translate allocate-vector)
  17                           (:arg-types positive-fixnum
  18                                       positive-fixnum
  19                                       positive-fixnum))
  20                          ((:arg type any-reg a0-offset)
  21                           (:arg length any-reg a1-offset)
  22                           (:arg words any-reg a2-offset)
  23                           (:res result descriptor-reg a0-offset)
  24
  25                           (:temp ndescr non-descriptor-reg nl0-offset)
  26                           (:temp vector descriptor-reg a3-offset))
  27   (pseudo-atomic ()
  28     (inst or vector alloc-tn other-pointer-lowtag)
  29     (inst add ndescr words (* (1+ vector-data-offset) n-word-bytes))
  30     (inst andn ndescr 7)
  31     (inst add alloc-tn ndescr)
  32     (inst srl ndescr type word-shift)
  33     (storew ndescr vector 0 other-pointer-lowtag)
  34     (storew length vector vector-length-slot other-pointer-lowtag))
  35   ;; This makes sure the zero byte at the end of a string is paged in so
  36   ;; the kernel doesn't bitch if we pass it the string.
  37   (storew zero-tn alloc-tn 0)
  38   (move result vector))
  39
  40
  41 \f
  42 ;;;; Hash primitives
  43
  44 ;;; this is commented out in the alpha port. I'm therefore going to
  45 ;;; comment it out here pending explanation -- CSR, 2001-08-31.
  46
  47 #|
  48 #+assembler
  49 (defparameter sxhash-simple-substring-entry (gen-label))
  50
  51 (define-assembly-routine (sxhash-simple-string
  52                           (:translate %sxhash-simple-string)
  53                           (:policy :fast-safe)
  54                           (:result-types positive-fixnum))
  55                          ((:arg string descriptor-reg a0-offset)
  56                           (:res result any-reg a0-offset)
  57
  58                           (:temp length any-reg a1-offset)
  59                           (:temp accum non-descriptor-reg nl0-offset)
  60                           (:temp data non-descriptor-reg nl1-offset)
  61                           (:temp temp non-descriptor-reg nl2-offset)
  62                           (:temp offset non-descriptor-reg nl3-offset))
  63
  64   (declare (ignore result accum data temp offset))
  65
  66   (inst b sxhash-simple-substring-entry)
  67   (loadw length string vector-length-slot other-pointer-lowtag))
  68
  69
  70 (define-assembly-routine (sxhash-simple-substring
  71                           (:translate %sxhash-simple-substring)
  72                           (:policy :fast-safe)
  73                           (:arg-types * positive-fixnum)
  74                           (:result-types positive-fixnum))
  75                          ((:arg string descriptor-reg a0-offset)
  76                           (:arg length any-reg a1-offset)
  77                           (:res result any-reg a0-offset)
  78
  79                           (:temp accum non-descriptor-reg nl0-offset)
  80                           (:temp data non-descriptor-reg nl1-offset)
  81                           (:temp temp non-descriptor-reg nl2-offset)
  82                           (:temp offset non-descriptor-reg nl3-offset))
  83   (emit-label sxhash-simple-substring-entry)
  84
  85   (inst li offset (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))
  86   (inst b test)
  87   (move accum zero-tn)
  88
  89   LOOP
  90
  91   (inst xor accum data)
  92   (inst sll temp accum 27)
  93   (inst srl accum 5)
  94   (inst or accum temp)
  95   (inst add offset 4)
  96
  97   TEST
  98
  99   (inst subcc length (fixnumize 4))
 100   (inst b :ge loop)
 101   (inst ld data string offset)
 102
 103   (inst addcc length (fixnumize 4))
 104   (inst b :eq done)
 105   (inst neg length)
 106   (inst sll length 1)
 107   (inst srl data length)
 108   (inst xor accum data)
 109
 110   DONE
 111
 112   (inst sll result accum 5)
 113   (inst srl result result 3))
 114 |#