X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdisassem.lisp;h=3ff06aa24d91ed7d0b7e51d238d234e294cd71f2;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=a7ec03bbbe9603b03e8f26c879afaed791f96541;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp
index a7ec03b..3ff06aa 100644
--- a/src/compiler/disassem.lisp
+++ b/src/compiler/disassem.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!DISASSEM")
-
-(file-comment
-  "$Header$")
 
 ;;; types and defaults
 
@@ -403,9 +400,7 @@
 	   (eq (car form) 'function))
       ;; a function def
       (let ((wrapper-name (symbolicate prefix "-" arg-name "-WRAPPER"))
-	    (wrapper-args nil))
-	(dotimes (i (length funargs))
-	  (push (gensym) wrapper-args))
+	    (wrapper-args (make-gensym-list (length funargs))))
 	(values `#',wrapper-name
 		`(defun ,wrapper-name ,wrapper-args
 		   (funcall ,form ,@wrapper-args))))
@@ -632,57 +627,6 @@
 				    arg ,args-var ',name)))
 			     ,args-var))))))))))
 
-;;; FIXME: old CMU CL version, doesn't work with SBCL bootstrapping
-;;; scheme, kept around for reference until I get the new sbcl-0.6.4
-;;; version to work, then can be deleted
-#|
-(defun gen-format-def-form (header descrips &optional (evalp t))
-  #!+sb-doc
-  "Generate a form to define an instruction format. See
-  DEFINE-INSTRUCTION-FORMAT for more info."
-  (when (atom header)
-    (setf header (list header)))
-  (destructuring-bind (name length &key default-printer include) header
-    (let ((args-var (gensym))
-	  (length-var (gensym))
-	  (all-wrapper-defs nil)
-	  (arg-count 0))
-      (collect ((arg-def-forms))
-	(dolist (descrip descrips)
-	  (let ((name (pop descrip)))
-	    (multiple-value-bind (descrip wrapper-defs)
-		(munge-fun-refs
-		 descrip evalp t (format nil "~:@(~A~)-~D" name arg-count))
-	      (arg-def-forms
-	       (update-args-form args-var `',name descrip evalp length-var))
-	      (setf all-wrapper-defs
-		    (nconc wrapper-defs all-wrapper-defs)))
-	    (incf arg-count)))
-	`(progn
-	   ,@all-wrapper-defs
-	   (eval-when (:compile-toplevel :execute)
-	     (let ((,length-var ,length)
-		   (,args-var
-		    ,(and include
-			  `(copy-list
-			    (format-args
-			     (format-or-lose ,include))))))
-	       ,@(arg-def-forms)
-	       (setf (gethash ',name *disassem-inst-formats*)
-		     (make-instruction-format
-		      :name ',name
-		      :length (bits-to-bytes ,length-var)
-		      :default-printer ,(maybe-quote evalp default-printer)
-		      :args ,args-var))
-	       (eval
-		`(progn
-		   ,@(mapcar #'(lambda (arg)
-				 (when (arg-fields arg)
-				   (gen-arg-access-macro-def-form
-				    arg ,args-var ',name)))
-			     ,args-var))))))))))
-|#
-
 ;;; FIXME: probably needed only at build-the-system time, not in
 ;;; final target system
 (defun modify-or-add-arg (arg-name
@@ -810,9 +754,7 @@
 	       ;; just use the same as the forms
 	       (setq vars nil))
 	      (t
-	       (setq vars nil)
-	       (dotimes (i (length forms))
-		 (push (gensym) vars))))
+	       (setq vars (make-gensym-list (length forms)))))
 	(set-arg-temps vars forms arg kind funstate)))
     (or vars forms)))