X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-ir2tran.lisp;h=420b129139f0d80e7d59f5fcae533613dc1bfbb4;hb=8deb4b7ca12aff6955d9cf3fc4de8fd688d3a773;hp=0f5f92e84c8f809e1633ac19b68dfb3f3058e6b5;hpb=e840f481796d191997a47421d60cd039cd260613;p=sbcl.git

diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp
index 0f5f92e..420b129 100644
--- a/src/compiler/generic/vm-ir2tran.lisp
+++ b/src/compiler/generic/vm-ir2tran.lisp
@@ -13,7 +13,19 @@
            sb!vm:instance-header-widetag sb!vm:instance-pointer-lowtag
            nil)
 
-(defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args) node dx)
+#!+stack-allocatable-fixed-objects
+(defoptimizer (%make-structure-instance stack-allocate-result) ((defstruct-description &rest args) node dx)
+  (aver (constant-lvar-p defstruct-description))
+  ;; A structure instance can be stack-allocated if it has no raw
+  ;; slots, or if we're on a target with a conservatively-scavenged
+  ;; stack.  We have no reader conditional for stack conservation, but
+  ;; it turns out that the only time stack conservation is in play is
+  ;; when we're on GENCGC (since CHENEYGC doesn't have conservation)
+  ;; and C-STACK-IS-CONTROL-STACK (otherwise, the C stack is the
+  ;; number stack, and we precisely-scavenge the control stack).
+  #!-(and :gencgc :c-stack-is-control-stack)
+  (zerop (sb!kernel::dd-raw-length (lvar-value defstruct-description)))
+  #!+(and :gencgc :c-stack-is-control-stack)
   t)
 
 (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag)
@@ -68,7 +80,7 @@
              (macrolet ((make-case ()
                           `(ecase raw-type
                              ((t)
-                              (vop set-slot node block object arg-tn
+                              (vop init-slot node block object arg-tn
                                    name (+ sb!vm:instance-slots-offset slot) lowtag))
                              ,@(mapcar (lambda (rsd)
                                          `(,(sb!kernel::raw-slot-data-raw-type rsd)
@@ -81,11 +93,11 @@
                                        nil))))
                (make-case))))
           (:dd
-           (vop set-slot node block object
+           (vop init-slot node block object
                 (emit-constant (sb!kernel::dd-layout-or-lose slot))
                 name sb!vm:instance-slots-offset lowtag))
           (otherwise
-           (vop set-slot node block object
+           (vop init-slot node block object
                 (ecase kind
                   (:arg
                    (aver args)
@@ -193,7 +205,7 @@
                          ,@(nreverse clauses)))))
                (frob)))
            (tnify (index)
-             (constant-tn (find-constant index))))
+             (emit-constant index)))
       (let ((setter (compute-setter))
             (length (length initial-contents)))
         (dotimes (i length)
@@ -218,21 +230,28 @@
                  node block (list value-tn) (node-lvar node))))))))
 
 ;;; Stack allocation optimizers per platform support
-;;;
-;;; Platforms with stack-allocatable vectors
-#!+(or hppa mips x86 x86-64)
+#!+stack-allocatable-vectors
 (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-bytes*
-                                                             sb!vm:n-word-bytes)
-                                                          sb!vm:vector-data-offset)))))))
+    (and
+     ;; Can't put unboxed data on the stack unless we scavenge it
+     ;; conservatively.
+     #!-c-stack-is-control-stack
+     (constant-lvar-p type)
+     #!-c-stack-is-control-stack
+     (member (lvar-value type)
+             '#.(list (sb!vm:saetp-typecode (find-saetp 't))
+                      (sb!vm:saetp-typecode (find-saetp 'fixnum))))
+     (or (eq dx :always-dynamic)
+         (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-bytes*
+                                                              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))
@@ -253,7 +272,7 @@
         (annotate-1-value-lvar arg)))))
 
 ;;; ...lists
-#!+(or alpha hppa mips ppc sparc x86 x86-64)
+#!+stack-allocatable-lists
 (progn
   (defoptimizer (list stack-allocate-result) ((&rest args) node dx)
     (declare (ignore node dx))
@@ -266,7 +285,9 @@
     t))
 
 ;;; ...conses
-#!+(or hppa mips x86 x86-64)
-(defoptimizer (cons stack-allocate-result) ((&rest args) node dx)
-  (declare (ignore node dx))
-  t)
+#!+stack-allocatable-fixed-objects
+(progn
+  (defoptimizer (cons stack-allocate-result) ((&rest args) node dx)
+    t)
+  (defoptimizer (%make-complex stack-allocate-result) ((&rest args) node dx)
+    t))