From 221fc7d118bd7c703a4dcccbfbbad5d6dd8a3ae6 Mon Sep 17 00:00:00 2001
From: pmai <pmai>
Date: Wed, 9 Oct 2002 15:32:29 +0000
Subject: [PATCH] This commits various patches submitted by Gerd Moellmann to
 remove unused code in various parts of PCL.  See also bug
 misc-unused-code-in-pcl in Entomotomy.

---
 pcl/boot.lisp   | 28 +---------------------------
 pcl/cache.lisp  | 27 ++++-----------------------
 pcl/defs.lisp   | 23 ++++++-----------------
 pcl/dlisp2.lisp | 23 ++++++-----------------
 pcl/dlisp3.lisp | 15 +--------------
 pcl/fin.lisp    | 43 +++----------------------------------------
 pcl/init.lisp   | 27 ++-------------------------
 7 files changed, 23 insertions(+), 163 deletions(-)

diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index 3480fa871..7fa6357ff 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.33 2002/10/09 14:19:11 pmai Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.34 2002/10/09 15:32:27 pmai Exp $")
 
 (in-package :pcl)
 
@@ -832,31 +832,6 @@ work during bootstrapping.
     (function
      (apply emf args))))
 
-;; This can be improved alot.
-(defun gf-make-function-from-emf (gf emf)
-  (etypecase emf
-    (fast-method-call (let* ((arg-info (gf-arg-info gf))
-			     (nreq (arg-info-number-required arg-info))
-			     (restp (arg-info-applyp arg-info)))
-			(lambda (&rest args)
-			  #+copy-&rest-arg (setq args (copy-list args))
-			  (trace-emf-call emf t args)
-			  (apply (fast-method-call-function emf)
-				 (fast-method-call-pv-cell emf)
-				 (fast-method-call-next-method-call emf)
-				 (if restp
-				     (let* ((rest-args (nthcdr nreq args))
-					    (req-args (ldiff args rest-args)))
-				       (nconc req-args rest-args))
-				     args)))))
-    (method-call (lambda (&rest args)
-		   #+copy-&rest-arg (setq args (copy-list args))
-		   (trace-emf-call emf t args)
-		   (apply (method-call-function emf)
-			  args
-			  (method-call-call-method-args emf))))
-    (function emf)))
-
 (defmacro bind-fast-lexical-method-macros ((args rest-arg next-method-call)
 					   &body body)
   `(macrolet ((call-next-method-bind (&body body)
@@ -1898,7 +1873,6 @@ work during bootstrapping.
 (defvar *fegf-debug-p* nil)
 
 (defun fix-early-generic-functions (&optional (noisyp *fegf-debug-p*))
-  (setq *fegf-started-p* t)
   (let ((accessors nil))
     ;; Rearrange *early-generic-functions* to speed up fix-early-generic-functions.
     (dolist (early-gf-spec *early-generic-functions*)
diff --git a/pcl/cache.lisp b/pcl/cache.lisp
index f4816216f..e344f2020 100644
--- a/pcl/cache.lisp
+++ b/pcl/cache.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.18 2002/09/07 13:28:45 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.19 2002/10/09 15:32:28 pmai Exp $")
 ;;;
 ;;; The basics of the PCL wrapper cache mechanism.
 ;;;
@@ -509,13 +509,6 @@
 		 (error "Wrapper returned from trap invalid.")))
 	  nwrapper))))
 
-(defmacro check-wrapper-validity1 (object)
-  (let ((owrapper (gensym)))
-    `(let ((,owrapper (kernel:layout-of object)))
-       (if (kernel:layout-invalid ,owrapper)
-	   (check-wrapper-validity ,object)
-	   ,owrapper))))
-
 
 (defvar *free-caches* nil)
 
@@ -839,23 +832,11 @@
 	   'invoke-effective-method-function)
       ,fn-variable ,applyp ,@required ,@(when applyp `(.dfun-rest-arg.)))))
 
-(defun make-dfun-call (metatypes applyp fn-variable)
-  (let ((required (dfun-arg-symbol-list metatypes)))
-    (if applyp
-	`(function-apply   ,fn-variable ,@required .dfun-rest-arg.)
-	`(function-funcall ,fn-variable ,@required))))
-
-(defun make-dfun-arg-list (metatypes applyp)
+(defun make-fast-method-call-lambda-list (metatypes applyp)
   (let ((required (dfun-arg-symbol-list metatypes)))
     (if applyp
-	`(list* ,@required .dfun-rest-arg.)
-	`(list ,@required))))
-
-(defun make-fast-method-call-lambda-list (metatypes applyp)
-  (nconc (list '.pv-cell. '.next-method-call.)
-	 (dfun-arg-symbol-list metatypes)
-	 (when applyp
-	   (list '.dfun-rest-arg.))))
+	`(.pv-cell. .next-method-call. ,@required .dfun-rest-arg.)
+	`(.pv-cell. .next-method-call. ,@required))))
 
 
 ;;;
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index ce41ab9ae..4b5cb7f90 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -28,33 +28,22 @@
 (in-package :pcl)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  ;; Probably have to add 'compile' if you use defconstructor.
+  (defvar *defclass-times*   '(load eval))
   
-(defvar *defclass-times*   '(load eval))	;Probably have to change this
-						;if you use defconstructor.
-(defvar *defmethod-times*  '(load eval))
-(defvar *defgeneric-times* '(load eval))
+  (defvar *defmethod-times*  '(load eval))
+  (defvar *defgeneric-times* '(load eval))
 
-; defvar is now actually in macros
-;(defvar *boot-state* ())			;NIL
-						;EARLY
-						;BRAID
-						;COMPLETE
-(defvar *fegf-started-p* nil)
-
-
-)
-
-(eval-when (:load-toplevel :execute)
   (when (eq *boot-state* 'complete)
     (error "Trying to load (or compile) PCL in an environment in which it~%~
             has already been loaded.  This doesn't work, you will have to~%~
             get a fresh lisp (reboot) and then load PCL."))
+  
   (when *boot-state*
     (cerror "Try loading (or compiling) PCL anyways."
 	    "Trying to load (or compile) PCL in an environment in which it~%~
              has already been partially loaded.  This may not work, you may~%~
-             need to get a fresh lisp (reboot) and then load PCL."))
-  )
+             need to get a fresh lisp (reboot) and then load PCL.")))
 
 
 
diff --git a/pcl/dlisp2.lisp b/pcl/dlisp2.lisp
index eb2e01907..aa2aa7082 100644
--- a/pcl/dlisp2.lisp
+++ b/pcl/dlisp2.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.8 2002/08/26 02:23:13 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.9 2002/10/09 15:32:28 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -70,22 +70,11 @@
 		      (emit-one-or-n-index-reader/writer-macro :writer nil nil)))))
    nil))
 
-;;; Note this list is setup in dlisp3.lisp when all the necessary
-;;; macros have been loaded.
-(defvar checking-or-caching-function-list nil)
-
-(defmacro emit-checking-or-caching-function-precompiled ()
-  `(cdr (assoc (list cached-emf-p return-value-p metatypes applyp)
-	       checking-or-caching-function-list
-	       :test #'equal)))
-
-(defun emit-checking-or-caching-function (cached-emf-p return-value-p metatypes applyp)
-  (let ((fn (emit-checking-or-caching-function-precompiled)))
-    (if fn
-	(values fn nil)
-	(values (emit-checking-or-caching-function-preliminary
-		 cached-emf-p return-value-p metatypes applyp)
-		t))))
+(defun emit-checking-or-caching-function (cached-emf-p return-value-p
+					  metatypes applyp)
+  (values (emit-checking-or-caching-function-preliminary
+	   cached-emf-p return-value-p metatypes applyp)
+	  t))
 
 (defvar not-in-cache (make-symbol "not in cache"))
 
diff --git a/pcl/dlisp3.lisp b/pcl/dlisp3.lisp
index 5e7fd45bb..a539c1327 100644
--- a/pcl/dlisp3.lisp
+++ b/pcl/dlisp3.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp3.lisp,v 1.5 2002/08/27 19:01:38 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp3.lisp,v 1.6 2002/10/09 15:32:28 pmai Exp $")
 ;;;
 
 (in-package :pcl)
@@ -66,19 +66,6 @@
     (NIL NIL (CLASS) T)
     (NIL NIL (CLASS CLASS) T))))
 
-(defmacro make-checking-or-caching-function-list ()
-  `(list ,@(mapcar #'(lambda (key)
-		       `(cons ',key (emit-checking-or-caching-macro ,@key)))
-		   checking-or-caching-list)))
-
-#+nil
-(defun initialize-checking-or-caching-function-list ()
-  (setq checking-or-caching-function-list
-	(make-checking-or-caching-function-list)))
-
-#+nil
-(initialize-checking-or-caching-function-list)
-
 ;;; Rather than compiling the constructors here, just tickle the range
 ;;; of shapes defined above, leaving the generation of the
 ;;; constructors to precompile-dfun-constructors.
diff --git a/pcl/fin.lisp b/pcl/fin.lisp
index aeedd9eb1..52acafde8 100644
--- a/pcl/fin.lisp
+++ b/pcl/fin.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.15 2002/08/27 19:01:39 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.16 2002/10/09 15:32:29 pmai Exp $")
 ;;;
 
   ;;   
@@ -110,23 +110,6 @@ explicitly marked saying who wrote it.
 ;;;       This must be SETF'able.
 ;;;       
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-(defconstant funcallable-instance-data
-             '(wrapper slots)
-  "These are the 'data-slots' which funcallable instances have so that
-   the meta-class funcallable-standard-class can store class, and static
-   slots in them.")
-)
-
-(defmacro funcallable-instance-data-position (data)
-  (if (and (consp data)
-           (eq (car data) 'quote))
-      (or (position (cadr data) funcallable-instance-data :test #'eq)
-          (progn
-            (warn "Unknown funcallable-instance data: ~S." (cadr data))
-            `(error "Unknown funcallable-instance data: ~S." ',(cadr data))))
-      `(position ,data funcallable-instance-data :test #'eq)))
-
 (declaim (notinline called-fin-without-function))
 (defun called-fin-without-function (&rest args)
   (declare (ignore args))
@@ -165,35 +148,15 @@ explicitly marked saying who wrote it.
   (assert (funcallable-instance-p fin))
   (setf (kernel:funcallable-instance-function fin) new-value))
 
-
-;;; FUNCALLABLE-INSTANCE-DATA-1  --  Interface
-;;;
-;;;    This "works" on non-PCL FINs, which allows us to weaken
-;;; FUNCALLABLE-INSTANCE-P to return trure for all FINs.  This is also
-;;; necessary for bootstrapping to work, since the layouts for early GFs are
-;;; not initially initialized.
-;;;
-(defmacro funcallable-instance-data-1 (fin slot)
-  (ecase (eval slot)
-    (wrapper `(kernel:%funcallable-instance-layout ,fin))
-    (slots `(kernel:%funcallable-instance-info ,fin 0))))
-
-(defmacro pcl-funcallable-instance-wrapper (x)
-  `(kernel:%funcallable-instance-layout ,x))
 
-  
 ;;;; Slightly Higher-Level stuff built on the implementation-dependent stuff.
 ;;;
-;;;
 
 (defmacro fsc-instance-p (fin)
   `(funcallable-instance-p ,fin))
 
-(defmacro fsc-instance-class (fin)
-  `(wrapper-class (funcallable-instance-data-1 ,fin 'wrapper)))
-
 (defmacro fsc-instance-wrapper (fin)
-  `(funcallable-instance-data-1 ,fin 'wrapper))
+  `(kernel:%funcallable-instance-layout ,fin))
 
 (defmacro fsc-instance-slots (fin)
-  `(funcallable-instance-data-1 ,fin 'slots))
+  `(kernel:%funcallable-instance-info ,fin 0))
diff --git a/pcl/init.lisp b/pcl/init.lisp
index a5f09304c..e0c596efb 100644
--- a/pcl/init.lisp
+++ b/pcl/init.lisp
@@ -26,7 +26,7 @@
 ;;;
 
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.13 2002/08/26 02:23:14 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.14 2002/10/09 15:32:29 pmai Exp $")
 ;;;
 ;;; This file defines the initialization and related protocols.
 ;;; 
@@ -55,34 +55,11 @@
     (apply #'initialize-instance instance initargs)
     instance))
 
-(defvar *default-initargs-flag* (list nil))
-
 (defmethod default-initargs ((class slot-class) supplied-initargs)
   (call-initialize-function
    (initialize-info-default-initargs-function
     (initialize-info class supplied-initargs))
-   nil supplied-initargs)
-  #||
-  ;; This implementation of default initargs is critically dependent
-  ;; on all-default-initargs not having any duplicate initargs in it.
-  (let ((all-default (class-default-initargs class))
-	(miss *default-initargs-flag*))
-    (flet ((getf* (plist key)
-	     (do ()
-		 ((null plist) miss)
-	       (if (eq (car plist) key)
-		   (return (cadr plist))
-		   (setq plist (cddr plist))))))
-      (labels ((default-1 (tail)
-		 (if (null tail)
-		     nil
-		     (if (eq (getf* supplied-initargs (caar tail)) miss)
-			 (list* (caar tail)
-				(funcall (cadar tail))
-				(default-1 (cdr tail)))
-			 (default-1 (cdr tail))))))
-	(append supplied-initargs (default-1 all-default)))))
-  ||#)
+   nil supplied-initargs))
 
 (defmethod initialize-instance ((instance slot-object) &rest initargs)
   (apply #'shared-initialize instance t initargs))
-- 
GitLab