X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=aa732a61a650ee6dab59dbf01b1dbf27f25d6fc6;hb=94ea2b2082deaa0331dfb66fa6af6ca12dd8dc83;hp=b7e211126f4f87e8fae5c47367a839f1164c0733;hpb=47c2f13d9cec42ff5b4f93782362579225026774;p=sbcl.git

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index b7e2111..aa732a6 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -72,7 +72,10 @@
 	       (/show0 "doing third SETF")
 	       (setf (finite-sb-live-tns res)
 		     (make-array ',size :initial-element nil))
-	       (/show0 "doing fourth and final SETF")
+	       (/show0 "doing fourth SETF")
+	       (setf (finite-sb-always-live-count res)
+		     (make-array ',size :initial-element 0))
+	       (/show0 "doing fifth and final SETF")
 	       (setf (gethash ',name *backend-sb-names*)
 		     res)))
 
@@ -751,13 +754,13 @@
 				(rassoc name (funs)))))
 		(unless name
 		  (error "no move function defined to ~:[save~;load~] SC ~S ~
-			  ~:[to~;from~] from SC ~S"
+                          ~:[to~;from~] from SC ~S"
 			 load-p sc-name load-p (sc-name alt)))
 		
 		(cond (found
 		       (unless (eq (cdr found) name)
 			 (error "can't tell whether to ~:[save~;load~]~@
-				 with ~S or ~S when operand is in SC ~S"
+                                 with ~S or ~S when operand is in SC ~S"
 				load-p name (cdr found) (sc-name alt)))
 		       (pushnew alt (car found)))
 		      (t
@@ -765,7 +768,7 @@
 	 ((member (sb-kind (sc-sb sc)) '(:non-packed :unbounded)))
 	 (t
 	  (error "SC ~S has no alternate~:[~; or constant~] SCs, yet it is~@
-		  mentioned in the restriction for operand ~S"
+                  mentioned in the restriction for operand ~S"
 		 sc-name load-p (operand-parse-name op))))))
     (funs)))
 
@@ -801,7 +804,7 @@
 		 ,form)))
 	`(when ,load-tn
 	   (error "load TN allocated, but no move function?~@
-		   VM definition is inconsistent, recompile and try again.")))))
+                   VM definition is inconsistent, recompile and try again.")))))
 
 ;;; Return the TN that we should bind to the operand's var in the
 ;;; generator body. In general, this involves evaluating the :LOAD-IF
@@ -1043,13 +1046,24 @@
 			    :key #'operand-parse-name))))))
   (values))
 
+(defun compute-parse-vop-operand-count (parse)
+  (declare (type vop-parse parse))
+  (labels ((compute-count-aux (parse)
+	     (declare (type vop-parse parse))
+	     (if (null (vop-parse-inherits parse))
+		 (length (vop-parse-operands parse))
+	         (+ (length (vop-parse-operands parse))
+		    (compute-count-aux 
+		     (vop-parse-or-lose (vop-parse-inherits parse)))))))
+    (if (null (vop-parse-inherits parse))
+	0
+        (compute-count-aux (vop-parse-or-lose (vop-parse-inherits parse))))))
+
 ;;; the top level parse function: clobber PARSE to represent the
 ;;; specified options.
 (defun parse-define-vop (parse specs)
   (declare (type vop-parse parse) (list specs))
-  (let ((*parse-vop-operand-count* (1- (+ (length (vop-parse-args parse))
-					  (length (vop-parse-results parse))
-					  (length (vop-parse-temps parse))))))
+  (let ((*parse-vop-operand-count* (compute-parse-vop-operand-count parse)))
     (dolist (spec specs)
       (unless (consp spec)
 	(error "malformed option specification: ~S" spec))
@@ -1158,7 +1172,7 @@
 			   (aref (sc-load-costs op-sc) load-scn))))
 	    (unless load
 	      (error "no move function defined to move ~:[from~;to~] SC ~
-		      ~S~%~:[to~;from~] alternate or constant SC ~S"
+                      ~S~%~:[to~;from~] alternate or constant SC ~S"
 		     load-p sc-name load-p (sc-name op-sc)))
 
 	    (let ((op-cost (svref costs op-scn)))
@@ -1259,7 +1273,7 @@
 				 (let ((alias (parse-operand-type alias)))
 				   (unless (eq (car alias) :or)
 				     (error "can't include primitive-type ~
-					     alias ~S in an :OR restriction: ~S"
+                                             alias ~S in an :OR restriction: ~S"
 					    item spec))
 				   (dolist (x (cdr alias))
 				     (results x)))
@@ -1298,10 +1312,10 @@
 			       nil)
 		    (when (svref load-scs rep) (return t)))
 	    (error "In the ~A ~:[result~;argument~] to VOP ~S,~@
-		    none of the SCs allowed by the operand type ~S can ~
-		    directly be loaded~@
-		    into any of the restriction's SCs:~%  ~S~:[~;~@
-		    [* type operand must allow T's SCs.]~]"
+                    none of the SCs allowed by the operand type ~S can ~
+                    directly be loaded~@
+                    into any of the restriction's SCs:~%  ~S~:[~;~@
+                    [* type operand must allow T's SCs.]~]"
 		   (operand-parse-name op) load-p (vop-parse-name parse)
 		   ptype
 		   scs (eq type '*)))))
@@ -1314,8 +1328,8 @@
 			     (meta-primitive-type-or-lose ptype))
 			(return t))))
 	  (warn "~:[Result~;Argument~] ~A to VOP ~S~@
-		 has SC restriction ~S which is ~
-		 not allowed by the operand type:~%  ~S"
+                 has SC restriction ~S which is ~
+                 not allowed by the operand type:~%  ~S"
 		load-p (operand-parse-name op) (vop-parse-name parse)
 		sc type)))))