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-on-heap
  15                           (:policy :fast-safe)
  16                           (:arg-types positive-fixnum
  17                                       positive-fixnum
  18                                       positive-fixnum))
  19                          ((:arg type any-reg a0-offset)
  20                           (:arg length any-reg a1-offset)
  21                           (:arg words any-reg a2-offset)
  22                           (:res result descriptor-reg a0-offset)
  23
  24                           (:temp ndescr non-descriptor-reg nl0-offset)
  25                           (:temp gc-temp non-descriptor-reg nl1-offset)
  26                           (:temp vector descriptor-reg a3-offset))
  27   (pseudo-atomic (gc-temp)
  28     ;; boxed words == unboxed bytes
  29     (inst add ndescr words (* (1+ vector-data-offset) n-word-bytes))
  30     (inst andn ndescr 7)
  31     (allocation nil ndescr other-pointer-lowtag vector :temp-tn gc-temp)
  32     (inst srl ndescr type n-fixnum-tag-bits)
  33     (storew ndescr vector 0 other-pointer-lowtag)
  34     (storew length vector vector-length-slot other-pointer-lowtag))
  35   (move result vector))
  36
  37 (define-assembly-routine (allocate-vector-on-stack
  38                           (:policy :fast-safe)
  39                           (:arg-types positive-fixnum
  40                                       positive-fixnum
  41                                       positive-fixnum))
  42                          ((:arg type any-reg a0-offset)
  43                           (:arg length any-reg a1-offset)
  44                           (:arg words any-reg a2-offset)
  45                           (:res result descriptor-reg a0-offset)
  46
  47                           (:temp ndescr non-descriptor-reg nl0-offset)
  48                           (:temp gc-temp non-descriptor-reg nl1-offset)
  49                           (:temp vector descriptor-reg a3-offset))
  50   (pseudo-atomic (gc-temp)
  51     ;; boxed words == unboxed bytes
  52     (inst add ndescr words (* (1+ vector-data-offset) n-word-bytes))
  53     (inst andn ndescr 7)
  54     (allocation nil ndescr other-pointer-lowtag vector :temp-tn gc-temp
  55                 :stack-p t)
  56     ;; We're pseudo-atomic here, so we can do whatever is most convenient
  57     ;; to zeroize the array data. Clear two words at a time upward from VECTOR
  58     ;; until reaching the new CSP-TN value. Don't pre-check for 0 payload words,
  59     ;; just consider the first two words as part of the array data.
  60     (let ((loop (gen-label)))
  61       (inst add ndescr vector (- other-pointer-lowtag))
  62       (emit-label loop)
  63       (storew zero-tn ndescr 0 0) ; next store is in the branch delay slot
  64       (inst add ndescr ndescr (* n-word-bytes 2))
  65       (inst cmp ndescr csp-tn)
  66       (inst b :lt loop)
  67       (storew zero-tn ndescr -1 0)) ; -1 because ptr was already bumped
  68     (inst srl ndescr type n-fixnum-tag-bits)
  69     (storew ndescr vector 0 other-pointer-lowtag)
  70     (storew length vector vector-length-slot other-pointer-lowtag))
  71   (move result vector))