diff --git a/pcl/boot.lisp b/pcl/boot.lisp
index 99daa34ef18f215fc01e85fe4e2b7266498713a0..008967825e514bf1aba17600f1c03da1d8addf16 100644
--- a/pcl/boot.lisp
+++ b/pcl/boot.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.19 1999/03/14 01:14:13 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.20 1999/05/30 23:13:51 pw Exp $")
 
 (in-package :pcl)
 
@@ -590,7 +590,6 @@ work during bootstrapping.
   (function #'identity :type function)
   call-method-args)
 
-#+cmu
 (declaim (ext:freeze-type method-call))
 
 (defmacro invoke-method-call1 (function args cm-args)
@@ -614,7 +613,6 @@ work during bootstrapping.
   next-method-call
   arg-info)
 
-#+cmu
 (declaim (ext:freeze-type fast-method-call))
 
 (defmacro fmc-funcall (fn pv-cell next-method-call &rest args)
@@ -629,7 +627,6 @@ work during bootstrapping.
 (defstruct fast-instance-boundp
   (index 0 :type fixnum))
 
-#+cmu
 (declaim (ext:freeze-type fast-instance-boundp))
 
 (eval-when (compile load eval)
@@ -679,9 +676,8 @@ work during bootstrapping.
   (setq restp (eval restp))
   `(progn
      (trace-emf-call ,emf ,restp (list ,@required-args+rest-arg))
-     (cond (#-(or lucid excl) (typep ,emf 'fast-method-call)
-	    #+(or lucid excl) (fast-method-call-p ,emf)
-	     (invoke-fast-method-call ,emf ,@required-args+rest-arg))
+     (cond ((typep ,emf 'fast-method-call)
+	    (invoke-fast-method-call ,emf ,@required-args+rest-arg))
 	   ,@(when (and (null restp) (= 1 (length required-args+rest-arg)))
 	       `(((typep ,emf 'fixnum)
 		  (let* ((.slots. (get-slots-or-nil
@@ -1200,42 +1196,39 @@ work during bootstrapping.
 	(intern (symbol-name key) (find-package "KEYWORD"))
 	(car key))))
 
-(defun ftype-declaration-from-lambda-list (lambda-list #+cmu name)
+(defun ftype-declaration-from-lambda-list (lambda-list name)
   (multiple-value-bind (nrequired noptional keysp restp allow-other-keys-p
 				  keywords keyword-parameters)
       (analyze-lambda-list lambda-list)
     (declare (ignore keyword-parameters))
-    (let* (#+cmu (old (c::info function type name))
-	   #+cmu (old-ftype (if (c::function-type-p old) old nil))
-	   #+cmu (old-restp (and old-ftype (c::function-type-rest old-ftype)))
-	   #+cmu (old-keys (and old-ftype
-				(mapcar #'c::key-info-name
-					(c::function-type-keywords old-ftype))))
-	   #+cmu (old-keysp (and old-ftype (c::function-type-keyp old-ftype)))
-	   #+cmu (old-allowp (and old-ftype (c::function-type-allowp old-ftype)))
-	   (keywords #+cmu (union old-keys (mapcar #'keyword-spec-name keywords))
-		     #-cmu (mapcar #'keyword-spec-name keywords)))
+    (let* ((old (c::info function type name))
+	   (old-ftype (if (c::function-type-p old) old nil))
+	   (old-restp (and old-ftype (c::function-type-rest old-ftype)))
+	   (old-keys (and old-ftype
+			  (mapcar #'c::key-info-name
+				  (c::function-type-keywords old-ftype))))
+	   (old-keysp (and old-ftype (c::function-type-keyp old-ftype)))
+	   (old-allowp (and old-ftype (c::function-type-allowp old-ftype)))
+	   (keywords (union old-keys (mapcar #'keyword-spec-name keywords))))
       `(function ,(append (make-list nrequired :initial-element 't)
 			  (when (plusp noptional)
 			    (append '(&optional)
 				    (make-list noptional :initial-element 't)))
-			  (when (or restp #+cmu old-restp)
+			  (when (or restp old-restp)
 			    '(&rest t))
-			  (when (or keysp #+cmu old-keysp)
+			  (when (or keysp old-keysp)
 			    (append '(&key)
 				    (mapcar #'(lambda (key)
 						`(,key t))
 					    keywords)
-				    (when (or allow-other-keys-p #+cmu old-allowp)
+				    (when (or allow-other-keys-p old-allowp)
 				      '(&allow-other-keys)))))
 		 *))))
 
 (defun proclaim-defgeneric (spec lambda-list)
-  #-cmu (declare (ignore lambda-list))
-  (let (#+cmu
-	(decl `(ftype ,(ftype-declaration-from-lambda-list lambda-list #+cmu spec)
+  (let ((decl `(ftype ,(ftype-declaration-from-lambda-list lambda-list spec)
 		      ,spec)))
-    #+cmu (proclaim decl)
+    (proclaim decl)
    ))
 
 ;;;; Early generic-function support
@@ -1259,7 +1252,6 @@ work during bootstrapping.
 	       existing function-specifier all-keys))))
 
 (defun generic-clobbers-function (function-specifier)
-  #+cmu
   (error 'kernel:simple-program-error
 	 :format-control
 	 "~S already names an ordinary function or a macro,~%~
@@ -1267,14 +1259,7 @@ work during bootstrapping.
 	  will require that you decide what to do with the existing function~%~
 	  definition.~%~
 	  The PCL-specific function MAKE-SPECIALIZABLE may be useful to you."
-	 :format-arguments (list function-specifier))
-  #-(or cmu)
-  (error "~S already names an ordinary function or a macro,~%~
-	  you may want to replace it with a generic function, but doing so~%~
-	  will require that you decide what to do with the existing function~%~
-	  definition.~%~
-	  The PCL-specific function MAKE-SPECIALIZABLE may be useful to you."
-	 function-specifier))
+	 :format-arguments (list function-specifier)))
 
 (defvar *sgf-wrapper* 
   (boot-make-wrapper (early-class-size 'standard-generic-function)
@@ -1332,7 +1317,6 @@ work during bootstrapping.
   (gf-info-c-a-m-emf-std-p t)
   gf-info-fast-mf-p)
 
-#+cmu
 (declaim (ext:freeze-type arg-info))
 
 (defun arg-info-valid-p (arg-info)
@@ -1533,13 +1517,13 @@ work during bootstrapping.
      fin 
      (or function
 	 (if (eq spec 'print-object)
-	     #'(#+cmu kernel:instance-lambda #-cmu lambda (instance stream)
+	     #'(kernel:instance-lambda (instance stream)
 		 (printing-random-thing (instance stream)
-		   (format stream "std-instance")))
-	     #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+					(format stream "std-instance")))
+	     #'(kernel:instance-lambda (&rest args)
 		 (declare (ignore args))
 		 (error "The function of the funcallable-instance ~S~
-                         has not been set" fin)))))
+			 has not been set" fin)))))
     (setf (gdefinition spec) fin)
     (bootstrap-set-slot 'standard-generic-function fin 'name spec)
     (bootstrap-set-slot 'standard-generic-function fin 'source (load-truename))
@@ -2072,7 +2056,7 @@ work during bootstrapping.
 (defmacro with-slots (slots instance &body body)
   (let ((in (gensym)))
     `(let ((,in ,instance))
-       #+cmu (declare (ignorable ,in))
+       (declare (ignorable ,in))
        ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
                              (third instance)
                              instance)))
@@ -2097,7 +2081,7 @@ work during bootstrapping.
 (defmacro with-accessors (slots instance &body body)
   (let ((in (gensym)))
     `(let ((,in ,instance))
-       #+cmu (declare (ignorable ,in))
+       (declare (ignorable ,in))
        ,@(let ((instance (if (and (consp instance) (eq (car instance) 'the))
                              (third instance)
                              instance)))
diff --git a/pcl/braid.lisp b/pcl/braid.lisp
index 594a24185f91d2283b8d97b6834c3748ae191564..7e8a76dec7345bbfe874fcdfc8ef866201ce7546 100644
--- a/pcl/braid.lisp
+++ b/pcl/braid.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.14 1998/12/20 04:30:16 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.15 1999/05/30 23:13:52 pw Exp $")
 ;;;
 ;;; Bootstrapping the meta-braid.
 ;;;
@@ -41,16 +41,9 @@
 (in-package :pcl)
 
 (defun allocate-standard-instance (wrapper &optional (slots-init nil slots-init-p))
-  #-new-kcl-wrapper
   (let ((instance (%%allocate-instance--class))
 	(no-of-slots (wrapper-no-of-instance-slots wrapper)))
     (setf (std-instance-wrapper instance) wrapper)
-    #-cmu
-    (setf (std-instance-slots instance) 
-	  (if slots-init-p
-	      (make-array no-of-slots :initial-contents slots-init)
-	      (make-array no-of-slots :initial-element *slot-unbound*)))
-    #+cmu ; faster version for CMUCL
     (setf (std-instance-slots instance) 
 	  (cond (slots-init-p
 		 ;; Inline the slots vector allocation and initialisation.
@@ -65,37 +58,22 @@
 		(t
 		 (make-array no-of-slots
 			     :initial-element pcl::*slot-unbound*))))
-    instance)
-  #+new-kcl-wrapper
-  (apply #'si:make-structure wrapper
-	 (if slots-init-p
-	     slots-init
-	     (let ((no-of-slots (si::s-data-length wrapper)))
-	       (if (< no-of-slots (fill-pointer *init-vector*))
-		   (aref *init-vector* no-of-slots)
-		   (get-init-list no-of-slots))))))
+    instance))
 
 (defmacro allocate-funcallable-instance-slots (wrapper &optional 
 						       slots-init-p slots-init)
-  #-new-kcl-wrapper
   `(let ((no-of-slots (wrapper-no-of-instance-slots ,wrapper)))
      ,(if slots-init-p
 	  `(if ,slots-init-p
 	       (make-array no-of-slots :initial-contents ,slots-init)
 	       (make-array no-of-slots :initial-element *slot-unbound*))
-	  `(make-array no-of-slots :initial-element *slot-unbound*)))
-  #+new-kcl-wrapper
-  (if slots-init-p
-      `(if ,slots-init-p
-	   (allocate-standard-instance ,wrapper ,slots-init)
-	   (allocate-standard-instance ,wrapper))
-      `(allocate-standard-instance ,wrapper)))
+	  `(make-array no-of-slots :initial-element *slot-unbound*))))
 
 (defun allocate-funcallable-instance (wrapper &optional (slots-init nil slots-init-p))
   (let ((fin (allocate-funcallable-instance-1)))
     (set-funcallable-instance-function
      fin
-     #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+     #'(kernel:instance-lambda (&rest args)
          (declare (ignore args))
 	 (error "The function of the funcallable-instance ~S has not been set"
 		fin)))
@@ -105,7 +83,6 @@
     fin))
 
 (defun allocate-structure-instance (wrapper &optional (slots-init nil slots-init-p))
-  #-new-kcl-wrapper
   (let* ((class (wrapper-class wrapper))
 	 (constructor (class-defstruct-constructor class)))
     (if constructor
@@ -115,11 +92,7 @@
 	    (dolist (slot slots)
 	      (setf (slot-value-using-class class instance slot) (pop slots-init))))
 	  instance)
-	(error "Can't allocate an instance of class ~S" (class-name class))))
-  #+new-kcl-wrapper
-  (if slots-init-p
-      (allocate-standard-instance wrapper slots-init)
-      (allocate-standard-instance wrapper)))
+	(error "Can't allocate an instance of class ~S" (class-name class)))))
 
 ;;;
 ;;; bootstrap-meta-braid
@@ -133,9 +106,6 @@
 				     *the-pcl-package*)))
 		     `(setf ,wr ,(if (eq class 'standard-generic-function)
 				     '*sgf-wrapper*
-				     #-cmu17
-				     `(make-wrapper (early-class-size ',class))
-				     #+cmu17
 				     `(boot-make-wrapper
 				       (early-class-size ',class)
 				       ',class))
@@ -144,8 +114,6 @@
 					 'funcallable-standard-class-wrapper
 					 'standard-class-wrapper))
 		            (wrapper-class ,wr) ,class
-		            #+new-kcl-wrapper (si::s-data-name ,wr)
-		                   #+new-kcl-wrapper ',class
 		            (find-class ',class) ,class)))
 	      classes)))		        
 
@@ -227,9 +195,6 @@
 				  ((eq class standard-generic-function)
 				   standard-generic-function-wrapper)
 				  (t
-				   #-cmu17
-				   (make-wrapper (length slots) class)
-				   #+cmu17
 				   (boot-make-wrapper (length slots) name))))
 		   (proto nil))
 	      (when (eq name 't) (setq *the-wrapper-of-t* wrapper))
@@ -240,7 +205,7 @@
 		(unless (eq (getf slot :allocation :instance) :instance)
 		  (error "Slot allocation ~S not supported in bootstrap.")))
 	      
-	      (when #+cmu17 (typep wrapper 'wrapper) #-cmu17 t
+	      (when (typep wrapper 'wrapper)
 		(setf (wrapper-instance-slots-layout wrapper)
 		      (mapcar #'canonical-slot-name slots))
 		(setf (wrapper-class-slots wrapper)
@@ -322,8 +287,6 @@
     (set-slot 'direct-subclasses (classes direct-subclasses))
     (set-slot 'direct-methods (cons nil nil))
     (set-slot 'wrapper wrapper)
-    #+new-kcl-wrapper
-    (setf (si::s-data-name wrapper) name)
     (set-slot 'predicate-name (or (cadr (assoc name *early-class-predicates*))
 				  (make-class-predicate-name name)))
     (set-slot 'plist
@@ -494,17 +457,11 @@
     (dolist (e *built-in-classes*)
       (destructuring-bind (name supers subs cpl prototype) e
 	(let* ((class (find-class name))
-	       #+cmu17
 	       (lclass (lisp:find-class name))
-	       (wrapper #-cmu17(make-wrapper 0 class)
-			#+cmu17(kernel:class-layout lclass)))
+	       (wrapper (kernel:class-layout lclass)))
 	  (set (get-built-in-class-symbol name) class)
 	  (set (get-built-in-wrapper-symbol name) wrapper)
-	  #+cmu17
 	  (setf (kernel:class-pcl-class lclass) class)
-	  #-cmu17
-	  (setf (wrapper-instance-slots-layout wrapper) ()
-		(wrapper-class-slots wrapper) ())
 
 	  (bootstrap-initialize-class 'built-in-class class
 				      name class-eq-wrapper nil
@@ -522,91 +479,17 @@
 ;;;
 ;;;
 ;;;
-#-(or new-kcl-wrapper cmu17)
-(progn
-(defvar *built-in-or-structure-wrapper-table*
-  (make-hash-table :test 'eq))
-
-(defvar wft-type1 nil)
-(defvar wft-wrapper1 nil)
-(defvar wft-type2 nil)
-(defvar wft-wrapper2 nil)
-
-(defun wrapper-for-structure (x)
-  (let ((type (structure-type x)))
-    (when (symbolp type)
-      (cond ((eq type 'std-instance) 
-	     (return-from wrapper-for-structure (std-instance-wrapper x)))
-	    ((eq type wft-type1) (return-from wrapper-for-structure wft-wrapper1))
-	    ((eq type wft-type2) (return-from wrapper-for-structure wft-wrapper2))
-	    (t (setq wft-type2 wft-type1  wft-wrapper2 wft-wrapper1))))
-    (let* ((cell (find-class-cell type))
-	   (class (or (find-class-cell-class cell)
-		      (let* (#+lucid 
-			     (*structure-type* type)
-			     #+lucid
-			     (*structure-length* (structure-length x type)))
-			(find-class-from-cell type cell))))
-	   (wrapper (if class (class-wrapper class) *the-wrapper-of-t*)))
-      (when (symbolp type)
-	(setq wft-type1 type  wft-wrapper1 wrapper))
-      wrapper)))
-
-(defun built-in-or-structure-wrapper1 (x)
-  (let ((biw (or (built-in-wrapper-of x) *the-wrapper-of-t*)))
-    (or (and (eq biw *the-wrapper-of-t*)
-	     (structurep x)
-	     (let* ((type (type-of x))
-		    #+lucid 
-		    (*structure-type* type)
-		    #+lucid
-		    (*structure-length* (structure-length x type))
-		    (class (find-class type nil)))
-	       (and class (class-wrapper class))))
-	biw)))
-)
-
-#|| ; moved to low.lisp
-(defmacro built-in-or-structure-wrapper (x)
-  (once-only (x)
-    (if (structure-functions-exist-p) ; otherwise structurep is too slow for this
-	`(if (structurep ,x)
-	     (wrapper-for-structure ,x)
-	     (if (symbolp ,x)
-		 (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*)
-		 (built-in-wrapper-of ,x)))
-	`(or (and (symbolp ,x)
-		  (if ,x *the-wrapper-of-symbol* *the-wrapper-of-null*))
-	     (built-in-or-structure-wrapper1 ,x)))))
-||#
-
-#-cmu17
-(defmacro wrapper-of-macro (x)
-  `(cond ((std-instance-p ,x)
-	  (std-instance-wrapper ,x))
-         ((fsc-instance-p ,x)
-	  (fsc-instance-wrapper ,x))	      
-         (t
-	  (#+new-kcl-wrapper built-in-wrapper-of
-	   #-new-kcl-wrapper built-in-or-structure-wrapper
-	   ,x))))
-
-#+cmu17
+
 (defmacro wrapper-of-macro (x)
   `(kernel:layout-of ,x))
 
 (defun class-of (x)
   (wrapper-class* (wrapper-of-macro x)))
 
-#+cmu17
 (declaim (inline wrapper-of))
 (defun wrapper-of (x)
   (wrapper-of-macro x))
 
-#-cmu17
-(defun structure-wrapper (x)
-  (class-wrapper (find-class (structure-type x))))
-
 (defvar find-structure-class nil)
 
 (defun eval-form (form)
@@ -629,15 +512,13 @@
 			:metaclass 'structure-class
 			:name symbol
 			:direct-superclasses
-			(cond #+cmu
-			      ;; Handle the CMUCL structure based conditions.
+			(cond ;; Handle the CMUCL structure based conditions.
 			      ((lisp:subtypep symbol 'condition)
 			       (mapcar #'lisp:class-name
 				       (kernel:class-direct-superclasses
 					(lisp:find-class symbol))))
 			      ;; Hack to add the stream class as a
 			      ;; mixin to the lisp-stream class.
-			      #+cmu
 			      ((eq symbol 'sys:lisp-stream)
 			       '(structure-object stream))
 			      ((structure-type-included-type-name symbol)
@@ -647,55 +528,6 @@
 				(structure-type-slot-description-list symbol)))))
       (error "~S is not a legal structure class name." symbol)))
 
-#-cmu17
-(eval-when (compile eval)
-
-(defun make-built-in-class-subs ()
-  (mapcar #'(lambda (e)
-	      (let ((class (car e))
-		    (class-subs ()))
-		(dolist (s *built-in-classes*)
-		  (when (memq class (cadr s)) (pushnew (car s) class-subs)))
-		(cons class class-subs)))
-	  (cons '(t) *built-in-classes*)))
-
-(defun make-built-in-class-tree ()
-  (let ((subs (make-built-in-class-subs)))
-    (labels ((descend (class)
-	       (cons class (mapcar #'descend (cdr (assq class subs))))))
-      (descend 't))))
-
-(defun make-built-in-wrapper-of-body ()
-  (make-built-in-wrapper-of-body-1 (make-built-in-class-tree)
-				   'x
-				   #'get-built-in-wrapper-symbol))
-
-(defun make-built-in-wrapper-of-body-1 (tree var get-symbol)
-  (let ((*specials* ()))
-    (declare (special *specials*))
-    (let ((inner (make-built-in-wrapper-of-body-2 tree var get-symbol)))
-      `(locally (declare (special .,*specials*)) ,inner))))
-
-(defun make-built-in-wrapper-of-body-2 (tree var get-symbol)
-  (declare (special *specials*))
-  (let ((symbol (funcall get-symbol (car tree))))
-    (push symbol *specials*)
-    (let ((sub-tests
-	    (mapcar #'(lambda (x)
-			(make-built-in-wrapper-of-body-2 x var get-symbol))
-		    (cdr tree))))
-      `(and (typep ,var ',(car tree))
-	    ,(if sub-tests
-		 `(or ,.sub-tests ,symbol)
-		 symbol)))))
-)
-
-#-cmu17
-(defun built-in-wrapper-of (x)
-  #.(when (fboundp 'make-built-in-wrapper-of-body) ; so we can at least read this file
-      (make-built-in-wrapper-of-body)))
-
-
 
 (defun method-function-returning-nil (args next-methods)
   (declare (ignore args next-methods))
@@ -737,7 +569,6 @@
     gf))
 
 
-#+cmu17
 ;;; Set inherits from CPL and register layout.  This actually installs the
 ;;; class in the lisp type system.
 ;;;
@@ -765,7 +596,6 @@
   (bootstrap-class-predicates nil)
   (bootstrap-built-in-classes)
 
-  #+cmu17
   (ext:do-hash (name x *find-class*)
     (let* ((class (find-class-from-cell name x))
 	   (layout (class-wrapper class))
@@ -786,10 +616,6 @@
   (setq *boot-state* 'braid)
   )
 
-#-cmu17
-(deftype slot-object ()
-  '(or standard-object structure-object))
-
 (defmethod no-applicable-method (generic-function &rest args)
   (cerror "Retry call to ~S"
 	  "No matching method for the generic-function ~S,~@
diff --git a/pcl/cache.lisp b/pcl/cache.lisp
index 9a0751d05320c5d93efc1b1a05d2c6526cf4c169..0e5091ba1c8e325be222770d481cf2397f7624f1 100644
--- a/pcl/cache.lisp
+++ b/pcl/cache.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.12 1999/03/11 16:51:02 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cache.lisp,v 1.13 1999/05/30 23:13:53 pw Exp $")
 ;;;
 ;;; The basics of the PCL wrapper cache mechanism.
 ;;;
@@ -94,7 +94,7 @@
 ;;;
 (defmacro cache-vector-ref (cache-vector location)
   `(svref (the simple-vector ,cache-vector)
-          (#-cmu the #+cmu ext:truly-the fixnum ,location)))
+          (ext:truly-the fixnum ,location)))
 
 (defmacro cache-vector-size (cache-vector)
   `(array-dimension (the simple-vector ,cache-vector) 0))
@@ -151,7 +151,6 @@
   (vector #() :type simple-vector)
   (overflow nil :type list))
 
-#+cmu
 (declaim (ext:freeze-type cache))
 
 (defun print-cache (cache stream depth)
@@ -247,43 +246,6 @@
 ;;; forms of this constant which it is more convenient for the runtime code
 ;;; to use.
 ;;; 
-#-cmu17
-(eval-when (compile load eval)
-
-(defconstant wrapper-cache-number-adds-ok 4)
-
-;;; Incorrect.  This actually allows 15 or 16 adds, depending on whether
-;;; most-positive-fixnum is all-ones.  -- Ram
-;;;
-(defconstant wrapper-cache-number-length
-	     (- (integer-length most-positive-fixnum)
-		wrapper-cache-number-adds-ok))
-
-(defconstant wrapper-cache-number-mask
-	     (1- (expt 2 wrapper-cache-number-length)))
-
-
-(defvar *get-wrapper-cache-number* (make-random-state))
-
-(defun get-wrapper-cache-number ()
-  (let ((n 0))
-    (declare (fixnum n))
-    (loop
-      (setq n
-	    (logand wrapper-cache-number-mask
-		    (random most-positive-fixnum *get-wrapper-cache-number*)))
-      (unless (zerop n) (return n)))))
-
-
-(unless (> wrapper-cache-number-length 8)
-  (error "In this implementation of Common Lisp, fixnums are so small that~@
-          wrapper cache numbers end up being only ~D bits long.  This does~@
-          not actually keep PCL from running, but it may degrade cache~@
-          performance.~@
-          You may want to consider changing the value of the constant~@
-          WRAPPER-CACHE-NUMBER-ADDS-OK.")))
-
-#+cmu17
 (progn
   (defconstant wrapper-cache-number-length
     (integer-length kernel:layout-hash-max))
@@ -315,181 +277,68 @@
 ;;; cache numbers on machines where the addressing modes make that a good
 ;;; idea.
 ;;; 
-#-structure-wrapper
-(progn
-(eval-when (compile load eval)
-(defconstant wrapper-layout
-	     '(number
-	       number
-	       number
-	       number
-	       number
-	       number
-	       number
-	       number
-	       state
-	       instance-slots-layout
-	       class-slots
-	       class
-	       no-of-instance-slots))
-)
-
-(eval-when (compile load eval)
-
-(defun wrapper-field (type)
-  (posq type wrapper-layout))
-
-(defun next-wrapper-field (field-number)
-  (position (nth field-number wrapper-layout)
-	    wrapper-layout
-	    :start (1+ field-number)))
-
-(defmacro first-wrapper-cache-number-index ()
-  `(wrapper-field 'number))
-
-(defmacro next-wrapper-cache-number-index (field-number)
-  `(next-wrapper-field ,field-number))
-
-);eval-when
-
-(defmacro wrapper-cache-number-vector (wrapper)
-  wrapper)
-
-(defmacro cache-number-vector-ref (cnv n)
-  `(svref ,cnv ,n))
-
-
-(defmacro wrapper-ref (wrapper n)
-  `(svref ,wrapper ,n))
-
-(defmacro wrapper-state (wrapper)
-  `(wrapper-ref ,wrapper ,(wrapper-field 'state)))
-
-(defmacro wrapper-instance-slots-layout (wrapper)
-  `(wrapper-ref ,wrapper ,(wrapper-field 'instance-slots-layout)))
-
-(defmacro wrapper-class-slots (wrapper)
-  `(wrapper-ref ,wrapper ,(wrapper-field 'class-slots)))
-
-(defmacro wrapper-class (wrapper)
-  `(wrapper-ref ,wrapper ,(wrapper-field 'class)))
-
-(defmacro wrapper-no-of-instance-slots (wrapper)
-  `(wrapper-ref ,wrapper ,(wrapper-field 'no-of-instance-slots)))
-
-(defmacro make-wrapper-internal ()
-  `(let ((wrapper (make-array ,(length wrapper-layout) :adjustable nil)))
-     ,@(gathering1 (collecting)
-	 (iterate ((i (interval :from 0))
-		   (desc (list-elements wrapper-layout)))
-	   (ecase desc
-	     (number
-	      (gather1 `(setf (wrapper-ref wrapper ,i)
-			      (get-wrapper-cache-number))))
-	     ((state instance-slots-layout class-slots class no-of-instance-slots)))))
-     (setf (wrapper-state wrapper) 't)     
-     wrapper))
-
-(defun make-wrapper (no-of-instance-slots &optional class)
-  (let ((wrapper (make-wrapper-internal)))
-    (setf (wrapper-no-of-instance-slots wrapper) no-of-instance-slots)
-    (setf (wrapper-class wrapper) class)
-    wrapper))
-
-)
 
 ; In CMUCL we want to do type checking as early as possible; structures help this.
-#+structure-wrapper
+
 (eval-when (compile load eval)
 
 (defconstant wrapper-cache-number-vector-length
-  #+cmu17 kernel:layout-hash-length #-cmu17 8)
-
-#-cmu17
-(deftype cache-number-vector ()
-  `(simple-array fixnum (,wrapper-cache-number-vector-length)))
+  kernel:layout-hash-length)
 
 (defconstant wrapper-layout (make-list wrapper-cache-number-vector-length
 				       :initial-element 'number))
-
 )
 
-#+structure-wrapper
+
 (progn
 
-#-(or cmu17)
-(defun make-wrapper-cache-number-vector ()
-  (let ((cnv (make-array #.wrapper-cache-number-vector-length
-			 :element-type 'fixnum)))
-    (dotimes (i #.wrapper-cache-number-vector-length)
-      (setf (aref cnv i) (get-wrapper-cache-number)))
-    cnv))
+(unless (boundp '*the-class-t*) (setq *the-class-t* nil))
 
+;;; Note that for CMU, the WRAPPER of a built-in or structure class will be
+;;; some other kind of KERNEL:LAYOUT, but this shouldn't matter, since the only
+;;; two slots that WRAPPER adds are meaningless in those cases.
+;;;
 
-#-cmu17
 (defstruct (wrapper
-	     (:print-function print-wrapper)
-	     (:constructor make-wrapper (no-of-instance-slots &optional class)))
-  (cache-number-vector (make-wrapper-cache-number-vector)
-		       :type cache-number-vector)
-  (state t :type (or (member t) cons)) 
-  ;;  either t or a list (state-sym new-wrapper)
-  ;;           where state-sym is either :flush or :obsolete
+	    (:include kernel:layout)
+	    (:conc-name %wrapper-)
+	    (:print-function print-wrapper)
+	    (:constructor make-wrapper-internal))
   (instance-slots-layout nil :type list)
-  (class-slots nil :type list)
-  (no-of-instance-slots 0 :type fixnum)
-  (class *the-class-t* :type class))
+  (class-slots nil :type list))
+(declaim (ext:freeze-type wrapper))
 
+(defmacro wrapper-class (wrapper)
+  `(kernel:class-pcl-class (kernel:layout-class ,wrapper)))
+(defmacro wrapper-no-of-instance-slots (wrapper)
+  `(kernel:layout-length ,wrapper))
+(declaim (inline wrapper-state (setf wrapper-state)))
+
+(defun wrapper-state (wrapper)
+  (let ((invalid (kernel:layout-invalid wrapper)))
+    (cond ((null invalid)
+	   t)
+	  ((atom invalid)
+	   ;; Some non-pcl object.  invalid is probably :INVALID
+	   ;; We should compute the new wrapper here instead
+	   ;; of returning nil, but why bother, since
+	   ;; obsolete-instance-trap can't use it.
+	   '(:obsolete nil))
+	  (t
+	   invalid))))
+
+(defun (setf wrapper-state) (new-value wrapper)
+  (setf (kernel:layout-invalid wrapper)
+	(if (eq new-value 't)
+	    nil
+	  new-value)))
 
-(unless (boundp '*the-class-t*) (setq *the-class-t* nil))
+(defmacro wrapper-instance-slots-layout (wrapper)
+  `(%wrapper-instance-slots-layout ,wrapper))
+(defmacro wrapper-class-slots (wrapper)
+  `(%wrapper-class-slots ,wrapper))
+(defmacro wrapper-cache-number-vector (x) x))
 
-;;; Note that for CMU, the WRAPPER of a built-in or structure class will be
-;;; some other kind of KERNEL:LAYOUT, but this shouldn't matter, since the only
-;;; two slots that WRAPPER adds are meaningless in those cases.
-;;;
-#+cmu17
-(progn
-  (defstruct (wrapper
-	      (:include kernel:layout)
-	      (:conc-name %wrapper-)
-	      (:print-function print-wrapper)
-	      (:constructor make-wrapper-internal))
-    (instance-slots-layout nil :type list)
-    (class-slots nil :type list))
-  (declaim (ext:freeze-type wrapper))
-
-  (defmacro wrapper-class (wrapper)
-    `(kernel:class-pcl-class (kernel:layout-class ,wrapper)))
-  (defmacro wrapper-no-of-instance-slots (wrapper)
-    `(kernel:layout-length ,wrapper))
-  (declaim (inline wrapper-state (setf wrapper-state)))
-
-  (defun wrapper-state (wrapper)
-    (let ((invalid (kernel:layout-invalid wrapper)))
-      (cond ((null invalid)
-	     t)
-	    ((atom invalid)
-	     ;; Some non-pcl object.  invalid is probably :INVALID
-	     ;; We should compute the new wrapper here instead
-	     ;; of returning nil, but why bother, since
-	     ;; obsolete-instance-trap can't use it.
-	     '(:obsolete nil))
-	    (t
-	     invalid))))
-  
-  (defun (setf wrapper-state) (new-value wrapper)
-    (setf (kernel:layout-invalid wrapper)
-	  (if (eq new-value 't)
-	      nil
-	      new-value)))
-
-  (defmacro wrapper-instance-slots-layout (wrapper)
-    `(%wrapper-instance-slots-layout ,wrapper))
-  (defmacro wrapper-class-slots (wrapper)
-    `(%wrapper-class-slots ,wrapper))
-  (defmacro wrapper-cache-number-vector (x) x))
-
-#+cmu17
 ;;; BOOT-MAKE-WRAPPER  --  Interface
 ;;;
 ;;;    Called in BRAID when we are making wrappers for classes whose slots are
@@ -517,10 +366,9 @@
 ;;; 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.
-#+cmu17
+
 (defvar *pcl-class-boot* nil)
 
-#+cmu17
 ;;; MAKE-WRAPPER  --  Interface
 ;;;
 ;;;    In CMU CL, the layouts (a.k.a wrappers) for built-in and structure
@@ -572,22 +420,9 @@
   `(and (< ,field-number #.(1- wrapper-cache-number-vector-length))
         (1+ ,field-number)))
 
-#-cmu17
-(defmacro cache-number-vector-ref (cnv n)
-  `(svref ,cnv ,n))
-
-#+cmu17
 (defmacro cache-number-vector-ref (cnv n)
   `(wrapper-cache-number-vector-ref ,cnv ,n))
 
-)
-
-#-cmu17
-(defmacro wrapper-cache-number-vector-ref (wrapper n)
-  `(the fixnum
-        (#-structure-wrapper svref #+structure-wrapper aref
-          (wrapper-cache-number-vector ,wrapper) ,n)))
-#+cmu17
 (defmacro wrapper-cache-number-vector-ref (wrapper n)
   `(kernel:layout-hash ,wrapper ,n))
 
@@ -595,13 +430,10 @@
   `(wrapper-no-of-instance-slots (class-wrapper ,class)))
 
 (defmacro wrapper-class* (wrapper)
-  #-(or cmu17)
-  `(wrapper-class ,wrapper)
-  #+(or cmu17)
   `(let ((wrapper ,wrapper))
      (or (wrapper-class wrapper)
          (find-structure-class
-	  #+cmu17 (lisp:class-name (kernel:layout-class wrapper))))))
+	  (lisp:class-name (kernel:layout-class wrapper))))))
 
 ;;;
 ;;; The wrapper cache machinery provides general mechanism for trapping on
@@ -676,21 +508,6 @@
 		 (error "Wrapper returned from trap invalid.")))
 	  nwrapper))))
 
-#-cmu17
-(defmacro check-wrapper-validity1 (object)
-  (let ((owrapper (gensym)))
-    `(let ((,owrapper (cond ((std-instance-p ,object)
-			     (std-instance-wrapper ,object))
-			    ((fsc-instance-p ,object)
-			     (fsc-instance-wrapper ,object))
-			    (t (wrapper-of ,object)))))
-       (if (eq 't (wrapper-state ,owrapper))
-	   ,owrapper
-	   (check-wrapper-validity ,object)))))
-
-#+cmu17
-;;; semantically equivalent, but faster.
-;;;
 (defmacro check-wrapper-validity1 (object)
   (let ((owrapper (gensym)))
     `(let ((,owrapper (kernel:layout-of object)))
diff --git a/pcl/cmu-low.lisp b/pcl/cmu-low.lisp
index 99de6e97c1f51ad07278f9f67b3e729bbbe78aa9..9ed7b61fd5e14f3294fc909a8049c5f24a03e111 100644
--- a/pcl/cmu-low.lisp
+++ b/pcl/cmu-low.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/cmu-low.lisp,v 1.17 1998/12/20 04:30:17 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/cmu-low.lisp,v 1.18 1999/05/30 23:13:53 pw Exp $")
 ;;; 
 ;;; This is the CMU Lisp version of the file low.
 ;;; 
@@ -83,31 +83,7 @@
 	       (eval:interpreted-function
 		(setf (eval:interpreted-function-name fcn) new-name))))
          fcn)
-        (t
-	 ;; pw-- This seems wrong and causes trouble. Tests show
-	 ;; that loading CL-HTTP resulted in ~5400 closures being
-	 ;; passed through this code of which ~4000 of them pointed
-	 ;; to but 16 closure-functions, including 1015 each of
-	 ;; DEFUN MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION
-	 ;; DEFUN MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION
-	 ;; DEFUN MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION.
-	 ;; Since the actual functions have been moved by PURIFY
-	 ;; to memory not seen by GC, changing a pointer there
-	 ;; not only clobbers the last change but leaves a dangling
-	 ;; pointer invalid  after the next GC. Comments in low.lisp
-	 ;; indicate this code need do nothing. Setting the
-	 ;; function-name to NIL loses some info, and not changing
-	 ;; it loses some info of potential hacking value. So,
-	 ;; lets not do this...
-	 #+nil
-         (let ((header (kernel:%closure-function fcn)))
-	   #+cmu17
-	   (setf (c::%function-name header) new-name)
-	   #-cmu17
-           (system:%primitive c::set-function-name header new-name))
-
-	 ;; Maybe add better scheme here someday.
-	 fcn)))
+        (t fcn)))
 
 (in-package "C")
 
@@ -202,8 +178,6 @@
 
 ;;;; Structure-instance stuff:
 
-(pushnew :structure-wrapper *features*)
-
 (defun structure-functions-exist-p ()
   t)
 
diff --git a/pcl/combin.lisp b/pcl/combin.lisp
index cb76ac83cde3ec9aa6d5f5a94b6e97125f57003e..f432d682a4cb94e1735e5d924edc5cb6eaec7ba6 100644
--- a/pcl/combin.lisp
+++ b/pcl/combin.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.8 1998/12/20 04:30:17 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/combin.lisp,v 1.9 1999/05/30 23:13:54 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/construct.lisp b/pcl/construct.lisp
index 2925bbdc3284e6540ebc5c07b40087d591515010..78c7756eacaab5ceaaad628849f86e1e604cd1d4 100644
--- a/pcl/construct.lisp
+++ b/pcl/construct.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.11 1998/12/20 04:30:18 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.12 1999/05/30 23:13:54 pw Exp $")
 ;;;
 ;;; This file defines the defconstructor and other make-instance optimization
 ;;; mechanisms.
@@ -130,13 +130,7 @@
        ;; tell the compile time environment that a function with this
        ;; name and this argument list has been defined.  The portable
        ;; way to do this is with defun.
-       #-cmu (proclaim '(notinline ,name))
-       #-cmu
-       (defun ,name ,lambda-list
-	 (declare (ignore ,@(extract-parameters lambda-list)))
-	 (error "Constructor ~S not loaded." ',name))
        ;; But the derived result type for the above is wrong under CMUCL.
-       #+cmu
        (proclaim '(ftype ,(ftype-declaration-from-lambda-list lambda-list name)
 		         ,name))
 
@@ -302,7 +296,7 @@
 (defmethod install-lazy-constructor-installer ((constructor constructor))
   (let ((class (constructor-class constructor)))
     (set-constructor-code constructor
-			  #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+			  #'(kernel:instance-lambda (&rest args)
 			      (multiple-value-bind (code type)
 				  (compute-constructor-code class constructor)
 				(set-constructor-code constructor code type)
@@ -633,7 +627,7 @@
      (lambda (&rest ignore)
        (declare (ignore ignore))
        (function
-	 (#+cmu kernel:instance-lambda #-cmu lambda ,arglist
+	 (kernel:instance-lambda ,arglist
 	   (make-instance
 	     ',(class-name class)
 	     ,@(gathering1 (collecting)
@@ -675,7 +669,7 @@
 		      (null (non-pcl-or-after-shared-initialize-methods-p
 			      shared)))
 	     (function
-	       (#+cmu kernel:instance-lambda #-cmu lambda ,arglist
+	       (kernel:instance-lambda ,arglist
 		 (declare #.*optimize-speed*)
 		 (let* ((.instance. (,raw-allocator .wrapper. .constants.))
 			(.slots. (,slots-fetcher .instance.))
@@ -835,7 +829,7 @@
 	   (when (and .constants.
 		      (null (non-pcl-initialize-instance-methods-p init))
 		      (null (non-pcl-shared-initialize-methods-p shared)))
-	     #'(#+cmu kernel:instance-lambda #-cmu lambda ,arglist
+	     #'(kernel:instance-lambda ,arglist
 		 (declare #.*optimize-speed*)
 		 (let* ((.instance. (,raw-allocator .wrapper. .constants.))
 			(.slots. (,slots-fetcher .instance.))
@@ -969,7 +963,7 @@
 						',supplied-initargs)
 	     (when .constants.
 	       (function
-		 (#+cmu kernel:instance-lambda #-cmu lambda ,arglist
+		 (kernel:instance-lambda ,arglist
 		   (declare #.*optimize-speed*)
 		   (let* ((.instance. (,raw-allocator .wrapper. .constants.))
 			  (.slots. (,slots-fetcher .instance.))
diff --git a/pcl/cpl.lisp b/pcl/cpl.lisp
index 0089e6cc0e22f5ca1808cf8ded0c9c0a2e254565..4690d9d5e6065b60f490710d0b3ab130f0a842f0 100644
--- a/pcl/cpl.lisp
+++ b/pcl/cpl.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cpl.lisp,v 1.8 1998/12/20 04:30:18 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/cpl.lisp,v 1.9 1999/05/30 23:13:55 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/defclass.lisp b/pcl/defclass.lisp
index bd1ad843b5d13a771e435870a0aba5193612ff3e..c7060a8938ec23822c1c236b526e5956a278e3ec 100644
--- a/pcl/defclass.lisp
+++ b/pcl/defclass.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defclass.lisp,v 1.15 1999/03/14 01:14:13 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defclass.lisp,v 1.16 1999/05/30 23:13:55 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -54,14 +54,9 @@
 		       (capitalize-words (car name) ()) (cdr name))
 	       (format nil "~S" name))))
     (definition-name)
-
-    #+cmu
     (if (member 'compile times)
         `(eval-when ,times ,form)
-        form)
-
-    #-(or cmu)
-    (make-progn `',name `(eval-when ,times ,form))))
+        form)))
 
 (defun make-progn (&rest forms)
   (let ((progn-form nil))
@@ -112,9 +107,6 @@
 		     "The value of the :metaclass option (~S) is not a~%~
 		      legal class name."
 		     :format-arguments (list (cadr option))))
-	    #-cmu17
-            (setq metaclass (cadr option))
-	    #+cmu17
 	    (setq metaclass
 		  (case (cadr option)
 		    (lisp:standard-class 'standard-class)
@@ -146,10 +138,10 @@
 		   `(progn
 		      ,@(mapcar #'(lambda (x)
 				    `(declaim (ftype (function (t) t) ,x)))
-				#+cmu *readers* #-cmu nil)
+				*readers*)
 		      ,@(mapcar #'(lambda (x)
 				    `(declaim (ftype (function (t t) t) ,x)))
-				#+cmu *writers* #-cmu nil)
+				*writers*)
 		      (let ,(mapcar #'cdr *initfunctions*)
 			(load-defclass ',name
 				       ',metaclass
diff --git a/pcl/defcombin.lisp b/pcl/defcombin.lisp
index ab09a3cfa81015ef5bd3193e6e34594811e1add6..09e916033cda719f290462f970b814f13441637d 100644
--- a/pcl/defcombin.lisp
+++ b/pcl/defcombin.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.9 1998/12/20 04:30:18 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defcombin.lisp,v 1.10 1999/05/30 23:13:55 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/defs.lisp b/pcl/defs.lisp
index bcf7f287446db726fcb498e764dd9c555b60fabf..d2fe7296c50da138df97f7ca9ac37ecc84e1f0f2 100644
--- a/pcl/defs.lisp
+++ b/pcl/defs.lisp
@@ -72,14 +72,9 @@
 ;;; the `real' definition without affecting the advise.
 ;;;
 (defun (setf gdefinition) (new-definition name)
-  #+cmu (progn
-	  (c::%%defun name new-definition nil)
-	  (c::note-name-defined name :function)
-	  new-definition)
-  #-(or cmu)
-  (setf (symbol-function name) new-definition))
-
-
+  (c::%%defun name new-definition nil)
+  (c::note-name-defined name :function)
+  new-definition)
 
 (proclaim '(special *the-class-t* 
 	            *the-class-vector* *the-class-symbol*
@@ -146,7 +141,6 @@
 					 :object (coerce-to-class (car args))))
 	       (class-eq (class-eq-specializer (coerce-to-class (car args))))
 	       (eql      (intern-eql-specializer (car args))))))
-	#+cmu17
 	((and (null args) (typep type 'lisp:class))
 	 (or (kernel:class-pcl-class type)
 	     (find-structure-class (lisp:class-name type))))
@@ -242,8 +236,7 @@
     ((not and or) `(,(car type) ,@(mapcar #'convert-to-system-type
 					  (cdr type))))
     ((class class-eq) ; class-eq is impossible to do right
-     #-cmu17 (class-name (cadr type))
-     #+cmu17 (kernel:layout-class (class-wrapper (cadr type))))
+     (kernel:layout-class (class-wrapper (cadr type))))
     (eql type)
     (t (if (null (cdr type))
 	   (car type)
@@ -281,13 +274,7 @@
 			 (convert-to-system-type type2))))))))
 
 (defun do-satisfies-deftype (name predicate)
-  #+cmu17 (declare (ignore name predicate))
-  #-(or cmu17)
-  ;; This is the default for ports for which we don't know any
-  ;; better.  Note that for most ports, providing this definition
-  ;; should just speed up class definition.  It shouldn't have an
-  ;; effect on performance of most user code.
-  (eval `(deftype ,name () '(satisfies ,predicate))))
+  (declare (ignore name predicate)))
 
 (defun make-type-predicate-name (name &optional kind)
   (if (symbol-package name)
@@ -423,7 +410,6 @@
 		 list)     ()                       (symbol list sequence t)
      nil)))
 
-#+cmu17
 (labels ((direct-supers (class)
 	   (if (typep class 'lisp:built-in-class)
 	       (kernel:built-in-class-direct-superclasses class)
@@ -464,24 +450,22 @@
 (defclass t () ()
   (:metaclass built-in-class))
 
-#+cmu17
-(progn
-  (defclass kernel:instance (t) ()
-    (:metaclass built-in-class))
-  
-  (defclass function (t) ()
-    (:metaclass built-in-class))
+(defclass kernel:instance (t) ()
+  (:metaclass built-in-class))
 
-  (defclass kernel:funcallable-instance (function) ()
-    (:metaclass built-in-class))
+(defclass function (t) ()
+  (:metaclass built-in-class))
+
+(defclass kernel:funcallable-instance (function) ()
+  (:metaclass built-in-class))
 
-  (defclass stream (t) ()
-    (:metaclass built-in-class)))
+(defclass stream (t) ()
+  (:metaclass built-in-class))
 
 (defclass slot-object (t) ()
   (:metaclass slot-class))
 
-(defclass structure-object (slot-object #+cmu17 kernel:instance) ()
+(defclass structure-object (slot-object kernel:instance) ()
   (:metaclass structure-class))
 
 (defstruct (dead-beef-structure-object
@@ -491,10 +475,10 @@
 (defclass std-object (slot-object) ()
   (:metaclass std-class))
 
-(defclass standard-object (std-object #+cmu17 kernel:instance) ())
+(defclass standard-object (std-object kernel:instance) ())
 
 (defclass funcallable-standard-object (std-object
-				       #+cmu17 kernel:funcallable-instance)
+				       kernel:funcallable-instance)
      ()
   (:metaclass funcallable-standard-class))
 
diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp
index acc2c17d8ac0bd98fe06f047de2d40ae0f35c450..8e8f56b6e0f6f631a4592bc9b83d6c6d1f42c0cb 100644
--- a/pcl/defsys.lisp
+++ b/pcl/defsys.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defsys.lisp,v 1.20 1999/03/14 01:14:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/defsys.lisp,v 1.21 1999/05/30 23:13:56 pw Exp $")
 ;;;
 ;;; Some support stuff for compiling and loading PCL.  It would be nice if
 ;;; there was some portable make-system we could all agree to share for a
@@ -80,7 +80,6 @@
 
 (defvar *pcl-system-date* "September 16 92 PCL (f)")
 
-#+cmu
 (setf (getf ext:*herald-items* :pcl)
       `("    CLOS based on PCL version:  " ,*pcl-system-date*))
 
@@ -144,8 +143,7 @@ and load your system with:
 ;;; defsys use the value of *port* rather than #+ and #- to conditionalize
 ;;; the way they work.
 ;;; 
-(defvar *port*
-        '(#+:CMU                 CMU))
+(defvar *port* '(CMU))
 
 ;;;
 ;;; When you get a copy of PCL (by tape or by FTP), the sources files will
@@ -173,7 +171,7 @@ and load your system with:
 ;;;       "mv *.lisp *.lsp".
 ;;;
 (defvar *default-pathname-extensions*
-  (car '(#+cmu ("lisp" . #.(c:backend-fasl-file-type c:*backend*)))))
+  (car '(("lisp" . #.(c:backend-fasl-file-type c:*backend*)))))
 
 (defvar *pathname-extensions*
   (let ((proper-extensions *default-pathname-extensions*))
@@ -363,7 +361,6 @@ and load your system with:
   (declare (ignore ignore))
   't)
 
-#+cmu17
 (defparameter *byte-files* '(defclass defcombin iterate env))
 
 (defun operate-on-system (name mode &optional arg print-only)
@@ -388,7 +385,7 @@ and load your system with:
 				   (make-pathname :defaults
 						  (make-binary-pathname name)
 						  :version :newest)
-				   #+cmu17 :byte-compile #+cmu17
+				   :byte-compile
 				   (if (and (member name *byte-files*)
 					    (member :small *features*))
 				       t
@@ -465,14 +462,6 @@ and load your system with:
   (declare (ignore errorp))
   *load-truename*)
 
-#-(or cmu Symbolics)
-(defvar *pcl-directory*
-	(or (load-truename t)
-	    (error "Because load-truename is not implemented in this port~%~
-                    of PCL, you must manually edit the definition of the~%~
-                    variable *pcl-directory* in the file defsys.lisp.")))
-
-#+cmu 
 (defvar *pcl-directory* (pathname "target:pcl/"))
 
 (defsystem pcl	   
@@ -592,8 +581,6 @@ and load your system with:
     (do-symbols (sym pkg)
       (when (eq pkg (symbol-package sym))
 	(if (or (constantp sym)
-		#-cmu (member sym '(wrapper cache arg-info pv-table))
-		#+cmu
 		(or (c::info setf inverse sym)
 		    (c::info setf expander sym)
 		    (c::info type kind sym)
@@ -605,6 +592,5 @@ and load your system with:
 	      (unless (or (eq sym 'reset-pcl-package)
 			  (eq sym 'reset-package))
 		(fmakunbound sym)
-		#+cmu
 		(fmakunbound `(setf ,sym)))
 	      (setf (symbol-plist sym) nil)))))))
diff --git a/pcl/dfun.lisp b/pcl/dfun.lisp
index 89e53ae9ea8e375fa34744757219ad58380f37b5..ffc82cb15eb2d05895448930dbf1e0bda75bbb79 100644
--- a/pcl/dfun.lisp
+++ b/pcl/dfun.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.9 1998/12/20 04:30:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dfun.lisp,v 1.10 1999/05/30 23:13:56 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -330,7 +330,6 @@ And so, we are saved.
 	 (declare (pcl-fast-call))
 	 (accessor-miss gf new arg dfun-info)))))
 
-#+cmu
 (declaim (ext:freeze-type dfun-info))
 
 
@@ -656,7 +655,6 @@ And so, we are saved.
 	   *secondary-dfun-call-cost*
 	   0))))
 
-#+cmu
 (progn
   (setq *non-built-in-typep-cost* 100)
   (setq *structure-typep-cost* 15)
@@ -742,7 +740,7 @@ And so, we are saved.
 
 (defun make-initial-dfun (gf)
   (let ((initial-dfun 
-	 #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+	 #'(kernel:instance-lambda (&rest args)
 	     #+copy-&rest-arg (setq args (copy-list args))
 	     (initial-dfun gf args))))
     (multiple-value-bind (dfun cache info)
@@ -777,11 +775,11 @@ And so, we are saved.
   (let* ((methods (early-gf-methods gf))
 	 (slot-name (early-method-standard-accessor-slot-name (car methods))))
     (ecase type
-      (reader #'(#+cmu kernel:instance-lambda #-cmu lambda (instance)
+      (reader #'(kernel:instance-lambda (instance)
 		  (let* ((class (class-of instance))
 			 (class-name (bootstrap-get-slot 'class class 'name)))
 		    (bootstrap-get-slot class-name instance slot-name))))
-      (writer #'(#+cmu kernel:instance-lambda #-cmu lambda (new-value instance)
+      (writer #'(kernel:instance-lambda (new-value instance)
 		  (let* ((class (class-of instance))
 			 (class-name (bootstrap-get-slot 'class class 'name)))
 		    (bootstrap-set-slot class-name instance slot-name new-value)))))))
@@ -868,7 +866,7 @@ And so, we are saved.
 	specls all-same-p)
     (cond ((null methods)
 	   (values
-	    #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+	    #'(kernel:instance-lambda (&rest args)
 		(apply #'no-applicable-method gf args))
 	    nil
 	    (no-methods-dfun-info)))
@@ -925,11 +923,7 @@ And so, we are saved.
 	       (caching))
 	      ((or invalidp
 		   (null nindex)))
-	      ((not #-cmu17
-		    (or (std-instance-p object)
-			(fsc-instance-p object))
-		    #+cmu17
-		    (pcl-instance-p object))
+	      ((not (pcl-instance-p object))
 	       (caching))
 	      ((or (neq ntype otype) (listp wrappers))
 	       (caching))
@@ -1484,7 +1478,7 @@ And so, we are saved.
       (if function-p
           #'(lambda (method-alist wrappers)
 	      (declare (ignore method-alist wrappers))
-	      #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+	      #'(kernel:instance-lambda (&rest args)
 	          (apply #'no-applicable-method gf args)))
 	  #'(lambda (method-alist wrappers)
 	      (declare (ignore method-alist wrappers))
@@ -1555,9 +1549,9 @@ And so, we are saved.
       (unless (eq 'default-method-only (type-of info))
 	(setq dfun (doctor-dfun-for-the-debugger 
 		    generic-function
-		    #+cmu dfun #-cmu (set-function-name dfun gf-name))))
+		    dfun)))
       (set-funcallable-instance-function generic-function dfun)
-      #+cmu (set-function-name generic-function gf-name)
+      (set-function-name generic-function gf-name)
       (when (and ocache (not (eq ocache cache))) (free-cache ocache))
       dfun)))
 
diff --git a/pcl/dlap.lisp b/pcl/dlap.lisp
index d355f374e1cf76ffb36d00c718e4b49e89ec368d..c9ecda9e89bc9170816c9831b10f0ada31342b48 100644
--- a/pcl/dlap.lisp
+++ b/pcl/dlap.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/dlap.lisp,v 1.7 1998/12/20 04:30:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/dlap.lisp,v 1.8 1999/05/30 23:13:57 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -64,16 +64,14 @@
     (generating-lap closure-variables
 		    arglist
        (with-lap-registers ((inst t)				   ;reg for the instance
-			    (wrapper #-structure-wrapper vector	   ;reg for the wrapper
-				     #+structure-wrapper t)
-			    #+structure-wrapper (cnv fixnum-vector)
+			    (wrapper t)
+			    (cnv fixnum-vector)
 			    (cache-no index))			   ;reg for the cache no
 	  (let ((index cache-no)				   ;This register is used
 								   ;for different values at
 								   ;different times.
 		(slots (and (null class-slot-p)
-			    (allocate-register #-new-kcl-wrapper 'vector
-					       #+new-kcl-wrapper t)))
+			    (allocate-register 'vector)))
 		(csv   (and class-slot-p
 			    (allocate-register t))))
 	    (prog1 (flatten-lap
@@ -94,11 +92,7 @@
 			  (opcode :move (operand :std-slots inst) slots))
 
 		     (opcode :label 'have-wrapper)
-		     #-structure-wrapper
-		     (opcode :move (operand :cref wrapper field) cache-no)
-		     #+structure-wrapper
 		     (opcode :move (emit-wrapper-cache-number-vector wrapper) cnv)
-		     #+structure-wrapper
 		     (opcode :move (operand :cref cnv field) cache-no)
 		     (opcode :izerop cache-no 'trap)		   ;obsolete wrapper?
 
@@ -129,7 +123,7 @@
   (let ((arglist (list (dfun-arg-symbol 0))))
     (generating-lap '(field cache-vector mask size index miss-fn)
 		    arglist
-      (with-lap-registers ((slots #-new-kcl-wrapper vector #+new-kcl-wrapper t))
+      (with-lap-registers ((slots vector))
 	(emit-dlap  arglist
 		    '(standard-instance)
 		    'trap
@@ -149,7 +143,7 @@
   (let ((arglist (list (dfun-arg-symbol 0) (dfun-arg-symbol 1))))
     (generating-lap '(field cache-vector mask size index miss-fn)
 		    arglist
-      (with-lap-registers ((slots #-new-kcl-wrapper vector #+new-kcl-wrapper t))
+      (with-lap-registers ((slots vector))
 	(emit-dlap arglist
 		   '(t standard-instance)
 		   'trap
@@ -171,7 +165,7 @@
   (let ((arglist (list (dfun-arg-symbol 0))))
     (generating-lap '(field cache-vector mask size miss-fn)
 		    arglist
-      (with-lap-registers ((slots #-new-kcl-wrapper vector #+new-kcl-wrapper t)
+      (with-lap-registers ((slots vector)
 			   (index index))
 	(emit-dlap arglist
 		   '(standard-instance)
@@ -187,7 +181,7 @@
   (let ((arglist (list (dfun-arg-symbol 0) (dfun-arg-symbol 1))))
     (generating-lap '(field cache-vector mask size miss-fn)
 		    arglist
-      (with-lap-registers ((slots #-new-kcl-wrapper vector #+new-kcl-wrapper t)
+      (with-lap-registers ((slots vector)
 			   (index index))
 	(flatten-lap
 	  (emit-dlap arglist
@@ -204,21 +198,15 @@
 
 (defun emit-checking (metatypes applyp)
   (let ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp)))
-    (generating-lap '(field cache-vector mask size 
-		      #-excl-sun4 emf #+excl-sun4 function 
-		      miss-fn)
+    (generating-lap '(field cache-vector mask size emf miss-fn)
 		    dlap-lambda-list
       (emit-dlap (remove '&rest dlap-lambda-list)
 		 metatypes		 
 		 'trap
-		 (with-lap-registers ((#-excl-sun4 emf #+excl-sun4 function t))
+		 (with-lap-registers ((emf t))
 		   (flatten-lap
-		     (opcode :move (operand :cvar 
-					    #-excl-sun4 'emf #+excl-sun4 'function)
-			     #-excl-sun4 emf 
-			     #+excl-sun4 function)
-		     #-excl-sun4 (opcode :emf-call emf)
-		     #+excl-sun4 (opcode :jmp function)))
+		     (opcode :move (operand :cvar 'emf) emf)
+		     (opcode :emf-call emf)))
 		 (with-lap-registers ((miss-function t))
 		   (flatten-lap
 		     (opcode :label 'trap)
@@ -230,19 +218,18 @@
   (let ((dlap-lambda-list (make-dlap-lambda-list metatypes applyp)))
     (generating-lap '(field cache-vector mask size miss-fn)
 		    dlap-lambda-list
-      (with-lap-registers ((#-excl-sun4 emf #+excl-sun4 function t))
+      (with-lap-registers ((emf t))
 	(emit-dlap (remove '&rest dlap-lambda-list)
 		   metatypes
 		   'trap
 		   (flatten-lap
-		    #-excl-sun4 (opcode :emf-call emf)
-		    #+excl-sun4 (opcode :jmp function))
+		    (opcode :emf-call emf))
 		   (with-lap-registers ((miss-function t))
 		     (flatten-lap
 		       (opcode :label 'trap)
 		       (opcode :move (operand :cvar 'miss-fn) miss-function)
 		       (opcode :jmp miss-function)))
-		   #-excl-sun4 emf #+excl-sun4 function)))))
+		   emf)))))
 
 (defun emit-constant-value (metatypes)
   (let ((dlap-lambda-list (make-dlap-lambda-list metatypes nil)))
@@ -264,15 +251,13 @@
 
 
 (defun emit-check-1-class-wrapper (wrapper cwrapper-0 miss-label)
-  (with-lap-registers ((cwrapper #-structure-wrapper vector
-				 #+structure-wrapper t))
+  (with-lap-registers ((cwrapper t))
     (flatten-lap
      (opcode :move (operand :cvar cwrapper-0) cwrapper)
      (opcode :neq wrapper cwrapper miss-label))))		;wrappers not eq, trap
 
 (defun emit-check-2-class-wrapper (wrapper cwrapper-0 cwrapper-1 miss-label)
-  (with-lap-registers ((cwrapper #-structure-wrapper vector
-				 #+structure-wrapper t))
+  (with-lap-registers ((cwrapper t))
     (flatten-lap
      (opcode :move (operand :cvar cwrapper-0) cwrapper)		;This is an OR.  Isn't
      (opcode :eq wrapper cwrapper 'hit-internal)		;assembly code fun
@@ -320,8 +305,7 @@
 
 (defun dlap-wrappers (metatypes)
   (mapcar #'(lambda (x) (and (neq x 't)
-			     (allocate-register #-structure-wrapper 'vector
-						#+structure-wrapper t)))
+			     (allocate-register t)))
 	  metatypes))
 
 (defun dlap-wrapper-moves (wrappers args metatypes miss-label slot-regs)
@@ -474,8 +458,7 @@
 (defun emit-check-1-wrapper-in-cache (cache-vector location wrapper hit-code)
   (let ((exit-emit-check-1-wrapper-in-cache 
 	  (make-symbol "exit-emit-check-1-wrapper-in-cache")))
-    (with-lap-registers ((cwrapper #-structure-wrapper vector
-				   #+structure-wrapper t))
+    (with-lap-registers ((cwrapper  t))
       (flatten-lap
 	(opcode :move (emit-cache-vector-ref cache-vector location) cwrapper)
 	(opcode :neq cwrapper wrapper exit-emit-check-1-wrapper-in-cache)
@@ -483,8 +466,7 @@
 	(opcode :label exit-emit-check-1-wrapper-in-cache)))))
 
 (defun emit-check-cache-entry (cache-vector location wrapper hit-label)
-  (with-lap-registers ((cwrapper #-structure-wrapper vector
-				 #+structure-wrapper t))
+  (with-lap-registers ((cwrapper t))
     (flatten-lap
       (opcode :move (emit-cache-vector-ref cache-vector location) cwrapper)
       (opcode :eq cwrapper wrapper hit-label))))
@@ -494,8 +476,7 @@
 	  (flatten-lap
 	    (gathering1 (flattening-lap)
 	      (iterate ((wrapper (list-elements wrappers)))
-		(with-lap-registers ((cwrapper #-structure-wrapper vector
-					       #+structure-wrapper t))
+		(with-lap-registers ((cwrapper t))
 		  (gather1
 		    (flatten-lap
 		      (opcode :move (emit-cache-vector-ref cache-vector location) cwrapper)
@@ -544,16 +525,12 @@
 
 (defun emit-1-wrapper-compute-primary-cache-location (wrapper primary wrapper-cache-no)
   (with-lap-registers ((mask index) 
-		       #+structure-wrapper (cnv fixnum-vector))
+		       (cnv fixnum-vector))
     (let ((field wrapper-cache-no))
       (flatten-lap
         (opcode :move (operand :cvar 'mask) mask)
         (opcode :move (operand :cvar 'field) field)
-	#-structure-wrapper
-        (opcode :move (emit-wrapper-ref wrapper field) wrapper-cache-no)
-	#+structure-wrapper
 	(opcode :move (emit-wrapper-cache-number-vector wrapper) cnv)
-	#+structure-wrapper
 	(opcode :move (emit-cache-number-vector-ref cnv field) wrapper-cache-no)
         (opcode :move (operand :ilogand wrapper-cache-no mask) primary)))))
 
@@ -567,13 +544,10 @@
 			 (i (interval :from 1)))
 		 (gather1
 		  (with-lap-registers ((wrapper-cache-no index)
-				       #+structure-wrapper (cnv fixnum-vector))
+				       (cnv fixnum-vector))
 		    (flatten-lap
-		     #-structure-wrapper
 		     (opcode :move (emit-wrapper-ref wrapper field) wrapper-cache-no)
-		     #+structure-wrapper
 		     (opcode :move (emit-wrapper-cache-number-vector wrapper) cnv)
-		     #+structure-wrapper
 		     (opcode :move (emit-cache-number-vector-ref cnv field)
 			     wrapper-cache-no)
 		     (opcode :izerop wrapper-cache-no miss-label)
@@ -592,7 +566,7 @@
   (let ((exit-emit-fetch-wrapper (make-symbol "exit-emit-fetch-wrapper")))
     (with-lap-registers ((arg t))
       (ecase metatype
-	((standard-instance #+new-kcl-wrapper structure-instance)
+	((standard-instance)
 	  (let ((get-std-inst-wrapper (make-symbol "get-std-inst-wrapper"))
 		(get-fsc-inst-wrapper (make-symbol "get-fsc-inst-wrapper")))
 	    (flatten-lap
@@ -618,10 +592,7 @@
 	      (opcode :move (operand :arg argument) arg)
 	      (opcode :std-instance-p arg get-std-inst-wrapper)
 	      (opcode :fsc-instance-p arg get-fsc-inst-wrapper)
-	      #-new-kcl-wrapper
 	      (opcode :move (operand :built-in-or-structure-wrapper arg) dest)
-	      #+new-kcl-wrapper
-	      (opcode :move (operand :built-in-wrapper arg) dest)
 	      (opcode :go exit-emit-fetch-wrapper)
 	      (opcode :label get-fsc-inst-wrapper)
 	      (opcode :move (operand :fsc-wrapper arg) dest)
@@ -629,15 +600,12 @@
 	      (opcode :label get-std-inst-wrapper)
 	      (opcode :move (operand :std-wrapper arg) dest)
 	      (opcode :label exit-emit-fetch-wrapper))))
-	((built-in-instance #-new-kcl-wrapper structure-instance)
+	((built-in-instance structure-instance)
 	  (when slot (error "Can't do a slot reg for this metatype."))
 	  (let ()
 	    (flatten-lap
 	      (opcode :move (operand :arg argument) arg)
 	      (opcode :std-instance-p arg miss-label)
 	      (opcode :fsc-instance-p arg miss-label)
-	      #-new-kcl-wrapper
-	      (opcode :move (operand :built-in-or-structure-wrapper arg) dest)
-	      #+new-kcl-wrapper
-	      (opcode :move (operand :built-in-wrapper arg) dest))))))))
+	      (opcode :move (operand :built-in-or-structure-wrapper arg) dest))))))))
 
diff --git a/pcl/dlisp.lisp b/pcl/dlisp.lisp
index b739afa78a4a29c377346e40753abcc6e99a94c5..fd203dabb124904e18e7f5ec17284af1b74b8729 100644
--- a/pcl/dlisp.lisp
+++ b/pcl/dlisp.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.6 1999/03/11 16:51:05 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.7 1999/05/30 23:13:58 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -108,7 +108,7 @@
 	 (lambda `(lambda ,closure-variables
 		    ,@(when (member 'miss-fn closure-variables)
 			`((declare (type function miss-fn))))
-		    #'(#+cmu kernel:instance-lambda #-cmu lambda ,args
+		    #'(kernel:instance-lambda ,args
 			#+copy-&rest-arg
 			,@(when rest
 			    `((setq .lap-rest-arg.
diff --git a/pcl/dlisp2.lisp b/pcl/dlisp2.lisp
index 2e84dc3a6c033814bc5df008f4c6820c05761f21..d2cf9e8faa8b18e77d68a6c2e7735383fcc59dfd 100644
--- a/pcl/dlisp2.lisp
+++ b/pcl/dlisp2.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.6 1998/12/20 04:30:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp2.lisp,v 1.7 1999/05/30 23:13:58 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -95,7 +95,7 @@
   (if cached-emf-p
       #'(lambda (cache miss-fn)
 	  (declare (type function miss-fn))
-	  #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+	  #'(kernel:instance-lambda (&rest args)
 	      (declare #.*optimize-speed*)
 	      #+copy-&rest-arg (setq args (copy-list args))
 	      (with-dfun-wrappers (args metatypes)
@@ -111,7 +111,7 @@
 			      (invoke-emf emf args))))))))
       #'(lambda (cache emf miss-fn)
 	  (declare (type function miss-fn))
-	  #'(#+cmu kernel:instance-lambda #-cmu lambda (&rest args)
+	  #'(kernel:instance-lambda (&rest args)
 	      (declare #.*optimize-speed*)
 	      #+copy-&rest-arg (setq args (copy-list args))
 	      (with-dfun-wrappers (args metatypes)
diff --git a/pcl/dlisp3.lisp b/pcl/dlisp3.lisp
index 9bcd4e631680137eb522aa1415f848df794c75cc..93e4e4cac159c522cfc76fafc603f46a303a4528 100644
--- a/pcl/dlisp3.lisp
+++ b/pcl/dlisp3.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp3.lisp,v 1.3 1998/12/20 04:30:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp3.lisp,v 1.4 1999/05/30 23:13:58 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/env.lisp b/pcl/env.lisp
index b88325e66c685a25d929a11670a40c24d6478b6d..b7e12dbcc6bd1171f8fb4a507ba5df5cf382b9d9 100644
--- a/pcl/env.lisp
+++ b/pcl/env.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.11 1999/03/11 16:51:05 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/env.lisp,v 1.12 1999/05/30 23:13:58 pw Exp $")
 ;;;
 ;;; Basic environmental stuff.
 ;;;
@@ -39,18 +39,9 @@
 
 (defgeneric describe-object (object stream))
 
-#-cmu
-(defun pcl-describe (object)
-  (describe-object object *standard-output*)
-  (values))
-
 (defmethod describe-object (object stream)
-  #+cmu
   (describe object stream))
 
-#-cmu
-(redefine-function 'describe 'pcl-describe)
-
 (defmethod describe-object ((object slot-object) stream)
   (let* ((class (class-of object))
 	 (slotds (slots-to-inspect class object))
@@ -151,21 +142,12 @@
     (when nick
       (format stream "You can also call it~@[ ~{~S~^, ~} or~] ~S.~%"
 	      (butlast nick) (first (last nick)))))  
-  (let* (#+cmu (internal (lisp::package-internal-symbols object))
-	 (internal-count #+cmu (- (lisp::package-hashtable-size internal)
-				  (lisp::package-hashtable-free internal))
-			 #-cmu 0)
-	 #+cmu (external (lisp::package-external-symbols object))
-	 (external-count #+cmu (- (lisp::package-hashtable-size external)
-				  (lisp::package-hashtable-free external))
-			 #-cmu 0))
-    #-cmu (do-external-symbols (sym object)
-	    (declare (ignore sym))
-	    (incf external-count))
-    #-cmu (do-symbols (sym object)
-	    (declare (ignore sym))
-	    (incf internal-count))
-    #-cmu (decf internal-count external-count)
+  (let* ((internal (lisp::package-internal-symbols object))
+	 (internal-count (- (lisp::package-hashtable-size internal)
+				  (lisp::package-hashtable-free internal)))
+	 (external (lisp::package-external-symbols object))
+	 (external-count (- (lisp::package-hashtable-size external)
+				  (lisp::package-hashtable-free external))))
     (format stream "It has ~D internal and ~D external symbols (~D total).~%"
 	    internal-count external-count (+ internal-count external-count)))
   (let ((used (package-use-list object)))
@@ -177,16 +159,13 @@
       (format stream "It is used by the packages ~{~S~^, ~}.~%"
 	      (mapcar #'package-name users)))))
 
-#+cmu
 (defmethod describe-object ((object package) stream)
   (describe-package object stream))
 
-#+cmu
 (defmethod describe-object ((object hash-table) stream)
   (format stream "~&~S is an ~a hash table."
 	  object
-	  #-cmu17 (lisp::hash-table-kind object)
-	  #+cmu17 (lisp::hash-table-test object))
+	  (lisp::hash-table-test object))
   (format stream "~&Its size is ~d buckets."
 	  (lisp::hash-table-size object))
   (format stream "~&Its rehash-size is ~d."
@@ -303,7 +282,6 @@
 (pushnew :portable-commonloops *features*)
 (pushnew :pcl-structures *features*)
 
-#+cmu
 (when (find-package "OLD-PCL")
   (setf (symbol-function (find-symbol "PRINT-OBJECT" :old-pcl))
         (symbol-function 'pcl::print-object)))
@@ -311,52 +289,45 @@
 
 ;;;; MAKE-LOAD-FORM
 
-#+cmu17
 (export '(cl::make-load-form cl::make-load-form-saving-slots) "CL")
 
-#+cmu17
-(progn
-  (defgeneric make-load-form (object &optional environment))
+(defgeneric make-load-form (object &optional environment))
 
-  (defmethod make-load-form ((object structure-object) &optional environment)
-    (declare (ignore environment))
-    (kernel:make-structure-load-form object))
+(defmethod make-load-form ((object structure-object) &optional environment)
+  (declare (ignore environment))
+  (kernel:make-structure-load-form object))
 
-  (defmethod make-load-form ((object wrapper) &optional env)
-    (declare (ignore env))
-    (let ((pname (kernel:class-proper-name (kernel:layout-class object))))
-      (unless pname
-	(error "Can't dump wrapper for anonymous class:~%  ~S"
-	       (kernel:layout-class object)))
-      `(kernel:class-layout (lisp:find-class ',pname))))
+(defmethod make-load-form ((object wrapper) &optional env)
+  (declare (ignore env))
+  (let ((pname (kernel:class-proper-name (kernel:layout-class object))))
+    (unless pname
+      (error "Can't dump wrapper for anonymous class:~%  ~S"
+	     (kernel:layout-class object)))
+    `(kernel:class-layout (lisp:find-class ',pname))))
 
-  (defun make-load-form-saving-slots (object &key slot-names environment)
-    (declare (ignore environment))
-    (when slot-names
-      (warn ":SLOT-NAMES MAKE-LOAD-FORM option not implemented, dumping all ~
-	     slots:~%  ~S"
-	    object))
-    :just-dump-it-normally))
+(defun make-load-form-saving-slots (object &key slot-names environment)
+  (declare (ignore environment))
+  (when slot-names
+    (warn ":SLOT-NAMES MAKE-LOAD-FORM option not implemented, dumping all ~
+	   slots:~%  ~S"
+	  object))
+  :just-dump-it-normally)
 
 
 ;;; The following are hacks to deal with CMU CL having two different CLASS
 ;;; classes.
 ;;;
-#+cmu17
 (defun coerce-to-pcl-class (class)
   (if (typep class 'lisp:class)
       (or (kernel:class-pcl-class class)
 	  (find-structure-class (lisp:class-name class)))
       class))
 
-#+cmu17
-(progn
-  (defmethod make-instance ((class lisp:class) &rest stuff)
-    (apply #'make-instance (coerce-to-pcl-class class) stuff))
-  (defmethod change-class (instance (class lisp:class))
-    (apply #'change-class instance (coerce-to-pcl-class class))))
+(defmethod make-instance ((class lisp:class) &rest stuff)
+  (apply #'make-instance (coerce-to-pcl-class class) stuff))
+(defmethod change-class (instance (class lisp:class))
+  (apply #'change-class instance (coerce-to-pcl-class class)))
 
-#+cmu17
 (macrolet ((frob (&rest names)
 	     `(progn
 		,@(mapcar #'(lambda (name)
diff --git a/pcl/extensions.lisp b/pcl/extensions.lisp
index a76786899731b604bcb58cfc9978eb2c96f5fdf1..f92f46b794638619681715ab1bc264d62aeabb50 100644
--- a/pcl/extensions.lisp
+++ b/pcl/extensions.lisp
@@ -16,9 +16,9 @@
 ;;; Suggestions, bugs, criticism and questions to lange@cs.ucla.edu
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.2 1998/12/20 04:30:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.3 1999/05/30 23:13:58 pw Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -491,10 +491,6 @@
             variable-accessors))
        ,@body))))
 
-
-#-(or KCL IBCL)
 (export *extensions-exports* *the-pcl-package*)
 
-#+(or KCL IBCL)
-(mapc 'export (list *extensions-exports*) (list *the-pcl-package*))
 
diff --git a/pcl/fast-init.lisp b/pcl/fast-init.lisp
index f062adb213adf8f26dbbe4feab3b3bcb3296bab2..a8084dc6ec08da04258a7609d315bd2ba7deb34e 100644
--- a/pcl/fast-init.lisp
+++ b/pcl/fast-init.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.4 1998/12/20 04:30:20 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.5 1999/05/30 23:13:59 pw Exp $")
 ;;;
 ;;; This file defines the optimized make-instance functions.
 ;;; 
@@ -910,12 +910,10 @@
 ;This optimization applys only when the first argument and all the even 
 ;numbered arguments are constants evaluating to interned symbols.
 
-#+cmu
 (declaim (ftype (function (t) symbol) get-make-instance-function-symbol))
 
 ; Use this definition in any CL implementation supporting 
 ; both define-compiler-macro and load-time-value.
-#+cmu
 (define-compiler-macro make-instance (&whole form &rest args)
   (declare (ignore args))
   (let* ((*make-instance-function-keys* nil)
diff --git a/pcl/fin.lisp b/pcl/fin.lisp
index 6adfef53b5d3eaad0bbac94d0887c39e10b74a8e..6b08189a6ad6a09c32cc65962dd2bff6674b49b2 100644
--- a/pcl/fin.lisp
+++ b/pcl/fin.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.12 1999/03/11 16:51:06 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fin.lisp,v 1.13 1999/05/30 23:13:59 pw Exp $")
 ;;;
 
   ;;   
@@ -152,12 +152,10 @@ explicitly marked saying who wrote it.
   ;; The debug-name for this function.
   (funcallable-instance-name nil))
 
-#+CMU
 ;;; Note: returns true for non-pcl funcallable structures.
 (import 'kernel:funcallable-instance-p)
 
-#+CMU
-(progn
+
 ;;; SET-FUNCALLABLE-INSTANCE-FUNCTION  --  Interface
 ;;;
 ;;;    Set the function that is called when FIN is called.
@@ -182,10 +180,6 @@ explicitly marked saying who wrote it.
 
 (defmacro pcl-funcallable-instance-wrapper (x)
   `(kernel:%funcallable-instance-layout ,x))
-                
-); End of #+cmu progn
-
-
 
   
 ;;;; Slightly Higher-Level stuff built on the implementation-dependent stuff.
diff --git a/pcl/fngen.lisp b/pcl/fngen.lisp
index 0e3b1693bb35a9a68e17545b0ebc6f5d03649ae5..4e2357902cf9e2c1fcdc4fab8a13559e20d63041 100644
--- a/pcl/fngen.lisp
+++ b/pcl/fngen.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.7 1998/12/20 04:30:20 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fngen.lisp,v 1.8 1999/05/30 23:14:00 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/fsc.lisp b/pcl/fsc.lisp
index d7b95a0edfb29ffb3e77f22cafb5eb4ec0974966..fdf45d27e78c836689d4c0569624c9c586ca2528 100644
--- a/pcl/fsc.lisp
+++ b/pcl/fsc.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fsc.lisp,v 1.8 1998/12/20 04:30:20 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/fsc.lisp,v 1.9 1999/05/30 23:14:00 pw Exp $")
 ;;;
 ;;; This file contains the definition of the FUNCALLABLE-STANDARD-CLASS
 ;;; metaclass.  Much of the implementation of this metaclass is actually
diff --git a/pcl/generic-functions.lisp b/pcl/generic-functions.lisp
index b7f57f948b2984610be0e68c1c9117daa73c6d2a..6c2d36f4fc8fb020ef971f0df6c2c3e5e407bbb0 100644
--- a/pcl/generic-functions.lisp
+++ b/pcl/generic-functions.lisp
@@ -1,8 +1,8 @@
 ;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*-
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.8 1998/12/20 04:30:20 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/generic-functions.lisp,v 1.9 1999/05/30 23:14:00 pw Exp $")
 ;;;
 
 (in-package :pcl)
diff --git a/pcl/init.lisp b/pcl/init.lisp
index 86acfcff9ef2de6acbf64a4784dcaff358561078..8306291acf80b4f188c549e88a74dda3cc45bab6 100644
--- a/pcl/init.lisp
+++ b/pcl/init.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.10 1999/03/11 16:51:09 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/init.lisp,v 1.11 1999/05/30 23:14:00 pw Exp $")
 ;;;
 ;;; This file defines the initialization and related protocols.
 ;;; 
@@ -171,11 +171,7 @@
   ;;
   (let* ((class (class-of instance))
 	 (slotds (class-slots class))
-	 #-new-kcl-wrapper
-	 (std-p #+cmu17
-		(pcl-instance-p instance)
-		#-cmu17
-		(or (std-instance-p instance) (fsc-instance-p instance))))
+	 (std-p (pcl-instance-p instance)))
     (dolist (slotd slotds)
       (let ((slot-name (slot-definition-name slotd))
 	    (slot-initargs (slot-definition-initargs slotd)))
diff --git a/pcl/iterate.lisp b/pcl/iterate.lisp
index 3c9a306be42431e6c7adacda946ee04dda9f3081..0f736bb2ed1dd7a2167fa2e46751028cdc05c98c 100644
--- a/pcl/iterate.lisp
+++ b/pcl/iterate.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/iterate.lisp,v 1.6 1998/12/20 04:30:21 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/iterate.lisp,v 1.7 1999/05/30 23:14:01 pw Exp $")
 ;;; 
 ;;; Original source {pooh/n}<pooh>vanmelle>lisp>iterate;4 created 27-Sep-88 12:35:33
 
@@ -298,16 +298,7 @@ NIL => never; :USER => those resulting from user code; T => always, even if it's
                  (generator (second clause)))
                 (setq
                  let-bindings
-                 (list (list gvar
-                             (cond
-			      #-cmu ; Python thinks this is unreachable.
-			      (leftover-body
-                                               ; Have to use this up
-                               `(progn ,@(prog1 leftover-body (setq 
-                                                                  leftover-body
-                                                                    nil))
-                                       generator))
-                              (t generator)))))
+                 (list (list gvar generator)))
                 (setq let-body `(funcall ,gvar #'(lambda nil ,finish-form)))))
            (push (mv-setq (copy-list vars)
                         let-body)
diff --git a/pcl/lap.lisp b/pcl/lap.lisp
index 7adddc86401be805ea2a6a2ebd61e31f89c5484f..a9f80e503aa1da94585aa10059de012797b8d58f 100644
--- a/pcl/lap.lisp
+++ b/pcl/lap.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/lap.lisp,v 1.7 1998/12/20 04:30:21 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/lap.lisp,v 1.8 1999/05/30 23:14:01 pw Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -222,7 +222,6 @@
     `(progn
        (eval-when (load eval) (load-defopcode ',name ',fn-name))
        (defun ,fn-name ,lambda-list
-	 #+Genera (declare (sys:function-parent ,name defopcode))
 	 (defopcode-1 ',name ',types ,@lambda-list)))))
 
 (defmacro defoperand (name types)
@@ -232,7 +231,6 @@
     `(progn
        (eval-when (load eval) (load-defoperand ',name ',fn-name))
        (defun ,fn-name ,lambda-list
-	 #+Genera (declare (sys:function-parent ,name defoperand))
 	 (defoperand-1 ',name ',types ,@lambda-list)))))
 
 (defun load-defopcode (name fn-name)
diff --git a/pcl/low.lisp b/pcl/low.lisp
index ce57ef71e3e9af99924f2fa94e1978faf62ce977..9460e2e85910ae4631affdea783fba61e9f7660a 100644
--- a/pcl/low.lisp
+++ b/pcl/low.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.10 1999/03/11 16:51:10 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.11 1999/05/30 23:14:03 pw Exp $")
 ;;;
 ;;; This file contains portable versions of low-level functions and macros
 ;;; which are ripe for implementation specific customization.  None of the
@@ -113,22 +113,12 @@
 ;;;
 ;;;  Very Low-Level representation of instances with meta-class standard-class.
 ;;;
-#-new-kcl-wrapper
-(progn
-#-cmu17
-(defstruct (std-instance (:predicate std-instance-p)
-			 (:conc-name %std-instance-)
-			 (:constructor %%allocate-instance--class ())
-			 (:print-function print-std-instance))
-  (wrapper nil)
-  (slots nil))
 
 (defmacro %instance-ref (slots index)
   `(%svref ,slots ,index))
 
 (defmacro instance-ref (slots index)
   `(svref ,slots ,index))
-)
 
 (defmacro std-instance-wrapper (x) `(%std-instance-wrapper ,x))
 (defmacro std-instance-slots   (x) `(%std-instance-slots ,x))
@@ -266,13 +256,9 @@
 ;;;
 (defvar *compiler-present-p* t)
 
-(defvar *compiler-speed*
-	#+(or KCL IBCL GCLisp CMU) :slow
-	#-(or KCL IBCL GCLisp CMU) :fast)
+(defvar *compiler-speed* :slow)
 
-(defvar *compiler-reentrant-p*
-	#+(and (not XKCL) (or KCL IBCL)) nil
-	#-(and (not XKCL) (or KCL IBCL)) t)
+(defvar *compiler-reentrant-p* t)
 
 (defun in-the-compiler-p ()
   )
diff --git a/pcl/macros.lisp b/pcl/macros.lisp
index a8a7cf540fcf3ee3a9631627c29476b4a825ef43..63e8f509fcda57536abf070abaf32e478f4d8d0b 100644
--- a/pcl/macros.lisp
+++ b/pcl/macros.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.13 1999/04/25 12:46:28 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/macros.lisp,v 1.14 1999/05/30 23:14:03 pw Exp $")
 ;;;
 ;;; Macros global variable definitions, and other random support stuff used
 ;;; by the rest of the system.
@@ -38,15 +38,15 @@
 (in-package :pcl)
 
 (proclaim '(declaration
-	     #-Genera values          ;I use this so that Zwei can remind
-				      ;me what values a function returns.
+	    values ;;I use this so that Zwei can remind
+	           ;;me what values a function returns.
 	     
-	     #-Genera arglist	      ;Tells me what the pretty arglist
-				      ;of something (which probably takes
-				      ;&rest args) is.
+	    arglist ;;Tells me what the pretty arglist
+	            ;;of something (which probably takes
+		    ;;&rest args) is.
 
-	     #-Genera indentation     ;Tells ZWEI how to indent things
-			              ;like defclass.
+	    indentation     ;;Tells ZWEI how to indent things
+			    ;;like defclass.
 	     class
 	     variable-rebinding
 	     pcl-fast-call
@@ -164,10 +164,6 @@
 	(return-from get-declaration (cdr form))))))
 
 
-#+Lucid
-(eval-when (compile load eval)
-  (eval `(defstruct ,(intern "FASLESCAPE" (find-package 'lucid)))))
-
 (defvar *keyword-package* (find-package 'keyword))
 
 (defun make-keyword (symbol)
@@ -260,18 +256,15 @@
 	  ((null pat) ())
 	(if (symbolp (setq var (car pat)))
 	    (progn
-	      #-:coral (unless (memq var '(nil ignore))
-			 (push var *destructure-vars*))
-	      #+:coral (push var *destructure-vars*)	      
+	      (unless (memq var '(nil ignore))
+			 (push var *destructure-vars*))	      
 	      (cond ((null (cdr pat))
 		     (push (make-pop var form ()) setqs))
 		    ((symbolp (cdr pat))
 		     (push (make-pop var form (cdr pat)) setqs)
 		     (push (cdr pat) *destructure-vars*)
 		     (return ()))
-		    #-:coral
 		    ((memq var '(nil ignore)) (incf pending-pops))
-		    #-:coral
 		    ((memq (cadr pat) '(nil ignore))
 		     (push (make-pop var form ()) setqs)
 		     (incf pending-pops 1))
@@ -335,18 +328,7 @@
 ;;; Similar to printing-random-object in the lisp machine but much simpler
 ;;; and machine independent.
 (defmacro printing-random-thing ((thing stream) &body body)
-  #+cmu17
-  `(print-unreadable-object (,thing ,stream :identity t) ,@body)
-  #-cmu17
-  (once-only (thing stream)
-    `(progn
-       (when *print-readably*
-	 (error "~S cannot be printed readably." thing))
-       (format ,stream "#<")
-       ,@body
-       (format ,stream " ")
-       (printing-random-thing-internal ,thing ,stream)
-       (format ,stream ">"))))
+  `(print-unreadable-object (,thing ,stream :identity t) ,@body))
 
 (defun printing-random-thing-internal (thing stream)
   (declare (ignore thing stream))
@@ -376,23 +358,6 @@
 	     (unless dashes-p (setf (elt string i) #\space)))
 	    (t (setq flag nil))))))
 
-#-(or lucid kcl)
-(eval-when (compile load eval)
-;(warn "****** Things will go faster if you fix define-compiler-macro")
-)
-
-#-cmu
-(defmacro define-compiler-macro (name arglist &body body)
-  #+(or lucid kcl)
-  `(#+lucid lcl:def-compiler-macro #+kcl si::define-compiler-macro
-	    ,name ,arglist
-	    ,@body)
-  #-(or kcl lucid)
-  (declare (ignore name arglist body))
-  #-(or kcl lucid)
-  nil)
-
-
 ;;;
 ;;; FIND-CLASS
 ;;;
@@ -463,7 +428,7 @@
 
 ; Use this definition in any CL implementation supporting 
 ; both define-compiler-macro and load-time-value.
-#+cmu ; Note that in CMU, lisp:find-class /= pcl:find-class
+; Note that in CMU, lisp:find-class /= pcl:find-class
 (define-compiler-macro find-class (&whole form
 				   symbol &optional (errorp t) environment)
   (declare (ignore environment))
@@ -476,9 +441,6 @@
 	    (class-cell (make-symbol "CLASS-CELL")))	
 	`(let ((,class-cell (load-time-value (find-class-cell ',symbol))))
 	   (or (find-class-cell-class ,class-cell)
-	       #-cmu17
-	       (find-class-from-cell ',symbol ,class-cell ,errorp)
-	       #+cmu17
 	       ,(if errorp
 		    `(find-class-from-cell ',symbol ,class-cell t)
 		    `(and (kernel:class-cell-class 
@@ -537,12 +499,10 @@
 	         (setq tail (funcall ,by tail))))))
 
 (defmacro function-funcall (form &rest args)
-  #-cmu `(funcall ,form ,@args)
-  #+cmu `(funcall (the function ,form) ,@args))
+  `(funcall (the function ,form) ,@args))
 
 (defmacro function-apply (form &rest args)
-  #-cmu `(apply ,form ,@args)
-  #+cmu `(apply (the function ,form) ,@args))
+  `(apply (the function ,form) ,@args))
 
 
 (defsetf slot-value set-slot-value)
diff --git a/pcl/methods.lisp b/pcl/methods.lisp
index df445118419568878b7223b97d981685f74ee3dd..63ca9ebd5a18017bcc8e1fdfe628a234000cc9b1 100644
--- a/pcl/methods.lisp
+++ b/pcl/methods.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.12 1998/12/20 04:30:21 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.13 1999/05/30 23:14:03 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -1033,7 +1033,7 @@
 		  (mec-all-class-lists (method-specializers method) precompute-p))))
       cache)))
 
-#+cmu
+
 (defmacro class-test (arg class)
   (cond ((eq class *the-class-t*)
 	 't)
@@ -1045,9 +1045,6 @@
 	 `(std-instance-p ,arg))
 	((eq class *the-class-funcallable-standard-object*)
 	 `(fsc-instance-p ,arg))
-	#-cmu17
-	((eq class *the-class-structure-object*)
-	 `(memq ',class (class-precedence-list (class-of ,arg))))
 	;; TYPEP is now sometimes faster than doing memq of the cpl
 	(t
 	 `(typep ,arg ',(class-name class)))))
@@ -1186,8 +1183,6 @@
 	    new-type
 	    `(and ,new-type ,@so-far)))))
 
-#+lcl3.0 (dont-use-production-compiler)
-
 (defun generate-discrimination-net-internal 
     (gf methods types methods-function test-function type-function)
   (let* ((arg-info (gf-arg-info gf))
@@ -1246,8 +1241,6 @@
 					   (do-if t) (do-if nil))))))))))
       (do-column precedence methods ()))))
 
-#+lcl3.0 (use-previous-compiler)
-
 (defun compute-secondary-dispatch-function (generic-function net &optional 
 					    method-alist wrappers)
   (function-funcall (compute-secondary-dispatch-function1 generic-function net)
@@ -1390,10 +1383,9 @@
 			(make-fast-method-call-lambda-list metatypes applyp))))
       (multiple-value-bind
 	  (cfunction constants)
-	  (get-function1 `(#+cmu ,(if function-p
-				      'kernel:instance-lambda
-				      'lambda)
-			   #-cmu lambda
+	  (get-function1 `(,(if function-p
+				'kernel:instance-lambda
+				'lambda)			   
 			   ,arglist
 				 ,@(unless function-p
 				     `((declare (ignore .pv-cell.
diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp
index 55f21b5ad7bf116f806511add378b46b574a1e71..5617e083d25695accf3e3a21172ac645647427e0 100644
--- a/pcl/pkg.lisp
+++ b/pcl/pkg.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.15 1998/12/20 04:30:22 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/pkg.lisp,v 1.16 1999/05/30 23:14:05 pw Exp $")
 ;;;
 ;;; CMUCL 18a: Jan-1998 -- Changing to DEFPACKAGE.
 ;;; Note that at this time CMUCL is not in compliance with ANSI
@@ -55,19 +55,12 @@
 	   "*ITERATE-WARNINGS*"))
 
 (defpackage "PCL" (:use :common-lisp :walker :iterate)
-  #+CMU
   (:shadow "DESTRUCTURING-BIND")
-  #+cmu17
   (:shadow "FIND-CLASS" "CLASS-NAME" "CLASS-OF"
 	   "CLASS" "BUILT-IN-CLASS" "STRUCTURE-CLASS"
 	   "STANDARD-CLASS")
-
-  #+cmu
   (:shadow "DOTIMES")
-
-  #+cmu
   (:import-from :kernel "FUNCALLABLE-INSTANCE-P")
-
   (:shadow "DOCUMENTATION")
 
 
@@ -115,12 +108,9 @@
 	   "SLOT-UNBOUND"
 	   "SLOT-VALUE"
 	   "STANDARD"
-	   #-CMU17 "STANDARD-CLASS"
 	   "STANDARD-GENERIC-FUNCTION"
 	   "STANDARD-METHOD"
 	   "STANDARD-OBJECT"
-	   #-CMU17 "STRUCTURE-CLASS"
-	   #-CMU17 "SYMBOL-MACROLET"
 	   "UPDATE-INSTANCE-FOR-DIFFERENT-CLASS"
 	   "UPDATE-INSTANCE-FOR-REDEFINED-CLASS"
 	   "WITH-ACCESSORS"
@@ -146,9 +136,7 @@
 	   "STANDARD-EFFECTIVE-SLOT-DEFINITION"
 	   "SPECIALIZER"
 	   "EQL-SPECIALIZER"
-	   #-CMU17 "BUILT-IN-CLASS"
 	   "FORWARD-REFERENCED-CLASS"
-	   #-CMU17 "STANDARD-CLASS"
 	   "FUNCALLABLE-STANDARD-CLASS"
 	   "FUNCALLABLE-STANDARD-OBJECT")
 
diff --git a/pcl/plap.lisp b/pcl/plap.lisp
index fd69ba4bf4d2bb4b7c42aae62a6c60d56c26f11b..bddcbd184f60d1f5c76023a3ba5c019153df24d0 100644
--- a/pcl/plap.lisp
+++ b/pcl/plap.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/plap.lisp,v 1.8 1998/12/20 04:30:22 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/plap.lisp,v 1.9 1999/05/30 23:14:06 pw Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -97,9 +97,6 @@
 	   (*lap-rest-p* (not (null rest))))
       `(lambda ,cvars
 	 #'(lambda ,args
-	     #-CMU (declare ,*lap-optimize-declaration*)
-	     #-CMU ,(make-lap-prog-internal i-regs v-regs fv-regs t-regs lap)
-	     #+CMU
              ;;
              ;; Use LOCALLY instead of a declare on the lambda so that we don't
              ;; suppress arg count checking...
@@ -123,10 +120,8 @@
 		    (append i-regs v-regs fv-regs t-regs))
 	   (declare (type fixnum ,@(mapcar #'lap-reg *lap-i-regs*))
 		    (type simple-vector ,@(mapcar #'lap-reg *lap-v-regs*))
-		    (type #+structure-wrapper cache-number-vector
-		          #-structure-wrapper (simple-array fixnum)
-		          ,@(mapcar #'lap-reg *lap-fv-regs*))
-	            #-cmu ,*lap-optimize-declaration*)
+		    (type  cache-number-vector
+		          ,@(mapcar #'lap-reg *lap-fv-regs*)))
 	   ,.code)))
 
 (defvar *empty-vector* '#())
@@ -189,7 +184,7 @@
     (:exit-lap-in-lisp () `(go exit-lap-in-lisp))
     
     (:break ()      `(break))
-    (:beep  ()      #+Genera`(zl:beep))
+    (:beep  ()      )
     (:print (val)   (lap-operands 'print val))
     ))
 
@@ -253,12 +248,10 @@
 (proclaim '(declaration pcl-fast-call))
 
 (defmacro RUNTIME\ FUNCALL (fn &rest args)
-  #+CMU `(funcall (the function ,fn) ,.args)
-  #-CMU `(funcall ,fn ,.args))
+  `(funcall (the function ,fn) ,.args))
 
 (defmacro RUNTIME\ APPLY (fn &rest args)
-  #+CMU `(apply (the function ,fn) ,.args)
-  #-CMU `(apply ,fn ,.args))
+  `(apply (the function ,fn) ,.args))
 
 (defmacro RUNTIME\ EMF-CALL (emf restp &rest required-args+rest-arg)
   `(invoke-effective-method-function ,emf ,restp ,@required-args+rest-arg))
@@ -311,30 +304,18 @@
 ;;; Some compilers are so stupid...
 ;;;
 (defmacro RUNTIME\ IREF (vector index)
-  #-structure-wrapper
-  `(svref (the simple-vector ,vector) (the fixnum ,index))
-  #+structure-wrapper
   `(aref ,vector (the fixnum ,index)))
 
 (defmacro RUNTIME\ ISET (vector index value)
   `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) ,value))
 
 (defmacro RUNTIME\ INSTANCE-REF (vector index)
-  #-new-kcl-wrapper
-  `(svref (the simple-vector ,vector) (the fixnum ,index))
-  #+new-kcl-wrapper
-  `(%instance-ref ,vector (the fixnum ,index)))
+  `(svref (the simple-vector ,vector) (the fixnum ,index)))
 
 (defmacro RUNTIME\ INSTANCE-SET (vector index value)
-  #-new-kcl-wrapper
-  `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) ,value)
-  #+new-kcl-wrapper
-  `(setf (%instance-ref ,vector (the fixnum ,index)) ,value))
+  `(setf (svref (the simple-vector ,vector) (the fixnum ,index)) ,value))
 
 (defmacro RUNTIME\ SVREF (vector fixnum)
-  #-structure-wrapper
-  `(svref (the simple-vector ,vector) (the fixnum ,fixnum))
-  #+structure-wrapper
   `(aref ,vector (the fixnum ,fixnum)))
 
 (defmacro RUNTIME\ I+ (index1 index2)
@@ -347,8 +328,7 @@
   `(the fixnum (1+ (the fixnum ,index))))
 
 (defmacro RUNTIME\ ILOGAND (index1 index2)
-  #-Lucid `(the fixnum (logand (the fixnum ,index1) (the fixnum ,index2)))
-  #+Lucid `(%logand ,index1 ,index2))
+  `(the fixnum (logand (the fixnum ,index1) (the fixnum ,index2))))
 
 (defmacro RUNTIME\ ILOGXOR (index1 index2)
   `(the fixnum (logxor (the fixnum ,index1) (the fixnum ,index2))))
diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp
index 8213be7dbc1e6bd5d70821049976c39421811363..6352ac7e50dbfbdcc4ca71b3470451c7c0114f9b 100644
--- a/pcl/slots-boot.lisp
+++ b/pcl/slots-boot.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.7 1999/03/11 16:51:16 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.8 1999/05/30 23:14:06 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -196,7 +196,7 @@
    `(boundp ,slot-name)))
 
 (defun make-optimized-structure-slot-value-using-class-method-function (function)
-  #+cmu (declare (type function function))
+  (declare (type function function))
   #'(lambda (class object slotd)
       (let ((value (funcall function object)))
 	(if (eq value *slot-unbound*)
@@ -204,13 +204,13 @@
 	    value))))	    
 
 (defun make-optimized-structure-setf-slot-value-using-class-method-function (function)
-  #+cmu (declare (type function function))
+  (declare (type function function))
   #'(lambda (nv class object slotd)
       (declare (ignore class slotd))
       (funcall function nv object)))
 
 (defun make-optimized-structure-slot-boundp-using-class-method-function (function)
-  #+cmu (declare (type function function))
+  (declare (type function function))
   #'(lambda (class object slotd)
       (declare (ignore class slotd))
       (not (eq (funcall function object) *slot-unbound*))))
@@ -237,7 +237,7 @@
 		 #'make-optimized-std-setf-slot-value-using-class-method-function)
 		(boundp 
 		 #'make-optimized-std-slot-boundp-using-class-method-function))))
-	#+cmu (declare (type function function))
+	(declare (type function function))
 	(values (funcall function fsc-p slot-name index) index))))
 
 (defun make-optimized-std-slot-value-using-class-method-function
diff --git a/pcl/slots.lisp b/pcl/slots.lisp
index 401b906d616bcb35281a0ec6cc37296519f79296..591fbdca771fa85f175ac19dba730a426a0742a0 100644
--- a/pcl/slots.lisp
+++ b/pcl/slots.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.11 1999/03/11 16:51:16 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.12 1999/05/30 23:14:06 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -309,7 +309,7 @@
      (slotd structure-effective-slot-definition))
   (let* ((function (slot-definition-internal-reader-function slotd))
 	 (value (funcall function object)))
-    #+cmu (declare (type function function))
+    (declare (type function function))
     (if (eq value *slot-unbound*)
 	(slot-unbound class object (slot-definition-name slotd))
 	value)))
@@ -319,7 +319,7 @@
 	       (object structure-object)
 	       (slotd structure-effective-slot-definition))
   (let ((function (slot-definition-internal-writer-function slotd)))
-    #+cmu (declare (type function function))
+    (declare (type function function))
     (funcall function new-value object)))
 
 (defmethod slot-boundp-using-class
diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp
index 4ef002f23f59fdb0822f3e025f4e84f565353a2f..c9b2fa7dc4679e597e3e2cc7fa7154428bf27180 100644
--- a/pcl/std-class.lisp
+++ b/pcl/std-class.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.24 1999/03/14 01:14:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.25 1999/05/30 23:14:08 pw Exp $")
 ;;;
 
 (in-package :pcl)
@@ -330,8 +330,7 @@
     ;; have a wrapper. RES is the incomplete PCL class. The Lisp class
     ;; does not yet exist. Maybe should return NIL in that case as RES
     ;; is not useful to the user?
-    #+cmu17 (and (class-wrapper res)(kernel:layout-class (class-wrapper res)))
-    #-cmu17 res))
+    (and (class-wrapper res)(kernel:layout-class (class-wrapper res)))))
 
 (setf (gdefinition 'load-defclass) #'real-load-defclass)
 
@@ -567,11 +566,7 @@
   (setf (slot-value class 'class-precedence-list) 
 	(compute-class-precedence-list class))
   (setf (slot-value class 'slots) (compute-slots class))
-  #-(or cmu17)
-  (unless (slot-value class 'wrapper) 
-    (setf (slot-value class 'wrapper) (make-wrapper 0 class)))
-  #+cmu17
- (let ((lclass (lisp:find-class (class-name class))))
+  (let ((lclass (lisp:find-class (class-name class))))
     (setf (kernel:class-pcl-class lclass) class)
     (setf (slot-value class 'wrapper) (kernel:class-layout lclass)))
   (update-pv-table-cache-info class)
@@ -709,7 +704,6 @@
 		   (class-wrapper class)))))
 
       (with-slots (wrapper slots) class
-	#+cmu17
 	(update-lisp-class-layout class nwrapper)
 	(setf slots eslotds
 	      (wrapper-instance-slots-layout nwrapper) nlayout
@@ -1045,7 +1039,6 @@
 	(setf (wrapper-class-slots nwrapper)
 	      (wrapper-class-slots owrapper))
 	(without-interrupts
-	  #+cmu17
 	  (update-lisp-class-layout class nwrapper)
 	  (setf (slot-value class 'wrapper) nwrapper)
 	  (invalidate-wrapper owrapper ':flush nwrapper))))))
@@ -1070,7 +1063,6 @@
       (setf (wrapper-class-slots nwrapper)
 	    (wrapper-class-slots owrapper))
       (without-interrupts
-	#+cmu17
 	(update-lisp-class-layout class nwrapper)
 	(setf (slot-value class 'wrapper) nwrapper)
 	(invalidate-wrapper owrapper ':obsolete nwrapper)
@@ -1112,7 +1104,6 @@
 (defvar *the-wrapper-of-structure-object* 
   (class-wrapper (find-class 'structure-object)))
 
-#+cmu17
 (define-condition obsolete-structure (error)
   ((datum :reader obsolete-structure-datum :initarg :datum))
   (:report
@@ -1125,16 +1116,10 @@
 	     (type-of (obsolete-structure-datum condition))))))
 
 (defun obsolete-instance-trap (owrapper nwrapper instance)
-  (if (not #-(or cmu17)
-           (or (std-instance-p instance) (fsc-instance-p instance))
-	   #+cmu17
-           (pcl-instance-p instance))
+  (if (not (pcl-instance-p instance))
       (if *in-obsolete-instance-trap*
           *the-wrapper-of-structure-object* 
            (let ((*in-obsolete-instance-trap* t))
-	     #-cmu17
-             (error "The structure ~S is obsolete." instance)
-	     #+cmu17
 	     (error 'obsolete-structure :datum instance)))
       (let* ((class (wrapper-class* nwrapper))
 	     (copy (allocate-instance class)) ;??? allocate-instance ???
@@ -1292,7 +1277,7 @@
 (defmethod class-default-initargs        ((class built-in-class)) ())
 
 (defmethod validate-superclass ((c class) (s built-in-class))
-  (or (eq s *the-class-t*) #+cmu (eq s *the-class-stream*)))
+  (or (eq s *the-class-t*) (eq s *the-class-stream*)))
 
 
 
diff --git a/pcl/structure-class.lisp b/pcl/structure-class.lisp
index 46c812953d0e3bd90ff937d7baf40831f691c04f..613e98bbb3d711d64e5dbdc7e58f2dfb9db26a3d 100644
--- a/pcl/structure-class.lisp
+++ b/pcl/structure-class.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/structure-class.lisp,v 1.2 1998/12/20 04:30:22 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/structure-class.lisp,v 1.3 1999/05/30 23:14:09 pw Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -94,9 +94,7 @@
          (conc-name
            (or (if defstruct-form (defstruct-form-conc-name defstruct-form))
                (slot-value class 'defstruct-conc-name)
-               (format nil #-excl "~s structure class "
-                           #+excl "~s_STRUCTURE.CLASS_"
-                           name)))
+               (format nil "~s structure class " name)))
          (defstruct-predicate
            (if defstruct-form (defstruct-form-predicate-name defstruct-form)))
          (pred-name  ;; Predicate name for class
diff --git a/pcl/user-instances.lisp b/pcl/user-instances.lisp
index 0038015f2950d6aeb7119748fe71a892ff7a90fe..e961f38df67c433d385cfec59a6759c00a399f32 100644
--- a/pcl/user-instances.lisp
+++ b/pcl/user-instances.lisp
@@ -18,9 +18,9 @@
 ;;; Suggestions, bugs, criticism and questions to lange@cs.ucla.edu
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.2 1998/12/20 04:30:23 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.3 1999/05/30 23:14:09 pw Exp $")
 ;;;
 
 (in-package 'pcl)
@@ -129,7 +129,7 @@
 (defmacro get-user-instance-slots (x)
   `(user-vector-instance-slots ,x))
 
-(eval-when (eval #+cmu load)
+(eval-when (eval load)
   (force-compile 'user-instance-p)
   (force-compile 'user-instance-slots)
   (force-compile 'user-instance-wrapper)
diff --git a/pcl/vector.lisp b/pcl/vector.lisp
index a6e115f071b0dc7e0c3fc42b841eb2d985f24f0d..ae65cb487619689b30facbf2eac41be5be785140 100644
--- a/pcl/vector.lisp
+++ b/pcl/vector.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.14 1999/03/14 01:14:14 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.15 1999/05/30 23:14:09 pw Exp $")
 ;;;
 ;;; Permutation vectors.
 ;;;
@@ -57,7 +57,6 @@
   (slot-name-lists nil :type list)
   (call-list nil :type list))
 
-#+cmu
 (declaim (ext:freeze-type pv-table))
 
 (defvar *initial-pv-table* (make-pv-table-internal nil nil))
@@ -177,8 +176,7 @@
 	    (iterate ((slot-names (list-elements slot-name-lists)))
 	      (when slot-names
 		(let* ((wrapper     (pop wrappers))
-		       (std-p #+cmu17 (typep wrapper 'wrapper)
-			      #-cmu17 t)
+		       (std-p (typep wrapper 'wrapper))
 		       (class       (wrapper-class* wrapper))
 		       (class-slots (and std-p (wrapper-class-slots wrapper))))
 		  (dolist (slot-name (cdr slot-names))
@@ -281,7 +279,7 @@
 
 (defun update-all-pv-table-caches (class slot-names)
   (let* ((cwrapper (class-wrapper class))
-	 (std-p #+cmu17 (typep cwrapper 'wrapper) #-cmu17 t)
+	 (std-p (typep cwrapper 'wrapper))
 	 (class-slots (and std-p (wrapper-class-slots cwrapper)))
 	 (class-slot-p-cell (list nil))
 	 (new-values (mapcar #'(lambda (slot-name)
@@ -866,7 +864,7 @@
      ,@forms))
 
 (defvar *non-variable-declarations*
-  '(#+cmu values method-name method-lambda-list
+  '(values method-name method-lambda-list
     optimize ftype inline notinline))
 
 (defvar *variable-declarations-with-argument*
@@ -1038,14 +1036,7 @@
 	 w (w-t pv-wrappers))
     (dolist (arg args)
       (setq w
-	    #+cmu17 (wrapper-of arg)
-	    #-cmu17
-	    (cond ((std-instance-p arg)
-		   (std-instance-wrapper arg))
-		  ((fsc-instance-p arg)
-		   (fsc-instance-wrapper arg))
-		  (t
-		   (built-in-or-structure-wrapper arg))))
+	    (wrapper-of arg))
       (unless (eq 't (wrapper-state w))
 	(setq w (check-wrapper-validity arg)))
       (setf (car w-t) w))
diff --git a/pcl/walk.lisp b/pcl/walk.lisp
index 4f89b723cb336847bc1534bf607a9ed4804a2ebc..39b662214c6ba33c9d0d85f4acb4eafca7f5b765 100644
--- a/pcl/walk.lisp
+++ b/pcl/walk.lisp
@@ -24,9 +24,9 @@
 ;;; Suggestions, comments and requests for improvements are also welcome.
 ;;; *************************************************************************
 ;;;
-#+cmu
+
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/walk.lisp,v 1.15 1998/12/20 04:30:23 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/walk.lisp,v 1.16 1999/05/30 23:14:10 pw Exp $")
 ;;;
 ;;; A simple code walker, based IN PART on: (roll the credits)
 ;;;   Larry Masinter's Masterscope
@@ -127,718 +127,7 @@
           This most likely source of this error is a program which tries to~%~
           to use the PCL portable code walker to build its own evaluator."))
 
-
-;;;
-;;; In Coral Common Lisp, the macroexpansion environment is just a list
-;;; of environment entries.  The cadr of each element specifies the type
-;;; of the element.  The only types that interest us are CCL::MACRO and
-;;; FUNCTION.  In these cases the element is interpreted as follows.
-;;;
-;;;   (<function-name> CCL::MACRO . macroexpansion-function)
-;;;   
-;;;   (<function-name> FUNCTION . <fn>)
-;;;   
-;;;   When in the compiler, <fn> is a gensym which will be
-;;;   a variable which bound at run-time to the function.
-;;;   When in the interpreter, <fn> is the actual function.
-;;;   
-;;;
-#+:Coral
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env
-							,functions
-							,macros)))
-     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  (dolist (f functions)
-    (push (list* f 'function (gensym)) env))
-  (dolist (m macros)
-    (push (list* (car m) 'ccl::macro (cadr m)) env))
-  env)
-
-(defun environment-function (env fn)
-  (let ((entry (assoc fn env :test #'equal)))
-    (and entry
-	 (eq (cadr entry) 'function)
-	 (cddr entry))))
 
-(defun environment-macro (env macro)
-  (let ((entry (assoc macro env :test #'equal)))
-    (and entry
-	 (eq (cadr entry) 'ccl::macro)
-	 (cddr entry))))
-
-);#+:Coral
-
-
-;;;
-;;; Franz Common Lisp is a lot like Coral Lisp.  The macroexpansion
-;;; environment is just a list of entries.  The cadr of each element
-;;; specifies the type of the element.  The types that interest us
-;;; are FUNCTION, EXCL::MACRO, and COMPILER::FUNCTION-VALUE.  These
-;;; are interpreted as follows:
-;;;
-;;;   (<function-name> FUNCTION . <a lexical closure>)
-;;;
-;;;      This happens in the interpreter with lexically
-;;;      bound functions.
-;;;
-;;;   (<function-name> COMPILER::FUNCTION-VALUE . <gensym>)
-;;;
-;;;      This happens in the compiler.  The gensym represents
-;;;      a variable which will be bound at run time to the
-;;;      function object.
-;;;
-;;;   (<function-name> EXCL::MACRO . <a lambda>)
-;;;
-;;;      In both interpreter and compiler, this is the
-;;;      representation used for macro definitions.
-;;;   
-;;;
-#+:ExCL
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env
-							,functions
-							,macros)))
-     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  (let (#+allegro-v4.1 (env-tail (cdr env)) #+allegro-v4.1 (env (car env)))
-    (dolist (f functions)
-      (push (list* f 'function #'unbound-lexical-function) env))
-    (dolist (m macros)
-      (push (list* (car m) 'excl::macro (cadr m)) env))
-    #-allegro-v4.1 env #+allegro-v4.1 (cons env env-tail)))
-
-(defun environment-function (env fn)
-  (let* (#+allegro-v4.1 (env (car env))
-	 (entry (assoc fn env :test #'equal)))
-    (and entry
-	 (or (eq (cadr entry) 'function)
-	     (eq (cadr entry) 'compiler::function-value))
-	 (cddr entry))))
-
-(defun environment-macro (env macro)
-  (let* (#+allegro-v4.1 (env (car env))
-	 (entry (assoc macro env :test #'equal)))
-    (and entry
-	 (eq (cadr entry) 'excl::macro)
-	 (cddr entry))))
-
-);#+:ExCL
-
-
-#+Lucid
-(progn
-  
-(proclaim '(inline
-	    %alphalex-p
-	    add-contour-to-env-shape
-	    make-function-variable
-	    make-sfc-contour
-	    sfc-contour-type
-	    sfc-contour-elements
-	    add-sfc-contour
-	    add-function-contour
-	    add-macrolet-contour
-	    find-variable-in-contour
-	    find-alist-element-in-contour
-	    find-macrolet-in-contour))
-
-(defun %alphalex-p (object)
-  #-Prime
-  (eq (cadddr (cddddr object)) 'lucid::%alphalex)
-  #+Prime
-  (eq (caddr (cddddr object)) 'lucid::%alphalex))
-
-#+Prime 
-(defun lucid::augment-lexenv-fvars-dummy (lexical vars)
-  (lucid::augment-lexenv-fvars-aux lexical vars '() '() 'flet '()))
-
-(defconstant function-contour 1)
-(defconstant macrolet-contour 5)
-
-(defstruct lucid::contour
-  type
-  elements)
-
-(defun add-contour-to-env-shape (contour-type elements env-shape)
-  (cons (make-contour :type contour-type
-		      :elements elements)
-	env-shape))
-
-(defstruct (variable (:constructor make-variable (name source-type)))
-  name
-  (identifier nil)
-  source-type)
-
-(defconstant function-sfc-contour 1)
-(defconstant macrolet-sfc-contour 8)
-(defconstant function-variable-type 1)
-
-(defun make-function-variable (name)
-  (make-variable name function-variable-type))
-
-(defun make-sfc-contour (type elements)
-  (cons type elements))
-
-(defun sfc-contour-type (sfc-contour)
-  (car sfc-contour))
-
-(defun sfc-contour-elements (sfc-contour)
-  (cdr sfc-contour))
-
-(defun add-sfc-contour (element-list environment type)
-  (cons (make-sfc-contour type element-list) environment))
-
-(defun add-function-contour (variable-list environment)
-  (add-sfc-contour variable-list environment function-sfc-contour))
-
-(defun add-macrolet-contour (alist environment)
-  (add-sfc-contour alist environment macrolet-sfc-contour))
-
-(defun find-variable-in-contour (name contour)
-  (dolist (element (sfc-contour-elements contour) nil)
-    (when (eq (variable-name element) name)
-      (return element))))
-
-(defun find-alist-element-in-contour (name contour)
-  (cdr (assoc name (sfc-contour-elements contour))))
-
-(defun find-macrolet-in-contour (name contour)
-  (find-alist-element-in-contour name contour))
-
-(defmacro do-sfc-contours ((contour-var environment &optional result)
-			   &body body)
-  `(dolist (,contour-var ,environment ,result) ,@body))
-
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)     
-  `(let* ((,new-env (with-augmented-environment-internal ,old-env
-							 ,functions
-							 ,macros)))
-     ,@body))
-
-;;;
-;;; with-augmented-environment-internal is where the real work of augmenting
-;;; the environment happens.
-;;; 
-(defun with-augmented-environment-internal (env functions macros)
-  (let ((function-names (mapcar #'first functions))
-	(macro-names (mapcar #'first macros))
-	(macro-functions (mapcar #'second macros)))
-    (cond ((or (null env)
-	       (contour-p (first env)))
-	   (when function-names
-	     (setq env (add-contour-to-env-shape function-contour
-						 function-names
-						 env)))
-	   (when macro-names
-	     (setq env (add-contour-to-env-shape macrolet-contour
-						 (pairlis macro-names
-							  macro-functions)
-						 env))))
-	  ((%alphalex-p env)
-	   (when function-names
-	     (setq env (lucid::augment-lexenv-fvars-dummy env function-names)))
-	   (when macro-names
-	     (setq env (lucid::augment-lexenv-mvars env
-						    macro-names
-						    macro-functions))))
-	  (t
-	   (when function-names
-	     (setq env (add-function-contour
-			 (mapcar #'make-function-variable function-names)
-			 env)))
-	   (when macro-names
-	     (setq env (add-macrolet-contour
-			 (pairlis macro-names macro-functions)
-			 env)))))
-    env))
-	 
-
-(defun environment-function (env fn)
-  (cond ((null env) nil)
-	((contour-p (first env))
-	 (if (lucid::find-lexical-function fn env)
-	     t
-	     nil))
-	((%alphalex-p env)
-	 (if (lucid::lexenv-fvar fn env)
-	     t
-	     nil))
-	(t (do-sfc-contours (contour env nil)
-	     (let ((type (sfc-contour-type contour)))
-	       (cond ((eql type function-sfc-contour)
-		      (when (find-variable-in-contour fn contour)
-			(return t)))
-		     ((eql type macrolet-sfc-contour)
-		      (when (find-macrolet-in-contour fn contour)
-			(return nil)))))))))
-		      
-(defun environment-macro (env macro)
-  (cond ((null env) nil)
-	((contour-p (first env))
-	 (lucid::find-lexical-macro macro env))
-	((%alphalex-p env)
-	 (lucid::lexenv-mvar macro env))
-	(t (do-sfc-contours (contour env nil)
-	     (let ((type (sfc-contour-type contour)))
-	       (cond ((eql type function-sfc-contour)
-		      (when (find-variable-in-contour macro contour)
-			(return nil)))
-		     ((eql type macrolet-sfc-contour)
-		      (let ((fn (find-macrolet-in-contour macro contour)))
-			(when fn
-			  (return fn))))))))))
-  
-
-);#+Lucid
-
-
-
-;;;
-;;; On the 3600, the documentation for how the environments are represented
-;;; is in sys:sys;eval.lisp.  That total information is not repeated here.
-;;; The important points are that:
-;;;    si:env-variables returns a list of which each element is:
-;;;
-;;;		(symbol value)
-;;;	     or (symbol . locative)
-;;;
-;;;	The first form is for lexical variables, the second for
-;;;	special and instance variables.  In either case CADR of
-;;;	the entry is the value and SETF of CADR is used to change
-;;;	the value.  Variables are looked up with ASSQ.
-;;;
-;;;    si:env-functions returns a list of which each element is:
-;;;     
-;;;		(symbol definition)
-;;;
-;;;	where definition is anything that could go in a function cell.
-;;;	This is used for both local functions and local macros.
-;;;
-;;; The 3600 stack conses its environments (at least in the interpreter).
-;;; This means that code written using this walker and running on the 3600
-;;; must not hold on to the environment after the walk-function returns.
-;;; No code in this walker or in PCL does that.
-;;;
-#+Genera
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  (let ((funs (make-symbol "FNS"))
-	(macs (make-symbol "MACROS"))
-	(new  (make-symbol "NEW")))
-    `(let ((,funs ,functions)
-	   (,macs ,macros)
-	   (,new ()))
-       (dolist (f ,funs)
-	 (push `(,(car f) ,#'unbound-lexical-function) ,new))
-       (dolist (m ,macs)
-	 (push `(,(car m) (special ,(cadr m))) ,new))
-       (let* ((.old-env. ,old-env)
-	      (.old-vars. (pop .old-env.))
-	      (.old-funs. (pop .old-env.))
-	      (.old-blks. (pop .old-env.))
-	      (.old-tags. (pop .old-env.))
-	      (.old-dcls. (pop .old-env.)))
-	 (si:with-interpreter-environment (,new-env
-					   .old-env.
-					   .old-vars.
-					   (append ,new .old-funs.)
-					   .old-blks.
-					   .old-tags.
-					   .old-dcls.)
-	   ,@body)))))
-  
-
-(defun environment-function (env fn)
-  (if (null env)
-      (values nil nil)
-      (let ((entry (assoc fn (si:env-functions env) :test #'equal)))
-	(if (and entry
-		 (or (not (listp (cadr entry)))
-		     (not (eq (caadr entry) 'special))))
-	    (values (cadr entry) t)
-	    (environment-function (si:env-parent env) fn)))))
-
-(defun environment-macro (env macro)
-  (if (null env)
-      (values nil nil)
-      (let ((entry (assoc macro (si:env-functions env) :test #'equal)))
-	(if (and entry
-		 (listp (cadr entry))
-		 (eq (caadr entry) 'special))
-	    (values (cadadr entry) t)
-	    (environment-macro (si:env-parent env) macro)))))
-
-);#+Genera
-
-#+Cloe-Runtime
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env ,functions ,macros)))
-     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  functions
-  (dolist (m macros)
-    (setf env `(,(first m) (compiler::macro . ,(second m)) ,@env)))
-  env)
-
-(defun environment-function (env fn)
-  nil)
-
-(defun environment-macro (env macro)
-  (let ((entry (getf env macro)))
-    (if (and (consp entry)
-	     (eq (car entry) 'compiler::macro))
-	(values (cdr entry) t)
-	(values nil nil))))
-
-);#+Cloe-Runtime
-
-
-;;;
-;;; In Xerox Lisp, the compiler and interpreter use different structures for
-;;; the environment.  This doesn't cause a serious problem, the parts of the
-;;; environments we are concerned with are fairly similar.
-;;; 
-#+:Xerox
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)     
-  `(let* ((,new-env (with-augmented-environment-internal ,old-env
-							 ,functions
-							 ,macros)))
-     ,@body))
-
-;;;
-;;; with-augmented-environment-internal is where the real work of augmenting
-;;; the environment happens.  Before it gets there, env had better not be NIL
-;;; anymore because we have to know what kind of environment we are supposed
-;;; to be building up.  This is probably never a real concern in practice.
-;;; It better not be because we don't do anything about it.
-;;; 
-(defun with-augmented-environment-internal (env functions macros)
-  (cond
-     ((compiler::env-p env)
-	(dolist (f functions)
-	   (setq env (compiler::copy-env-with-function
-		       env f :function)))
-	(dolist (m macros)
-	   (setq env (compiler::copy-env-with-function
-	 	  env (car m) :macro (cadr m)))))
-     (t (setq env (if (il:environment-p env)
-		    (il:\\copy-environment env)
-		    (il:\\make-environment)))
-	;; The functions field of the environment is a plist of function names
-	;; and conses like (:function . fn) or (:macro . expansion-fn).
-	;; Note that we can't smash existing entries in this plist since these
-	;; are likely shared with older environments.
-	(dolist (f functions)
-	  (setf (il:environment-functions env)
-		(list* f (cons :function #'unbound-lexical-function)
-		       (il:environment-functions env))))
-	(dolist (m macros)
-	  (setf (il:environment-functions env)
-		(list* (car m) (cons :macro (cadr m))
-		       (il:environment-functions env))))))
-  env)
-
-(defun environment-function (env fn)
-  (cond ((compiler::env-p env) (eq (compiler:env-fboundp env fn) :function))
-	((il:environment-p env) (eq (getf (il:environment-functions env) fn)
-				    :function))
-	(t nil)))
-
-(defun environment-macro (env macro) 
-  (cond ((compiler::env-p env)
-	 (multiple-value-bind (type def)
-	     (compiler:env-fboundp env macro)
-	   (when (eq type :macro) def)))
-	((il:environment-p env)
-	 (xcl:destructuring-bind (type . def)
-	     (getf (il:environment-functions env) macro)
-	   (when (eq type :macro) def)))
-	(t nil)))
-
-);#+:Xerox
-
-
-;;;
-;;; In IBUKI Common Lisp, the macroexpansion environment is a three element
-;;; list.  The second element describes lexical functions and macros.  The 
-;;; function entries in this list have the form 
-;;;     (<name> . (FUNCTION . (<function-value> . nil))
-;;; The macro entries have the form 
-;;;     (<name> . (MACRO . (<macro-value> . nil)).
-;;;
-;;;
-#+(or KCL IBCL)
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-	  `(let ((,new-env (with-augmented-environment-internal ,old-env
-								,functions
-								,macros)))
-	     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  (let ((first (first env))
-	(lexicals (second env))
-	(third (third env)))
-    (dolist (f functions)
-      (push `(,(car f) .  (function  . (,#'unbound-lexical-function . nil)))
-	    lexicals))
-    (dolist (m macros)
-      (push `(,(car m)  .  (macro . ( ,(cadr m) . nil))) 
-	    lexicals))
-    (list first lexicals third)))
-
-(defun environment-function (env fn)
-  (when env
-	(let ((entry (assoc fn (second env))))
-	  (and entry
-	       (eq (cadr entry) 'function)
-	       (caddr entry)))))
-
-(defun environment-macro (env macro)
-  (when env
-	(let ((entry (assoc macro (second env))))
-	  (and entry
-	       (eq (cadr entry) 'macro)
-	       (caddr entry)))))
-);#+(or KCL IBCL)
-
-
-;;;   --- TI Explorer --
-
-;;; An environment is a two element list, whose car we can ignore and
-;;; whose cadr is list of the local-definitions-frames. Each
-;;; local-definitions-frame holds either macros or functions, but not
-;;; both.  Each frame is a plist of <name> <def> <name> <def> ...  where
-;;; <name> is a locative to the function cell of the symbol that names
-;;; the function or macro, and <def> is the new def or NIL if this is function
-;;; redefinition or (cons 'ticl:macro <macro-expansion-function>) if this is a macro
-;;; redefinition.
-;;;
-;;; Here's an example.  For the form:
-;;; (defun foo ()
-;;;   (macrolet ((bar (a b) (list a b))
-;;;	         (bar2 (a b) (list a b)))
-;;;     (flet ((some-local-fn (c d) (print (list c d)))
-;;;	       (another (c d) (print (list c d))))
-;;;       (bar (some-local-fn 1 2) 3))))
-
-;;; the environment arg to macroexpand-1 when called on
-;;; (bar (some-local-fn 1 2) 3)
-;;;is 
-;;;(NIL ((#<DTP-LOCATIVE 4710602> NIL
-;;;       #<DTP-LOCATIVE 4710671> NIL)
-;;;      (#<DTP-LOCATIVE 7346562>
-;;;       (TICL:MACRO TICL:NAMED-LAMBDA (BAR (:DESCRIPTIVE-ARGLIST (A B)))
-;;;		   (SYS::*MACROARG* &OPTIONAL SYS::*MACROENVIRONMENT*)
-;;;		   (BLOCK BAR ....))
-;;;       #<DTP-LOCATIVE 4710664>
-;;;       (TICL:MACRO TICL:NAMED-LAMBDA (BAR2 (:DESCRIPTIVE-ARGLIST (A B)))
-;;;		   (SYS::*MACROARG* &OPTIONAL SYS::*MACROENVIRONMENT*)
-;;;		   (BLOCK BAR2 ....))))
-#+TI
-(progn 
-
-;;; from sys:site;macros.lisp
-(eval-when (compile load eval)
-  
-(DEFMACRO MACRO-DEF? (thing)
-  `(AND (CONSP ,thing) (EQ (CAR ,thing) 'TICL::MACRO)))
-
-;; the following macro generates code to check the 'local' environment
-;; for a macro definition for THE SYMBOL <name>. Such a definition would
-;; be set up only by a MACROLET. If a macro definition for <name> is
-;; found, its expander function is returned.
-
-(DEFMACRO FIND-LOCAL-DEFINITION (name local-function-environment)
-  `(IF ,local-function-environment
-       (LET ((vcell (ticl::LOCF (SYMBOL-FUNCTION ,name))))
-	 (DOLIST (frame  ,local-function-environment)
-	   ;; <value> is nil or a locative
-	   (LET ((value (sys::GET-LOCATION-OR-NIL (ticl::LOCF frame)
-						  vcell))) 
-	     (When value (RETURN (CAR value))))))
-       nil)))
-
- 
-;;;Edited by Reed Hastings         13 Jan 88  16:29
-(defun environment-macro (env macro)
-  "returns what macro-function would, ie. the expansion function"
-  ;;some code picked off macroexpand-1
-  (let* ((local-definitions (cadr env))
-	 (local-def (find-local-definition macro local-definitions)))
-    (if (macro-def? local-def)
-	(cdr local-def))))
-
-;;;Edited by Reed Hastings         13 Jan 88  16:29
-;;;Edited by Reed Hastings         7 Mar 88  19:07
-(defun environment-function (env fn)
-  (let* ((local-definitions (cadr env)))
-    (dolist (frame local-definitions)
-      (let ((val (getf frame
-		       (ticl::locf (symbol-function fn))
-		       :not-found-marker)))
-	(cond ((eq val :not-found-marker))
-	      ((functionp val) (return t))
-	      ((and (listp val)
-		    (eq (car val) 'ticl::macro))
-	       (return nil))
-	      (t
-	       (error "we are confused")))))))
-	     
-
-;;;Edited by Reed Hastings         13 Jan 88  16:29
-;;;Edited by Reed Hastings         7 Mar 88  19:07
-(defun with-augmented-environment-internal (env functions macros)
-  (let ((local-definitions (cadr env))
-	(new-local-fns-frame
-	  (mapcan #'(lambda (fn)
-		      (list (ticl:locf (symbol-function (car fn)))
-			    #'unbound-lexical-function))
-		  functions))
-	 (new-local-macros-frame
-	   (mapcan #'(lambda (m)
-		       (list (ticl:locf (symbol-function (car m))) (cons 'ticl::macro (cadr m))))
-		   macros)))
-    (when new-local-fns-frame 
-      (push new-local-fns-frame local-definitions))
-    (when new-local-macros-frame
-      (push new-local-macros-frame local-definitions))   
-    `(,(car env) ,local-definitions)))
-
-
-;;;Edited by Reed Hastings         7 Mar 88  19:07
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env
-							,functions
-							,macros)))
-     ,@body))
-
-);#+TI
-
-
-#+(and dec vax common)
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env
-							,functions
-							,macros)))
-     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  #'(lambda (op &optional (arg nil arg-p))
-      (cond ((eq op :macro-function) 
-	     (unless arg-p (error "Invalid environment use."))
-	     (lookup-macro-function arg env functions macros))
-            (arg-p
-	     (error "Invalid environment operation: ~S ~S" op arg))
-            (t
-	     (lookup-macro-function op env functions macros)))))
-
-(defun lookup-macro-function (name env fns macros)
-  (let ((m (assoc name macros)))
-    (cond (m                (cadr m))
-          ((assoc name fns) :function)
-          (env              (funcall env name))
-          (t                nil))))
-
-(defun environment-macro (env macro)
-  (let ((m (and env (funcall env macro))))
-    (and (not (eq m :function)) 
-         m)))
-
-;;; Nobody calls environment-function.  What would it return, anyway?
-);#+(and dec vax common)
-
-
-;;;
-;;; In Golden Common Lisp, the macroexpansion environment is just a list
-;;; of environment entries.  Unless the car of the list is :compiler-menv 
-;;; it is an interpreted environment.  The cadr of each element specifies 
-;;; the type of the element.  The only types that interest us are GCL:MACRO
-;;; and FUNCTION.  In these cases the element is interpreted as follows.
-;;;
-;;; Compiled:
-;;;   (<function-name> <gensym> macroexpansion-function)
-;;;   (<function-name> <fn>)
-;;;   
-;;; Interpreted:
-;;;   (<function-name> GCL:MACRO macroexpansion-function)
-;;;   (<function-name> <fn>)
-;;;   
-;;;   When in the compiler, <fn> is a gensym which will be
-;;;   a variable which bound at run-time to the function.
-;;;   When in the interpreter, <fn> is the actual function.
-;;;   
-;;;
-#+gclisp
-(progn
-
-(defmacro with-augmented-environment
-	  ((new-env old-env &key functions macros) &body body)
-  `(let ((,new-env (with-augmented-environment-internal ,old-env
-							,functions
-							,macros)))
-     ,@body))
-
-(defun with-augmented-environment-internal (env functions macros)
-  (let ((new-entries nil))
-    (dolist (f functions)
-      (push (cons (car f) nil) new-entries))
-    (dolist (m macros)
-      (push (cons (car m)
-		  (if (eq :compiler-menv (car env))
-		      (if (eq (caadr m) 'lisp::lambda)
-			  `(,(gensym) ,(cadr m))
-			`(,(gensym) ,@(cadr m)))
-		    `(gclisp:MACRO ,@(cadr m))))
-	      new-entries))
-    (if (eq :compiler-menv (car env))
-	`(:compiler-menv ,@new-entries ,@(cdr env))
-      (append new-entries env))))
-
-(defun environment-function (env fn)
-  (let ((entry (lisp::lexical-function fn env)))
-    (and entry 
-	 (eq entry 'lisp::lexical-function)
-	 fn)))
-
-(defun environment-macro (env macro)
-  (let ((entry (assoc macro (if (eq :compiler-menv (first env))
-				 (rest env)
-			       env))))
-    (and entry
-	 (consp entry)
-	 (symbolp (car entry))			;name
-	 (symbolp (cadr entry))			;gcl:macro or gensym
-	 (nthcdr 2 entry))))
-
-);#+gclisp
 
 
 ;;;; CMU Common Lisp version of environment frobbing stuff.
@@ -850,8 +139,6 @@
 ;;; or a list (MACRO . <function>) (a local macro, with the specifier
 ;;; expander.)    Note that Name may be a (SETF <name>) function.
 
-#+:CMU
-(progn
 
 (defmacro with-augmented-environment
 	  ((new-env old-env &key functions macros) &body body)
@@ -893,8 +180,6 @@
 	   (eq (cadr entry) 'c::macro)
 	   (function-lambda-expression (cddr entry))))))
 
-); end of #+:CMU
-
 
 
 (defmacro with-new-definition-in-environment
@@ -918,20 +203,11 @@
 	      (,new-env ,old-env :functions ,functions :macros ,macros)
 	 ,@body))))
 
-#-Genera
 (defun convert-macro-to-lambda (llist body &optional (name "Dummy Macro"))
   (let ((gensym (make-symbol name)))
     (eval `(defmacro ,gensym ,llist ,@body))
     (macro-function gensym)))
 
-#+Genera
-(defun convert-macro-to-lambda (llist body &optional (name "Dummy Macro"))
-  (si:defmacro-1
-    'sys:named-lambda 'sys:special (make-symbol name) llist body))
-
-
-
-
 
 ;;;
 ;;; Now comes the real walker.
@@ -1028,36 +304,9 @@
 ;;; Common Lisp nit:
 ;;;   variable-globally-special-p should be defined in Common Lisp.
 ;;;
-#-(or Genera Cloe-Runtime Lucid Xerox Excl KCL IBCL (and dec vax common) :CMU HP-HPLabs
-      GCLisp TI pyramid)
-(defvar *globally-special-variables* ())
 
 (defun variable-globally-special-p (symbol)
-  #+Genera                      (si:special-variable-p symbol)
-  #+Cloe-Runtime		(compiler::specialp symbol)
-  #+Lucid                       (lucid::proclaimed-special-p symbol)
-  #+TI                          (get symbol 'special)
-  #+Xerox                       (il:variable-globally-special-p symbol)
-  #+(and dec vax common)        (get symbol 'system::globally-special)
-  #+(or KCL IBCL)               (si:specialp symbol)
-  #+excl                        (get symbol 'excl::.globally-special.)
-  #+:CMU			(eq (ext:info variable kind symbol) :special)
-  #+HP-HPLabs                   (member (get symbol 'impl:vartype)
-					'(impl:fluid impl:global)
-					:test #'eq)
-  #+:GCLISP                     (gclisp::special-p symbol)
-  #+pyramid			(or (get symbol 'lisp::globally-special)
-				    (get symbol
-					 'clc::globally-special-in-compiler))
-  #+:CORAL                      (ccl::proclaimed-special-p symbol)
-  #-(or Genera Cloe-Runtime Lucid Xerox Excl KCL IBCL (and dec vax common) :CMU HP-HPLabs
-	GCLisp TI pyramid :CORAL)
-  (or (not (null (member symbol *globally-special-variables* :test #'eq)))
-      (when (eval `(flet ((ref () ,symbol))
-		     (let ((,symbol '#,(list nil)))
-		       (and (boundp ',symbol) (eq ,symbol (ref))))))
-	(push symbol *globally-special-variables*)
-	t)))
+  (eq (ext:info variable kind symbol) :special))
 
 
   ;;   
@@ -1168,7 +417,7 @@
 (define-walker-template SYMBOL-MACROLET      walk-symbol-macrolet)
 (define-walker-template TAGBODY              walk-tagbody)
 (define-walker-template THE                  (NIL QUOTE EVAL))
-#+cmu(define-walker-template EXT:TRULY-THE   (NIL QUOTE EVAL))
+(define-walker-template EXT:TRULY-THE        (NIL QUOTE EVAL))
 (define-walker-template THROW                (NIL EVAL EVAL))
 (define-walker-template UNWIND-PROTECT       (NIL RETURN REPEAT (EVAL)))
 
@@ -1184,36 +433,6 @@
 (define-walker-template PROG*   walk-prog*)
 (define-walker-template COND    (NIL REPEAT ((TEST REPEAT (EVAL)))))
 
-#+Genera
-(progn
-  (define-walker-template zl::named-lambda walk-named-lambda)
-  (define-walker-template SCL:LETF walk-let)
-  (define-walker-template SCL:LETF* walk-let*)
-  )
-
-#+Lucid
-(progn
-  (define-walker-template #+LCL3.0 lucid-common-lisp:named-lambda
-			  #-LCL3.0 sys:named-lambda walk-named-lambda)
-  )
-
-#+(or KCL IBCL)
-(progn
-  (define-walker-template lambda-block walk-named-lambda);Not really right,
-							 ;we don't hack block
-						         ;names anyways.
-  )
-
-#+TI
-(progn
-  (define-walker-template TICL::LET-IF walk-let-if)
-  )
-
-#+:Coral
-(progn
-  (define-walker-template ccl:%stack-block walk-let)
-  )
-
 
 
 (defvar walk-form-expand-macros-p nil)
@@ -1356,10 +575,7 @@
 			  newnewnewform)))
 		   ((and (symbolp fn)
 			 (not (fboundp fn))
-			 #+cmu17
-			 (special-operator-p fn)
-			 #-cmu17
-			 (special-form-p fn))
+			 (special-operator-p fn))
 		    (error
 		     "~S is a special form, not defined in the CommonLisp.~%~
 		      manual This code walker doesn't know how to walk it.~%~
@@ -1386,8 +602,6 @@
 			 (= (length form) 2)
 			 (eq (car form) 'setf)))
 		form)
-	       #+Lispm
-	       ((sys:validate-function-spec form) form)
 	       (t (walk-form-internal form context env)))))
       (case (car template)
         (REPEAT