diff --git a/compiler/ctype.lisp b/compiler/ctype.lisp
index ac87a9e3a6f9d36969839ae181c345e12eca821f..2abe7a253456f229b73ad460f7d87c61a58733f5 100644
--- a/compiler/ctype.lisp
+++ b/compiler/ctype.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.27 1993/08/25 00:14:59 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ctype.lisp,v 1.28 1993/09/10 19:09:04 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -300,8 +300,9 @@
 		    (:keyword
 		     (keys (make-key-info :name (arg-info-keyword info)
 					  :type type)))
-		    (:rest
-		     (setq rest *universal-type*)))
+		    ((:rest :more-context)
+		     (setq rest *universal-type*))
+		    (:more-count))
 		  (req type))))
 	  
 	  (make-function-type
@@ -671,7 +672,13 @@
 		 (res (type-union (pop opt) (or def-type *universal-type*))))
 		(:rest
 		 (when (function-type-rest type)
-		   (res (specifier-type 'list)))))
+		   (res (specifier-type 'list))))
+		(:more-context
+		 (when (function-type-rest type)
+		   (res *universal-type*)))
+		(:more-count
+		 (when (function-type-rest type)
+		   (res (specifier-type 'fixnum)))))
 	      (vars arg)
 	      (when (arg-info-supplied-p info)
 		(res *universal-type*)
diff --git a/compiler/debug-dump.lisp b/compiler/debug-dump.lisp
index 43b9cf5b400b23821ec3f6032608a22c2d09e26c..820f8b02cac4c07f668c3df44cbc27343ec76892 100644
--- a/compiler/debug-dump.lisp
+++ b/compiler/debug-dump.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.38 1993/08/25 00:15:01 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug-dump.lisp,v 1.39 1993/09/10 19:09:07 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -522,6 +522,8 @@
 			  (res (arg-info-keyword info)))
 			 (:rest
 			  (res 'rest-arg))
+			 (:more-context
+			  (res 'more-arg))
 			 (:optional
 			  (unless saw-optional
 			    (res 'optional-args)
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index 7714d18a1d974f39dd9e52153548d9cec2dd71d1..c503b430e439c26f0c6ad1be36890a8b56139b6d 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.101 1993/08/24 02:12:06 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.102 1993/09/10 19:09:09 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1263,8 +1263,10 @@
 (proclaim '(function find-lambda-vars (list)
 		     (values list boolean boolean list list)))
 (defun find-lambda-vars (list)
-  (multiple-value-bind (required optional restp rest keyp keys allowp aux)
-		       (parse-lambda-list list)
+  (multiple-value-bind
+      (required optional restp rest keyp keys allowp aux
+		morep more-context more-count)
+      (parse-lambda-list list)
     (collect ((vars)
 	      (names-so-far)
 	      (aux-vars)
@@ -1307,6 +1309,18 @@
 	    (setf (lambda-var-arg-info var) (make-arg-info :kind :rest))
 	    (vars var)
 	    (names-so-far rest)))
+
+	(when morep
+	  (let ((var (varify-lambda-arg more-context (names-so-far))))
+	    (setf (lambda-var-arg-info var)
+		  (make-arg-info :kind :more-context))
+	    (vars var)
+	    (names-so-far more-context))
+	  (let ((var (varify-lambda-arg more-count (names-so-far))))
+	    (setf (lambda-var-arg-info var)
+		  (make-arg-info :kind :more-count))
+	    (vars var)
+	    (names-so-far more-count)))
 	
 	(dolist (spec keys)
 	  (cond
@@ -1609,7 +1623,7 @@
 ;;; the compilation policy over to the interface policy, so that keyword args
 ;;; will be checked even when type checking isn't on in general.
 ;;;
-(defun convert-more-entry (res entry-vars entry-vals rest keys)
+(defun convert-more-entry (res entry-vars entry-vals rest morep keys)
   (declare (type optional-dispatch res) (list entry-vars entry-vals keys))
   (collect ((arg-vars)
 	    (arg-vals (reverse entry-vals))
@@ -1635,6 +1649,9 @@
 
       (when rest
 	(arg-vals `(%listify-rest-args ,n-context ,n-count)))
+      (when morep
+	(arg-vals n-context)
+	(arg-vals n-count))
 
       (when (optional-dispatch-keyp res)
 	(let ((n-index (gensym))
@@ -1725,8 +1742,8 @@
 ;;; entry's argument.
 ;;;
 (defun ir1-convert-more (res default-vars default-vals entry-vars entry-vals
-			     rest keys supplied-p-p body aux-vars aux-vals
-			     cont)
+			     rest more-context more-count keys supplied-p-p
+			     body aux-vars aux-vals cont)
   (declare (type optional-dispatch res)
 	   (list default-vars default-vals entry-vars entry-vals keys body
 		 aux-vars aux-vals)
@@ -1738,6 +1755,11 @@
     (when rest
       (main-vars rest)
       (main-vals '()))
+    (when more-context
+      (main-vars more-context)
+      (main-vals nil)
+      (main-vars more-count)
+      (main-vals 0))
 
     (dolist (key keys)
       (let* ((info (lambda-var-arg-info key))
@@ -1783,7 +1805,7 @@
 	   (last-entry (convert-optional-entry main-entry default-vars
 					       (main-vals) ())))
       (setf (optional-dispatch-main-entry res) main-entry)
-      (convert-more-entry res entry-vars entry-vals rest keys)
+      (convert-more-entry res entry-vars entry-vals rest more-context keys)
 
       (push (if supplied-p-p
 		(convert-optional-entry last-entry entry-vars entry-vals ())
@@ -1840,7 +1862,7 @@
 	     ;; Handle &key with no keys...
 	     (ir1-convert-more res default-vars default-vals
 			       entry-vars entry-vals
-			       nil vars supplied-p-p body aux-vars
+			       nil nil nil vars supplied-p-p body aux-vars
 			       aux-vals cont)
 	     (let ((fun (ir1-convert-lambda-body body (reverse default-vars)
 						 aux-vars aux-vals t cont)))
@@ -1875,12 +1897,17 @@
 	     (:rest
 	      (ir1-convert-more res default-vars default-vals
 				entry-vars entry-vals
-				arg (rest vars) supplied-p-p body
+				arg nil nil (rest vars) supplied-p-p body
 				aux-vars aux-vals cont))
+	     (:more-context
+	      (ir1-convert-more res default-vars default-vals
+				entry-vars entry-vals
+				nil arg (second vars) (cddr vars) supplied-p-p
+				body aux-vars aux-vals cont))
 	     (:keyword
 	      (ir1-convert-more res default-vars default-vals
 				entry-vars entry-vals
-				nil vars supplied-p-p body aux-vars
+				nil nil nil vars supplied-p-p body aux-vars
 				aux-vals cont)))))))
 
 
diff --git a/compiler/locall.lisp b/compiler/locall.lisp
index ae356e0405479ba9f876cbef25dab864227e7053..fad7c8fbba2aad4c897b52ecba3ed1180291dc67 100644
--- a/compiler/locall.lisp
+++ b/compiler/locall.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.41 1993/05/08 00:42:36 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.42 1993/09/10 19:09:16 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -559,7 +559,11 @@
 	    (ecase (arg-info-kind info)
 	      (:keyword
 	       (key-vars var))
-	      ((:rest :optional))))))
+	      ((:rest :optional))
+	      ((:more-context :more-count)
+	       (compiler-warning "Can't local-call functions with &MORE args.")
+	       (setf (basic-combination-kind call) :error)
+	       (return-from convert-more-call))))))
 
       (dotimes (i max)
 	(temps (gensym "FIXED-ARG-TEMP-")))
diff --git a/compiler/node.lisp b/compiler/node.lisp
index 0bd41be27a8e6f073eed8293081b08b8b4540434..f26703d1738f5863993cb14f9b26cf651239c5c7 100644
--- a/compiler/node.lisp
+++ b/compiler/node.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.31 1993/08/21 09:57:25 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.32 1993/09/10 19:09:18 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1042,7 +1042,8 @@
   ;;
   ;; The kind of argument being described.  Required args only have arg
   ;; info structures if they are special.
-  (kind (required-argument) :type (member :required :optional :keyword :rest))
+  (kind (required-argument) :type (member :required :optional :keyword :rest
+					  :more-context :more-count))
   ;;
   ;; If true, the Var for supplied-p variable of a keyword or optional arg.
   ;; This is true for keywords with non-constant defaults even when there is no
diff --git a/compiler/proclaim.lisp b/compiler/proclaim.lisp
index 6a652539bd6351569a4ab1a65207086eaab039e4..51c84b5b3f2ad2d7e6b35b8043b4593fe7743b08 100644
--- a/compiler/proclaim.lisp
+++ b/compiler/proclaim.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.28 1993/03/16 01:52:26 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/proclaim.lisp,v 1.29 1993/09/10 19:09:22 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -23,11 +23,11 @@
 (export '(inhibit-warnings freeze-type optimize-interface constant-function))
 (in-package "KERNEL")
 (export '(note-name-defined define-function-name undefine-function-name
-			    *type-system-initialized* %note-type-defined))
+	  *type-system-initialized* %note-type-defined))
 (in-package "LISP")
 (export '(declaim proclaim))
 (in-package "C")
-
+(export '(&more))
 
 ;;; True if the type system has been properly initialized, and thus is o.k. to
 ;;; use.
@@ -95,7 +95,7 @@
 
 ;;; Parse-Lambda-List  --  Interface
 ;;;
-;;;    Break a lambda-list into its component parts.  We return eight values:
+;;;    Break a lambda-list into its component parts.  We return eleven values:
 ;;;  1] A list of the required args.
 ;;;  2] A list of the optional arg specs.
 ;;;  3] True if a rest arg was specified.
@@ -104,13 +104,17 @@
 ;;;  6] A list of the keyword arg specs.
 ;;;  7] True if &allow-other-keys was specified.
 ;;;  8] A list of the &aux specifiers.
+;;;  9] True if a more arg was specified.
+;;; 10] The &more context var
+;;; 11] The &more count var
 ;;;
 ;;; The top-level lambda-list syntax is checked for validity, but the arg
 ;;; specifiers are just passed through untouched.  If something is wrong, we
 ;;; use Compiler-Error, aborting compilation to the last recovery point.
 ;;;
 (proclaim '(function parse-lambda-list (list)
-		     (values list list boolean t boolean list boolean list)))
+		     (values list list boolean t boolean list boolean list
+			     boolean t t)))
 (defun parse-lambda-list (list)
   (collect ((required)
 	    (optional)
@@ -118,6 +122,9 @@
 	    (aux))
     (let ((restp nil)
 	  (rest nil)
+	  (morep nil)
+	  (more-context nil)
+	  (more-count nil)
 	  (keyp nil)
 	  (allowp nil)
 	  (state :required))
@@ -135,8 +142,13 @@
 	       (unless (member state '(:required &optional))
 		 (compiler-error "Misplaced &rest in lambda-list: ~S." list))
 	       (setq state '&rest))
+	      (&more
+	       (unless (member state '(:required &optional))
+		 (compiler-error "Misplaced &more in lambda-list: ~S." list))
+	       (setq morep t  state '&more-context))
 	      (&key
-	       (unless (member state '(:required &optional :post-rest))
+	       (unless (member state '(:required &optional :post-rest
+						 :post-more))
 		 (compiler-error "Misplaced &key in lambda-list: ~S." list))
 	       (setq keyp t)
 	       (setq state '&key))
@@ -145,7 +157,7 @@
 		 (compiler-error "Misplaced &allow-other-keys in lambda-list: ~S." list))
 	       (setq allowp t  state '&allow-other-keys))
 	      (&aux
-	       (when (eq state '&rest)
+	       (when (member state '(&rest &more-context &more-count))
 		 (compiler-error "Misplaced &aux in lambda-list: ~S." list))
 	       (setq state '&aux))
 	      (t
@@ -155,11 +167,17 @@
 	      (&optional (optional arg))
 	      (&rest
 	       (setq restp t  rest arg  state :post-rest))
+	      (&more-context
+	       (setq more-context arg  state '&more-count))
+	      (&more-count
+	       (setq more-count arg  state :post-more))
 	      (&key (keys arg))
 	      (&aux (aux arg))
 	      (t
 	       (compiler-error "Found garbage in lambda-list when expecting a keyword: ~S." arg)))))
-    (values (required) (optional) restp rest keyp (keys) allowp (aux)))))
+      
+      (values (required) (optional) restp rest keyp (keys) allowp (aux)
+	      morep more-context more-count))))
 
 
 ;;; Check-Function-Name  --  Interface
diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp
index 45e434e5e44d39d715dfb277f0781b9440d4081e..aa8b3a1086139177feedb7621319f0b7d0798fc1 100644
--- a/compiler/typetran.lisp
+++ b/compiler/typetran.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.24 1993/08/19 21:03:39 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.25 1993/09/10 19:09:23 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -366,9 +366,12 @@
 		       nil))))
     (multiple-value-bind
 	(pred get-layout)
-	(if (csubtypep class (specifier-type 'funcallable-instance))
-	    (values 'funcallable-instance-p '%funcallable-instance-layout)
-	    (values '%instancep '%instance-layout))
+	(cond ((csubtypep class (specifier-type 'instance))
+	       (values '%instancep '%instance-layout))
+	      ((csubtypep class (specifier-type 'funcallable-instance))
+	       (values 'funcallable-instance-p '%funcallable-instance-layout))
+	      (t
+	       (values '(lambda (x) (declare (ignore x)) t) 'layout-of)))
       (cond
        ((not (and name (eq (find-class name) class)))
 	(compiler-error "Can't compile TYPEP of anonymous or undefined ~