Simplify EMIT-VOP further.
[sbcl.git] / src / compiler / meta-vmdef.lisp
index b7318fe..e29e5ba 100644 (file)
   (note nil :type (or string null))
   ;; a list of the names of the Effects and Affected attributes for
   ;; this VOP
-  (effects '(any) :type list)
-  (affected '(any) :type list)
+  (effects '#1=(any) :type list)
+  (affected '#1# :type list)
   ;; a list of the names of functions this VOP is a translation of and
   ;; the policy that allows this translation to be done. :FAST is a
   ;; safe default, since it isn't a safe policy.
                          1)
                       (ash (meta-sc-number-or-lose sc) 1))))
           (incf index))
-        ;; KLUDGE: As in the other COERCEs wrapped around with
-        ;; MAKE-SPECIALIZABLE-ARRAY results in COMPUTE-REF-ORDERING,
-        ;; this coercion could be removed by a sufficiently smart
-        ;; compiler, but I dunno whether Python is that smart. It
-        ;; would be good to check this and help it if it's not smart
-        ;; enough to remove it for itself. However, it's probably not
-        ;; urgent, since the overhead of an extra no-op conversion is
-        ;; unlikely to be large compared to consing and corresponding
-        ;; GC. -- WHN ca. 19990701
-        `(coerce ,results '(specializable-vector ,element-type))))))
+        ;; KLUDGE: The load-time MAKE-ARRAY here is an artifact of our
+        ;; cross-compilation strategy, and the conservative
+        ;; assumptions we are forced to make on which specialized
+        ;; arrays exist on the host lisp that the cross-compiler is
+        ;; running on.  (We used to use COERCE here, but that caused
+        ;; SUBTYPEP calls too early in cold-init for comfort).  --
+        ;; CSR, 2009-10-30
+        `(make-array ,(length results) :element-type '(specializable ,element-type) :initial-contents ',results)))))
 
 (defun compute-ref-ordering (parse)
   (let* ((num-args (+ (length (vop-parse-args parse))
           (let ((target (find-operand (operand-parse-target op) parse
                                       '(:temporary :result))))
             ;; KLUDGE: These formulas must be consistent with those in
-            ;; %EMIT-GENERIC-VOP, and this is currently maintained by
+            ;; EMIT-VOP, and this is currently maintained by
             ;; hand. -- WHN 2002-01-30, paraphrasing APD
             (targets (+ (* index max-vop-tn-refs)
                         (ecase (operand-parse-kind target)
             (incf index)))
         `(:num-args ,num-args
           :num-results ,num-results
-          ;; KLUDGE: The (COERCE .. (SPECIALIZABLE-VECTOR ..)) wrapper
-          ;; here around the result returned by
-          ;; MAKE-SPECIALIZABLE-ARRAY above was of course added to
-          ;; help with cross-compilation. "A sufficiently smart
-          ;; compiler" should be able to optimize all this away in the
-          ;; final target Lisp, leaving a single MAKE-ARRAY with no
-          ;; subsequent coercion. However, I don't know whether Python
-          ;; is that smart. (Can it figure out the return type of
-          ;; MAKE-ARRAY? Does it know that COERCE can be optimized
-          ;; away if the input type is known to be the same as the
-          ;; COERCEd-to type?) At some point it would be good to test
-          ;; to see whether this construct is in fact causing run-time
-          ;; overhead, and fix it if so. (Some declarations of the
-          ;; types returned by MAKE-ARRAY might be enough to fix it.)
-          ;; However, it's probably not urgent to fix this, since it's
-          ;; hard to imagine that any overhead caused by calling
-          ;; COERCE and letting it decide to bail out could be large
-          ;; compared to the cost of consing and GCing the vectors in
-          ;; the first place. -- WHN ca. 19990701
-          :ref-ordering (coerce ',ordering
-                                '(specializable-vector ,oe-type))
+          ;; KLUDGE: see the comment regarding MAKE-ARRAY in
+          ;; COMPUTE-TEMPORARIES-DESCRIPTION.  -- CSR, 2009-10-30
+          :ref-ordering (make-array ,(length ordering)
+                                    :initial-contents ',ordering
+                                    :element-type '(specializable ,oe-type))
           ,@(when (targets)
-              `(:targets (coerce ',(targets)
-                                 '(specializable-vector ,te-type)))))))))
+              `(:targets (make-array ,(length (targets))
+                                     :initial-contents ',(targets)
+                                     :element-type '(specializable ,te-type)))))))))
 
 (defun make-emit-function-and-friends (parse)
-  `(:emit-function #'emit-generic-vop
-    :temps ,(compute-temporaries-description parse)
+  `(:temps ,(compute-temporaries-description parse)
     ,@(compute-ref-ordering parse)))
 \f
 ;;;; generator functions
                               (rest type))))
            (:constant
             ``(:constant ,#'(lambda (x)
-                              (typep x ',(second type)))
+                              (sb!xc:typep x ',(second type)))
                          ,',(second type)))))))
 
 (defun specify-operand-types (types ops more-ops)
 ;;;     :LOAD-IF EXPRESSION
 ;;;         Controls whether automatic operand loading is done.
 ;;;         EXPRESSION is evaluated with the fixed operand TNs bound.
-;;;         If EXPRESSION is true,then loading is done and the variable
+;;;         If EXPRESSION is true, then loading is done and the variable
 ;;;         is bound to the load TN in the generator body. Otherwise,
 ;;;         loading is not done, and the variable is bound to the actual
 ;;;         operand.
 ;;; Call the emit function for TEMPLATE, linking the result in at the
 ;;; end of BLOCK.
 (defmacro emit-template (node block template args results &optional info)
-  (with-unique-names (first last)
-    (once-only ((n-node node)
-                (n-block block)
-                (n-template template))
-      `(multiple-value-bind (,first ,last)
-           (funcall (template-emit-function ,n-template)
-                    ,n-node ,n-block ,n-template ,args ,results
-                    ,@(when info `(,info)))
-         (insert-vop-sequence ,first ,last ,n-block nil)))))
+  `(emit-and-insert-vop ,node ,block ,template ,args ,results nil
+                        ,@(when info `(,info))))
 
 ;;; VOP Name Node Block Arg* Info* Result*
 ;;;