From 554d78debd8eab9455e5283639c2fb71fac75deb Mon Sep 17 00:00:00 2001 From: Thiemo Seufer Date: Thu, 11 Dec 2008 20:28:13 +0000 Subject: [PATCH] 1.0.23.33: Stack-allocatable vectors for MIPS. --- src/assembly/mips/array.lisp | 55 ++++++++++-------------------------- src/compiler/generic/vm-ir2tran.lisp | 2 +- src/compiler/mips/alloc.lisp | 55 ++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 72 insertions(+), 42 deletions(-) rewrite src/assembly/mips/array.lisp (70%) diff --git a/src/assembly/mips/array.lisp b/src/assembly/mips/array.lisp dissimilarity index 70% index 3c53f1ede..5e68e8732 100644 --- a/src/assembly/mips/array.lisp +++ b/src/assembly/mips/array.lisp @@ -1,40 +1,15 @@ -;;;; various array operations that are too expensive (in space) to do -;;;; inline - -;;;; This software is part of the SBCL system. See the README file for -;;;; more information. -;;;; -;;;; This software is derived from the CMU CL system, which was -;;;; written at Carnegie Mellon University and released into the -;;;; public domain. The software is in the public domain and is -;;;; provided with absolutely no warranty. See the COPYING and CREDITS -;;;; files for more information. - -(in-package "SB!VM") - -(define-assembly-routine (allocate-vector - (:policy :fast-safe) - (:translate allocate-vector) - (: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 nl4-offset)) - ;; This is kinda sleezy, changing words like this. But we can because - ;; the vop thinks it is temporary. - (inst addu words (+ lowtag-mask - (* vector-data-offset n-word-bytes))) - (inst srl ndescr type word-shift) - (inst srl words n-lowtag-bits) - (inst sll words n-lowtag-bits) - - (pseudo-atomic (pa-flag) - (inst or result alloc-tn other-pointer-lowtag) - (inst addu alloc-tn words) - (storew ndescr result 0 other-pointer-lowtag) - (storew length result vector-length-slot other-pointer-lowtag))) +;;;; various array operations that are too expensive (in space) to do +;;;; inline + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!VM") + +;;;; Note: ALLOCATE-VECTOR is now implemented as a VOP. diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 40eb40c9d..c864d264b 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -175,7 +175,7 @@ ;;; Stack allocation optimizers per platform support ;;; ;;; Platforms with stack-allocatable vectors -#!+(or x86 x86-64) +#!+(or mips x86 x86-64) (progn (defoptimizer (allocate-vector stack-allocate-result) ((type length words) node dx) diff --git a/src/compiler/mips/alloc.lisp b/src/compiler/mips/alloc.lisp index dd9b3044a..30c14390d 100644 --- a/src/compiler/mips/alloc.lisp +++ b/src/compiler/mips/alloc.lisp @@ -77,6 +77,61 @@ ;;;; Special purpose inline allocators. +;;; ALLOCATE-VECTOR +(define-vop (allocate-vector-on-heap) + (:args (type :scs (unsigned-reg)) + (length :scs (any-reg)) + (words :scs (any-reg))) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum) + (:temporary (:sc non-descriptor-reg :offset nl0-offset) bytes) + (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) + (:results (result :scs (descriptor-reg) :from :load)) + (:policy :fast-safe) + (:generator 100 + (inst addu bytes words (+ lowtag-mask + (* vector-data-offset n-word-bytes))) + (inst srl bytes n-lowtag-bits) + (inst sll bytes n-lowtag-bits) + (pseudo-atomic (pa-flag) + (inst or result alloc-tn other-pointer-lowtag) + (inst addu alloc-tn bytes) + (storew type result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag)))) + +(define-vop (allocate-vector-on-stack) + (:args (type :scs (unsigned-reg)) + (length :scs (any-reg)) + (words :scs (any-reg))) + (:arg-types positive-fixnum + positive-fixnum + positive-fixnum) + (:temporary (:sc non-descriptor-reg :offset nl0-offset) bytes) + (:temporary (:sc non-descriptor-reg :offset nl1-offset) temp) + (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) + (:results (result :scs (descriptor-reg) :from :load)) + (:policy :fast-safe) + (:generator 100 + (inst addu bytes words (+ lowtag-mask + (* vector-data-offset n-word-bytes))) + (inst srl bytes n-lowtag-bits) + (inst sll bytes n-lowtag-bits) + ;; FIXME: It would be good to check for stack overflow here. + (pseudo-atomic (pa-flag) + (align-csp temp) + (inst or result csp-tn other-pointer-lowtag) + (inst addu temp csp-tn (* vector-data-offset n-word-bytes)) + (inst addu csp-tn bytes) + (storew type result 0 other-pointer-lowtag) + (storew length result vector-length-slot other-pointer-lowtag) + (let ((loop (gen-label))) + (emit-label loop) + (storew zero-tn temp 0) + (inst bne temp csp-tn loop) + (inst addu temp n-word-bytes)) + (align-csp temp)))) + (define-vop (allocate-code-object) (:args (boxed-arg :scs (any-reg)) (unboxed-arg :scs (any-reg))) diff --git a/version.lisp-expr b/version.lisp-expr index cc4b0dfbe..68858ff44 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.23.32" +"1.0.23.33" -- 2.11.4.GIT