X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-ir2tran.lisp;h=0f5f92e84c8f809e1633ac19b68dfb3f3058e6b5;hb=d25e3478acccec70402ff32554669a982be8e281;hp=40eb40c9dadf89ff9ef6b4a5140df9886a2977e3;hpb=45618b17bd28aa3f0124eb675460c005f34322b0;p=sbcl.git

diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp
index 40eb40c..0f5f92e 100644
--- a/src/compiler/generic/vm-ir2tran.lisp
+++ b/src/compiler/generic/vm-ir2tran.lisp
@@ -14,7 +14,6 @@
            nil)
 
 (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)
@@ -156,6 +155,52 @@
       (emit-inits node block name result lowtag words `((:dd . ,c-dd) ,@c-slot-specs) args)
       (move-lvar-result node block locs lvar))))
 
+(defoptimizer (initialize-vector ir2-convert)
+    ((vector &rest initial-contents) node block)
+  (let* ((vector-ctype (lvar-type vector))
+         (elt-ctype (if (array-type-p vector-ctype)
+                        (array-type-specialized-element-type vector-ctype)
+                        (bug "Unknow vector type in IR2 conversion for ~S."
+                             'initialize-vector)))
+         (saetp (find-saetp-by-ctype elt-ctype))
+         (lvar (node-lvar node))
+         (locs (lvar-result-tns lvar (list (primitive-type vector-ctype))))
+         (result (first locs))
+         (elt-ptype (primitive-type elt-ctype))
+         (tmp (make-normal-tn elt-ptype)))
+    (emit-move node block (lvar-tn node block vector) result)
+    (flet ((compute-setter ()
+             (macrolet
+                 ((frob ()
+                    (let ((*package* (find-package :sb!vm))
+                          (clauses nil))
+                      (map nil (lambda (s)
+                                 (when (sb!vm:saetp-specifier s)
+                                   (push
+                                    `(,(sb!vm:saetp-typecode s)
+                                       (lambda (index tn)
+                                         #!+(or x86 x86-64)
+                                         (vop ,(symbolicate "DATA-VECTOR-SET-WITH-OFFSET/"
+                                                            (sb!vm:saetp-primitive-type-name s))
+                                              node block result index tn 0 tn)
+                                         #!-(or x86 x86-64)
+                                         (vop ,(symbolicate "DATA-VECTOR-SET/"
+                                                            (sb!vm:saetp-primitive-type-name s))
+                                              node block result index tn tn)))
+                                    clauses)))
+                           sb!vm:*specialized-array-element-type-properties*)
+                      `(ecase (sb!vm:saetp-typecode saetp)
+                         ,@(nreverse clauses)))))
+               (frob)))
+           (tnify (index)
+             (constant-tn (find-constant index))))
+      (let ((setter (compute-setter))
+            (length (length initial-contents)))
+        (dotimes (i length)
+          (emit-move node block (lvar-tn node block (pop initial-contents)) tmp)
+          (funcall setter (tnify i) tmp))))
+    (move-lvar-result node block locs lvar)))
+
 ;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite
 ;;; cut it for symbols, where under certain compilation options
 ;;; (e.g. #!+SB-THREAD) we have to do something complicated, rather
@@ -175,7 +220,7 @@
 ;;; Stack allocation optimizers per platform support
 ;;;
 ;;; Platforms with stack-allocatable vectors
-#!+(or x86 x86-64)
+#!+(or hppa mips x86 x86-64)
 (progn
   (defoptimizer (allocate-vector stack-allocate-result)
       ((type length words) node dx)
@@ -185,7 +230,7 @@
         ;; stack guard pages.
         (values-subtypep (lvar-derived-type words)
                          (load-time-value
-                          (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-size*
+                          (specifier-type `(integer 0 ,(- (/ sb!vm::*backend-page-bytes*
                                                              sb!vm:n-word-bytes)
                                                           sb!vm:vector-data-offset)))))))
 
@@ -208,7 +253,7 @@
         (annotate-1-value-lvar arg)))))
 
 ;;; ...lists
-#!+(or alpha mips ppc sparc x86 x86-64)
+#!+(or alpha hppa mips ppc sparc x86 x86-64)
 (progn
   (defoptimizer (list stack-allocate-result) ((&rest args) node dx)
     (declare (ignore node dx))
@@ -221,7 +266,7 @@
     t))
 
 ;;; ...conses
-#!+(or mips x86 x86-64)
+#!+(or hppa mips x86 x86-64)
 (defoptimizer (cons stack-allocate-result) ((&rest args) node dx)
   (declare (ignore node dx))
   t)