faster SVREF and (SETF SVREF) compilation

[sbcl.git] / src / compiler / sparc / call.lisp

diff --git a/src/compiler/sparc/call.lisp b/src/compiler/sparc/call.lisp
index 73b64c7..8956262 100644 (file)
--- a/src/compiler/sparc/call.lisp
+++ b/src/compiler/sparc/call.lisp
@@ -397,6 +397,15 @@ default-value-8
               nvals)
   (:temporary (:scs (non-descriptor-reg)) temp))
 
+\f
+;;; This hook in the codegen pass lets us insert code before fall-thru entry
+;;; points, local-call entry points, and tail-call entry points.  The default
+;;; does nothing.
+(defun emit-block-header (start-label trampoline-label fall-thru-p alignp)
+  (declare (ignore fall-thru-p alignp))
+  (when trampoline-label
+    (emit-label trampoline-label))
+  (emit-label start-label))
 
 \f
 ;;;; Local call with unknown values convention return:
@@ -1127,8 +1136,7 @@ default-value-8
     (let* ((enter (gen-label))
            (loop (gen-label))
            (done (gen-label))
-           (dx-p (node-stack-allocate-p node))
-           (alloc-area-tn (if dx-p csp-tn alloc-tn)))
+           (dx-p (node-stack-allocate-p node)))
       (move context context-arg)
       (move count count-arg)
       ;; Check to see if there are any arguments.
@@ -1138,15 +1146,13 @@ default-value-8
 
       ;; We need to do this atomically.
       (pseudo-atomic ()
-        (when dx-p
-          (align-csp temp))
         ;; Allocate a cons (2 words) for each item.
-        (inst andn result alloc-area-tn lowtag-mask)
-        (inst or result list-pointer-lowtag)
-        (move dst result)
         (inst sll temp count 1)
+        (allocation result temp list-pointer-lowtag
+                    :stack-p dx-p
+                    :temp-tn dst)
         (inst b enter)
-        (inst add alloc-area-tn temp)
+        (move dst result)
 
         ;; Compute the next cons and store it in the current one.
         (emit-label loop)