src/assembly/ppc/array.lisp

   1 ;;;; various array operations that are too expensive (in space) to do
   2 ;;;; inline
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!VM")
  14 \f
  15 (define-assembly-routine (allocate-vector-on-heap
  16                           (:policy :fast-safe)
  17                           #!-stack-allocatable-vectors
  18                           (:translate allocate-vector)
  19                           (:arg-types positive-fixnum
  20                                       positive-fixnum
  21                                       positive-fixnum))
  22     ((:arg type any-reg a0-offset)
  23      (:arg length any-reg a1-offset)
  24      (:arg words any-reg a2-offset)
  25      (:res result descriptor-reg a0-offset)
  26
  27      (:temp ndescr non-descriptor-reg nl0-offset)
  28      (:temp pa-flag non-descriptor-reg nl3-offset)
  29      (:temp vector descriptor-reg a3-offset)
  30      (:temp temp non-descriptor-reg nl2-offset))
  31   (pseudo-atomic (pa-flag)
  32     ;; boxed words == unboxed bytes
  33     (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes))
  34     (inst clrrwi ndescr ndescr n-lowtag-bits)
  35     (allocation vector ndescr other-pointer-lowtag
  36                 :temp-tn temp
  37                 :flag-tn pa-flag)
  38     (inst srwi ndescr type word-shift)
  39     (storew ndescr vector 0 other-pointer-lowtag)
  40     (storew length vector vector-length-slot other-pointer-lowtag))
  41   ;; This makes sure the zero byte at the end of a string is paged in so
  42   ;; the kernel doesn't bitch if we pass it the string.
  43   ;;
  44   ;; rtoy says to turn this off as it causes problems with CMUCL.
  45   ;;
  46   ;; I don't think we need to do this anymore. It looks like this
  47   ;; inherited from the SPARC port and does not seem to be
  48   ;; necessary. Turning this on worked at some point, but I have not
  49   ;; tested with the final GENGC-related changes. CLH 20060221
  50   ;;
  51   ;;  (storew zero-tn alloc-tn 0)
  52   (move result vector))
  53
  54 #!+stack-allocatable-vectors
  55 (define-assembly-routine (allocate-vector-on-stack
  56                           (:policy :fast-safe)
  57                           (:arg-types positive-fixnum
  58                                       positive-fixnum
  59                                       positive-fixnum))
  60     ((:arg type any-reg a0-offset)
  61      (:arg length any-reg a1-offset)
  62      (:arg words any-reg a2-offset)
  63      (:res result descriptor-reg a0-offset)
  64
  65      (:temp ndescr non-descriptor-reg nl0-offset)
  66      (:temp pa-flag non-descriptor-reg nl3-offset)
  67      (:temp vector descriptor-reg a3-offset)
  68      (:temp temp non-descriptor-reg nl2-offset))
  69   (pseudo-atomic (pa-flag)
  70     ;; boxed words == unboxed bytes
  71     (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes))
  72     (inst clrrwi ndescr ndescr n-lowtag-bits)
  73     (align-csp temp)
  74     (inst ori vector csp-tn other-pointer-lowtag)
  75     (inst add csp-tn csp-tn ndescr)
  76     (inst srwi temp type word-shift)
  77     (storew temp vector 0 other-pointer-lowtag)
  78     ;; Our storage is allocated, but not initialized, and our contract
  79     ;; calls for it to be zero-fill.  Do so now.
  80     (let ((loop (gen-label)))
  81       (inst addi temp vector (- n-word-bytes other-pointer-lowtag))
  82       ;; The header word has already been set, skip it.
  83       (inst addi ndescr ndescr (- (fixnumize 1)))
  84       (emit-label loop)
  85       (inst addic. ndescr ndescr (- (fixnumize 1)))
  86       (storew zero-tn temp 0)
  87       (inst addi temp temp n-word-bytes)
  88       (inst bgt loop))
  89     ;; Our zero-fill loop always executes at least one store, so to
  90     ;; ensure that there is at least one slot available to be
  91     ;; clobbered, we defer setting the vector-length slot until now.
  92     (storew length vector vector-length-slot other-pointer-lowtag))
  93   (move result vector))