[Sbcl-commits] master: Implement stack-allocatable-lists on ARM.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  52a2d9c1a6f76731f839d30f8554ef176a57ec2c (commit)
      from  c6fe7400a2a0bc1859b41058bf88c698d7ab3393 (commit)

- Log -----------------------------------------------------------------
commit 52a2d9c1a6f76731f839d30f8554ef176a57ec2c
Author: Stas Boukarev <sta...@gm...>
Date:   Mon May 12 20:20:04 2014 +0400

    Implement stack-allocatable-lists on ARM.
---
 make-config.sh               |    1 +
 src/code/gc.lisp             |    6 +++---
 src/compiler/arm/alloc.lisp  |   10 +++++++++-
 src/compiler/arm/call.lisp   |   30 +++++++++++-------------------
 src/compiler/arm/macros.lisp |    9 +++++++++
 5 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/make-config.sh b/make-config.sh
index 5de750e..8f70972 100755
--- a/make-config.sh
+++ b/make-config.sh
@@ -681,6 +681,7 @@ elif [ "$sbcl_arch" = "arm" ]; then
     # hooks in for someone to add the support later.
     printf ' :arm-vfp :arm-vfpv2' >> $ltf
     printf ' :ash-right-vops' >> $ltf
+    printf ' :stack-allocatable-lists' >> $ltf
 else
     # Nothing need be done in this case, but sh syntax wants a placeholder.
     echo > /dev/null
diff --git a/src/code/gc.lisp b/src/code/gc.lisp
index 0665477..547ddfd 100644
--- a/src/code/gc.lisp
+++ b/src/code/gc.lisp
@@ -28,9 +28,9 @@
   (extern-alien "bytes_allocated" os-vm-size-t))
 #!-gencgc
 (defun dynamic-usage ()
-  (the (unsigned-byte 32)
-       (- (sap-int (sb!c::dynamic-space-free-pointer))
-          (current-dynamic-space-start))))
+  (truly-the word
+             (- (sap-int (sb!c::dynamic-space-free-pointer))
+                (current-dynamic-space-start))))
 
 (defun static-space-usage ()
   (- (ash sb!vm:*static-space-free-pointer* sb!vm:n-fixnum-tag-bits)
diff --git a/src/compiler/arm/alloc.lisp b/src/compiler/arm/alloc.lisp
index d639a43..c086ec4 100644
--- a/src/compiler/arm/alloc.lisp
+++ b/src/compiler/arm/alloc.lisp
@@ -22,6 +22,7 @@
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :fast-safe)
+  (:node-var node)
   (:generator 0
     (cond ((zerop num)
            (move result null-tn))
@@ -40,7 +41,14 @@
              (let* ((cons-cells (if star (1- num) num))
                     (alloc (* (pad-data-block cons-size) cons-cells)))
                (pseudo-atomic (pa-flag)
-                 (allocation res alloc list-pointer-lowtag :flag-tn 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)))
                  (move ptr res)
                  (dotimes (i (1- cons-cells))
                    (storew (maybe-load (tn-ref-tn things)) ptr
diff --git a/src/compiler/arm/call.lisp b/src/compiler/arm/call.lisp
index 7bca54d..744b6cf 100644
--- a/src/compiler/arm/call.lisp
+++ b/src/compiler/arm/call.lisp
@@ -510,23 +510,16 @@
     ;; We need to do this atomically.
     (pseudo-atomic (pa-flag)
       ;; Allocate a cons (2 words) for each item.
-      (if (node-stack-allocate-p node)
-          #!-(or)
-          (error "Don't know how to stack-allocate an &REST list.")
-          #!+(or)
-          (progn
-            (align-csp temp)
-            (inst clrrwi result csp-tn n-lowtag-bits)
-            (inst ori result result list-pointer-lowtag)
-            (move dst result)
-            (inst slwi temp count 1)
-            (inst add csp-tn csp-tn temp))
-          (progn
-            (inst mov temp (lsl count 1))
-            (allocation result temp list-pointer-lowtag
-                        :flag-tn pa-flag)
-            (move dst result)))
-
+      (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)))
+      (move result dst)
       ;; FIXME: This entire loop is based on the PPC version, which is
       ;; a poor fit for the ARM instruction set.
       (inst b ENTER)
@@ -543,8 +536,7 @@
 
       ;; Dec count, and if != zero, go back for more.
       (inst subs count count (fixnumize 1))
-      ;; Store the value into the car of the current cons (in the delay
-      ;; slot).
+      ;; Store the value into the car of the current cons.
       (storew temp dst 0 list-pointer-lowtag)
       (inst b :gt LOOP)
 
diff --git a/src/compiler/arm/macros.lisp b/src/compiler/arm/macros.lisp
index 9e8f761..850f7f5 100644
--- a/src/compiler/arm/macros.lisp
+++ b/src/compiler/arm/macros.lisp
@@ -97,6 +97,15 @@
 (defmacro store-csp (source &optional (predicate :al))
   `(store-symbol-value ,source *control-stack-pointer* ,predicate))
 
+(defun align-csp (csp temp)
+  ;; 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))
+
 ;;; Macros to handle the fact that we cannot use the machine native call and
 ;;; return instructions.
 

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL