From a5b844b680721c3cbe8fb1c1e19eb4e47579e07b Mon Sep 17 00:00:00 2001 From: Alastair Bridgewater Date: Thu, 25 Apr 2013 14:55:13 -0400 Subject: [PATCH] ppc support for stack-allocatable-vectors * This turned out to be fairly straightforward. Unlike in a heap-allocation-only regime, where a VOP is required to :TRANSLATE ALLOCATE-VECTOR, the :STACK-ALLOCATABLE-VECTORS feature enables an LTN-ANNOTATE optimizer for ALLOCATE-VECTOR that substitutes invocations of one of two named VOPs. * To convert from the old regime to the new, rename the old VOP to fit the new naming scheme, and write a new VOP to do the stack allocation. * As a cleaning-up-a-loose-end matter, lose the :TRANSLATE option for the old VOP. * And as a "being somewhat cute about things" matter, make the support for stack-allocatable-vectors selectable at build time, which should provide a quick overview of how to make this work on some other platform, should anyone else be interested later on. --- make-config.sh | 2 +- src/assembly/ppc/array.lisp | 44 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 44 insertions(+), 2 deletions(-) diff --git a/make-config.sh b/make-config.sh index 6a0e6f4..557f85f 100644 --- a/make-config.sh +++ b/make-config.sh @@ -613,7 +613,7 @@ elif [ "$sbcl_arch" = "mips" ]; then printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf printf ' :alien-callbacks' >> $ltf elif [ "$sbcl_arch" = "ppc" ]; then - printf ' :gencgc :stack-allocatable-closures' >> $ltf + printf ' :gencgc :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf printf ' :linkage-table :raw-instance-init-vops :memory-barrier-vops' >> $ltf printf ' :compare-and-swap-vops :multiply-high-vops' >> $ltf diff --git a/src/assembly/ppc/array.lisp b/src/assembly/ppc/array.lisp index e59c3c0..40409a5 100644 --- a/src/assembly/ppc/array.lisp +++ b/src/assembly/ppc/array.lisp @@ -12,8 +12,9 @@ (in-package "SB!VM") -(define-assembly-routine (allocate-vector +(define-assembly-routine (allocate-vector-on-heap (:policy :fast-safe) + #!-stack-allocatable-vectors (:translate allocate-vector) (:arg-types positive-fixnum positive-fixnum @@ -49,3 +50,44 @@ ;; ;; (storew zero-tn alloc-tn 0) (move result vector)) + +#!+stack-allocatable-vectors +(define-assembly-routine (allocate-vector-on-stack + (:policy :fast-safe) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum)) + ((:arg type any-reg a0-offset) + (:arg length any-reg a1-offset) + (:arg words any-reg a2-offset) + (:res result descriptor-reg a0-offset) + + (:temp ndescr non-descriptor-reg nl0-offset) + (:temp pa-flag non-descriptor-reg nl3-offset) + (:temp vector descriptor-reg a3-offset) + (:temp temp non-descriptor-reg nl2-offset)) + (pseudo-atomic (pa-flag) + ;; boxed words == unboxed bytes + (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes)) + (inst clrrwi ndescr ndescr n-lowtag-bits) + (align-csp temp) + (inst ori vector csp-tn other-pointer-lowtag) + (inst add csp-tn csp-tn ndescr) + (inst srwi temp type word-shift) + (storew temp vector 0 other-pointer-lowtag) + ;; Our storage is allocated, but not initialized, and our contract + ;; calls for it to be zero-fill. Do so now. + (let ((loop (gen-label))) + (inst addi temp vector (- n-word-bytes other-pointer-lowtag)) + ;; The header word has already been set, skip it. + (inst addi ndescr ndescr (- (fixnumize 1))) + (emit-label loop) + (inst addic. ndescr ndescr (- (fixnumize 1))) + (storew zero-tn temp 0) + (inst addi temp temp n-word-bytes) + (inst bgt loop)) + ;; Our zero-fill loop always executes at least one store, so to + ;; ensure that there is at least one slot available to be + ;; clobbered, we defer setting the vector-length slot until now. + (storew length vector vector-length-slot other-pointer-lowtag)) + (move result vector)) -- 1.7.10.4