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