* boot/ast.boot (shoeCompTran): Simplify.

	(shoeCompTran1): Partially defer translation of fluid variable
	definition.
	(bindFluidVars!): New. Complete translation.
	(groupFluidVars): New.
	* interp/newfort.boot (fortFormatIntrinsics): Remove redundant return.

4 files changed, 263 insertions, 158 deletions

diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 8ec1bc57..0eb9fefd 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -995,9 +995,9 @@
             (LIST 'COND (LIST |isPred| |rhs|)))))))
 
 (DEFUN |bfLET| (|lhs| |rhs|)
-  (PROG (|$letGenVarCounter|)
+  (LET ((|$letGenVarCounter| 0))
     (DECLARE (SPECIAL |$letGenVarCounter|))
-    (RETURN (PROGN (SETQ |$letGenVarCounter| 0) (|bfLET1| |lhs| |rhs|)))))
+    (|bfLET1| |lhs| |rhs|)))
 
 (DEFUN |addCARorCDR| (|acc| |expr|)
   (PROG (|funsR| |funsA| |p| |funs|)
@@ -1034,13 +1034,9 @@
         (T (LIST |op| |left| |right|))))
 
 (DEFUN |bfIS| (|left| |right|)
-  (PROG (|$inDefIS| |$isGenVarCounter|)
-    (DECLARE (SPECIAL |$inDefIS| |$isGenVarCounter|))
-    (RETURN
-     (PROGN
-      (SETQ |$isGenVarCounter| 0)
-      (SETQ |$inDefIS| T)
-      (|bfIS1| |left| |right|)))))
+  (LET* ((|$isGenVarCounter| 0) (|$inDefIS| T))
+    (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|))
+    (|bfIS1| |left| |right|)))
 
 (DEFUN |bfISReverse| (|x| |a|)
   (PROG (|y|)
@@ -1707,8 +1703,8 @@
                               |body|))))))))))))
 
 (DEFUN |shoeCompTran| (|x|)
-  (PROG (|fl| |fvars| |body'| |lvars| |dollarVars| |locVars| |fluidVars| |body|
-         |args| |lamtype|)
+  (PROG (|fl| |fvars| |body'| |dollarVars| |locVars| |fluidVars| |body| |args|
+         |lamtype|)
     (DECLARE (SPECIAL |$typings|))
     (RETURN
      (PROGN
@@ -1725,23 +1721,20 @@
                (|shoeATOMs| |args|)))
       (SETQ |body|
               (PROGN
-               (SETQ |lvars|
-                       (|append| (|deref| |fluidVars|) (|deref| |locVars|)))
-               (SETF (|deref| |fluidVars|)
-                       (|setUnion| (|deref| |fluidVars|)
-                                   (|deref| |dollarVars|)))
                (SETQ |body'| |body|)
                (COND
                 (|$typings|
                  (SETQ |body'| (CONS (CONS 'DECLARE |$typings|) |body'|))))
                (COND
-                ((|deref| |fluidVars|)
-                 (SETQ |fvars|
-                         (LIST 'DECLARE (CONS 'SPECIAL (|deref| |fluidVars|))))
-                 (SETQ |body'| (CONS |fvars| |body'|))))
+                ((SETQ |fvars|
+                         (|setDifference| (|deref| |dollarVars|)
+                                          (|deref| |fluidVars|)))
+                 (SETQ |body'|
+                         (CONS (LIST 'DECLARE (CONS 'SPECIAL |fvars|))
+                               |body'|))))
                (COND
-                ((OR |lvars| (|needsPROG| |body|))
-                 (|shoePROG| |lvars| |body'|))
+                ((OR (|deref| |locVars|) (|needsPROG| |body'|))
+                 (|shoePROG| (|deref| |locVars|) |body'|))
                 (T |body'|))))
       (COND
        ((SETQ |fl| (|shoeFluids| |args|))
@@ -1755,7 +1748,8 @@
            (T (SETQ |op| (CAR |body|)) (SETQ |args| (CDR |body|))
             (COND ((|symbolMember?| |op| '(RETURN RETURN-FROM)) T)
                   ((|symbolMember?| |op|
-                                    '(LET PROG
+                                    '(LET LET*
+                                       PROG
                                        LOOP
                                        BLOCK
                                        DECLARE
@@ -1846,29 +1840,36 @@
                           (SETQ |ISTMP#2| (CDR |ISTMP#1|))
                           (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                (PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
-              (RPLACA |x| 'SETQ)
               (SETF (CADDR |x|)
                       (|shoeCompTran1| |r| |fluidVars| |locVars| |dollarVars|))
               (COND
-               ((SYMBOLP |l|)
-                (COND
-                 ((|bfBeginsDollar| |l|)
-                  (COND
-                   ((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
-                    (SETF (|deref| |dollarVars|)
-                            (CONS |l| (|deref| |dollarVars|)))))
-                  |x|)
-                 (T
-                  (COND
-                   ((NOT (|symbolMember?| |l| (|deref| |locVars|)))
-                    (SETF (|deref| |locVars|) (CONS |l| (|deref| |locVars|)))))
-                  |x|)))
-               ((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|))
+               ((AND (CONSP |l|) (EQ (CAR |l|) '|%Dynamic|)
+                     (PROGN
+                      (SETQ |ISTMP#1| (CDR |l|))
+                      (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+                           (PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
                 (COND
-                 ((NOT (|symbolMember?| (CADR |l|) (|deref| |fluidVars|)))
+                 ((NOT (|symbolMember?| |y| (|deref| |fluidVars|)))
                   (SETF (|deref| |fluidVars|)
-                          (CONS (CADR |l|) (|deref| |fluidVars|)))))
-                (RPLACA (CDR |x|) (CADR |l|)) |x|)))
+                          (CONS |y| (|deref| |fluidVars|)))))
+                (SETF (CADR |x|) |y|) |x|)
+               (T (RPLACA |x| 'SETQ)
+                (COND
+                 ((SYMBOLP |l|)
+                  (COND
+                   ((|bfBeginsDollar| |l|)
+                    (COND
+                     ((NOT (|symbolMember?| |l| (|deref| |dollarVars|)))
+                      (SETF (|deref| |dollarVars|)
+                              (CONS |l| (|deref| |dollarVars|)))))
+                    |x|)
+                   (T
+                    (COND
+                     ((NOT (|symbolMember?| |l| (|deref| |locVars|)))
+                      (SETF (|deref| |locVars|)
+                              (CONS |l| (|deref| |locVars|)))))
+                    |x|)))
+                 (T |x|)))))
              ((EQ U '|%Leave|) (RPLACA |x| 'RETURN) |x|)
              ((|symbolMember?| U '(PROG LAMBDA)) (SETQ |newbindings| NIL)
               (LET ((|bfVar#1| (CADR |x|)) (|y| NIL))
@@ -1946,7 +1947,101 @@
               (RPLACD |x|
                       (|shoeCompTran1| (CDR |x|) |fluidVars| |locVars|
                                        |dollarVars|))
-              |x|)))))))
+              (|bindFluidVars!| |x|))))))))
+
+(DEFUN |bindFluidVars!| (|x|)
+  (PROG (|y| |stmts| |init| |ISTMP#1|)
+    (RETURN
+     (PROGN
+      (COND
+       ((AND (CONSP |x|)
+             (PROGN
+              (SETQ |ISTMP#1| (CAR |x|))
+              (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'L%T)
+                   (PROGN (SETQ |init| (CDR |ISTMP#1|)) T)))
+             (PROGN (SETQ |stmts| (CDR |x|)) T))
+        (RPLACA |x|
+                (|groupFluidVars| (LIST |init|) (LIST (CAR |init|)) |stmts|))
+        (RPLACD |x| NIL)))
+      (COND
+       ((AND (CONSP |x|) (EQ (CAR |x|) 'PROGN)
+             (PROGN
+              (SETQ |ISTMP#1| (CDR |x|))
+              (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|))
+                   (PROGN (SETQ |y| (CAR |ISTMP#1|)) T))))
+        |y|)
+       (T |x|))))))
+
+(DEFUN |groupFluidVars| (|inits| |vars| |stmts|)
+  (PROG (|stmts'| |vars'| |ISTMP#6| |ISTMP#5| |ISTMP#4| |ISTMP#3| |inits'|
+         |ISTMP#2| |ISTMP#1|)
+    (RETURN
+     (COND
+      ((AND (CONSP |stmts|) (NULL (CDR |stmts|))
+            (PROGN
+             (SETQ |ISTMP#1| (CAR |stmts|))
+             (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET)
+                  (PROGN
+                   (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                   (AND (CONSP |ISTMP#2|)
+                        (PROGN
+                         (SETQ |inits'| (CAR |ISTMP#2|))
+                         (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+                         (AND (CONSP |ISTMP#3|)
+                              (PROGN
+                               (SETQ |ISTMP#4| (CAR |ISTMP#3|))
+                               (AND (CONSP |ISTMP#4|)
+                                    (EQ (CAR |ISTMP#4|) 'DECLARE)
+                                    (PROGN
+                                     (SETQ |ISTMP#5| (CDR |ISTMP#4|))
+                                     (AND (CONSP |ISTMP#5|)
+                                          (NULL (CDR |ISTMP#5|))
+                                          (PROGN
+                                           (SETQ |ISTMP#6| (CAR |ISTMP#5|))
+                                           (AND (CONSP |ISTMP#6|)
+                                                (EQ (CAR |ISTMP#6|) 'SPECIAL)
+                                                (PROGN
+                                                 (SETQ |vars'| (CDR |ISTMP#6|))
+                                                 T)))))))
+                              (PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T)))))))
+            (CONSP |inits'|) (NULL (CDR |inits'|)))
+       (|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
+                         |stmts'|))
+      ((AND (CONSP |stmts|) (NULL (CDR |stmts|))
+            (PROGN
+             (SETQ |ISTMP#1| (CAR |stmts|))
+             (AND (CONSP |ISTMP#1|) (EQ (CAR |ISTMP#1|) 'LET*)
+                  (PROGN
+                   (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                   (AND (CONSP |ISTMP#2|)
+                        (PROGN
+                         (SETQ |inits'| (CAR |ISTMP#2|))
+                         (SETQ |ISTMP#3| (CDR |ISTMP#2|))
+                         (AND (CONSP |ISTMP#3|)
+                              (PROGN
+                               (SETQ |ISTMP#4| (CAR |ISTMP#3|))
+                               (AND (CONSP |ISTMP#4|)
+                                    (EQ (CAR |ISTMP#4|) 'DECLARE)
+                                    (PROGN
+                                     (SETQ |ISTMP#5| (CDR |ISTMP#4|))
+                                     (AND (CONSP |ISTMP#5|)
+                                          (NULL (CDR |ISTMP#5|))
+                                          (PROGN
+                                           (SETQ |ISTMP#6| (CAR |ISTMP#5|))
+                                           (AND (CONSP |ISTMP#6|)
+                                                (EQ (CAR |ISTMP#6|) 'SPECIAL)
+                                                (PROGN
+                                                 (SETQ |vars'| (CDR |ISTMP#6|))
+                                                 T)))))))
+                              (PROGN (SETQ |stmts'| (CDR |ISTMP#3|)) T))))))))
+       (|groupFluidVars| (|append| |inits| |inits'|) (|append| |vars| |vars'|)
+                         |stmts'|))
+      ((AND (CONSP |inits|) (NULL (CDR |inits|)))
+       (LIST 'LET |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
+             (|bfMKPROGN| |stmts|)))
+      (T
+       (LIST 'LET* |inits| (LIST 'DECLARE (CONS 'SPECIAL |vars|))
+             (|bfMKPROGN| |stmts|)))))))
 
 (DEFUN |bfTagged| (|a| |b|)
   (DECLARE (SPECIAL |$typings| |$op|))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index a03b67b9..c21669f2 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -91,29 +91,31 @@
       |a|))))
 
 (DEFUN |bpIndentParenthesized| (|f|)
-  (PROG (|$bpCount| |a|)
-    (DECLARE (SPECIAL |$bpCount| |$inputStream| |$bpParenCount| |$stok|))
+  (PROG (|a|)
+    (DECLARE (SPECIAL |$inputStream| |$bpParenCount| |$stok|))
     (RETURN
-     (PROGN
-      (SETQ |$bpCount| 0)
-      (SETQ |a| |$stok|)
-      (COND
-       ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
-        (|bpNext|)
+     (LET ((|$bpCount| 0))
+       (DECLARE (SPECIAL |$bpCount|))
+       (PROGN
+        (SETQ |a| |$stok|)
         (COND
-         ((AND (APPLY |f| NIL) (|bpFirstTok|)
-               (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
-          (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
-          (COND ((EQL |$bpCount| 0) T)
-                (T
-                 (SETQ |$inputStream|
-                         (|append| (|bpAddTokens| |$bpCount|) |$inputStream|))
-                 (|bpFirstToken|)
-                 (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
-         ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
-          (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
-         (T (|bpParenTrap| |a|))))
-       (T NIL))))))
+         ((|bpEqPeek| 'OPAREN) (SETQ |$bpParenCount| (+ |$bpParenCount| 1))
+          (|bpNext|)
+          (COND
+           ((AND (APPLY |f| NIL) (|bpFirstTok|)
+                 (OR (|bpEqPeek| 'CPAREN) (|bpParenTrap| |a|)))
+            (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|)
+            (COND ((EQL |$bpCount| 0) T)
+                  (T
+                   (SETQ |$inputStream|
+                           (|append| (|bpAddTokens| |$bpCount|)
+                                     |$inputStream|))
+                   (|bpFirstToken|)
+                   (COND ((EQL |$bpParenCount| 0) (|bpCancel|) T) (T T)))))
+           ((|bpEqPeek| 'CPAREN) (|bpPush| (|bfTuple| NIL))
+            (SETQ |$bpParenCount| (- |$bpParenCount| 1)) (|bpNextToken|) T)
+           (T (|bpParenTrap| |a|))))
+         (T NIL)))))))
 
 (DEFUN |bpParenthesized| (|f|)
   (PROG (|a|)
@@ -1170,27 +1172,27 @@
        (|bpPush| (|bfCaseItem| (|bpPop2|) (|bpPop1|)))))
 
 (DEFUN |bpOutItem| ()
-  (PROG (|$GenVarCounter| |$op| |r| |ISTMP#2| |l| |ISTMP#1| |b|)
-    (DECLARE (SPECIAL |$GenVarCounter| |$op| |$InteractiveMode|))
+  (PROG (|r| |ISTMP#2| |l| |ISTMP#1| |b|)
+    (DECLARE (SPECIAL |$InteractiveMode|))
     (RETURN
-     (PROGN
-      (SETQ |$op| NIL)
-      (SETQ |$GenVarCounter| 0)
-      (|bpRequire| #'|bpComma|)
-      (SETQ |b| (|bpPop1|))
-      (|bpPush|
-       (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
-             ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
-                   (PROGN
-                    (SETQ |ISTMP#1| (CDR |b|))
-                    (AND (CONSP |ISTMP#1|)
-                         (PROGN
-                          (SETQ |l| (CAR |ISTMP#1|))
-                          (SETQ |ISTMP#2| (CDR |ISTMP#1|))
-                          (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
-                               (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
-                   (SYMBOLP |l|))
-              (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
-                    (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
-             (T (|translateToplevel| |b| NIL))))))))
+     (LET* ((|$op| NIL) (|$GenVarCounter| 0))
+       (DECLARE (SPECIAL |$op| |$GenVarCounter|))
+       (PROGN
+        (|bpRequire| #'|bpComma|)
+        (SETQ |b| (|bpPop1|))
+        (|bpPush|
+         (COND ((AND (CONSP |b|) (EQ (CAR |b|) '+LINE)) (LIST |b|))
+               ((AND (CONSP |b|) (EQ (CAR |b|) 'L%T)
+                     (PROGN
+                      (SETQ |ISTMP#1| (CDR |b|))
+                      (AND (CONSP |ISTMP#1|)
+                           (PROGN
+                            (SETQ |l| (CAR |ISTMP#1|))
+                            (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                            (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                                 (PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
+                     (SYMBOLP |l|))
+                (COND (|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
+                      (T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
+               (T (|translateToplevel| |b| NIL)))))))))
 
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index af316d42..b48125fc 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -53,37 +53,35 @@
                   (T T)))))))
 
 (DEFUN |shoeLineToks| (|s|)
-  (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |dq|
-         |command|)
-    (DECLARE (SPECIAL |$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f|))
+  (PROG (|toks| |dq| |command|)
     (RETURN
-     (PROGN
-      (SETQ |$f| NIL)
-      (SETQ |$r| NIL)
-      (SETQ |$ln| NIL)
-      (SETQ |$n| NIL)
-      (SETQ |$sz| NIL)
-      (SETQ |$floatok| T)
-      (SETQ |$linepos| |s|)
-      (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
-            ((NULL |$n|) (|shoeLineToks| |$r|))
-            ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
-             (COND
-              ((SETQ |command| (|shoeLine?| |$ln|))
-               (SETQ |dq|
-                       (|dqUnit|
-                        (|shoeConstructToken| |$linepos|
-                                              (|shoeLeafLine| |command|) 0)))
-               (CONS (LIST |dq|) |$r|))
-              ((SETQ |command| (|shoeLisp?| |$ln|))
-               (|shoeLispToken| |$r| |command|))
-              (T (|shoeLineToks| |$r|))))
-            (T (SETQ |toks| NIL)
-             (LOOP
-              (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
-                    (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
-             (COND ((NULL |toks|) (|shoeLineToks| |$r|))
-                   (T (CONS (LIST |toks|) |$r|)))))))))
+     (LET* ((|$f| NIL)
+            (|$r| NIL)
+            (|$ln| NIL)
+            (|$n| NIL)
+            (|$sz| NIL)
+            (|$floatok| T)
+            (|$linepos| |s|))
+       (DECLARE (SPECIAL |$f| |$r| |$ln| |$n| |$sz| |$floatok| |$linepos|))
+       (COND ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
+             ((NULL |$n|) (|shoeLineToks| |$r|))
+             ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
+              (COND
+               ((SETQ |command| (|shoeLine?| |$ln|))
+                (SETQ |dq|
+                        (|dqUnit|
+                         (|shoeConstructToken| |$linepos|
+                                               (|shoeLeafLine| |command|) 0)))
+                (CONS (LIST |dq|) |$r|))
+               ((SETQ |command| (|shoeLisp?| |$ln|))
+                (|shoeLispToken| |$r| |command|))
+               (T (|shoeLineToks| |$r|))))
+             (T (SETQ |toks| NIL)
+              (LOOP
+               (COND ((NOT (< |$n| |$sz|)) (RETURN NIL))
+                     (T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
+              (COND ((NULL |toks|) (|shoeLineToks| |$r|))
+                    (T (CONS (LIST |toks|) |$r|)))))))))
 
 (DEFUN |shoeLispToken| (|s| |string|)
   (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 31e89d35..9362b70e 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -122,9 +122,9 @@
     (|endCompileDuration|)))
 
 (DEFUN BOOTCLAM (|fn| |out|)
-  (PROG (|$bfClamming|)
+  (LET ((|$bfClamming| T))
     (DECLARE (SPECIAL |$bfClamming|))
-    (RETURN (PROGN (SETQ |$bfClamming| T) (BOOTCLAMLINES NIL |fn| |out|)))))
+    (BOOTCLAMLINES NIL |fn| |out|)))
 
 (DEFUN BOOTCLAMLINES (|lines| |fn| |out|) (BOOTTOCLLINES |lines| |fn| |out|))
 
@@ -252,18 +252,20 @@
         (PROGN (|closeStream| |a|) (|setCurrentPackage| |b|)))))))
 
 (DEFUN BOCLAM (|fn|)
-  (PROG (|$bfClamming| |a| |callingPackage|)
-    (DECLARE (SPECIAL |$bfClamming|))
+  (PROG (|a| |callingPackage|)
     (RETURN
      (PROGN
       (SETQ |callingPackage| *PACKAGE*)
       (IN-PACKAGE "BOOTTRAN")
-      (SETQ |$bfClamming| T)
-      (UNWIND-PROTECT
+      (LET ((|$bfClamming| T))
+        (DECLARE (SPECIAL |$bfClamming|))
+        (UNWIND-PROTECT
+            (PROGN
+             (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
+             (|shoeToConsole| |a| |fn|))
           (PROGN
-           (SETQ |a| (|inputTextFile| (|shoeAddbootIfNec| |fn|)))
-           (|shoeToConsole| |a| |fn|))
-        (PROGN (|closeStream| |a|) (|setCurrentPackage| |callingPackage|)))))))
+           (|closeStream| |a|)
+           (|setCurrentPackage| |callingPackage|))))))))
 
 (DEFUN |shoeToConsole| (|a| |fn|)
   (COND ((NULL |a|) (|shoeNotFound| |fn|))
@@ -805,25 +807,30 @@
 (DEFPARAMETER |$lispWordTable| NIL)
 
 (DEFUN |shoeDfu| (|a| |fn|)
-  (PROG (|$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
-         |$lispWordTable| |stream|)
-    (DECLARE
-     (SPECIAL |$bfClamming| |$bootDefinedTwice| |$bootUsed| |$bootDefined|
-      |$lispWordTable|))
+  (PROG (|stream|)
     (RETURN
      (COND ((NULL |a|) (|shoeNotFound| |fn|))
-           (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
-            (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
-              (SETF (|tableValue| |$lispWordTable| |i|) T))
-            (SETQ |$bootDefined| (|makeTable| #'EQ))
-            (SETQ |$bootUsed| (|makeTable| #'EQ))
-            (SETQ |$bootDefinedTwice| NIL) (SETQ |$bfClamming| NIL)
-            (|shoeDefUse| (|shoeTransformStream| |a|))
-            (UNWIND-PROTECT
-                (PROGN
-                 (SETQ |stream| (|outputTextFile| (CONCAT |fn| ".defuse")))
-                 (|shoeReport| |stream|))
-              (|closeStream| |stream|)))))))
+           (T
+            (LET ((|$lispWordTable| (|makeTable| #'EQ)))
+              (DECLARE (SPECIAL |$lispWordTable|))
+              (PROGN
+               (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
+                 (SETF (|tableValue| |$lispWordTable| |i|) T))
+               (LET* ((|$bootDefined| (|makeTable| #'EQ))
+                      (|$bootUsed| (|makeTable| #'EQ))
+                      (|$bootDefinedTwice| NIL)
+                      (|$bfClamming| NIL))
+                 (DECLARE
+                  (SPECIAL |$bootDefined| |$bootUsed| |$bootDefinedTwice|
+                   |$bfClamming|))
+                 (PROGN
+                  (|shoeDefUse| (|shoeTransformStream| |a|))
+                  (UNWIND-PROTECT
+                      (PROGN
+                       (SETQ |stream|
+                               (|outputTextFile| (CONCAT |fn| ".defuse")))
+                       (|shoeReport| |stream|))
+                    (|closeStream| |stream|)))))))))))
 
 (DEFUN |shoeReport| (|stream|)
   (PROG (|b| |a|)
@@ -1082,25 +1089,28 @@
        (|closeStream| |a|)))))
 
 (DEFUN |shoeXref| (|a| |fn|)
-  (PROG (|$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable| |stream|
-         |out|)
-    (DECLARE
-     (SPECIAL |$bfClamming| |$bootUsed| |$bootDefined| |$lispWordTable|))
+  (PROG (|stream| |out|)
     (RETURN
      (COND ((NULL |a|) (|shoeNotFound| |fn|))
-           (T (SETQ |$lispWordTable| (|makeTable| #'EQ))
-            (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
-              (SETF (|tableValue| |$lispWordTable| |i|) T))
-            (SETQ |$bootDefined| (|makeTable| #'EQ))
-            (SETQ |$bootUsed| (|makeTable| #'EQ)) (SETQ |$bfClamming| NIL)
-            (|shoeDefUse| (|shoeTransformStream| |a|))
-            (SETQ |out| (CONCAT |fn| ".xref"))
-            (UNWIND-PROTECT
-                (PROGN
-                 (SETQ |stream| (|outputTextFile| |out|))
-                 (|shoeXReport| |stream|)
-                 |out|)
-              (|closeStream| |stream|)))))))
+           (T
+            (LET ((|$lispWordTable| (|makeTable| #'EQ)))
+              (DECLARE (SPECIAL |$lispWordTable|))
+              (PROGN
+               (DO-SYMBOLS (|i| (FIND-PACKAGE "LISP"))
+                 (SETF (|tableValue| |$lispWordTable| |i|) T))
+               (LET* ((|$bootDefined| (|makeTable| #'EQ))
+                      (|$bootUsed| (|makeTable| #'EQ))
+                      (|$bfClamming| NIL))
+                 (DECLARE (SPECIAL |$bootDefined| |$bootUsed| |$bfClamming|))
+                 (PROGN
+                  (|shoeDefUse| (|shoeTransformStream| |a|))
+                  (SETQ |out| (CONCAT |fn| ".xref"))
+                  (UNWIND-PROTECT
+                      (PROGN
+                       (SETQ |stream| (|outputTextFile| |out|))
+                       (|shoeXReport| |stream|)
+                       |out|)
+                    (|closeStream| |stream|)))))))))))
 
 (DEFUN |shoeXReport| (|stream|)
   (PROG (|a| |c|)