Menu
▾
▴
[Sbcl-commits] master: Abstract stack allocation into ALLOCATION macro on ARM.
|
From: stassats <sta...@us...> - 2014-05-13 20:06:01
|
The branch "master" has been updated in SBCL:
via a1bae90283c26ccf477dd4d1ac5bb43d3dfb99c2 (commit)
from ad14f0470f220a438632abc323305ffb8dbd18dd (commit)
- Log -----------------------------------------------------------------
commit a1bae90283c26ccf477dd4d1ac5bb43d3dfb99c2
Author: Stas Boukarev <sta...@gm...>
Date: Tue May 13 22:17:48 2014 +0400
Abstract stack allocation into ALLOCATION macro on ARM.
---
src/compiler/arm/alloc.lisp | 18 +++++++-----------
src/compiler/arm/call.lisp | 18 +++++++++---------
src/compiler/arm/macros.lisp | 37 +++++++++++++++++++++++++------------
3 files changed, 41 insertions(+), 32 deletions(-)
diff --git a/src/compiler/arm/alloc.lisp b/src/compiler/arm/alloc.lisp
index c086ec4..8c4c455 100644
--- a/src/compiler/arm/alloc.lisp
+++ b/src/compiler/arm/alloc.lisp
@@ -41,14 +41,9 @@
(let* ((cons-cells (if star (1- num) num))
(alloc (* (pad-data-block cons-size) cons-cells)))
(pseudo-atomic (pa-flag)
- (cond ((node-stack-allocate-p node)
- (align-csp res pa-flag)
- (composite-immediate-instruction add pa-flag res alloc)
- (inst orr res res list-pointer-lowtag)
- (store-csp pa-flag))
- (t
- (allocation res alloc list-pointer-lowtag
- :flag-tn pa-flag)))
+ (allocation res alloc list-pointer-lowtag
+ :flag-tn pa-flag
+ :stack-allocate-p (node-stack-allocate-p node))
(move ptr res)
(dotimes (i (1- cons-cells))
(storew (maybe-load (tn-ref-tn things)) ptr
@@ -179,12 +174,13 @@
(define-vop (fixed-alloc)
(:args)
(:info name words type lowtag stack-allocate-p)
- (:ignore name stack-allocate-p)
+ (:ignore name)
(:results (result :scs (descriptor-reg)))
(:temporary (:sc non-descriptor-reg :offset ocfp-offset) pa-flag)
(:generator 4
- (with-fixed-allocation (result pa-flag type words :lowtag lowtag)
- )))
+ (with-fixed-allocation (result pa-flag type words
+ :lowtag lowtag
+ :stack-allocate-p stack-allocate-p))))
(define-vop (var-alloc)
(:args (extra :scs (any-reg)))
diff --git a/src/compiler/arm/call.lisp b/src/compiler/arm/call.lisp
index 744b6cf..07bb71f 100644
--- a/src/compiler/arm/call.lisp
+++ b/src/compiler/arm/call.lisp
@@ -510,15 +510,15 @@
;; We need to do this atomically.
(pseudo-atomic (pa-flag)
;; Allocate a cons (2 words) for each item.
- (cond ((node-stack-allocate-p node)
- (align-csp dst pa-flag)
- (inst add pa-flag dst (lsl count 1))
- (inst orr dst dst list-pointer-lowtag)
- (store-csp pa-flag))
- (t
- (inst mov temp (lsl count 1))
- (allocation dst temp list-pointer-lowtag
- :flag-tn pa-flag)))
+ (let* ((dx-p (node-stack-allocate-p node))
+ (size (cond (dx-p
+ (lsl count 1))
+ (t
+ (inst mov temp (lsl count 1))
+ temp))))
+ (allocation dst size list-pointer-lowtag
+ :flag-tn pa-flag
+ :stack-allocate-p dx-p))
(move result dst)
;; FIXME: This entire loop is based on the PPC version, which is
;; a poor fit for the ARM instruction set.
diff --git a/src/compiler/arm/macros.lisp b/src/compiler/arm/macros.lisp
index 850f7f5..6fc3da0 100644
--- a/src/compiler/arm/macros.lisp
+++ b/src/compiler/arm/macros.lisp
@@ -97,14 +97,13 @@
(defmacro store-csp (source &optional (predicate :al))
`(store-symbol-value ,source *control-stack-pointer* ,predicate))
-(defun align-csp (csp temp)
+(defun align-csp (csp)
;; Aligns and loads the csp
;; is used for stack allocation of dynamic-extent objects
(load-csp csp)
(inst tst csp lowtag-mask)
(inst add :ne csp csp n-word-bytes)
- (inst mov :ne temp 0)
- (storew temp csp -1 0 :ne))
+ (storew null-tn csp -1 0 :ne))
;;; Macros to handle the fact that we cannot use the machine native call and
;;; return instructions.
@@ -184,17 +183,30 @@
;;; surround a call to ALLOCATION anyway), and to indicate that the
;;; P-A FLAG-TN is also acceptable here.
-(defmacro allocation (result-tn size lowtag &key flag-tn)
+(defmacro allocation (result-tn size lowtag &key flag-tn
+ stack-allocate-p)
;; Normal allocation to the heap.
- (let ((alloc-size (gensym)))
- `(let ((,alloc-size ,size))
- (load-symbol-value ,flag-tn *allocation-pointer*)
- (inst add ,result-tn ,flag-tn ,lowtag)
- (inst add ,flag-tn ,flag-tn ,alloc-size)
- (store-symbol-value ,flag-tn *allocation-pointer*))))
+ (once-only ((result-tn result-tn)
+ (size size)
+ (lowtag lowtag)
+ (flag-tn flag-tn)
+ (stack-allocate-p stack-allocate-p))
+ `(cond (,stack-allocate-p
+ (align-csp ,result-tn)
+ (if (integerp ,size)
+ (composite-immediate-instruction add ,flag-tn ,result-tn ,size)
+ (inst add ,flag-tn ,result-tn ,size))
+ (inst orr ,result-tn ,result-tn ,lowtag)
+ (store-csp ,flag-tn))
+ (t
+ (load-symbol-value ,flag-tn *allocation-pointer*)
+ (inst add ,result-tn ,flag-tn ,lowtag)
+ (inst add ,flag-tn ,flag-tn ,size)
+ (store-symbol-value ,flag-tn *allocation-pointer*)))))
(defmacro with-fixed-allocation ((result-tn flag-tn type-code size
- &key (lowtag other-pointer-lowtag))
+ &key (lowtag other-pointer-lowtag)
+ stack-allocate-p)
&body body)
"Do stuff to allocate an other-pointer object of fixed Size with a single
word header having the specified Type-Code. The result is placed in
@@ -205,7 +217,8 @@
(type-code type-code) (size size) (lowtag lowtag))
`(pseudo-atomic (,flag-tn)
(allocation ,result-tn (pad-data-block ,size) ,lowtag
- :flag-tn ,flag-tn)
+ :flag-tn ,flag-tn
+ :stack-allocate-p ,stack-allocate-p)
(when ,type-code
(inst mov ,flag-tn (ash (1- ,size) n-widetag-bits))
(inst orr ,flag-tn ,flag-tn ,type-code)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|