src/assembly/arm/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                           (:arg-types positive-fixnum
  18                                       positive-fixnum
  19                                       positive-fixnum))
  20     ((:arg type any-reg r0-offset)
  21      (:arg length any-reg r1-offset)
  22      (:arg words any-reg r2-offset)
  23      (:res result descriptor-reg r0-offset)
  24
  25      (:temp ndescr non-descriptor-reg nl2-offset)
  26      (:temp pa-flag non-descriptor-reg ocfp-offset)
  27      (:temp vector descriptor-reg r8-offset))
  28   ;; Why :LINK NIL?
  29   ;; Either LR or PC need to always point into the code object.
  30   ;; Since this is a static assembly routine, PC is already not pointing there.
  31   ;; But it's called using blx, so LR is still good.
  32   ;; Normally PSEUDO-ATOMIC calls do_pending_interrupt using BLX too,
  33   ;; which will make LR point here, now GC can collect the parent function away.
  34   ;; But the call to do_pending_interrupt is at the end, and there's
  35   ;; nothing more needed to be done by the routine, so
  36   ;; do_pending_interrupt can return to the parent function directly.
  37   ;; This still uses the normal :return-style, BX LR, since the call
  38   ;; to do_pending_interrupt interrupt is conditional.
  39   (pseudo-atomic (pa-flag :link nil)
  40     ;; boxed words == unboxed bytes
  41     (inst add ndescr words (* (1+ vector-data-offset) n-word-bytes))
  42     (inst bic ndescr ndescr lowtag-mask)
  43     (allocation vector ndescr other-pointer-lowtag :flag-tn pa-flag)
  44     (inst mov ndescr (lsr type word-shift))
  45     (storew ndescr vector 0 other-pointer-lowtag)
  46     ;; Touch the last element, to ensure that null-terminated strings
  47     ;; passed to C do not cause a WP violation in foreign code.
  48     ;; Do that before storing length, since nil-arrays don't have any
  49     ;; space, but may have non-zero length.
  50     #!-gencgc
  51     (inst mov ndescr 0)
  52     #!-gencgc
  53     (storew ndescr pa-flag -1)
  54     (storew length vector vector-length-slot other-pointer-lowtag)
  55     (move result vector)))
  56
  57 (define-assembly-routine (allocate-vector-on-stack
  58                           (:policy :fast-safe)
  59                           (:arg-types positive-fixnum
  60                                       positive-fixnum
  61                                       positive-fixnum))
  62     ((:arg type any-reg r0-offset)
  63      (:arg length any-reg r1-offset)
  64      (:arg words any-reg r2-offset)
  65      (:res result descriptor-reg r0-offset)
  66
  67      (:temp ndescr non-descriptor-reg nl2-offset)
  68      (:temp pa-flag non-descriptor-reg ocfp-offset)
  69      (:temp vector descriptor-reg r8-offset))
  70   ;; See why :LINK NIL is needed in ALLOCATE-VECTOR-ON-HEAP above.
  71   (pseudo-atomic (pa-flag :link nil)
  72     ;; boxed words == unboxed bytes
  73     (inst add ndescr words (* (1+ vector-data-offset) n-word-bytes))
  74     (inst bic ndescr ndescr lowtag-mask)
  75     (allocation vector ndescr other-pointer-lowtag
  76                 :flag-tn pa-flag
  77                 :stack-allocate-p t)
  78     (inst mov pa-flag (lsr type word-shift))
  79     (storew pa-flag vector 0 other-pointer-lowtag)
  80     ;; Zero fill
  81     (let ((loop (gen-label)))
  82       (inst sub result vector (- other-pointer-lowtag n-word-bytes))
  83       ;; The header word has already been set, skip it.
  84       (inst sub ndescr ndescr (fixnumize 1))
  85       (inst mov pa-flag 0)
  86       (emit-label loop)
  87       (inst str pa-flag (@ result n-word-bytes :post-index))
  88       (inst subs ndescr ndescr (fixnumize 1))
  89       (inst b :gt loop))
  90     (storew length vector vector-length-slot other-pointer-lowtag)
  91     (move result vector)))