diff --git a/bootfiles/18e/boot16.lisp b/bootfiles/18e/boot16.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..c8314780a21a9e34dcc3bce2b1a2dda3cbe67731
--- /dev/null
+++ b/bootfiles/18e/boot16.lisp
@@ -0,0 +1,23 @@
+;;;
+;;; Bootstrap file for adding an IR1 attribute.
+;;;
+
+(in-package :c)
+
+(handler-bind ((error (lambda (c)
+			(declare (ignore c))
+			(invoke-restart 'continue))))
+  (def-boolean-attribute ir1
+    call
+    unsafe
+    unwind
+    any
+    foldable
+    flushable
+    movable
+    predicate
+    recursive
+    explicit-check
+    dynamic-extent-closure-safe))
+
+;;; End of file.
diff --git a/code/byte-interp.lisp b/code/byte-interp.lisp
index c0c4c5a3381f5adc388cea99b50265d8f6cd6742..3bf7429314e8683cfc65675af352081696702887 100644
--- a/code/byte-interp.lisp
+++ b/code/byte-interp.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.39 2003/07/16 09:51:57 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/byte-interp.lisp,v 1.40 2003/08/25 20:51:01 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -42,6 +42,18 @@
 (deftype return-pc ()
   `(integer ,(- max-pc) ,max-pc))
 
+
+;;; These dummies are defined here, to make a build without compiler
+;;; work.
+
+(defun %dynamic-extent (kind sp)
+  (declare (ignore kind sp)))
+
+(defun %dynamic-extent-start ())
+
+(defun %dynamic-extent-end (kind sp)
+  (declare (ignore kind sp)))
+
 
 ;;;; Byte functions:
 
@@ -987,8 +999,8 @@
 ;;; dispatch tree.
 ;;; 
 
-#+nil (declaim (start-block byte-interpret byte-interpret-byte
-			    invoke-xep invoke-local-entry-point))
+(declaim (start-block byte-interpret byte-interpret-byte
+		      invoke-xep invoke-local-entry-point))
 
 (defvar *byte-trace* nil)
 
@@ -1521,5 +1533,5 @@
 	  (push-eval-stack num-results)
 	  (byte-interpret old-component (- old-pc) old-fp)))))
 
-;(declaim (end-block byte-interpret byte-interpret-byte invoke-xep))
+(declaim (end-block byte-interpret byte-interpret-byte invoke-xep))
 
diff --git a/code/exports.lisp b/code/exports.lisp
index 38ac5bd070911a9f051034f0c465be4c068e1896..ad741c21da51523be4fd30fbca4b80e31ab26cef 100644
--- a/code/exports.lisp
+++ b/code/exports.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.222 2003/08/08 11:32:52 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.223 2003/08/25 20:51:01 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1582,7 +1582,9 @@
 	   "%SET-FUNCTION-SELF"
 	   "IR2-COMPONENT-DYNCOUNT-INFO"
 	   "DYNCOUNT-INFO" "DYNCOUNT-INFO-P"
-	   "TRUST-DYNAMIC-EXTENT-DECLARATION-P")
+	   "TRUST-DYNAMIC-EXTENT-DECLARATION-P"
+	   "IR2-STACK-ALLOCATE"
+	   "%DYNAMIC-EXTENT" "%DYNAMIC-EXTENT-START" "%DYNAMIC-EXTENT-END")
   )
 (defpackage "XREF"
   (:export "INIT-XREF-DATABASE"
diff --git a/compiler/alpha/alloc.lisp b/compiler/alpha/alloc.lisp
index 4b015afefa9e2606267fec383889e3cbef617747..6126a9a56d1ab1eed042d7a9c02e3298d0a6b35b 100644
--- a/compiler/alpha/alloc.lisp
+++ b/compiler/alpha/alloc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/alloc.lisp,v 1.4 2003/08/06 21:10:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/alloc.lisp,v 1.5 2003/08/25 20:50:59 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -17,6 +17,21 @@
 
 (in-package "ALPHA")
 
+
+;;;; Dynamic-Extent (not implemented).
+
+(define-vop (%dynamic-extent-start)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
+(define-vop (%dynamic-extent-end)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
 
 ;;;; LIST and LIST*
 
@@ -26,7 +41,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
 	      res)
-  (:info num)
+  (:info num dynamic-extent)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
@@ -155,7 +170,7 @@
 
 (define-vop (fixed-alloc)
   (:args)
-  (:info name words type lowtag)
+  (:info name words type lowtag dynamic-extent)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
diff --git a/compiler/byte-comp.lisp b/compiler/byte-comp.lisp
index 92c061e58802ed8339e3fe9c726c19329919c260..0b93ee89f190ccf558f77893049ac0230084f3f9 100644
--- a/compiler/byte-comp.lisp
+++ b/compiler/byte-comp.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.35 2003/07/16 09:51:57 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.36 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -695,7 +695,7 @@
 		  ;;
 		  ;; If for a lexical exit, we will see a breakup later, so
 		  ;; don't consume :NLX-ENTRY now.
-		  (:tagbody)
+		  ((:tagbody :dynamic-extent))
 		  (:block
 		   (let ((cont (nlx-info-continuation nlx-info)))
 		     (when (interesting cont)
diff --git a/compiler/envanal.lisp b/compiler/envanal.lisp
index ebdc818ca32b25b6e9c2a15cda03f963ec5fe851..90b39b75c32ff7de83ae7a93fddc82583e6c9758 100644
--- a/compiler/envanal.lisp
+++ b/compiler/envanal.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.29 2003/06/03 12:22:37 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/envanal.lisp,v 1.30 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -49,6 +49,7 @@
   
   (find-non-local-exits component)
   (find-cleanup-points component)
+  (find-dynamic-extent-safe-closures component)
   (tail-annotate component)
 
   (dolist (fun (component-lambdas component))
@@ -348,7 +349,11 @@
 			(code `(%lexical-exit-breakup ',nlx)))))
 		   (t
 		    (dolist (nlx (cleanup-nlx-info cleanup))
-		      (code `(%lexical-exit-breakup ',nlx)))))))))
+		      (code `(%lexical-exit-breakup ',nlx))))))
+	    (:dynamic-extent
+	     (let ((kind (continuation-value (first args)))
+		   (sp (unless *byte-compiling* (second args))))
+	       (code `(%dynamic-extent-end ',kind ',sp)))))))
 
       (when (code)
 	(assert (not (node-tail-p (block-last block1))))
@@ -358,7 +363,7 @@
 	(dolist (fun (reanalyze-funs))
 	  (local-call-analyze-1 fun)))))
 
-  (undefined-value))
+  (values))
 
 
 ;;; Find-Cleanup-Points  --  Internal
@@ -409,3 +414,78 @@
 			   (eq (basic-combination-kind use) :local)))
 		(setf (node-tail-p use) t)))))))
   (undefined-value))
+
+
+;;;; Dynamic-Extent Closures
+
+(defvar *suppress-dynamic-extent-safe-closures* nil)
+
+;;;
+;;; Mark closures that can be allocated on the stack because they are
+;;; passed to functions that are known as dynamic-extent-closure-safe.
+;;; Return a list of combinations taking such closures.
+;;;
+(defun mark-dynamic-extent-safe-closures (component)
+  (declare (type component component))
+  (collect ((combinations))
+    (do-blocks (block component)
+      (do-nodes (node cont block)
+	(when (and (combination-p node)
+		   (let ((info (basic-combination-kind node)))
+		     (and (function-info-p info)
+			  (ir1-attributep (function-info-attributes info)
+					  dynamic-extent-closure-safe))))
+	  (dolist (arg (combination-args node))
+	    (when (and arg
+		       (not (continuation-dynamic-extent arg))
+		       (ref-p (continuation-use arg))
+		       (let ((leaf (ref-leaf (continuation-use arg))))
+			 (and (lambda-p leaf)
+			      (environment-closure
+			       (get-lambda-environment leaf)))))
+	      (setf (continuation-dynamic-extent arg) t)
+	      (combinations node))))))
+    (combinations)))
+
+;;;
+;;; Find some more closures that can be allocated with dynamic extent
+;;; because they are arguments to functions that are declared
+;;; dynamic-extent-safe.
+;;;
+(defun find-dynamic-extent-safe-closures (component)
+  (declare (type component component))
+  (flet ((insert-dynamic-extent-start (combination)
+	 (declare (type combination combination))
+	 (let ((fun (basic-combination-fun combination)))
+	   (ensure-block-start fun)
+	   (let* ((block (continuation-block fun))
+		  (pred (first (block-pred block))))
+	     (assert (= 1 (length (block-pred block))))
+	     (assert (= 1 (length (block-succ pred))))
+	     (assert (not (eq pred (component-head (block-component block)))))
+	     (let ((cleanup (insert-cleanup-code
+			     pred block combination
+			     `(%dynamic-extent :closure
+					       (%dynamic-extent-start)))))
+	       (second (basic-combination-args (block-last cleanup)))))))
+	   
+	 (insert-dynamic-extent-end (combination start-cont)
+	   (declare (type combination combination)
+		    (type continuation start-cont))
+	   (let* ((call-block (node-block combination)))
+	     (ensure-block-start (node-cont combination))
+	     (assert (= 1 (length (block-succ call-block))))
+	     (insert-cleanup-code
+	      call-block (first (block-succ call-block)) combination
+	      `(%dynamic-extent-end :closure ',start-cont)))))
+    
+    (unless (or *byte-compiling* *suppress-dynamic-extent-safe-closures*)
+      (dolist (combination (mark-dynamic-extent-safe-closures component))
+	(let ((cont (insert-dynamic-extent-start combination)))
+	  (insert-dynamic-extent-end combination cont)
+	  (when *dynamic-extent-trace*
+	    (format t "~&===> dynamic-extent-safe closure in ~s~%"
+		    (component-name component))))))
+    
+    (values)))
+
diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp
index 104e649b0bc3098c87df799a76ca12f07ddf6e8c..4af53fa903456c18fb270116da072fe8a9cdb8bc 100644
--- a/compiler/fndb.lisp
+++ b/compiler/fndb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.124 2003/08/16 11:45:47 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.125 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -133,9 +133,10 @@
 (defknown funcall (callable &rest t) *)
 
 (defknown (mapcar maplist mapcan mapcon) (callable list &rest list) list
-  (call))
+  (call dynamic-extent-closure-safe))
 
-(defknown (mapc mapl) (callable list &rest list) list (foldable call))
+(defknown (mapc mapl) (callable list &rest list) list
+  (foldable call dynamic-extent-closure-safe))
 
 ;;; We let values-list be foldable, since constant-folding will turn it into
 ;;; VALUES.  VALUES is not foldable, since MV constants are represented by a
@@ -412,27 +413,27 @@
   :derive-type (result-type-specifier-nth-arg 1))
 
 (defknown map (type-specifier callable sequence &rest sequence) consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
 ;  :derive-type 'type-spec-arg1  Nope... (map nil ...) returns null, not nil.
   )
 
 (defknown map-into (sequence callable &rest sequence)
   sequence
-  (call)
+  (call dynamic-extent-closure-safe)
   :derive-type #'result-type-first-arg)
 
 ;;; Returns predicate result... 
 (defknown some (callable sequence &rest sequence) t
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (every notany notevery) (callable sequence &rest sequence) boolean
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 ;;; Unsafe for :Initial-Value...
 (defknown reduce (callable sequence &key (:from-end t) (:start index)
 			   (:end sequence-end) (:initial-value t) (:key callable))
   t
-  (foldable flushable call unsafe))
+  (foldable flushable call unsafe dynamic-extent-closure-safe))
 
 (defknown fill (sequence t &key (:start index) (:end sequence-end)) sequence
   (unsafe)
@@ -448,7 +449,7 @@
      (:test-not callable) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown substitute
@@ -456,21 +457,21 @@
      (:test-not callable) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown (remove-if remove-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:count sequence-count) (:key callable))
   consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown (substitute-if substitute-if-not)
   (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown delete
@@ -478,7 +479,7 @@
      (:test-not callable) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown nsubstitute
@@ -486,88 +487,88 @@
      (:test-not callable) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown (delete-if delete-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:count sequence-count) (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 2))
 
 (defknown (nsubstitute-if nsubstitute-if-not)
   (t callable sequence &key (:from-end t) (:start index) (:end sequence-end)
      (:count sequence-count) (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 3))
 
 (defknown remove-duplicates
   (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
 	    (:end sequence-end) (:key callable))
   consed-sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 1))
 
 (defknown delete-duplicates
   (sequence &key (:test callable) (:test-not callable) (:start index) (:from-end t)
 	    (:end sequence-end) (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 1))
 
 (defknown find (t sequence &key (:test callable) (:test-not callable)
 		  (:start index) (:from-end t) (:end sequence-end) (:key callable))
   t
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (find-if find-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:key callable))
   t
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown position (t sequence &key (:test callable) (:test-not callable)
 		      (:start index) (:from-end t) (:end sequence-end)
 		      (:key callable))
   (or index null)
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (position-if position-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:key callable))
   (or index null)
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown count (t sequence &key (:test callable) (:test-not callable)
 		      (:start index) (:from-end t) (:end sequence-end)
 		      (:key callable))
   index
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (count-if count-if-not)
   (callable sequence &key (:from-end t) (:start index) (:end sequence-end)
 	    (:key callable))
   index
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (mismatch search)
   (sequence sequence &key (:from-end t) (:test callable) (:test-not callable)
 	    (:start1 index) (:end1 sequence-end) (:start2 index) (:end2 sequence-end)
 	    (:key callable))
   (or index null)
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 ;;; Not flushable, since vector sort guaranteed in-place...
 (defknown (stable-sort sort) (sequence callable &key (:key callable)) sequence
-  (call)
+  (call dynamic-extent-closure-safe)
   :derive-type (sequence-result-nth-arg 1))
 
 (defknown merge (type-specifier sequence sequence callable
 				&key (:key callable))
   sequence
-  (flushable call)
+  (flushable call dynamic-extent-closure-safe)
   :derive-type (result-type-specifier-nth-arg 1))
 
 (defknown read-sequence (sequence stream &key (:start index)
@@ -593,7 +594,7 @@
 (defknown cons (t t) cons (movable flushable unsafe))
 
 (defknown tree-equal (t t &key (:test callable) (:test-not callable)) boolean
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 (defknown endp (list) boolean (foldable flushable movable))
 (defknown list-length (list) (or index null) (foldable flushable))
 (defknown (nth nthcdr) (unsigned-byte list) t (foldable flushable))
@@ -620,51 +621,52 @@
 
 (defknown (nsubst subst) (t t t &key (:key callable) (:test callable)
 			    (:test-not callable))
-  list (flushable unsafe call))
+  list (flushable unsafe call dynamic-extent-closure-safe))
 
 (defknown (subst-if subst-if-not nsubst-if nsubst-if-not)
 	  (t t t &key (:key callable))
-  list (flushable unsafe call))
+  list (flushable unsafe call dynamic-extent-closure-safe))
 
 (defknown (sublis nsublis) (list t &key (:key callable) (:test callable)
 				 (:test-not callable))
-  list (flushable unsafe call))
+  list (flushable unsafe call dynamic-extent-closure-safe))
 
 (defknown member (t list &key (:key callable) (:test callable)
 		    (:test-not callable))
-  list (foldable flushable call))
+  list (foldable flushable call dynamic-extent-closure-safe))
 (defknown (member-if member-if-not) (callable list &key (:key callable))
-  list (foldable flushable call))
+  list (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown tailp (t list) boolean (foldable flushable))
 
 (defknown adjoin (t list &key (:key callable) (:test callable)
 		    (:test-not callable))
-  list (foldable flushable unsafe call))
+  list (foldable flushable unsafe call dynamic-extent-closure-safe))
 
 (defknown (union intersection set-difference set-exclusive-or)
 	  (list list &key (:key callable) (:test callable) (:test-not callable))
   list
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (nunion nintersection nset-difference nset-exclusive-or)
 	  (list list &key (:key callable) (:test callable) (:test-not callable))
   list
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
-(defknown subsetp 
-	  (list list &key (:key callable) (:test callable) (:test-not callable))
+(defknown subsetp (list list &key (:key callable) (:test callable)
+			(:test-not callable))
   boolean
-  (foldable flushable call))
+  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown acons (t t t) list (movable flushable unsafe))
 (defknown pairlis (t t &optional t) list (flushable unsafe))
 
 (defknown (rassoc assoc)
 	  (t list &key (:key callable) (:test callable) (:test-not callable))
-  list (foldable flushable call))
+  list (foldable flushable call dynamic-extent-closure-safe))
 (defknown (assoc-if-not assoc-if rassoc-if rassoc-if-not)
-	  (callable list &key (:key callable)) list (foldable flushable call))
+	  (callable list &key (:key callable)) list
+	  (foldable flushable call dynamic-extent-closure-safe))
 
 (defknown (memq assq) (t list) list (foldable flushable unsafe))
 (defknown delq (t list) list (flushable unsafe))
@@ -684,7 +686,8 @@
   (foldable flushable unsafe))
 (defknown %puthash (t hash-table t) t (unsafe))
 (defknown remhash (t hash-table) boolean ())
-(defknown maphash (callable hash-table) null (foldable flushable call))
+(defknown maphash (callable hash-table) null
+  (foldable flushable call dynamic-extent-closure-safe))
 (defknown clrhash (hash-table) hash-table ())
 (defknown hash-table-count (hash-table) index (foldable flushable))
 (defknown hash-table-rehash-size (hash-table) (or (integer 1) (float (1.0)))
@@ -1143,6 +1146,9 @@
 (defknown %instance-typep (t (or type-specifier ctype)) boolean
   (movable flushable explicit-check))
 
+(defknown %dynamic-extent (t t) void)
+(defknown %dynamic-extent-start () t)
+(defknown %dynamic-extent-end (t t) void)
 (defknown %cleanup-point () void)
 (defknown %special-bind (t t) void)
 (defknown %special-unbind (t) void)
diff --git a/compiler/generic/vm-ir2tran.lisp b/compiler/generic/vm-ir2tran.lisp
index 15ec1a42a79eda7c9ec1816629cfc8f51a8a9664..65876d97c60c1c038dd160dc668d195bf77fa45b 100644
--- a/compiler/generic/vm-ir2tran.lisp
+++ b/compiler/generic/vm-ir2tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-ir2tran.lisp,v 1.9 1997/01/18 14:31:15 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-ir2tran.lisp,v 1.10 2003/08/25 20:50:59 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -80,7 +80,8 @@
 
 #-gengc
 (defun do-fixed-alloc (node block name words type lowtag result)
-  (vop fixed-alloc node block name words type lowtag result))
+  (vop fixed-alloc node block name words type lowtag
+       (ir2-stack-allocate node) result))
 
 (defoptimizer ir2-convert-fixed-allocation
 	      ((&rest args) node block name words type lowtag inits)
diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp
index d76a428cdbe4f48e2f05dbf38114e708a77fc7c7..5664dc06a5ea3044f5c3dfe4565a6a79eba419d8 100644
--- a/compiler/globaldb.lisp
+++ b/compiler/globaldb.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.43 2003/08/06 19:00:13 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.44 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1168,29 +1168,3 @@
 
 (declaim (freeze-type info-env))
 
-(defvar *trust-dynamic-extent-declarations*
-  (lambda (safety space speed debug)
-    (declare (ignore space speed debug) (fixnum safety))
-    (< safety 3))
-  "If null, don't trust dynamic-extent declarations.
-
-   If T, always trust dynamic-extent declarations.
-
-   Otherwise, the value of this variable must be a function of four
-   arguments SAFETY, SPACE, SPEED, and DEBUG.  If the function returns
-   true when called, dynamic-extent declarations are trusted,
-   otherwise, they are not trusted.
-
-   Default is a function that returns true if SAFETY < 3.")
-
-(defun trust-dynamic-extent-declaration-p (&optional node)
-  (declare (type (or null node) node))
-  (let ((trust *trust-dynamic-extent-declarations*))
-    (if (functionp trust)
-	(let ((cookie (lexenv-cookie (if node
-					 (node-lexenv node)
-					 *lexical-environment*))))
-	  (funcall trust (cookie-safety cookie) (cookie-space cookie)
-		   (cookie-speed cookie) (cookie-debug cookie)))
-	trust)))
-
diff --git a/compiler/hppa/alloc.lisp b/compiler/hppa/alloc.lisp
index c9807e3b390ff26f7df7962da71295eb90a31052..2ea4ffcf541845d72640fc69ffe460da91b0335f 100644
--- a/compiler/hppa/alloc.lisp
+++ b/compiler/hppa/alloc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/alloc.lisp,v 1.5 2003/08/06 21:10:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/alloc.lisp,v 1.6 2003/08/25 20:50:59 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,6 +16,22 @@
 
 (in-package "HPPA")
 
+
+;;;; Dynamic-Extent (not implemented).
+
+(define-vop (%dynamic-extent-start)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
+(define-vop (%dynamic-extent-end)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
+
 
 ;;;; LIST and LIST*
 
@@ -25,7 +41,7 @@
   (:temporary (:scs (descriptor-reg)) temp)
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
 	      res)
-  (:info num)
+  (:info num dynamic-extent)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
@@ -156,7 +172,7 @@
 
 (define-vop (fixed-alloc)
   (:args)
-  (:info name words type lowtag)
+  (:info name words type lowtag dynamic-extent)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index a00aa6eef5840848a1dfee7e3d205e661ddd5961..45b6f08bf3e790b82d5b167bc26687907966130f 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.161 2003/08/07 09:48:43 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.162 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -121,25 +121,147 @@
   DEFUNs is used when compiling calls to that function.  If false, only
   information from FTYPE proclamations will be used.")
 
-
-;; returns non-nil if X and Y name the same function. This is more
-;; involved than a simple call to EQ due to support for generalized
-;; function names. In the IR1 representation, the local function INNER
-;; in the following
-;;
-;;   (defun outer (a)
-;;      (flet ((inner (x) (random x)))
-;;         (declaim (inline inner))
-;;         (inner a)))
-;;
-;; will have a lambda-name of (FLET INNER OUTER). Some parts of the
-;; compiler may search for it under the name INNER. 
+;;;
+;;; Returns non-nil if X and Y name the same function. This is more
+;;; involved than a simple call to EQ due to support for generalized
+;;; function names. In the IR1 representation, the local function INNER
+;;; in the following
+;;;
+;;;   (defun outer (a)
+;;;      (flet ((inner (x) (random x)))
+;;;         (declaim (inline inner))
+;;;         (inner a)))
+;;;
+;;; will have a lambda-name of (FLET INNER OUTER). Some parts of the
+;;; compiler may search for it under the name INNER.
+;;;
 (defun function-name-eqv-p (x y)
   (or (equal x y)
       (and (consp y)
            (member (car y) '(flet labels))
            (equal x (cadr y)))))
 
+
+;;;; Dynamic-Extent
+
+(defvar *trust-dynamic-extent-declarations* #+x86 t #-x86 nil
+  "If null, don't trust dynamic-extent declarations.
+
+   If T, always trust dynamic-extent declarations.
+
+   Otherwise, the value of this variable must be a function of four
+   arguments SAFETY, SPACE, SPEED, and DEBUG.  If the function returns
+   true when called, dynamic-extent declarations are trusted,
+   otherwise they are not trusted.")
+
+(defvar *dynamic-extent-trace* nil)
+
+(defun trust-dynamic-extent-declaration-p
+    (&optional (lexenv *lexical-environment*))
+  (declare (type lexenv lexenv))
+  (let ((trust *trust-dynamic-extent-declarations*))
+    (if (functionp trust)
+	(let ((cookie (lexenv-cookie lexenv)))
+	  (funcall trust (cookie-safety cookie) (cookie-space cookie)
+		   (cookie-speed cookie) (cookie-debug cookie)))
+	trust)))
+
+
+(defun process-dynamic-extent-declaration (spec vars fvars lexenv)
+  (declare (list spec vars fvars) (type lexenv lexenv))
+  (if (trust-dynamic-extent-declaration-p lexenv)
+      (collect ((dynamic-extent))
+	(dolist (name (cdr spec))
+	  (cond ((symbolp name)
+		 (let* ((bound-var (find-in-bindings vars name))
+			(var (or bound-var
+				 (lexenv-find name variables)
+				 (find-free-variable name))))
+		   (if (leaf-p var)
+		       (if bound-var
+			   (setf (leaf-dynamic-extent var) t)
+			   (dynamic-extent var)))))
+		((and (consp name)
+		      (eq (car name) 'function)
+		      (null (cddr name))
+		      (valid-function-name-p (cadr name)))
+		 (let* ((fn-name (cadr name))
+			(fn (find fn-name fvars
+				  :key #'leaf-name
+				  :test #'function-name-eqv-p)))
+		   (if fn
+		       (setf (leaf-dynamic-extent fn) t)
+		       (dynamic-extent (find-lexically-apparent-function
+					fn-name
+					"in a dynamic-extent declaration")))))
+		(t
+		 (compiler-warning
+		  "~@<Invalid name ~s in a dynamic-extent declaration.~@:>"
+		  name))))
+	(if (dynamic-extent)
+	    (make-lexenv :default lexenv :dynamic-extent (dynamic-extent))
+	    lexenv))
+      lexenv))
+  
+;;;
+;;; Value is true if some dynamic-extent allocation can be done in the
+;;; initialization of variables Vars with values Vals.
+;;;
+(defun dynamic-extent-allocation-p (vars vals)
+  (loop for var in vars and val in vals
+	thereis (and (leaf-dynamic-extent var)
+		     (consp val)
+		     (memq (car val) '(list list* cons)))))
+
+;;;
+;;; Return a list of indices for arguments in Args which might end up
+;;; as dynamic-extent closures.  We can't tell for sure here because
+;;; environment analysis runs after IR1 conversion, so we don't know
+;;; yet what are closures and what not.
+;;;
+(defun dynamic-extent-closure-args (args)
+  (declare (list args))
+  (flet ((find-local-function (name)
+	   (let ((var (lexenv-find-function name)))
+	     (when (leaf-p var)
+	       var))))
+    (let ((dynamic-extent (lexenv-dynamic-extent *lexical-environment*)))
+      (collect ((indices))
+	(do* ((i 0 (1+ i))
+	      (tail args (cdr tail))
+	      (arg (car tail) (car tail)))
+	     ((null tail))
+	  (when (and (consp arg)
+		     (eq (car arg) 'function)
+		     (valid-function-name-p (cadr arg))
+		     (let ((fn (find-local-function (cadr arg))))
+		       (and fn
+			    (or (leaf-dynamic-extent fn)
+				(and (functional-p fn)
+				     (or (memq fn dynamic-extent)
+					 (memq (functional-entry-function fn)
+					       dynamic-extent)))))))
+	    (indices i)))
+	(indices)))))
+
+;;;
+;;; Evaluate Body wrapped in a dynamic-extent cleanup.
+;;; FIXME: Maybe don't %dynamic-extent-start if kind = :rest.
+;;;
+(defun gen-%dynamic-extent (kind)
+  `(%dynamic-extent ,kind (%dynamic-extent-start)))
+
+(defmacro with-dynamic-extent ((start cont nnext-cont kind) &body body)
+  `(progn
+     (continuation-starts-block ,cont)
+     (let ((.cleanup. (make-cleanup :kind :dynamic-extent))
+	   (.next-cont. (make-continuation))
+	   (,nnext-cont (make-continuation)))
+       (ir1-convert ,start .next-cont. (gen-%dynamic-extent ,kind))
+       (setf (cleanup-mess-up .cleanup.) (continuation-use .next-cont.))
+       (let ((*lexical-environment* (make-lexenv :cleanup .cleanup.)))
+	 (ir1-convert .next-cont. ,nnext-cont '(%cleanup-point))
+	 (locally ,@body)))))
 
 
 ;;;; Namespace management utilities:
@@ -771,10 +893,18 @@
 (defun ir1-convert-combination (start cont form fun)
   (declare (type continuation start cont) (list form) (type leaf fun)
 	   (values combination))
-  (let ((fun-cont (make-continuation)))
-    (reference-leaf start fun-cont fun)
-    (ir1-convert-combination-args fun-cont cont (cdr form))))
-
+  (let ((indices (dynamic-extent-closure-args (cdr form))))
+    (if indices
+	(with-dynamic-extent (start cont nnext-cont :closure)
+	  (when *dynamic-extent-trace*
+	    (format t "~&dynamic-extent args ~:s in ~s~%" indices form))
+	  (let ((fun-cont (make-continuation)))
+	    (reference-leaf nnext-cont fun-cont fun)
+	    (ir1-convert-combination-args fun-cont cont (cdr form) indices)))
+	(let ((fun-cont (make-continuation)))
+	  (reference-leaf start fun-cont fun)
+	  (ir1-convert-combination-args fun-cont cont (cdr form))))))
+      
 
 ;;; IR1-Convert-Combination-Args  --  Internal
 ;;;
@@ -783,19 +913,30 @@
 ;;; for the call.  Args is the list of arguments for the call, which defaults
 ;;; to the cdr of source.  We return the Combination node.
 ;;;
-(defun ir1-convert-combination-args (fun-cont cont args)
+(defun ir1-convert-combination-args (fun-cont cont args
+				     &optional dynamic-extent-args)
   (declare (type continuation fun-cont cont) (list args))
   (let ((node (make-combination fun-cont)))
     (setf (continuation-dest fun-cont) node)
     (assert-continuation-type
      fun-cont (values-specifier-type '(values (or function symbol) &rest t)))
     (collect ((arg-conts))
-      (let ((this-start fun-cont))
+      (let ((this-start fun-cont)
+	    (lambda-vars (let* ((use (continuation-use fun-cont))
+				(leaf (when use (ref-leaf use))))
+			   (when (lambda-p leaf)
+			     (lambda-vars leaf))))
+	    (i 0))
 	(dolist (arg args)
 	  (let ((this-cont (make-continuation node)))
+	    (when (or (and lambda-vars
+			   (leaf-dynamic-extent (pop lambda-vars)))
+		      (member i dynamic-extent-args))
+	      (setf (continuation-dynamic-extent this-cont) t))
 	    (ir1-convert this-start this-cont arg)
 	    (setq this-start this-cont)
-	    (arg-conts this-cont)))
+	    (arg-conts this-cont)
+	    (incf i)))
 	(prev-link node this-start)
 	(use-continuation node cont)
 	(setf (combination-args node) (arg-conts))))
@@ -897,7 +1038,8 @@
 
 ;;;; PROCESS-DECLARATIONS:
 
-(declaim (start-block process-declarations make-new-inlinep))
+(declaim (start-block process-declarations make-new-inlinep
+		      find-in-bindings))
 
 ;;; Find-In-Bindings  --  Internal
 ;;;
@@ -1141,40 +1283,6 @@
 	(setf (lambda-var-ignorep var) t)))))
   (undefined-value))
 
-(defun process-dynamic-extent-declaration (spec vars fvars lexenv)
-  (declare (list spec vars fvars) (type lexenv lexenv))
-  (collect ((dynamic-extent))
-    (dolist (name (cdr spec))
-      (cond ((symbolp name)
-	     (let* ((bound-var (find-in-bindings vars name))
-		    (var (or bound-var
-			     (lexenv-find name variables)
-			     (find-free-variable name))))
-	       (if (leaf-p var)
-		   (if bound-var
-		       (setf (leaf-dynamic-extent var) t)
-		       (dynamic-extent var)))))
-	    ((and (consp name)
-		  (eq (car name) 'function)
-		  (null (cddr name))
-		  (valid-function-name-p (cadr name)))
-	     (let* ((fn-name (cadr name))
-		    (fn (find fn-name fvars
-			      :key #'leaf-name
-			      :test #'function-name-eqv-p)))
-	       (if fn
-		   (setf (leaf-dynamic-extent fn) t)
-		   (dynamic-extent (find-lexically-apparent-function
-				    fn-name
-				    "in a dynamic-extent declaration")))))
-	    (t
-	     (compiler-warning
-	      "~@<Invalid name ~s in a dynamic-extent declaration.~@:>"
-	      name))))
-    (if (dynamic-extent)
-	(make-lexenv :default lexenv :dynamic-extent (dynamic-extent))
-	lexenv)))
-  
 (defvar *suppress-values-declaration* nil
   "If true, processing of the VALUES declaration is inhibited.")
 
@@ -1296,7 +1404,8 @@
 ;;;; Lambda hackery:  
 
 (declaim (start-block ir1-convert-lambda ir1-convert-lambda-body
-		      ir1-convert-aux-bindings varify-lambda-arg))
+		      ir1-convert-aux-bindings varify-lambda-arg
+		      ir1-convert-dynamic-extent-bindings))
 
 ;;; Varify-Lambda-Arg  --  Internal
 ;;;
@@ -1500,7 +1609,17 @@
 		   *lexical-environment*)))
 	  (ir1-convert-combination-args fun-cont cont
 					(list (first aux-vals))))))
-  (undefined-value))
+  (values))
+
+(defun ir1-convert-dynamic-extent-bindings (start cont body aux-vars
+					    aux-vals interface)
+  (declare (type continuation start cont) (list body aux-vars aux-vals))
+  (if (dynamic-extent-allocation-p aux-vars aux-vals)
+      (with-dynamic-extent (start cont nnext-cont :bind)
+	(ir1-convert-aux-bindings nnext-cont cont body aux-vars
+				  aux-vals interface))
+      (ir1-convert-aux-bindings start cont body aux-vars aux-vals interface))
+  (values))
 
 
 ;;; IR1-Convert-Special-Bindings  --  Internal
@@ -1516,12 +1635,13 @@
 ;;; cleanup, causing cleanup code to be emitted when the scope is exited.
 ;;;
 (defun ir1-convert-special-bindings (start cont body aux-vars aux-vals
-					   interface svars)
+				     interface svars)
   (declare (type continuation start cont)
 	   (list body aux-vars aux-vals svars))
   (cond
    ((null svars)
-    (ir1-convert-aux-bindings start cont body aux-vars aux-vals interface))
+    (ir1-convert-dynamic-extent-bindings start cont body aux-vars aux-vals
+					 interface))
    (t
     (continuation-starts-block cont)
     (let ((cleanup (make-cleanup :kind :special-bind))
@@ -1535,7 +1655,7 @@
 	(ir1-convert next-cont nnext-cont '(%cleanup-point))
 	(ir1-convert-special-bindings nnext-cont cont body aux-vars aux-vals
 				      interface (rest svars))))))
-  (undefined-value))
+  (values))
 
 
 ;;; IR1-Convert-Lambda-Body  --  Internal
@@ -1565,7 +1685,8 @@
 	   (type (or continuation null) result))
   (let* ((bind (make-bind))
 	 (lambda (make-lambda :vars vars  :bind bind))
-	 (result (or result (make-continuation))))
+	 (result (or result (make-continuation)))
+	 (dynamic-extent-rest nil))
     (setf (lambda-home lambda) lambda)
     (collect ((svars)
 	      (new-venv nil cons))
@@ -1577,21 +1698,31 @@
 		 (svars var)
 		 (new-venv (cons (leaf-name specvar) specvar)))
 		(t
-		 (new-venv (cons (leaf-name var) var))))))
-      
-      (let ((*lexical-environment*
-	     (make-lexenv :variables (new-venv)  :lambda lambda
-			  :cleanup nil)))
+		 (new-venv (cons (leaf-name var) var)))))
+	(let ((info (lambda-var-arg-info var)))
+	  (when (and info
+		     (eq :rest (arg-info-kind info))
+		     (leaf-dynamic-extent var))
+	    (setq dynamic-extent-rest var))))
+
+      (let* ((*lexical-environment*
+	      (make-lexenv :variables (new-venv)  :lambda lambda
+			   :cleanup nil)))
 	(setf (bind-lambda bind) lambda)
 	(setf (node-lexenv bind) *lexical-environment*)
-	
+
 	(let ((cont1 (make-continuation))
 	      (cont2 (make-continuation)))
 	  (continuation-starts-block cont1)
 	  (prev-link bind cont1)
 	  (use-continuation bind cont2)
-	  (ir1-convert-special-bindings cont2 result body aux-vars aux-vals
-					interface (svars)))
+	  (if dynamic-extent-rest
+	      (with-dynamic-extent (cont2 result nnext-cont :rest)
+		(ir1-convert-special-bindings nnext-cont result body
+					      aux-vars aux-vals
+					      interface (svars)))
+	      (ir1-convert-special-bindings cont2 result body aux-vars aux-vals
+					    interface (svars))))
 
 	(let ((block (continuation-block result)))
 	  (when block
@@ -2530,24 +2661,24 @@
   "FUNCTION Name
   Return the lexically apparent definition of the function Name.  Name may also
   be a lambda."
-  (if (consp thing)
-      (case (car thing)
-	((lambda)
-	 (reference-leaf start cont (ir1-convert-lambda thing nil 'function)))
-	((instance-lambda)
-	 (let ((res (ir1-convert-lambda `(lambda ,@(cdr thing))
-					nil 'function)))
-	   (setf (getf (functional-plist res) :fin-function) t)
-	   (reference-leaf start cont res)))
-	(t
-	 (if (valid-function-name-p thing)
-	     (let ((var (find-lexically-apparent-function
-			 thing "as the argument to FUNCTION")))
-	       (reference-leaf start cont var))
-	     (compiler-error "Illegal function name: ~S" thing))))
-      (let ((var (find-lexically-apparent-function
-		  thing "as the argument to FUNCTION")))
-	(reference-leaf start cont var))))
+  (flet ((reference-it ()
+	   (let ((fn (find-lexically-apparent-function
+		      thing "as the argument to FUNCTION")))
+	     (reference-leaf start cont fn))))
+    (if (consp thing)
+	(case (car thing)
+	  ((lambda)
+	   (reference-leaf start cont (ir1-convert-lambda thing nil 'function)))
+	  ((instance-lambda)
+	   (let ((res (ir1-convert-lambda `(lambda ,@(cdr thing))
+					  nil 'function)))
+	     (setf (getf (functional-plist res) :fin-function) t)
+	     (reference-leaf start cont res)))
+	  (t
+	   (if (valid-function-name-p thing)
+	       (reference-it)
+	       (compiler-error "Illegal function name: ~S" thing))))
+	(reference-it))))
 
 
 ;;;; Funcall:
@@ -2883,7 +3014,6 @@
 
     (values (vars) (vals) (names))))
 
-
 (def-ir1-translator let ((bindings &parse-body (body decls))
 			 start cont)
   "LET ({(Var [Value]) | Var}*) Declaration* Form*
@@ -2892,11 +3022,17 @@
   evaluated."
   (multiple-value-bind (vars values)
       (extract-let-variables bindings 'let)
-    (let* ((*lexical-environment* (process-declarations decls vars nil cont))
-	   (fun-cont (make-continuation))
-	   (fun (ir1-convert-lambda-body body vars)))
-      (reference-leaf start fun-cont fun)
-      (ir1-convert-combination-args fun-cont cont values))))
+    (let ((*lexical-environment* (process-declarations decls vars nil cont)))
+      (if (dynamic-extent-allocation-p vars values)
+	  (with-dynamic-extent (start cont nnext-cont :bind)
+	    (let ((fun-cont (make-continuation))
+		  (fun (ir1-convert-lambda-body body vars)))
+	      (reference-leaf nnext-cont fun-cont fun)
+	      (ir1-convert-combination-args fun-cont cont values)))
+	  (let ((fun-cont (make-continuation))
+		(fun (ir1-convert-lambda-body body vars)))
+	    (reference-leaf start fun-cont fun)
+	    (ir1-convert-combination-args fun-cont cont values))))))
 
 (def-ir1-translator locally ((&parse-body (body decls))
                             start cont)
@@ -2905,8 +3041,6 @@
    where the given Declaration's have effect."
   (let* ((*lexical-environment* (process-declarations decls nil nil cont)))
     (ir1-convert-progn-body start cont body)))
-        
-
 
 (def-ir1-translator let* ((bindings &parse-body (body decls))
 			  start cont)
@@ -2914,9 +3048,9 @@
   Similar to LET, but the variables are bound sequentially, allowing each Value
   form to reference any of the previous Vars."
   (multiple-value-bind (vars values)
-		       (extract-let-variables bindings 'let*)
+      (extract-let-variables bindings 'let*)
     (let ((*lexical-environment* (process-declarations decls vars nil cont)))
-      (ir1-convert-aux-bindings start cont body vars values nil))))
+      (ir1-convert-dynamic-extent-bindings start cont body vars values nil))))
 
 
 ;;;; Flet and Labels:
@@ -2968,7 +3102,7 @@
   do not enclose the definitions; any use of Name in the Forms will refer to
   the lexically apparent function definition in the enclosing environment."
   (multiple-value-bind (names defs)
-		       (extract-flet-variables definitions 'flet)
+      (extract-flet-variables definitions 'flet)
     (let* ((fvars (mapcar #'(lambda (n d)
 			      (ir1-convert-lambda d n 'flet))
 			  names defs))
diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp
index d5e0a88b6bc5b53c2d0598b651c066a301949b4e..75ff9c2130ecf51d9cf6b3fcf62409eba61ccdec 100644
--- a/compiler/ir2tran.lisp
+++ b/compiler/ir2tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.73 2003/08/06 21:10:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.74 2003/08/25 20:51:00 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -32,6 +32,10 @@ compilation policy")
 (defvar *enable-stack-clearing* t
   "If non-NIL and the compilation policy allows, stack clearing is enabled.")
 
+(defun ir2-stack-allocate (node)
+  (declare (type node node))
+  (continuation-dynamic-extent (node-cont node)))
+
 
 ;;;; Moves and type checks:
 
@@ -218,15 +222,13 @@ compilation policy")
 		    (assert (eq (functional-kind leaf) :top-level-xep))
 		    nil))))
     (cond (closure
-	   (let* ((this-env (node-environment node))
-		  (entry-fn (functional-entry-function leaf))
-		  (dynamic-extent
-		   (or (leaf-dynamic-extent entry-fn)
-		       (memq entry-fn
-			     (lexenv-dynamic-extent (node-lexenv node))))))
+	   (let ((this-env (node-environment node))
+		 (dynamic-extent (ir2-stack-allocate node)))
+	     (when *dynamic-extent-trace*
+	       (format t "~&===> make-closure ~s (~d)~%"
+		       dynamic-extent (length closure)))
 	     (vop make-closure node block entry (length closure)
-		  dynamic-extent
-		  res)
+		  dynamic-extent res)
 	     (loop for what in closure and n from 0 do
 	       (unless (and (lambda-var-p what)
 			    (null (leaf-refs what)))
@@ -236,7 +238,7 @@ compilation policy")
 		      n)))))
 	  (t
 	   (emit-move node block entry res))))
-  (undefined-value))
+  (values))
 
 
 ;;; IR2-Convert-Set  --  Internal
@@ -711,15 +713,15 @@ compilation policy")
 ;;;
 (defun ir2-convert-let (node block fun)
   (declare (type combination node) (type ir2-block block) (type clambda fun))
-  (mapc #'(lambda (var arg)
-	    (when arg
-	      (let ((src (continuation-tn node block arg))
-		    (dest (leaf-info var)))
-		(if (lambda-var-indirect var)
-		    (do-make-value-cell node block src dest)
-		    (emit-move node block src dest)))))
-	(lambda-vars fun) (basic-combination-args node))
-  (undefined-value))
+  (loop for var in (lambda-vars fun)
+	and arg in (basic-combination-args node)
+	when arg do
+	  (let ((src (continuation-tn node block arg))
+		(dest (leaf-info var)))
+	    (if (lambda-var-indirect var)
+		(do-make-value-cell node block src dest)
+		(emit-move node block src dest))))
+    (values))
 
 
 ;;; EMIT-PSETQ-MOVES  --  Internal
@@ -1404,6 +1406,29 @@ compilation policy")
 		  nil)
 		 ((reference-tn-list locs t)))))))))
 
+
+;;;; Dynamic-Extent
+
+(defoptimizer (%dynamic-extent ir2-convert) ((kind sp) node block)
+  node block sp kind)
+
+(defoptimizer (%dynamic-extent-start ir2-convert) (() node block)
+  (let ((tn (environment-live-tn (make-stack-pointer-tn)
+				 (node-environment node)))
+	(2cont (continuation-info (node-cont node))))
+    (setf (ir2-continuation-locs 2cont) (list tn))
+    (when *dynamic-extent-trace*
+      (format t "~&===> %dynamic-extent-start ~s ~s~%" tn
+	      (node-cont node)))
+    (vop %dynamic-extent-start node block tn)))
+
+(defoptimizer (%dynamic-extent-end ir2-convert) ((kind sp) node block)
+  (let* ((sp (continuation-value sp))
+	 (tn (first (ir2-continuation-locs (continuation-info sp)))))
+    (when *dynamic-extent-trace*
+      (format t "~&===> %dynamic-extent-end ~s ~s ~s~%"
+	      (continuation-value kind) sp tn))
+    (vop %dynamic-extent-end node block tn)))
 
 
 ;;;; Special binding:
@@ -1657,9 +1682,12 @@ compilation policy")
 		       (cont (node-cont node))
 		       (res (continuation-result-tns
 			     cont
-			     (list (primitive-type (specifier-type 'list))))))
+			     (list (primitive-type (specifier-type 'list)))))
+		       (dynamic-extent (ir2-stack-allocate node)))
+		  (when (and dynamic-extent *dynamic-extent-trace*)
+		    (format t "~&===> list/list* ~d~%" (length args)))
 		  (vop* ,name node block (refs) ((first res) nil)
-			(length args))
+			(length args) dynamic-extent)
 		  (move-continuation-result node block res cont)))))
   (frob list)
   (frob list*))
@@ -1776,8 +1804,7 @@ compilation policy")
 				tn)))))))
 	      ((not (eq (ir2-block-next 2block) (block-info target)))
 	       (vop branch last 2block (block-label target)))))))
-  
-  (undefined-value))
+  (values))
 
 
 ;;; IR2-Convert-Block  --  Internal
@@ -1833,8 +1860,9 @@ compilation policy")
 	 (when (exit-entry node)
 	   (ir2-convert-exit node 2block)))
 	(entry
-	 (ir2-convert-entry node 2block)))))
+	 (ir2-convert-entry node 2block))))
 
-  (finish-ir2-block block)
+    (finish-ir2-block block)
+    (values)))
 
-  (undefined-value))
+;;; End of file.
diff --git a/compiler/knownfun.lisp b/compiler/knownfun.lisp
index 6cbb5af2baf1450f015c2f46622f164bdfcd27f9..d3c4b61ec451abfafb34213005fc3b26dcc425dd 100644
--- a/compiler/knownfun.lisp
+++ b/compiler/knownfun.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.25 2003/08/02 11:52:15 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/knownfun.lisp,v 1.26 2003/08/25 20:50:59 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -77,7 +77,10 @@
   ;;
   ;; Function does explicit argument type checking, so the declared type should
   ;; not be asserted when a definition is compiled.
-  explicit-check)
+  explicit-check
+  ;;
+  ;; Safe to stack-allocate function args that are closures.
+  dynamic-extent-closure-safe)
 
 (defstruct (function-info
 	    (:print-function %print-function-info)
diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp
index 34ebc9d138a9f1d3deb16b31eb82be70799053cd..55b510f4ca7ccca2306dab2203eb107032a3fa1f 100644
--- a/compiler/mips/alloc.lisp
+++ b/compiler/mips/alloc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.30 2003/08/06 21:10:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.31 2003/08/25 20:50:59 gerd Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,6 +16,21 @@
 
 (in-package "MIPS")
 
+
+;;;; Dynamic-Extent (not implemented).
+
+(define-vop (%dynamic-extent-start)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
+(define-vop (%dynamic-extent-end)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
 
 ;;;; LIST and LIST*
 
@@ -27,7 +42,7 @@
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
 	      res)
   (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
-  (:info num)
+  (:info num dynamic-extent)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
@@ -213,7 +228,7 @@
 
 (define-vop (fixed-alloc)
   (:args)
-  (:info name words type lowtag)
+  (:info name words type lowtag dynamic-extent)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
diff --git a/compiler/node.lisp b/compiler/node.lisp
index 76283204878ddc9e90e2f873a8a4c626a1b91681..c87b3517761c4ba1382ecec5e6df6085630baf12 100644
--- a/compiler/node.lisp
+++ b/compiler/node.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.42 2003/08/06 19:01:17 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/node.lisp,v 1.43 2003/08/25 20:50:59 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -233,7 +233,11 @@
   (%type-check t :type (member t nil :deleted :no-check :error))
   ;;
   ;; Something or other that the back end annotates this continuation with.
-  (info nil))
+  (info nil)
+  ;;
+  ;; True if this value can be allocated with dynamic extent.
+  (dynamic-extent nil :type boolean))
+
 
 (defun %print-continuation (s stream d)
   (declare (ignore d))
@@ -531,7 +535,8 @@
   ;;
   ;; The kind of thing that has to be cleaned up.
   (kind (required-argument)
-	:type (member :special-bind :catch :unwind-protect :block :tagbody))
+	:type (member :special-bind :catch :unwind-protect :block :tagbody
+		      :dynamic-extent))
   ;;
   ;; The node that messes things up.  This is the last node in the
   ;; non-messed-up environment.  Null only temporarily.  This could be deleted
diff --git a/compiler/ppc/alloc.lisp b/compiler/ppc/alloc.lisp
index 855ba5525b8158a657f0975a5e0db712df01cde9..26ea125a103ae96a7fca1cd25033dc2504308f92 100644
--- a/compiler/ppc/alloc.lisp
+++ b/compiler/ppc/alloc.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/ppc/alloc.lisp,v 1.3 2003/08/06 21:10:35 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.4 2003/08/25 20:50:58 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -18,6 +18,21 @@
 
 (in-package "PPC")
 
+
+;;;; Dynamic-Extent (not implemented).
+
+(define-vop (%dynamic-extent-start)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
+(define-vop (%dynamic-extent-end)
+  (:args (saved-stack-pointer :scs (any-reg)))
+  (:results)
+  (:policy :safe)
+  (:generator 0))
+
 
 ;;;; LIST and LIST*
 
@@ -28,7 +43,7 @@
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
 	      res)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
-  (:info num)
+  (:info num dynamic-extent)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
@@ -163,7 +178,7 @@
 
 (define-vop (fixed-alloc)
   (:args)
-  (:info name words type lowtag)
+  (:info name words type lowtag dynamic-extent)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) temp)
diff --git a/compiler/seqtran.lisp b/compiler/seqtran.lisp
index ead63aeb683b52cbdd7b31eb51ab4f7b520fefbc..c741461a8b7f308312b99da5cd386092556e205f 100644
--- a/compiler/seqtran.lisp
+++ b/compiler/seqtran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.27 2003/04/27 13:58:59 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.28 2003/08/25 20:50:59 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -37,6 +37,7 @@
 	     (let ((temp (gensym))
 		   (map-result (gensym)))
 	       `(let ((,map-result (list nil)))
+		  (declare (dynamic-extent ,map-result))
 		  (do-anonymous ((,temp ,map-result) . ,(do-clauses))
 				 (,endtest (cdr ,map-result))
 		    (setq ,temp (last (nconc ,temp ,call)))))))
@@ -44,6 +45,7 @@
 	     (let ((temp (gensym))
 		   (map-result (gensym)))
 	       `(let ((,map-result (list nil)))
+		  (declare (dynamic-extent ,map-result))
 		  (do-anonymous ((,temp ,map-result) . ,(do-clauses))
 				 (,endtest (cdr ,map-result))
 		    (rplacd ,temp (setq ,temp (list ,call)))))))
diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp
index d698cb9b25642d573203958408dada082de6f7cf..3d83f980e26332cfc2a82e0e0adb311a97336e2c 100644
--- a/compiler/x86/alloc.lisp
+++ b/compiler/x86/alloc.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/x86/alloc.lisp,v 1.10 2003/08/06 19:01:17 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.11 2003/08/25 20:50:58 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -21,6 +21,25 @@
 
 (in-package :x86)
 
+
+;;;; Dynamic-Extent
+
+;;;
+;;; Take an arg where to move the stack pointer instead of returning
+;;; it via :results, because the former generates a single move.
+;;;
+(define-vop (%dynamic-extent-start)
+  (:args (saved-stack-pointer :scs (any-reg control-stack)))
+  (:results)
+  (:policy :safe)
+  (:generator 0 (inst mov saved-stack-pointer esp-tn)))
+
+(define-vop (%dynamic-extent-end)
+  (:args (saved-stack-pointer :scs (any-reg control-stack)))
+  (:results)
+  (:policy :safe)
+  (:generator 0 (inst mov esp-tn saved-stack-pointer)))
+
 
 ;;;; LIST and LIST*
 
@@ -28,7 +47,7 @@
   (:args (things :more t))
   (:temporary (:sc unsigned-reg) ptr temp)
   (:temporary (:sc unsigned-reg :to (:result 0) :target result) res)
-  (:info num)
+  (:info num dynamic-extent)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
@@ -49,9 +68,12 @@
 			     (move temp ,tn)
 			     temp))))
 		     (storew reg ,list ,slot vm:list-pointer-type))))
-	     (let ((cons-cells (if star (1- num) num)))
+	     (let ((cons-cells (if star (1- num) num))
+		   (*enable-pseudo-atomic* (unless dynamic-extent
+					     *enable-pseudo-atomic*)))
 	       (pseudo-atomic
-		(allocation res (* (pad-data-block cons-size) cons-cells) node)
+		(allocation res (* (pad-data-block cons-size) cons-cells) node
+			    dynamic-extent)
 		(inst lea res
 		      (make-ea :byte :base res :disp list-pointer-type))
 		(move ptr res)
@@ -195,16 +217,18 @@
 
 (define-vop (fixed-alloc)
   (:args)
-  (:info name words type lowtag)
+  (:info name words type lowtag dynamic-extent)
   (:ignore name)
   (:results (result :scs (descriptor-reg)))
   (:node-var node)
   (:generator 50
-    (pseudo-atomic
-     (allocation result (pad-data-block words) node)
-     (inst lea result (make-ea :byte :base result :disp lowtag))
-     (when type
-       (storew (logior (ash (1- words) type-bits) type) result 0 lowtag)))))
+    (let ((*enable-pseudo-atomic* (unless dynamic-extent
+				    *enable-pseudo-atomic*)))
+      (pseudo-atomic
+       (allocation result (pad-data-block words) node dynamic-extent)
+       (inst lea result (make-ea :byte :base result :disp lowtag))
+       (when type
+	 (storew (logior (ash (1- words) type-bits) type) result 0 lowtag))))))
 
 (define-vop (var-alloc)
   (:args (extra :scs (any-reg)))
diff --git a/compiler/x86/macros.lisp b/compiler/x86/macros.lisp
index 46bafc1fddb708184b8e27234b19c89c98a8e829..a66cf61e85db86a8068648bb73c165ec054e08bd 100644
--- a/compiler/x86/macros.lisp
+++ b/compiler/x86/macros.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/x86/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/macros.lisp,v 1.21 2003/08/25 20:50:58 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -245,12 +245,10 @@
 ;;; Allocate SIZE bytes from the stack, storing a pointer to the
 ;;; allocated memory in ALLOC-TN.
 ;;;
-(defun stack-allocation (alloc-tn size)
-  (load-size alloc-tn alloc-tn size)
-  (inst neg alloc-tn)
-  (inst add alloc-tn esp-tn)
-  (inst and alloc-tn #xfffffff8)	;align on double-word boundary
-  (inst mov esp-tn alloc-tn)
+(defun dynamic-extent-allocation (alloc-tn nbytes)
+  (inst sub esp-tn nbytes)
+  (inst and esp-tn #xfffffff8)
+  (inst mov alloc-tn esp-tn)
   (values))
 
 (defun allocation (alloc-tn size &optional inline dynamic-extent)
@@ -259,10 +257,8 @@
    If Inline is a VOP node-var then it is used to make an appropriate
    speed vs size decision.  If Dynamic-Extent is true, and otherwise
    appropriate, allocate from the stack."
-  (cond ((and inline
-	      dynamic-extent
-	      (trust-dynamic-extent-declaration-p inline))
-	 (stack-allocation alloc-tn size))
+  (cond (dynamic-extent
+	 (dynamic-extent-allocation alloc-tn size))
 	((and *maybe-use-inline-allocation*
 	      (or (null inline)
 		  (policy inline (>= speed space)))
diff --git a/docs/cmu-user/extensions.tex b/docs/cmu-user/extensions.tex
index 415471be93f4f303f96fffacbc29ca66190629bf..bf8648c57f9b886fb837c66d8d670d28b275a216 100644
--- a/docs/cmu-user/extensions.tex
+++ b/docs/cmu-user/extensions.tex
@@ -2203,16 +2203,16 @@ actual arguments and constructs an effective method function from
 applicable methods, using the generic function's method combination.
 
 Effective methods can be precomputed at method load time instead of
-when the generic function is called by setting
-\code{pcl:*max-emf-precomputation-methods*} to a nonzero number.
+when the generic function is called depending on the value of
+\code{pcl:*max-emf-precomputation-methods*}.
 
 \begin{defvar}{pcl:}{*max-emf-precomputation-methods*}
-  If nonzero, precompute effective methods when methods are loaded,
-  and the method's generic function has less than the specified
-  number of methods.
+  If nonzero, the default value is 100, precompute effective methods
+  when methods are loaded, and the method's generic function has less
+  than the specified number of methods.
   
-  If zero, the default, compute effective methods only when the
-  generic function is called.
+  If zero, compute effective methods only when the generic function is
+  called.
 \end{defvar}
 
 
@@ -2462,3 +2462,106 @@ innermost fwrapper.
   object from a function name.
 \end{defmac}
 
+\section{Dynamic-Extent Declarations}
+\cindex{dynamic-extent}
+
+On x86 and sparc, \cmucl{} can exploit \code{dynamic-extent}
+declarations by allocating objects on the stack instead of the heap.
+
+You can tell \cmucl{} to trust or not trust \code{dynamic-extent}
+declarations by setting the variable
+\code{*trust-dynamic-extent-declarations*}.
+
+\begin{defvar}{ext:}{*trust-dynamic-extent-declarations*}
+  If the value of \code{*trust-dynamic-extent-declarations*} is 
+  \code{NIL}, \code{dynamic-extent} declarations are effectively
+  ignored.
+
+  If the value of this variable is a function, the function is called
+  with four arguments to determine if a \code{dynamic-extent} 
+  declaration should be trusted.  The arguments are the safety,
+  space, speed, and debug settings at the point where the 
+  \code{dynamic-extent} declaration is used.  If the function
+  returns true, the declaration is trusted, otherwise it is not
+  trusted.
+
+  In all other cases, \code{dynamic-extent} declarations are
+  trusted.
+\end{defvar}
+
+Please note that stack-allocation is inherently unsafe.  If you make a
+mistake, and a stack-allocated object or part of it escapes, \cmucl{}
+is likely to crash, or format your hard disk.
+
+\subsection{\code{&rest} argument lists}
+\cpsubindex{dynamic-extent}{rest lists}
+
+Rest argument lists can be allocated on the stack by declaring the
+rest argument variable \code{dynamic-extent}.  Examples:
+
+\begin{lisp}
+(defun foo (x &rest rest)
+  (declare (dynamic-extent rest))
+  ...)
+
+(defun bar ()
+  (lambda (&rest rest)
+    (declare (dynamic-extent rest))
+    ...))
+\end{lisp}
+
+\subsection{Closures}
+\cpsubindex{dynamic-extent}{closures}
+
+Closures for local functions can be allocated on the stack if the
+local function is declared \code{dynamic-extent}, and the closure
+appears as an argument in the call of a named function.  In the
+example:
+
+\begin{lisp}
+(defun foo (x)
+  (flet ((bar () x))
+    (declare (dynamic-extent #'bar))
+    (baz #'bar)))
+\end{lisp}
+
+the closure passed to function \code{baz} is allocated on the stack.
+Likewise in the example:
+
+\begin{lisp}
+(defun foo (x)
+  (flet ((bar () x))
+    (baz #'bar)
+    (locally (declare (dynamic-extent #'bar))
+      (baz #'bar))))
+\end{lisp}
+
+\cpsubindex{dynamic-extent}{known CL functions}
+
+Stack-allocation of closures can also automatically take place when
+calling certain known CL functions taking function arguments, for
+example \code{some} or \code{find-if}.
+
+\subsection{\code{list}, \code{list*}, and \code{cons}}
+\cpsubindex{dynamic-extent}{list, list*, cons}
+
+New conses allocated by \code{list}, \code{list*}, or \code{cons}
+which are used to initialize variables can be allocated from the stack
+if the variables are declared \code{dynamic-extent}.  In the case of
+\code{cons}, only the outermost cons cell is allocated from the stack;
+this is an arbitrary restriction.
+
+\begin{lisp}
+(let ((x (list 1 2))
+      (y (list* 1 2 x))
+      (z (cons 1 (cons 2 nil))))
+  (declare (dynamic-extent x y z))
+  ...
+  (setq x (list 2 3))
+  ...)
+\end{lisp}
+
+Please note that the \code{setq} of \code{x} in the example program
+assigns to \code{x} a list that is allocated from the heap.  This is
+another arbitrary restriction that exists because other Lisps behave
+that way.
diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt
index 72c07ce3b2d7164ed48b2c4b79c944420f960173..c05b9152bb6b407b54d7f7a63a60f139dbe86713 100644
--- a/general-info/release-19a.txt
+++ b/general-info/release-19a.txt
@@ -180,13 +180,13 @@ New in this release:
        default to preserve current behavior.  Set the version to
        :NEWEST to create versions.
      - LDB backtrace on x86.
-     - DYNAMIC-EXTENT support on x86 and sparc for &REST arg lists and
-       closures.  Stack-allocation can be controlled with the new
-       variable EXT:*TRUST-DYNAMIC-EXTENT-DECLARATIONS*, which see.
-       Default is to stack-allocate if speed >= safety.  Be warned
-       that all bets are off if a stack-allocated object or parts of
-       it escape; CMUCL might crash or format your hard disk.
-     - Generation GC (gencgc) available for Sparc/Solaris on an
+     - DYNAMIC-EXTENT support on x86 and sparc.  Stack-allocation can
+       be controlled by the setting of
+       EXT:*TRUST-DYNAMIC-EXTENT-DECLARATIONS*.  See also the CMU User
+       Manual.  Be warned that all bets are off if a stack-allocated
+       object or parts of it escape; CMUCL might crash or format your
+       hard disk.
+     - Generational GC (gencgc) available for Sparc/Solaris on an
        experimental basis.  Despite the name and feature, it is not
        conservative. 
 
@@ -230,11 +230,13 @@ New in this release:
        The default method of this generic function signals a
        continuable error of type PCL:NO-PRIMARY-METHOD-ERROR.
      - Effective methods are no longer precomputed at method load
-       time, for conformance with CLtS.
-       PCL:*MAX-EMF-PRECOMPUTATION-METHODS* can be set to a number >
-       0 to allow effective method precomputation when the generic
-       function in question has less than the specified number of
-       methods.
+       time, if the generic function has more than 
+       PCL:*MAX-EMF-PRECOMPUTATION-METHODS* methods (default 100).
+     - The loading of methods with invalid qualifiers no longer
+       signals an error, for standard's conformance.  Instead, a
+       warning is printed at method load time.  An error is
+       signaled if the generic function is called with arguments such
+       that the method is used.
 
   * Improvements to Hemlock, the Emacs-like editor: