[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] CVS: sbcl/src/compiler/generic vm-ir2tran.lisp, 1.16,
From:       Nikodemus Siivola <demoss () users ! sourceforge ! net>
Date:       2008-07-30 17:58:46
Message-ID: E1KOFwk-0005Qn-4v () sc8-pr-cvs8 ! sourceforge ! net
[Download RAW message or body]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20769/src/compiler/generic

Modified Files:
	vm-ir2tran.lisp 
Log Message:
1.0.19.7: refactor stack allocation decisions

 * Remove SB-C::STACK-ALLOCATE-* policies.

 * Obey DYNAMIC-EXTENT declarations if SB-EXT:*STACK-ALLOCATE-DYNAMIC-EXTENT*
   is true (the default), with the following exceptions:

    ** Value cells are not stack allocated.

    ** Vectors that may be longer then a single page are stack
       allocated only in SAFETY 0 policies.

 * New declaration: SB-INT:TRULY-DYNAMIC-EXTENT. Always stack-allocates,
   regardless of SB-EXT:*STACK-ALLOCATE-DYNAMIC-EXTENT*. Also causes stack
   allocation of value cells and potentially large vectors.

   Used exclusively inside SBCL.

 * Move STACK-ALLOCATE-RESULT optimizers from backends to
   src/compiler/generic/vm-ir2tran.lisp.

 * Documentation.


Index: vm-ir2tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-ir2tran.lisp,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- vm-ir2tran.lisp	23 Jun 2008 00:55:49 -0000	1.16
+++ vm-ir2tran.lisp	30 Jul 2008 17:58:42 -0000	1.17
@@ -13,7 +13,8 @@
            sb!vm:instance-header-widetag sb!vm:instance-pointer-lowtag
            nil)
 
-(defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args))
+(defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args) node dx)
+  (declare (ignore node dx))
   t)
 
 (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag)
@@ -170,3 +171,57 @@
                      (lvar-tn node block symbol) value-tn)
                 (move-lvar-result
                  node block (list value-tn) (node-lvar node))))))))
+
+;;; Stack allocation optimizers per platform support
+;;;
+;;; Platforms with stack-allocatable vectors
+#!+(or x86 x86-64)
+(progn
+  (defoptimizer (allocate-vector stack-allocate-result)
+      ((type length words) node dx)
+    (or (eq dx :truly)
+        (zerop (policy node safety))
+        ;; a vector object should fit in one page -- otherwise it might go past
+        ;; stack guard pages.
+        (values-subtypep (lvar-derived-type words)
+                         (load-time-value
+                          (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-size*
+                                                             sb!vm:n-word-bytes)
+                                                          sb!vm:vector-data-offset)))))))
+
+  (defoptimizer (allocate-vector ltn-annotate) ((type length words) call ltn-policy)
+    (let ((args (basic-combination-args call))
+          (template (template-or-lose (if (awhen (node-lvar call)
+                                            (lvar-dynamic-extent it))
+                                          'sb!vm::allocate-vector-on-stack
+                                          'sb!vm::allocate-vector-on-heap))))
+      (dolist (arg args)
+        (setf (lvar-info arg)
+              (make-ir2-lvar (primitive-type (lvar-type arg)))))
+      (unless (is-ok-template-use template call (ltn-policy-safe-p ltn-policy))
+        (ltn-default-call call)
+        (return-from allocate-vector-ltn-annotate-optimizer (values)))
+      (setf (basic-combination-info call) template)
+      (setf (node-tail-p call) nil)
+
+      (dolist (arg args)
+        (annotate-1-value-lvar arg)))))
+
+;;; ...lists
+#!+(or alpha mips ppc sparc x86 x86-64)
+(progn
+  (defoptimizer (list stack-allocate-result) ((&rest args) node dx)
+    (declare (ignore node dx))
+    (not (null args)))
+  (defoptimizer (list* stack-allocate-result) ((&rest args) node dx)
+    (declare (ignore node dx))
+    (not (null (rest args))))
+  (defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args) node dx)
+    (declare (ignore node dx))
+    t))
+
+;;; ...conses
+#!+(or x86 x86-64)
+(defoptimizer (cons stack-allocate-result) ((&rest args) node dx)
+  (declare (ignore node dx))
+  t)


-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]