X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmeta-vmdef.lisp;h=a3fcba105472d7f9b779c9e7110902559e7c960f;hb=51cf665f514935c8067f86f3850fd917731cada0;hp=7d5b1bbf700310acfa76512dfe16fd8d7f6eba26;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git

diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 7d5b1bb..a3fcba1 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)))))
 
@@ -1504,11 +1502,11 @@
 ;;;     are defaulted from the inherited argument (or result) of the same
 ;;;     name. The following operand options are defined:
 ;;;
-;;; :SCs (SC*)
-;;;     :SCs specifies good SCs for this operand. Other SCs will be
-;;;	penalized according to move costs. A load TN will be allocated if
-;;;	necessary, guaranteeing that the operand is always one of the
-;;;	specified SCs.
+;;;     :SCs (SC*)
+;;;         :SCs specifies good SCs for this operand. Other SCs will
+;;;         be penalized according to move costs. A load TN will be
+;;;         allocated if necessary, guaranteeing that the operand is
+;;;         always one of the specified SCs.
 ;;;
 ;;;     :LOAD-TN Load-Name
 ;;;         Load-Name is bound to the load TN allocated for this