diff --git a/pcl/cmu-low.lisp b/pcl/cmu-low.lisp
index e529dbc193e192715f4762152da20b1cd7a135bb..46c7fd2b36247b902b0729346afb6c04bab0d069 100644
--- a/pcl/cmu-low.lisp
+++ b/pcl/cmu-low.lisp
@@ -1,7 +1,7 @@
-;;;-*-Mode:LISP; Package:(PCL LISP 1000); Base:10; Syntax:Common-lisp -*-
+;;;-*-Mode:LISP; Package:PCL; Base:10; Syntax:Common-lisp -*-
 ;;;
 ;;; *************************************************************************
-;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
+;;; Copyright (c) 1985, 1986, 1987, 1988 Xerox Corporation.
 ;;; All rights reserved.
 ;;;
 ;;; Use and copying of this software and preparation of derivative works
@@ -33,27 +33,49 @@
 ;;;;;; Cache No's
   ;;  
 
-;;; Abuse the type declaration, but it generates great code.
-
-;(defun symbol-cache-no (symbol mask)
-;  (logand (the fixnum (system:%primitive lisp::make-immediate-type
-;					 symbol
-;					 system::%+-fixnum-type))
-;	  (the fixnum mask)))
-;
-;(clc::deftransform symbol-cache-no symbol-cache-no-transform (symbol mask)
-;  `(logand (the fixnum (system:%primitive lisp::make-immediate-type
-;					  ,symbol
-;					  system::%+-fixnum-type))
-;	   (the fixnum ,mask)))
+(proclaim '(inline object-cache-no))
 
 (defun object-cache-no (symbol mask)
-  (logand (the fixnum (system:%primitive lisp::make-immediate-type
-					 symbol
-					 system::%+-fixnum-type))
+  (logand (ext:truly-the fixnum (system:%primitive make-fixnum symbol))
 	  (the fixnum mask)))
 
-(clc::deftransform object-cache-no object-cache-no-transform (symbol mask)
-  `(logand (the fixnum (system:%primitive lisp::make-immediate-type
-					  ,symbol
-					  system::%+-fixnum-type))
+
+
+(defun function-arglist (fcn)
+  "Returns the argument list of a compiled function, if possible."
+  (cond ((symbolp fcn)
+	 (when (fboundp fcn)
+	   (function-arglist (symbol-function fcn))))
+	((eval:interpreted-function-p fcn)
+	 (eval:interpreted-function-name fcn))
+	((functionp fcn)
+	 (let ((lambda-expr (function-lambda-expression fcn)))
+	   (if lambda-expr
+	       (cadr lambda-expr)
+	       (let ((function (kernel:%closure-function fcn)))
+		 (values (read-from-string
+			  (kernel:%function-header-arglist function)))))))))
+
+
+;;; We have this here and in fin.lisp, 'cause PCL wants to compile this
+;;; file first.
+;;; 
+(defsetf funcallable-instance-name set-funcallable-instance-name)
+
+(defun set-function-name (fcn new-name)
+  "Set the name of a compiled function object."
+  (cond ((symbolp fcn)
+	 (set-function-name (symbol-function fcn) new-name))
+	((funcallable-instance-p fcn)
+	 (setf (funcallable-instance-name fcn) new-name)
+	 fcn)
+	(t
+	 (let ((header (kernel:%closure-function fcn)))
+	   (system:%primitive c::set-function-name header
+			      (if (symbolp new-name)
+				  new-name
+				  (let ((*package* *the-pcl-package*)
+					(*print-case* :upcase)
+					(*print-gensym* 't))
+				    (prin1-to-string new-name)))))
+	 fcn)))
diff --git a/pcl/defsys.lisp b/pcl/defsys.lisp
index 7606fdd94bf8e816844c04dfbfb8ac5cfee4226c..b64d278a7d4babd2a29924eab65de804abea66a7 100644
--- a/pcl/defsys.lisp
+++ b/pcl/defsys.lisp
@@ -269,7 +269,7 @@ and load your system with:
              #+(and Lucid MIPS)                  ("lisp"  . "mbin")
              #+(and Lucid PRISM)                 ("lisp"  . "abin")
 	     #+excl                              ("cl"    . "fasl")
-             #+:CMU                              ("slisp" . "sfasl")
+             #+:CMU ("lisp" . #+pmax "mips-fasl" #-(or pmax) "fasl")
              #+HP                                ("l"     . "b")
              #+TI ("lisp" . #.(string (si::local-binary-file-type)))
              #+:gclisp                           ("LSP"   . "F2S")
@@ -395,7 +395,8 @@ and load your system with:
     (let ((*system-directory* (funcall (car system)))
 	  (modules (cadr system))
 	  (transformations ()))
-      (labels ((load-source (name pathname)
+      (labels (#+nil ;; This isn't used?
+	       (load-source (name pathname)
 		 (format t "~&Loading source of ~A..." name)
 		 (or print-only (load pathname)))
 	       (load-binary (name pathname)
@@ -557,11 +558,7 @@ and load your system with:
     ;;
     #+LUCID (or lucid::*source-pathname* (bad-time))))
 
-(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.")))
+(defvar *pcl-directory* (pathname "pcl:"))
 
 
 (defsystem pcl	   
diff --git a/pcl/fin.lisp b/pcl/fin.lisp
index 46995d65c4fb35a3c812b06e2a15e2daa37cd26e..820494b17dff18c2714b5799dac31f5d445add28 100644
--- a/pcl/fin.lisp
+++ b/pcl/fin.lisp
@@ -106,12 +106,16 @@ explicitly marked saying who wrote it.
 ;;;       This must be SETF'able.
 ;;;       
 
+(eval-when (compile eval load)
+
 (defconstant funcallable-instance-data
              '(wrapper slots)
   "These are the 'data-slots' which funcallable instances have so that
    the meta-class funcallable-standard-class can store class, and static
    slots in them.")
 
+); eval-when (compile eval load)
+
 (defmacro funcallable-instance-data-position (data)
   (if (and (consp data)
            (eq (car data) 'quote)
@@ -965,44 +969,61 @@ explicitly marked saying who wrote it.
 
 ;;; Implementation of funcallable instances for CMU Common Lisp.
 ;;;
-;;; Similiar to the code for VAXLISP implementation.
+
 #+:CMU
 (progn
 
+(defstruct funcallable-instance-info
+  (function #'(lambda (&rest args) (declare (ignore args))
+		(called-fin-without-function))
+	    :type function)
+  (name "Unnamed funcallable instance")
+  . #.funcallable-instance-data)
+
+(proclaim '(inline funcallable-instance-info funcallable-instance-p))
+
+
+(defun funcallable-instance-info (fin)
+  (system:find-if-in-closure #'funcallable-instance-info-p fin))
+
+
 (defun allocate-funcallable-instance-1 ()
-  `(lisp::%compiled-closure%
-     ()
-     ,#'(lambda (&rest args)
-	  (declare (ignore args))
-	  (called-fin-without-function))
-     ,(make-array (length funcallable-instance-data))))
+  (let ((info (make-funcallable-instance-info)))
+    #'(lambda (&rest args)
+	(apply (funcallable-instance-info-function info) args))))
 
-(proclaim '(inline funcallable-instance-p))
-(defun funcallable-instance-p (x)
-  (and (consp x)
-       (eq (car x) 'lisp::%compiled-closure%)
-       (not (null (cdddr x)))))
 
-(defun set-funcallable-instance-function (fin func)
-  (cond ((not (funcallable-instance-p fin))
-	 (error "~S is not a funcallable-instance" fin))
-	((not (functionp func))
-	 (error "~S is not a function" func))
-	((and (consp func) (eq (car func) 'lisp::%compiled-closure%))
-	 (setf (cadr fin) (cadr func)
-	       (caddr fin) (caddr func)))
-	(t (set-funcallable-instance-function fin
-					      (make-trampoline func)))))
+(defun funcallable-instance-p (thing)
+  (and (functionp thing)
+       (= (kernel:get-type thing) vm:closure-header-type)
+       (funcallable-instance-info thing)
+       t))
 
-(defun make-trampoline (function)
-  #'(lambda (&rest args)
-      (apply function args)))
 
-(eval-when (eval) (compile 'make-trampoline))
+(defun set-funcallable-instance-function (fin new-value)
+  (setf (funcallable-instance-info-function (funcallable-instance-info fin))
+	new-value))
+
+
+(defun funcallable-instance-name (fin)
+  (funcallable-instance-info-name (funcallable-instance-info fin)))
+
+(defun set-funcallable-instance-name (fin new-value)
+  (setf (funcallable-instance-info-name (funcallable-instance-info fin))
+	new-value))
+
+(defsetf funcallable-instance-name set-funcallable-instance-name)
+
+
+(defmacro funcallable-instance-data-1 (fin slot)
+  (unless (and (listp slot) (eq (car slot) 'quote))
+    (error "Non-constant name for funcallable-instance-data-1: ~S" slot))
+  `(,(intern (concatenate 'simple-string
+			  "FUNCALLABLE-INSTANCE-INFO-"
+			  (string (cadr slot)))
+	     *the-pcl-package*)
+    (funcallable-instance-info ,fin)))
 
-(defmacro funcallable-instance-data-1 (instance data)
-  `(svref (cadddr ,instance)
-	  (funcallable-instance-data-position ,data)))
 
 ); End of :CMU
 
diff --git a/pcl/pkg.lisp b/pcl/pkg.lisp
index aece6d9da7b84d0854792c753ffbd35b252e0b41..8593c4979e394a94998004f2de69382682dfd474 100644
--- a/pcl/pkg.lisp
+++ b/pcl/pkg.lisp
@@ -40,6 +40,10 @@
 	  defmethod)
 	*the-pcl-package*)
 
+#+CMU
+(shadow '(destructuring-bind)
+	*the-pcl-package*)
+
 #+GCLisp
 (shadow '(string-append memq assq delq neq make-instance)
 	*the-pcl-package*)
@@ -117,7 +121,7 @@
 );eval-when 
 
 #-(or KCL IBCL)
-(export *exports* *the-pcl-package*)
+(export '#.*exports* *the-pcl-package*)
 
 #+(or KCL IBCL)
 (mapc 'export (list *exports*) (list *the-pcl-package*))
diff --git a/pcl/walk.lisp b/pcl/walk.lisp
index 9e7edbbfe338481b2727135c5d4e6830d1d12403..520e4d1f25ab36b819517260868e246132cdc147 100644
--- a/pcl/walk.lisp
+++ b/pcl/walk.lisp
@@ -805,6 +805,57 @@
 
 );#+gclisp
 
+
+;;;; CMU Common Lisp version of environment frobbing stuff.
+
+;;; In CMU Common Lisp, the environment (well, the function/macro part of
+;;; the environment) is represented as a list of entries, with each entry
+;;; being of the form (name type . fn) where type is either macro or
+;;; function.
+
+#+:CMU
+(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)
+  ;; Note: In order to record the correct function definition, we would
+  ;; have to create an interpreted closure, but the with-new-definition
+  ;; macro down below makes no distinction between flet and labels, so
+  ;; we have no idea what to use for the environment.  So we just blow it
+  ;; off, 'cause anything real we do would be wrong.  We still have to
+  ;; make an entry so we can tell functions from macros.
+  (let ((c::*lexical-environment* (or env (c::make-null-environment))))
+    (c::make-lexenv
+     :functions
+     (append (mapcar #'(lambda (f)
+			 (list (car f) 'function))
+		     functions)
+	     (mapcar #'(lambda (m)
+			 (list* (car m) 'lisp::macro (cadr m)))
+		     macros)))))
+
+(defun environment-function (env fn)
+  (when env
+    (let ((entry (assoc fn (c::lexenv-functions env) :test #'eq)))
+      (and entry 
+	   (eq (cadr entry) 'function)
+	   (cddr entry)))))
+
+(defun environment-macro (env macro)
+  (when env
+    (let ((entry (assoc macro (c::lexenv-functions env) :test #'eq)))
+      (and entry 
+	   (eq (cadr entry) 'lisp::macro)
+	   (cddr entry)))))
+
+); end of #+:CMU
+
 
 
 (defmacro with-new-definition-in-environment
@@ -946,9 +997,7 @@
   #+(and dec vax common)        (get symbol 'system::globally-special)
   #+(or KCL IBCL)               (si:specialp symbol)
   #+excl                        (get symbol 'excl::.globally-special.)
-  #+:CMU			(or (get symbol 'lisp::globally-special)
-				    (get symbol
-					 'clc::globally-special-in-compiler))
+  #+:CMU			(eq (ext:info variable kind symbol) :special)
   #+HP-HPLabs                   (member (get symbol 'impl:vartype)
 					'(impl:fluid impl:global)
 					:test #'eq)
@@ -1260,7 +1309,11 @@
         (SET
           (walk-form-internal form :SET env))
         ((LAMBDA CALL)
-	 (cond ((symbolp form) form)
+	 (cond ((or (symbolp form)
+		    (and (listp form)
+			 (= (length form) 2)
+			 (eq (car form) 'setf)))
+		form)
 	       #+Lispm
 	       ((sys:validate-function-spec form) form)
 	       (t (walk-form-internal form context env)))))