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