X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=dc5b37d32ee73cb7e26579427a3d17be0f0aa793;hb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;hp=b44b9ab9f8811e11179086b80853deaba789643b;hpb=c6f456356fb8899efa02b2a74a23e653fef3e57d;p=sbcl.git

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index b44b9ab..dc5b37d 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -275,8 +275,7 @@
 ;;; type descriptor for the Lisp type that is equivalent to this type.
 (defmacro !def-primitive-type (name scs &key (type name))
   (declare (type symbol name) (type list scs))
-  (let ((scns (mapcar #'meta-sc-number-or-lose scs))
-	(ctype-form `(specifier-type ',type)))
+  (let ((scns (mapcar #'meta-sc-number-or-lose scs)))
     `(progn
        (/show0 "doing !DEF-PRIMITIVE-TYPE, NAME=..")
        (/primitive-print ,(symbol-name name))
@@ -284,9 +283,8 @@
 	 (setf (gethash ',name *backend-meta-primitive-type-names*)
 	       (make-primitive-type :name ',name
 				    :scs ',scns
-				    :type ,ctype-form)))
-       ,(once-only ((n-old `(gethash ',name *backend-primitive-type-names*))
-		    (n-type ctype-form))
+				    :specifier ',type)))
+       ,(once-only ((n-old `(gethash ',name *backend-primitive-type-names*)))
 	  `(progn
 	     ;; If the PRIMITIVE-TYPE structure already exists, we
 	     ;; destructively modify it so that existing references in
@@ -300,13 +298,13 @@
 	     (cond (,n-old
 		    (/show0 "in ,N-OLD clause of COND")
 		    (setf (primitive-type-scs ,n-old) ',scns)
-		    (setf (primitive-type-type ,n-old) ,n-type))
+		    (setf (primitive-type-specifier ,n-old) ',type))
 		   (t
 		    (/show0 "in T clause of COND")
 		    (setf (gethash ',name *backend-primitive-type-names*)
 			  (make-primitive-type :name ',name
 					       :scs ',scns
-					       :type ,n-type))))
+					       :specifier ',type))))
 	     (/show0 "done with !DEF-PRIMITIVE-TYPE")
 	     ',name)))))
 
@@ -681,8 +679,16 @@
 				       nil)
 				   t)))
 			   :key #'car))
-	     (oe-type '(mod #.max-vop-tn-refs)) ; :REF-ORDERING element type
-	     (te-type '(mod #.(* max-vop-tn-refs 2))) ; :TARGETS element type
+	     ;; :REF-ORDERING element type
+	     ;;
+	     ;; KLUDGE: was (MOD #.MAX-VOP-TN-REFS), which is still right
+	     (oe-type '(unsigned-byte 8))
+	     ;; :TARGETS element-type
+	     ;;
+	     ;; KLUDGE: was (MOD #.(* MAX-VOP-TN-REFS 2)), which does
+	     ;; not correspond to the definition in
+	     ;; src/compiler/vop.lisp.
+	     (te-type '(unsigned-byte 16))
 	     (ordering (make-specializable-array
 			(length sorted)
 			:element-type oe-type)))
@@ -748,13 +754,13 @@
 				(rassoc name (funs)))))
 		(unless name
 		  (error "no move function defined to ~:[save~;load~] SC ~S ~
-			  with ~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~]~@
-				 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
@@ -1259,7 +1265,7 @@
 		       (error "bad thing to be a operand type: ~S" spec)))))))
     (mapcar #'parse-operand-type specs)))
 
-;;; Check the consistency of Op's Sc restrictions with the specified
+;;; Check the consistency of OP's SC restrictions with the specified
 ;;; primitive-type restriction. :CONSTANT operands have already been
 ;;; filtered out, so only :OR and * restrictions are left.
 ;;;