Cope with SBCL-1.0.28 improvements.

	* boot/translator.boot (translateToplevel): Load imported modules.
	* boot/ast.boot ($constantIdentifiers): New.
	($activeNamespace): Likewise.
	(bfSimpleDefinition): Likewise.
	(isDynamicVariable): Likewise.
	(shoeCompTran1): Tidy.  Use it.
	* boot/parser.boot (bpSimpleDefinitionTail): Use bfSimpleDefinition.
	* boot/Makefile.in (stage1/%.clisp): Specify load directory.
	(stage2/%.clisp): Likewise.
	* lisp/core.lisp.in (startCompileDuration): Export.
	(endCompileDuration): Likewise.

7 files changed, 128 insertions, 47 deletions

diff --git a/src/boot/Makefile.in b/src/boot/Makefile.in
index c6fad676..357874ae 100644
--- a/src/boot/Makefile.in
+++ b/src/boot/Makefile.in
@@ -148,7 +148,7 @@ stage1/bootsys$(EXEEXT): $(stage1_boot_objects)
 		 --output=$@ --load-directory=stage1 $(stage1_boot_objects)
 
 stage1/%.clisp: %.boot strap/stamp stage1/.started
-	strap/bootsys -- --translate --output=$@ $<
+	strap/bootsys -- --translate --load-directory=stage1 --output=$@ $<
 
 
 ##
@@ -175,7 +175,7 @@ stage2/bootsys$(EXEEXT): $(stage2_boot_objects)
 		--output=$@ --load-directory=stage2 $(stage2_boot_objects)
 
 stage2/%.clisp: %.boot stage1/stamp stage2/.started
-	stage1/bootsys -- --translate --output=$@ $<
+	stage1/bootsys -- --translate --load-directory=stage2 --output=$@ $<
 
 ##
 ## Generic rules for compiling FASLs
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 0e42ac62..b49f149f 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -47,6 +47,14 @@ module ast
 ++ translated with the obvious semantics, e.g. no caching.
 $bfClamming := false
 
+++ List of identifiers defined as constants in the current
+++ translation unit.
+$constantIdentifiers := nil
+
+++ When non-nil holds the scope nominated  in the most recent
+++ namespace definition.
+$activeNamespace := nil
+
 --% Basic types used in Boot codes.
 
 %Thing <=> true
@@ -193,7 +201,17 @@ bfColonAppend(x,y) ==
 bfDefinition: (%Thing,%Thing,%Thing) -> %List 
 bfDefinition(bflhsitems, bfrhs,body) ==
        ['DEF,bflhsitems,bfrhs,body]
+
+bfSimpleDefinition: (%Thing,%Thing) -> %Thing
+bfSimpleDefinition(lhs,rhs) ==
+  if atom lhs then
+    $constantIdentifiers := [lhs,:$constantIdentifiers]
+  else if lhs is ["%Signature",id,.] then
+    $constantIdentifiers := [id,:$constantIdentifiers]
+  ConstantDefinition(lhs,rhs)
  
+
+
 bfMDefinition: (%Thing,%Thing,%Thing) -> %List 
 bfMDefinition(bflhsitems, bfrhs,body) ==
        bfMDef('MDEF,bflhsitems,bfrhs,body)
@@ -946,14 +964,25 @@ shoeATOMs x==
          else if atom x
               then [x]
               else append(shoeATOMs first x,shoeATOMs rest x)
+
+++ Return true if `x' is an identifier name that designates a
+++ dynamic (e.g. Lisp special) variable.  
+isDynamicVariable x ==
+  IDENTP x and bfBeginsDollar x =>
+    MEMQ(x,$constantIdentifiers) => false
+    CONSTANTP x => false
+    BOUNDP x or null $activeNamespace => true
+    y := FIND_-SYMBOL(STRING x,$activeNamespace) => not CONSTANTP y
+    true
+  false
  
 shoeCompTran1 x==
     atom x=>
-                IDENTP x and bfBeginsDollar x=>
-                    $dollarVars:=
-                          MEMQ(x,$dollarVars)=>$dollarVars
-                          cons(x,$dollarVars)
-                nil
+      isDynamicVariable x =>
+	$dollarVars:=
+	   MEMQ(x,$dollarVars)=>$dollarVars
+	   cons(x,$dollarVars)
+      nil
     U:=car x
     EQ(U,"QUOTE")=>nil
     x is ["L%T",l,r]=>
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index b881ffe2..68300d52 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2008, Gabriel Dos Reis.
+-- Copyright (C) 2007-2009, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -883,7 +883,7 @@ bpDDef() ==  bpName() and bpDefTail()
 bpSimpleDefinitionTail() ==
   bpEqKey "DEF" and
     (bpWhere() or bpTrap())
-      and bpPush ConstantDefinition(bpPop2(), bpPop1())
+      and bpPush bfSimpleDefinition(bpPop2(), bpPop1())
 
 ++ Parse the remaining of a compound definition.
 bpCompoundDefinitionTail() ==
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 62028541..bd54f16f 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -7,6 +7,10 @@
 
 (DEFPARAMETER |$bfClamming| NIL)
 
+(DEFPARAMETER |$constantIdentifiers| NIL)
+
+(DEFPARAMETER |$activeNamespace| NIL)
+
 (DEFTYPE |%Thing| () 'T)
 
 (DEFTYPE |%Boolean| () 'BOOLEAN)
@@ -214,6 +218,31 @@
 (DEFUN |bfDefinition| (|bflhsitems| |bfrhs| |body|)
   (LIST 'DEF |bflhsitems| |bfrhs| |body|))
 
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing|) |%Thing|)
+                |bfSimpleDefinition|))
+
+(DEFUN |bfSimpleDefinition| (|lhs| |rhs|)
+  (PROG (|ISTMP#2| |id| |ISTMP#1|)
+    (DECLARE (SPECIAL |$constantIdentifiers|))
+    (RETURN
+      (PROGN
+        (COND
+          ((ATOM |lhs|)
+           (SETQ |$constantIdentifiers|
+                 (CONS |lhs| |$constantIdentifiers|)))
+          ((AND (CONSP |lhs|) (EQ (CAR |lhs|) '|%Signature|)
+                (PROGN
+                  (SETQ |ISTMP#1| (CDR |lhs|))
+                  (AND (CONSP |ISTMP#1|)
+                       (PROGN
+                         (SETQ |id| (CAR |ISTMP#1|))
+                         (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                         (AND (CONSP |ISTMP#2|)
+                              (EQ (CDR |ISTMP#2|) NIL))))))
+           (SETQ |$constantIdentifiers|
+                 (CONS |id| |$constantIdentifiers|))))
+        (|ConstantDefinition| |lhs| |rhs|)))))
+
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%List|)
                 |bfMDefinition|))
 
@@ -1622,6 +1651,21 @@
     ((ATOM |x|) (LIST |x|))
     ('T (APPEND (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|))))))
 
+(DEFUN |isDynamicVariable| (|x|)
+  (PROG (|y|)
+    (DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|))
+    (RETURN
+      (COND
+        ((AND (IDENTP |x|) (|bfBeginsDollar| |x|))
+         (COND
+           ((MEMQ |x| |$constantIdentifiers|) NIL)
+           ((CONSTANTP |x|) NIL)
+           ((OR (BOUNDP |x|) (NULL |$activeNamespace|)) T)
+           ((SETQ |y| (FIND-SYMBOL (STRING |x|) |$activeNamespace|))
+            (NOT (CONSTANTP |y|)))
+           (#0='T T)))
+        (#0# NIL)))))
+
 (DEFUN |shoeCompTran1| (|x|)
   (PROG (|res| |newbindings| |r| |ISTMP#2| |l| |ISTMP#1| U)
     (DECLARE (SPECIAL |$fluidVars| |$locVars| |$dollarVars|))
@@ -1629,7 +1673,7 @@
       (COND
         ((ATOM |x|)
          (COND
-           ((AND (IDENTP |x|) (|bfBeginsDollar| |x|))
+           ((|isDynamicVariable| |x|)
             (SETQ |$dollarVars|
                   (COND
                     ((MEMQ |x| |$dollarVars|) |$dollarVars|)
@@ -2203,7 +2247,6 @@
     (APPEND |$NativeSimpleDataTypes| '(|void| |string|)))
 
 (DEFUN |isSimpleNativeType| (|t|)
-  (DECLARE (SPECIAL |$NativeSimpleReturnTypes|))
   (MEMBER |t| |$NativeSimpleReturnTypes|))
 
 (DECLAIM (FTYPE (FUNCTION (|%Symbol|) |%Symbol|) |coreSymbol|))
@@ -2219,7 +2262,6 @@
 
 (DEFUN |nativeType| (|t|)
   (PROG (|t'|)
-    (DECLARE (SPECIAL |$NativeTypeTable|))
     (RETURN
       (COND
         ((NULL |t|) |t|)
@@ -2315,7 +2357,6 @@
         (#0# (|unknownNativeTypeError| |t|))))))
 
 (DEFUN |nativeReturnType| (|t|)
-  (DECLARE (SPECIAL |$NativeSimpleReturnTypes|))
   (COND
     ((MEMBER |t| |$NativeSimpleReturnTypes|) (|nativeType| |t|))
     ('T
@@ -2325,7 +2366,6 @@
 
 (DEFUN |nativeArgumentType| (|t|)
   (PROG (|t'| |c| |m|)
-    (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
     (RETURN
       (COND
         ((MEMBER |t| |$NativeSimpleDataTypes|) (|nativeType| |t|))
@@ -2508,7 +2548,6 @@
 
 (DEFUN |genGCLnativeTranslation,gclTypeInC| (|x|)
   (PROG (|ISTMP#3| |ISTMP#2| |ISTMP#1|)
-    (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
     (RETURN
       (COND
         ((MEMBER |x| |$NativeSimpleDataTypes|) (SYMBOL-NAME |x|))
@@ -2531,7 +2570,6 @@
 
 (DEFUN |genGCLnativeTranslation,gclArgInC| (|x| |a|)
   (PROG (|y| |c|)
-    (DECLARE (SPECIAL |$NativeSimpleDataTypes|))
     (RETURN
       (COND
         ((MEMBER |x| |$NativeSimpleDataTypes|) |a|)
@@ -2625,7 +2663,6 @@
 
 (DEFUN |genECLnativeTranslation,selectDatum| (|x|)
   (PROG (|y| |c|)
-    (DECLARE (SPECIAL |$ECLVersionNumber|))
     (RETURN
       (COND
         ((|isSimpleNativeType| |x|) "")
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index fc373262..56275620 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -920,7 +920,7 @@
 
 (DEFUN |bpSimpleDefinitionTail| ()
   (AND (|bpEqKey| 'DEF) (OR (|bpWhere|) (|bpTrap|))
-       (|bpPush| (|ConstantDefinition| (|bpPop2|) (|bpPop1|)))))
+       (|bpPush| (|bfSimpleDefinition| (|bpPop2|) (|bpPop1|)))))
 
 (DEFUN |bpCompoundDefinitionTail| ()
   (AND (|bpVariable|) (|bpReturnType|) (|bpEqKey| 'DEF)
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 32cad87a..b809ddd6 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -84,7 +84,6 @@
         (#0# NIL)))))
 
 (DEFUN |genOptimizeOptions| (|stream|)
-  (DECLARE (SPECIAL |$LispOptimizeOptions|))
   (REALLYPRETTYPRINT
       (LIST 'PROCLAIM
             (LIST 'QUOTE (CONS 'OPTIMIZE |$LispOptimizeOptions|)))
@@ -124,12 +123,15 @@
 (DEFUN BOOTTOCL (|fn| |out|)
   (PROG (|result| |callingPackage|)
     (RETURN
-      (PROGN
-        (SETQ |callingPackage| *PACKAGE*)
-        (IN-PACKAGE "BOOTTRAN")
-        (SETQ |result| (BOOTTOCLLINES NIL |fn| |out|))
-        (|setCurrentPackage| |callingPackage|)
-        |result|))))
+      (UNWIND-PROTECT
+        (PROGN
+          (|startCompileDuration|)
+          (SETQ |callingPackage| *PACKAGE*)
+          (IN-PACKAGE "BOOTTRAN")
+          (SETQ |result| (BOOTTOCLLINES NIL |fn| |out|))
+          (|setCurrentPackage| |callingPackage|)
+          |result|)
+        (|endCompileDuration|)))))
 
 (DEFUN BOOTCLAM (|fn| |out|)
   (DECLARE (SPECIAL |$bfClamming|))
@@ -171,12 +173,15 @@
 (DEFUN BOOTTOCLC (|fn| |out|)
   (PROG (|result| |callingPackage|)
     (RETURN
-      (PROGN
-        (SETQ |callingPackage| *PACKAGE*)
-        (IN-PACKAGE "BOOTTRAN")
-        (SETQ |result| (BOOTTOCLCLINES NIL |fn| |out|))
-        (|setCurrentPackage| |callingPackage|)
-        |result|))))
+      (UNWIND-PROTECT
+        (PROGN
+          (|startCompileDuration|)
+          (SETQ |callingPackage| *PACKAGE*)
+          (IN-PACKAGE "BOOTTRAN")
+          (SETQ |result| (BOOTTOCLCLINES NIL |fn| |out|))
+          (|setCurrentPackage| |callingPackage|)
+          |result|)
+        (|endCompileDuration|)))))
 
 (DEFUN BOOTTOCLCLINES (|lines| |fn| |outfn|)
   (PROG (|infn|)
@@ -602,8 +607,8 @@
 (DEFUN |translateToplevel| (|b| |export?|)
   (PROG (|lhs| |t| |ISTMP#2| |n| |ISTMP#1| |sig| |bfVar#17| |bfVar#16|
                |xs|)
-    (DECLARE (SPECIAL |$InteractiveMode| |$foreignsDefsForCLisp|
-                      |$currentModuleName|))
+    (DECLARE (SPECIAL |$activeNamespace| |$InteractiveMode|
+                      |$foreignsDefsForCLisp| |$currentModuleName|))
     (RETURN
       (COND
         ((ATOM |b|) (LIST |b|))
@@ -653,7 +658,9 @@
                                (SETQ |bfVar#14| (CDR |bfVar#14|))))))))
              (|Import|
                  (LET ((|m| (CAR |bfVar#17|)))
-                   (LIST (LIST 'IMPORT-MODULE (STRING |m|)))))
+                   (PROGN
+                     (|bootImport| (STRING |m|))
+                     (LIST (LIST 'IMPORT-MODULE (STRING |m|))))))
              (|ImportSignature|
                  (LET ((|x| (CAR |bfVar#17|))
                        (|sig| (CADR |bfVar#17|)))
@@ -721,7 +728,9 @@
                                   |export?|)))))))
              (|namespace|
                  (LET ((|n| (CAR |bfVar#17|)))
-                   (LIST (LIST 'IN-PACKAGE (STRING |n|)))))
+                   (PROGN
+                     (SETQ |$activeNamespace| (STRING |n|))
+                     (LIST (LIST 'IN-PACKAGE (STRING |n|))))))
              (T (LIST (|translateToplevelExpression| |b|))))))))))
 
 (DEFUN |bpOutItem| ()
@@ -1343,7 +1352,6 @@
 
 (DEFUN |getIntermediateLispFile| (|file| |options|)
   (PROG (|out|)
-    (DECLARE (SPECIAL |$effectiveFaslType|))
     (RETURN
       (PROGN
         (SETQ |out| (NAMESTRING (|getOutputPathname| |options|)))
@@ -1401,7 +1409,6 @@
      (|coreError| "don't know how to load a dynamically linked module"))))
 
 (DEFUN |loadSystemRuntimeCore| ()
-  (DECLARE (SPECIAL |$NativeModuleExt|))
   (COND
     ((OR (|%hasFeature| :ECL) (|%hasFeature| :GCL)) NIL)
     ('T
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 70c5da4e..083c374f 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -91,11 +91,14 @@ shoeCOMPILE_-FILE lspFileName ==
 
  
 BOOTTOCL(fn, out) ==
-  callingPackage := _*PACKAGE_*
-  IN_-PACKAGE '"BOOTTRAN"
-  result := BOOTTOCLLINES(nil,fn, out)
-  setCurrentPackage callingPackage
-  result
+  UNWIND_-PROTECT(
+    PROGN(startCompileDuration(),
+      callingPackage := _*PACKAGE_*,
+      IN_-PACKAGE '"BOOTTRAN",
+      result := BOOTTOCLLINES(nil,fn, out),
+      setCurrentPackage callingPackage,
+      result),
+    endCompileDuration())
  
 ++ (bootclam "filename") translates the file "filename.boot" to
 ++ the common lisp file "filename.clisp" , producing, for each function
@@ -126,11 +129,14 @@ shoeClLines(a,fn,lines,outfn)==
 ++ the common lisp file "filename.clisp" with the original boot
 ++ code as comments
 BOOTTOCLC(fn, out)==
-  callingPackage := _*PACKAGE_*
-  IN_-PACKAGE '"BOOTTRAN"
-  result := BOOTTOCLCLINES(nil, fn, out)
-  setCurrentPackage callingPackage
-  result
+  UNWIND_-PROTECT(
+    PROGN(startCompileDuration(),
+      callingPackage := _*PACKAGE_*,
+      IN_-PACKAGE '"BOOTTRAN",
+      result := BOOTTOCLCLINES(nil, fn, out),
+      setCurrentPackage callingPackage,
+      result),
+    endCompileDuration())
  
 BOOTTOCLCLINES(lines, fn, outfn)==
   infn:=shoeAddbootIfNec fn
@@ -421,6 +427,7 @@ translateToplevel(b,export?) ==
         :[first translateToplevel(d,true) for d in ds]]
 
     Import(m) => 
+      bootImport STRING m
       [["IMPORT-MODULE", STRING m]]
 
     ImportSignature(x, sig) =>
@@ -445,6 +452,7 @@ translateToplevel(b,export?) ==
       [maybeExportDecl(["DEFPARAMETER",lhs,rhs],export?)]
 
     namespace(n) =>
+      $activeNamespace := STRING n
       [["IN-PACKAGE",STRING n]]
 
     otherwise =>