From f61b94d26de9fff3c52b99176278e6f50a103693 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Tue, 10 Jan 2017 18:44:01 -0500 Subject: [PATCH] Kill *PCL-CLASS-BOOT* hack. --- src/code/class.lisp | 47 ----------------------------------------- src/code/early-defmethod.lisp | 3 --- src/pcl/gray-streams-class.lisp | 11 ++++------ src/pcl/wrapper.lisp | 21 +++--------------- 4 files changed, 7 insertions(+), 75 deletions(-) diff --git a/src/code/class.lisp b/src/code/class.lisp index 144c7f04a..7a10851e9 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1270,53 +1270,6 @@ between the ~A definition and the ~A definition" :invalidate nil))))) (/show0 "done with loop over *!BUILT-IN-CLASSES*")) -;;; Define temporary PCL STANDARD-CLASSes. These will be set up -;;; correctly and the Lisp layout replaced by a PCL wrapper after PCL -;;; is loaded and the class defined. -(!cold-init-forms - (/show0 "about to define temporary STANDARD-CLASSes") - ;; You'd think with all the pedantic explanation in here it would at least - ;; be right, but it isn't: layout-inherits for FUNDAMENTAL-STREAM - ;; ends up as (T SLOT-OBJECT STREAM STANDARD-OBJECT) - (dolist (x '(;; Why is STREAM duplicated in this list? Because, when - ;; the inherits-vector of FUNDAMENTAL-STREAM is set up, - ;; a vector containing the elements of the list below, - ;; i.e. '(T STREAM STREAM), is created, and - ;; this is what the function ORDER-LAYOUT-INHERITS - ;; would do, too. - ;; - ;; So, the purpose is to guarantee a valid layout for - ;; the FUNDAMENTAL-STREAM class, matching what - ;; ORDER-LAYOUT-INHERITS would do. - ;; ORDER-LAYOUT-INHERITS would place STREAM at index 2 - ;; in the INHERITS(-VECTOR). Index 1 would not be - ;; filled, so STREAM is duplicated there (as - ;; ORDER-LAYOUTS-INHERITS would do). Maybe the - ;; duplicate definition could be removed (removing a - ;; STREAM element), because FUNDAMENTAL-STREAM is - ;; redefined after PCL is set up, anyway. But to play - ;; it safely, we define the class with a valid INHERITS - ;; vector. - (fundamental-stream (t stream stream)))) - (/show0 "defining temporary STANDARD-CLASS") - (let* ((name (first x)) - (inherits-list (second x)) - (classoid (make-standard-classoid :name name)) - (classoid-cell (find-classoid-cell name :create t))) - ;; Needed to open-code the MAP, below - (declare (type list inherits-list)) - (setf (classoid-cell-classoid classoid-cell) classoid - (info :type :kind name) :instance) - (let ((inherits (map 'simple-vector - (lambda (x) - (classoid-layout (find-classoid x))) - inherits-list))) - #-sb-xc-host (/show0 "INHERITS=..") #-sb-xc-host (/hexstr inherits) - (register-layout (find-and-init-or-check-layout name 0 inherits - -1 +layout-all-tagged+) - :invalidate nil)))) - (/show0 "done defining temporary STANDARD-CLASSes")) - ;;; Now that we have set up the class heterarchy, seal the sealed ;;; classes. This must be done after the subclasses have been set up. (!cold-init-forms diff --git a/src/code/early-defmethod.lisp b/src/code/early-defmethod.lisp index ccd9b314f..2a312362f 100644 --- a/src/code/early-defmethod.lisp +++ b/src/code/early-defmethod.lisp @@ -56,9 +56,6 @@ (defvar *!trivial-methods* '()) (defun !trivial-defmethod (name specializer qualifier lambda-list lambda source-loc) (let ((gf (assoc name *!trivial-methods*))) - (unless gf - (setq gf (cons name #())) - (push gf *!trivial-methods*)) ;; Append the method but don't bother finding a predicate for it. ;; Methods occurring in early warm load (notably from SB-FASTEVAL) ;; wil be properly installed when 'pcl/print-object.lisp' is loaded. diff --git a/src/pcl/gray-streams-class.lisp b/src/pcl/gray-streams-class.lisp index 0f2f5fbbf..17baced98 100644 --- a/src/pcl/gray-streams-class.lisp +++ b/src/pcl/gray-streams-class.lisp @@ -10,13 +10,10 @@ (in-package "SB-GRAY") -;;; Bootstrap the FUNDAMENTAL-STREAM class. -(let ((sb-pcl::*pcl-class-boot* 'fundamental-stream)) - (defclass fundamental-stream (standard-object stream) - ((open-p :initform t - :accessor stream-open-p)) - #+sb-doc - (:documentation "Base class for all Gray streams."))) +(defclass fundamental-stream (standard-object stream) + ((open-p :initform t :accessor stream-open-p)) + #+sb-doc + (:documentation "Base class for all Gray streams.")) ;;; Define the stream classes. (defclass fundamental-input-stream (fundamental-stream) nil diff --git a/src/pcl/wrapper.lisp b/src/pcl/wrapper.lisp index 4deae52e3..1e083d93e 100644 --- a/src/pcl/wrapper.lisp +++ b/src/pcl/wrapper.lisp @@ -55,12 +55,6 @@ :classoid (make-standard-classoid :name name :pcl-class class)))))) -;;; The following variable may be set to a STANDARD-CLASS that has -;;; already been created by the lisp code and which is to be redefined -;;; by PCL. This allows STANDARD-CLASSes to be defined and used for -;;; type testing and dispatch before PCL is loaded. -(defvar *pcl-class-boot* nil) - ;;; In SBCL, as in CMU CL, the layouts (a.k.a wrappers) for built-in ;;; and structure classes already exist when PCL is initialized, so we ;;; don't necessarily always make a wrapper. Also, we help maintain @@ -79,18 +73,9 @@ ((or (*subtypep (class-of class) *the-class-standard-class*) (*subtypep (class-of class) *the-class-funcallable-standard-class*) (typep class 'forward-referenced-class)) - (cond ((and *pcl-class-boot* - (eq (slot-value class 'name) *pcl-class-boot*)) - (let ((found (find-classoid - (slot-value class 'name)))) - (unless (classoid-pcl-class found) - (setf (classoid-pcl-class found) class)) - (aver (eq (classoid-pcl-class found) class)) - found)) - (t - (let ((name (slot-value class 'name))) - (make-standard-classoid :pcl-class class - :name (and (symbolp name) name)))))) + (let ((name (slot-value class 'name))) + (make-standard-classoid :pcl-class class + :name (and (symbolp name) name)))) (t (bug "Got to T branch in ~S" 'make-wrapper)))))) (t -- 2.11.4.GIT