From: Stas Boukarev <stassats@gmail.com>
Date: Mon, 24 Jun 2013 10:28:30 +0000 (+0400)
Subject: Simplify EMIT-VOP further.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8900bab84deb87a7e2a039db7ecb224bcf871708;p=sbcl.git

Simplify EMIT-VOP further.

EMIT-VOP is only ever used in conjunction with INSERT-VOP-SEQUENCE, by
returning two values: first and last VOPs, all linked together,
INSERT-VOP-SEQUENCE then inserts them into the block. But nowadays
EMIT-VOP always returns the same VOP as the second value.
* EMIT-VOP now returns one value, the emitted VOP.
* INSERT-VOP-SEQUENCE is renamed to INSERT-VOP, accepts only one VOP.
* A new function EMIT-AND-INSERT-VOP is added, which combines them,
  and is used anywhere where EMIT-VOP was used.

This makes things less complicated, and reduces core size by 32KB, the
same as the previous commit, for a total of 64KB of savings
essentially for free.

(Also squeeze a couple of line-break fixes)
---

diff --git a/src/code/debug-var-io.lisp b/src/code/debug-var-io.lisp
index 94a59ce..eac1df3 100644
--- a/src/code/debug-var-io.lisp
+++ b/src/code/debug-var-io.lisp
@@ -40,10 +40,10 @@
 
 (defmacro read-var-integer (vec index)
   (once-only ((vec vec))
-    `(multiple-value-bind (vector new-index)
+    `(multiple-value-bind (value new-index)
          (%read-var-integer ,vec ,index)
        (setf ,index new-index)
-       vector)))
+       value)))
 
 ;;; Take an adjustable vector VEC with a fill pointer and push the
 ;;; variable length representation of INT on the end.
diff --git a/src/compiler/alpha/pred.lisp b/src/compiler/alpha/pred.lisp
index 413eaab..fe67c27 100644
--- a/src/compiler/alpha/pred.lisp
+++ b/src/compiler/alpha/pred.lisp
@@ -33,8 +33,7 @@
   (:generator 0
      (error "BRANCH-IF not yet implemented")))
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node dst-tn x-tn y-tn))
   nil)
 
diff --git a/src/compiler/hppa/pred.lisp b/src/compiler/hppa/pred.lisp
index d6261fb..8c40e9a 100644
--- a/src/compiler/hppa/pred.lisp
+++ b/src/compiler/hppa/pred.lisp
@@ -23,8 +23,7 @@
   (:generator 0
      (error "BRANCH-IF not yet implemented")))
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node dst-tn x-tn y-tn))
   nil)
 
diff --git a/src/compiler/ir2opt.lisp b/src/compiler/ir2opt.lisp
index 8705c4a..8fef8ec 100644
--- a/src/compiler/ir2opt.lisp
+++ b/src/compiler/ir2opt.lisp
@@ -128,13 +128,11 @@
   (delete-vop vop)
   (flet ((load-and-coerce (dst src)
            (when (and dst (neq dst src))
-             (let ((end  (ir2-block-last-vop 2block))
-                   (move (template-or-lose 'move)))
-               (multiple-value-bind (first last)
-                   (emit-vop node 2block move
-                             (reference-tn src nil)
-                             (reference-tn dst t))
-                 (insert-vop-sequence first last 2block end))))))
+             (emit-and-insert-vop node 2block
+                                  (template-or-lose 'move)
+                                  (reference-tn src nil)
+                                  (reference-tn dst t)
+                                  (ir2-block-last-vop 2block)))))
     (load-and-coerce arg-if   value-if)
     (load-and-coerce arg-else value-else))
   (emit-template node 2block (template-or-lose cmove-vop)
diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 44276fd..e29e5ba 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -1741,14 +1741,8 @@
 ;;; 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)
-           (emit-vop ,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*
 ;;;
diff --git a/src/compiler/mips/pred.lisp b/src/compiler/mips/pred.lisp
index 7bd7c16..1590060 100644
--- a/src/compiler/mips/pred.lisp
+++ b/src/compiler/mips/pred.lisp
@@ -24,8 +24,7 @@
   (:generator 0
      (error "BRANCH-IF not yet implemented")))
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node dst-tn x-tn y-tn))
   nil)
 
diff --git a/src/compiler/ppc/pred.lisp b/src/compiler/ppc/pred.lisp
index 9237916..5ea56ac 100644
--- a/src/compiler/ppc/pred.lisp
+++ b/src/compiler/ppc/pred.lisp
@@ -27,8 +27,7 @@
   (:generator 0
      (error "BRANCH-IF not yet implemented")))
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node dst-tn x-tn y-tn))
   nil)
 
diff --git a/src/compiler/sparc/pred.lisp b/src/compiler/sparc/pred.lisp
index 9677a69..ba29770 100644
--- a/src/compiler/sparc/pred.lisp
+++ b/src/compiler/sparc/pred.lisp
@@ -34,8 +34,7 @@
   (:generator 0
      (error "BRANCH-IF not yet implemented")))
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node dst-tn x-tn y-tn))
   nil)
 
diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp
index c75aebf..79ce6dc 100644
--- a/src/compiler/tn.lisp
+++ b/src/compiler/tn.lisp
@@ -343,10 +343,7 @@
            (type template template) (type tn x y))
   (let ((arg (reference-tn x nil))
         (result (reference-tn y t)))
-    (multiple-value-bind (first last)
-        (emit-vop node block template arg result)
-      (insert-vop-sequence first last block before)
-      last)))
+    (emit-and-insert-vop node block template arg result before)))
 
 ;;; like EMIT-MOVE-TEMPLATE, except that we pass in INFO args too
 (defun emit-load-template (node block template x y info &optional before)
@@ -354,10 +351,7 @@
            (type template template) (type tn x y))
   (let ((arg (reference-tn x nil))
         (result (reference-tn y t)))
-    (multiple-value-bind (first last)
-        (emit-vop node block template arg result info)
-      (insert-vop-sequence first last block before)
-      last)))
+    (emit-and-insert-vop node block template arg result before info)))
 
 ;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes two args
 (defun emit-move-arg-template (node block template x f y &optional before)
@@ -367,20 +361,14 @@
         (f-ref (reference-tn f nil))
         (y-ref (reference-tn y t)))
     (setf (tn-ref-across x-ref) f-ref)
-    (multiple-value-bind (first last)
-        (emit-vop node block template x-ref y-ref)
-      (insert-vop-sequence first last block before)
-      last)))
+    (emit-and-insert-vop node block template x-ref y-ref before)))
 
 ;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes no args
 (defun emit-context-template (node block template y &optional before)
   (declare (type node node) (type ir2-block block)
            (type template template) (type tn y))
   (let ((y-ref (reference-tn y t)))
-    (multiple-value-bind (first last)
-        (emit-vop node block template nil y-ref)
-      (insert-vop-sequence first last block before)
-      last)))
+    (emit-and-insert-vop node block template nil y-ref before)))
 
 ;;; Return the label marking the start of Block, assigning one if necessary.
 (defun block-label (block)
@@ -406,27 +394,33 @@
     (setf (ir2-block-dropped-thru-to 2block) t))
   nil)
 
-;;; Link a list of VOPs from First to Last into Block, Before the specified
-;;; VOP. If Before is NIL, insert at the end.
-(defun insert-vop-sequence (first last block before)
-  (declare (type vop first last) (type ir2-block block)
+;;; Insert a VOP into BLOCK, before the specified
+;;; BEFORE VOP. If BEFORE is NIL, insert at the end.
+(defun insert-vop (vop block before)
+  (declare (type vop vop) (type ir2-block block)
            (type (or vop null) before))
   (if before
       (let ((prev (vop-prev before)))
-        (setf (vop-prev first) prev)
+        (setf (vop-prev vop) prev)
         (if prev
-            (setf (vop-next prev) first)
-            (setf (ir2-block-start-vop block) first))
-        (setf (vop-next last) before)
-        (setf (vop-prev before) last))
+            (setf (vop-next prev) vop)
+            (setf (ir2-block-start-vop block) vop))
+        (setf (vop-next vop) before)
+        (setf (vop-prev before) vop))
       (let ((current (ir2-block-last-vop block)))
-        (setf (vop-prev first) current)
-        (setf (ir2-block-last-vop block) last)
+        (setf (vop-prev vop) current)
+        (setf (ir2-block-last-vop block) vop)
         (if current
-            (setf (vop-next current) first)
-            (setf (ir2-block-start-vop block) first))))
+            (setf (vop-next current) vop)
+            (setf (ir2-block-start-vop block) vop))))
   (values))
 
+(defun emit-and-insert-vop (node block template arg result before
+                            &optional info)
+  (let ((vop (emit-vop node block template arg result info)))
+    (insert-vop vop block before)
+    vop))
+
 ;;; Delete all of the TN-REFs associated with VOP and remove VOP from the IR2.
 (defun delete-vop (vop)
   (declare (type vop vop))
diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp
index a52b0f7..adf60b6 100644
--- a/src/compiler/vmdef.lisp
+++ b/src/compiler/vmdef.lisp
@@ -114,18 +114,15 @@
 
 (def!constant sc-bits (integer-length (1- sc-number-limit)))
 
-;; a function that emits the VOPs for this template. Arguments:
-;;  1] Node for source context.
-;;  2] IR2-BLOCK that we place the VOP in.
-;;  3] This structure.
-;;  4] Head of argument TN-REF list.
-;;  5] Head of result TN-REF list.
-;;  6] If INFO-ARG-COUNT is non-zero, then a list of the magic
-;;     arguments.
-;;
-;; Two values are returned: the first and last VOP emitted. This vop
-;; sequence must be linked into the VOP Next/Prev chain for the
-;; block. At least one VOP is always emitted.
+;;; Emit a VOP for TEMPLATE. Arguments:
+;;; NODE Node for source context.
+;;; BLOCK IR2-BLOCK that we place the VOP in.
+;;; TEMPLATE: VOP template
+;;; ARGS Head of argument TN-REF list.
+;;; RESULT Head of result TN-REF list.
+;;; INFO If INFO-ARG-COUNT is non-zero, then a list of the magic arguments.
+;;;
+;;; Return the emitted vop
 (defun emit-vop (node block template args results &optional info)
   (let* ((vop (make-vop block node template args results))
          (num-args (vop-info-num-args template))
@@ -195,7 +192,7 @@
                    (target-if-desirable
                     (aref refs (ldb (byte 8 8) target))
                     (aref refs (ldb (byte 8 0) target)))))))
-           (values vop vop))
+           vop)
       (fill *vop-tn-refs* nil))))
 
 ;;;; function translation stuff
diff --git a/src/compiler/x86-64/pred.lisp b/src/compiler/x86-64/pred.lisp
index 9dce152..8f2abbd 100644
--- a/src/compiler/x86-64/pred.lisp
+++ b/src/compiler/x86-64/pred.lisp
@@ -95,8 +95,7 @@
    the values, and VOP-name the name of the VOP that will be used
    to execute the conditional move.")
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node))
   (let* ((ptype (sb!c::tn-primitive-type dst-tn))
          (name  (sb!c::primitive-type-name ptype))
diff --git a/src/compiler/x86/pred.lisp b/src/compiler/x86/pred.lisp
index 0288887..5ed4fd9 100644
--- a/src/compiler/x86/pred.lisp
+++ b/src/compiler/x86/pred.lisp
@@ -82,8 +82,7 @@
    the values, and VOP-name the name of the VOP that will be used
    to execute the conditional move.")
 
-(defun
-    convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
   (declare (ignore node))
   (let* ((ptype (sb!c::tn-primitive-type dst-tn))
          (name  (sb!c::primitive-type-name ptype))