diff --git a/compiler/alloc.lisp b/compiler/alloc.lisp
index 913556b701305a28feb6bef82dcbf564ff55dae1..1fa619d1aa551f2a669397e66675011461c9f540 100644
--- a/compiler/alloc.lisp
+++ b/compiler/alloc.lisp
@@ -94,6 +94,8 @@
 (defmacro node-deinits ()
   '(progn
      (setf (node-derived-type structure) *wild-type*)
+     (setf (node-lexenv structure) *undefined*)
+     (setf (node-source-path structure) nil)
      (setf (node-reoptimize structure) t)
      (setf (node-cont structure) nil)
      (setf (node-prev structure) nil)
@@ -101,8 +103,7 @@
 
 (defmacro node-inits ()
   '(progn
-     (setf (node-cookie structure) *current-cookie*)
-     (setf (node-default-cookie structure) *default-cookie*)
+     (setf (node-lexenv structure) *lexical-environment*)
      (setf (node-source-path structure) *current-path*)))
 
 
@@ -128,12 +129,9 @@
     (setf (block-last structure) nil)
     (setf (block-next structure) nil)
     (setf (block-prev structure) nil)
-    (setf (block-reoptimize structure) t)
-    (setf (block-flush-p structure) t)
-    (setf (block-type-check structure) t)
-    (setf (block-delete-p structure) nil)
-    (setf (block-type-asserted structure) t)
-    (setf (block-test-modified structure) t)
+    (setf (block-flags structure)
+	  (block-attributes reoptimize flush-p type-check type-asserted
+			    test-modified))
     (setf (block-kill structure) nil)
     (setf (block-gen structure) nil)
     (setf (block-in structure) nil)
@@ -141,29 +139,24 @@
     (setf (block-flag structure) nil)
     (setf (block-info structure) nil)
     (setf (block-test-constraint structure) nil))
-   ((setf (block-lambda structure) *current-lambda*)
-    (setf (block-start-cleanup structure) *current-cleanup*)
-    (setf (block-end-cleanup structure) *current-cleanup*)
-    (setf (block-component structure) *current-component*)
+   ((setf (block-component structure) *current-component*)
     (setf (block-start structure) start)))
   
-  ((ref (derived-type source leaf inlinep)) node-source
+  ((ref (derived-type leaf inlinep)) node-source-path
    ((node-deinits)
     (setf (ref-leaf structure) *undefined*))
    ((node-inits)
     (setf (node-derived-type structure) derived-type)
-    (setf (node-source structure) source)
     (setf (ref-leaf structure) leaf)
     (setf (ref-inlinep structure) inlinep)))
 
-  ((combination (source fun)) node-source
+  ((combination (fun)) node-source-path
    ((node-deinits)
     (setf (basic-combination-fun structure) *undefined*)
     (setf (basic-combination-args structure) nil)
     (setf (basic-combination-kind structure) :full)
     (setf (basic-combination-info structure) nil))
    ((node-inits)
-    (setf (node-source structure) source)
     (setf (basic-combination-fun structure) fun)))
   
   ((ir2-block (block)) ir2-block-next
@@ -298,10 +291,10 @@
 
 ;;; MACERATE-IR1-COMPONENT  --  Interface
 ;;;
-(defun macerate-IR1-component (component)
-  (declare (type component component))
+(defun macerate-ir1-component (component)
+  (declare (type component component) (optimize (safety 0)))
   (zap-in (block (component-head component) block-next)
-    (when (block-lambda block)
+    (when (block-start block)
       (let ((cont (block-start block))
 	    (last-cont (node-cont (block-last block)))
 	    next-cont
@@ -311,7 +304,10 @@
 	  (setq next-cont (node-cont node))
 	  (typecase node
 	    (ref (unmake-ref node))
-	    (combination (unmake-combination node)))
+	    (combination (unmake-combination node))
+	    (t
+	     (let ((structure node))
+	       (node-deinits))))
 	  (unmake-continuation cont)
 	  (when (eq next-cont last-cont)
 	    (when (eq (continuation-block next-cont) block)
@@ -321,12 +317,25 @@
     (unmake-block block))
 
   (dolist (fun (component-lambdas component))
+    (setf (leaf-refs fun) nil)
     (let ((tails (lambda-tail-set fun)))
       (when tails
 	(setf (tail-set-info tails) nil)))
     (let ((env (lambda-environment fun)))
       (setf (environment-info env) nil)
+      (setf (environment-function env) *undefined*)
       (dolist (nlx (environment-nlx-info env))
 	(setf (nlx-info-info nlx) nil)))
-    (dolist (var (lambda-vars fun))
-      (setf (leaf-info var) nil))))
+    (macrolet ((frob (fun)
+		 `(progn
+		    (dolist (var (lambda-vars ,fun))
+		      (setf (leaf-refs var) nil)
+		      (setf (basic-var-sets var) nil)
+		      (setf (leaf-info var) nil))
+		    (setf (lambda-vars ,fun) nil)
+		    (setf (lambda-environment ,fun) nil))))
+      (frob fun)
+      (dolist (let (lambda-lets fun))
+	(frob let)
+	(setf (lambda-home let) nil))
+      (setf (lambda-lets fun) nil))))