* interp/sys-driver.boot (initializeDatabases): Honor --initial-db.

	(initializeGlobalState): Don't bind $compileDefaultsOnly.
	* interp/sys-globals.boot ($compileDefaultsOnly): Remove.
	* interp/define.boot (compDefineCategory): Adjust.
	(compDefineCategory1): Likewise.
	(compDefineFunctor1): Clear dbCapsuleDefinitions.
	* interp/lisplib.boot (compDefineLisplib): Tidy.
	* interp/daase.lisp (BROWSEOPEN): Use dbSourceFile.
	(GETDATABASE): Likewise.
	(LOCALNRLIB): Likewise.
	(WRITE-BROWSEDB): Likewise.
	* algebra/Makefile.in (COMPILE_SPAD): Specifiy initial DB.
	(BOOTSTRAP): Likewise.

8 files changed, 100 insertions, 81 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 1b8b723a..8da85ba8 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,19 @@
+2011-11-13  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/sys-driver.boot (initializeDatabases): Honor --initial-db.
+	(initializeGlobalState): Don't bind $compileDefaultsOnly.
+	* interp/sys-globals.boot ($compileDefaultsOnly): Remove.
+	* interp/define.boot (compDefineCategory): Adjust.
+	(compDefineCategory1): Likewise.
+	(compDefineFunctor1): Clear dbCapsuleDefinitions.
+	* interp/lisplib.boot (compDefineLisplib): Tidy.
+	* interp/daase.lisp (BROWSEOPEN): Use dbSourceFile.
+	(GETDATABASE): Likewise.
+	(LOCALNRLIB): Likewise.
+	(WRITE-BROWSEDB): Likewise.
+	* algebra/Makefile.in (COMPILE_SPAD): Specifiy initial DB.
+	(BOOTSTRAP): Likewise.
+
 2011-11-12  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/br-data.boot (buildLibdbConEntry): Exit early if argument
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in
index 49f8eb56..73b5800a 100644
--- a/src/algebra/Makefile.in
+++ b/src/algebra/Makefile.in
@@ -83,13 +83,13 @@ DRIVER = ../driver/open-axiom$(EXEEXT)
 INTERPSYS = ../interp/interpsys$(EXEEXT)
 
 COMPILE_SPAD = $(DRIVER) --execpath=$(INTERPSYS) \
-		--system="$(AXIOM)" \
+		--system="$(AXIOM)" --initial-db=initdb.daase \
 		--sysdb="$(axiom_src_datadir)/algebra/" \
 		--strap=strap-2 --optimize=3 \
 		--system-algebra --compile $<
 
 BOOTSTRAP = $(DRIVER) --execpath=$(INTERPSYS) \
-		--system="$(AXIOM)" \
+		--system="$(AXIOM)" --initial-db=initdb.daase \
 		--sysdb="$(axiom_src_datadir)/algebra/" \
 		--system-algebra --compile
 
@@ -100,7 +100,6 @@ BOOTSTRAP = $(DRIVER) --execpath=$(INTERPSYS) \
 ## They are needed only for their being known as constructors.
 ## Consequently, the dependencies listed here are at the categories
 ## inheritance level; not necessarily at the use level.
-strap-0/TYPE.$(FASLEXT): initdb.daase
 strap-0/UTYPE.$(FASLEXT): strap-0/TYPE.$(FASLEXT)
 strap-0/BASTYPE.$(FASLEXT): strap-0/TYPE.$(FASLEXT)
 strap-0/KOERCE.$(FASLEXT): strap-0/TYPE.$(FASLEXT)
@@ -1103,6 +1102,7 @@ strap-2/BOOLEAN.$(FASLEXT): strap-2/PROPLOG.$(FASLEXT) \
 strap-0 strap-1 strap-2:
 	$(mkdir_p) $@
 
+.PRECIOUS: strap-0/%.$(FASLEXT)
 strap-0/%.$(FASLEXT): %.spad | strap-0
 	$(BOOTSTRAP) --sysalg=strap-0 --bootstrap $< \
 		&& cp $*.NRLIB/code.$(FASLEXT) $@ && \
@@ -1110,6 +1110,7 @@ strap-0/%.$(FASLEXT): %.spad | strap-0
 			cp $*.NRLIB/code.lsp strap-0/$*.lsp; fi && \
 		rm -rf $*.NRLIB
 
+.PRECIOUS: strap-1/%.$(FASLEXT)
 strap-1/%.$(FASLEXT): %.spad | strap-1
 	$(BOOTSTRAP) --strap=strap-0 --sysalg=strap-1 --optimize=3 $< && \
 		cp $*.NRLIB/code.$(FASLEXT) $@ && \
@@ -1119,7 +1120,8 @@ strap-1/%.$(FASLEXT): %.spad | strap-1
 			cp $*.NRLIB/code.lsp strap-1/$*.lsp; fi && \
 		rm -rf $*.NRLIB $*-.NRLIB
 
-strap-2/%.$(FASLEXT): %.spad | strap-2
+.PRECIOUS: strap-2/%.$(FASLEXT)
+strap-2/%.$(FASLEXT): %.spad initdb.daase | strap-2
 	$(BOOTSTRAP) --strap=strap-1 --sysalg=strap-2 --optimize=3 $< && \
 		cp $*.NRLIB/code.$(FASLEXT) $@ && \
 		if test -d $*-.NRLIB; then cp $*-.NRLIB/code.$(FASLEXT) \
@@ -2427,7 +2429,7 @@ initdb.daase: $(SPADFILES)
 mostlyclean-local:
 	@rm -f $(OUT)/*.$(FASLEXT) $(OUT)/*.daase
 	@rm -rf *.NRLIB
-	@rm -rf *.DAASE *.daase libdb.text initdb.*
+	@rm -rf *.DAASE *.daase libdb.text
 	@rm -rf strap*
 	@rm -f *stamp
 
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 8024a8fc..6d989a2c 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -528,7 +528,7 @@
 	  (warn "will create a new one~%")
 	  (setq dbstruct (|makeDB| (first item)))
 	  (setq *allconstructors* (adjoin item *allconstructors*)))
-	(setf (database-sourcefile dbstruct) (second item))
+	(setf (|dbSourceFile| dbstruct) (second item))
 	(setf (|dbConstructorForm| dbstruct) (third item))
 	(setf (database-documentation dbstruct) (fourth item))
 	(setf (|dbAttributes| dbstruct) (fifth item))
@@ -719,7 +719,7 @@
 	      (sourcefile
 	       (setq stream *browse-stream*)
 	       (when struct
-		 (setq data (database-sourcefile struct))))
+		 (setq data (|dbSourceFile| struct))))
 	      (constructorform
 	       (setq stream *browse-stream*)
 	       (when struct
@@ -791,7 +791,7 @@
 		(dependents
 		 (setf (database-dependents struct) data))
 		(sourcefile
-		 (setf (database-sourcefile struct) data))))
+		 (setf (|dbSourceFile| struct) data))))
 	(case key ; fixup the special cases
 	      (sourcefile
 	       (when (and data (string= (directory-namestring data) "")
@@ -922,11 +922,11 @@
 			   (fetchdata alist in "constructorModemap"))
 		     (setf (|dbModemaps| dbstruct) 
 			   (fetchdata alist in "modemaps"))
-		     (setf (database-sourcefile dbstruct) 
+		     (setf (|dbSourceFile| dbstruct) 
 			   (fetchdata alist in "sourceFile"))
 		     (when make-database?
-		       (setf (database-sourcefile dbstruct)
-			     (file-namestring  (database-sourcefile dbstruct))))
+		       (setf (|dbSourceFile| dbstruct)
+			     (file-namestring  (|dbSourceFile| dbstruct))))
 		     (setf (|dbConstructorKind| dbstruct)
 			   (setq kind (fetchdata alist in "constructorKind")))
 		     (setf (|dbCategory| dbstruct)
@@ -1222,7 +1222,7 @@
    (let (struct)
     (setq struct (|constructorDB| constructor))
      ; sourcefile is small. store the string directly
-    (setq src (database-sourcefile struct))
+    (setq src (|dbSourceFile| struct))
     (setq formpos (file-position out))
     (print (|squeezeCopy| (|dbConstructorForm| struct)) out)
     (finish-output out)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 5e46a464..719f81e8 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -945,8 +945,6 @@ compDefineCategory1(df is ['DEF,form,sig,body],m,e,prefix,fal) ==
     T := compDefine1(mkCategoryPackage(form,cat,categoryCapsule),$EmptyMode,e)
            or return stackSemanticError(
                         ['"cannot compile defaults of",:bright opOf form],nil)
-    if $compileDefaultsOnly then 
-      [d,m,e] := T
   [d,m,e]
 
 makeCategoryPredicates(form,u) ==
@@ -1144,8 +1142,7 @@ compDefineCategory(df,m,e,prefix,fal) ==
   kind := dbConstructorKind db
   kind ~= "category" => throwKeyedMsg("S2IC0016",[ctor,"category",kind])
   dbConstructorForm(db) := lhs
-  $insideFunctorIfTrue or $compileDefaultsOnly =>
-    compDefineCategory1(df,m,e,prefix,fal)
+  $insideFunctorIfTrue => compDefineCategory1(df,m,e,prefix,fal)
   compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
 
 
@@ -1390,6 +1387,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],
     dbFormalSubst(db) := pairList(form.args,$FormalMapVariableList)
     dbTemplate(db) := nil
     dbLookupFunction(db) := nil
+    dbCapsuleDefinitions(db) := nil
     deduceImplicitParameters(db,$e)
     $formalArgList:= [:argl,:$formalArgList]
     -- all defaulting packages should have caching turned off
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index ccf402ce..f1f98eb5 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -84,18 +84,17 @@ constructor? name ==
  
 domainForm?: %Form -> %Boolean
 domainForm? d ==
-  getConstructorKindFromDB opOf d = "domain"
+  getConstructorKindFromDB opOf d is "domain"
 
 packageForm?: %Form -> %Boolean
 packageForm? d ==
-  getConstructorKindFromDB opOf d = "package"
+  getConstructorKindFromDB opOf d is "package"
 
 categoryFrom?: %Form -> %Boolean
 categoryForm? c ==
   op := opOf c
   builtinCategoryName? op => true
-  getConstructorKindFromDB op is "category" => true
-  false
+  getConstructorKindFromDB op is "category"
 
 -- probably will switch over to 'libName soon
 getLisplibName(c) == getConstructorAbbreviation(c)
diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot
index 49fa50cf..32e00181 100644
--- a/src/interp/lisplib.boot
+++ b/src/interp/lisplib.boot
@@ -410,29 +410,28 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   --fn= compDefineCategory1 OR compDefineFunctor1
   sayMSG fillerSpaces(72,char "-")
   $op: local := op
-  dbPredicates(constructorDB op) := nil
+  db := constructorDB op
+  dbPredicates(db) := nil
   $lisplibOperationAlist: local := nil
   $libFile: local := nil
---  $lisplibRelatedDomains: local := nil   --from ++ Related Domains: see c-doc
   --for categories, is rhs of definition; otherwise, is target of functor
   --will eventually become the "constructorCategory" property in lisplib
   --set in compDefineCategory1 if category, otherwise in finalizeLisplib
-  libName := getConstructorAbbreviation op
+  libName := dbAbbreviation db
+  if dbSourceFile db = nil then
+    dbSourceFile(db) := namestring _/EDITFILE
   $compileDocumentation => compileDocumentation(op,libName)
   sayMSG ['"   initializing ",$spadLibFT,:bright libName,
     '"for",:bright op]
   initializeLisplib libName
   sayMSG ['"   compiling into ",$spadLibFT,:bright libName]
-  -- res:= FUNCALL(fn,df,m,e,prefix,fal)
-  -- sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
-  -- finalizeLisplib libName
   -- following guarantee's compiler output files get closed.
   ok := false;
   try
     res:= FUNCALL(fn,df,m,e,prefix,fal)
-    leaveIfErrors(libName,dbConstructorKind constructorDB $op)
+    leaveIfErrors(libName,dbConstructorKind db)
     sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
-    ok := finalizeLisplib(op,libName)
+    ok := finalizeLisplib(db,libName)
   finally RSHUT $libFile
   if ok then lisplibDoRename(libName)
   filearg := $FILEP(libName,$spadLibFT,$libraryDirectory)
@@ -441,7 +440,7 @@ compDefineLisplib(df:=["DEF",[op,:.],:.],m,e,prefix,fal,fn) ==
   sayMSG fillerSpaces(72,char "-")
   unloadOneConstructor op
   $buildingSystemAlgebra => res
-  LOCALDATABASE([symbolName getConstructorAbbreviationFromDB op],nil)
+  LOCALDATABASE([symbolName dbAbbreviation db],nil)
   $newConlist := [op, :$newConlist]  ---------->  bound in function "compiler"
   res
  
@@ -487,46 +486,54 @@ writeLookupFunction(db,file) ==
       'lookupFunction,'dbLookupFunction,file)
   nil
 
-writeKind(ctor,kind,file) ==
-  writeInfo(ctor,kind,'constructorKind,'dbConstructorKind,file)
+writeKind(db,file) ==
+  writeInfo(dbConstructor db,dbConstructorKind db,
+    'constructorKind,'dbConstructorKind,file)
 
 writeAbbreviation(db,file) ==
   writeInfo(dbConstructor db,dbAbbreviation db,
     'abbreviation,'dbAbbreviation,file)
 
-writeConstructorForm(ctor,form,file) ==
-  writeInfo(ctor,form,'constructorForm,'dbConstructorForm,file)
+writeConstructorForm(db,file) ==
+  writeInfo(dbConstructor db,dbConstructorForm db,
+    'constructorForm,'dbConstructorForm,file)
 
-writeCategory(ctor,cat,file) ==
-  writeInfo(ctor,cat,'constructorCategory,'dbCategory,file)
+writeCategory(db,file) ==
+  writeInfo(dbConstructor db,dbCategory db,
+    'constructorCategory,'dbCategory,file)
 
-writeSuperDomain(ctor,domPred,file) ==
-  writeInfo(ctor,domPred,'superDomain,'dbSuperDomain,file)
+writeSuperDomain(db,file) ==
+  writeInfo(dbConstructor db,dbSuperDomain db,
+    'superDomain,'dbSuperDomain,file)
 
-writePredicates(ctor,preds,file) ==
-  writeInfo(ctor,preds,'predicates,'dbPredicates,file)
+writePredicates(db,file) ==
+  writeInfo(dbConstructor db,dbPredicates db,
+    'predicates,'dbPredicates,file)
 
 writeOperations(ctor,ops,file) ==
   writeInfo(ctor,ops,'operationAlist,'dbOperations,file)
 
-writeAttributes(ctor,ats,file) ==
- writeInfo(ctor,ats,'attributes,'dbAttributes,file)
+writeAttributes(db,file) ==
+ writeInfo(dbConstructor db,dbAttributes db,
+   'attributes,'dbAttributes,file)
 
-writeConstructorModemap(ctor,mm,file) ==
-  writeInfo(ctor,mm,'constructorModemap,'dbConstructorModemap,file)
+writeConstructorModemap(db,file) ==
+  writeInfo(dbConstructor db,dbConstructorModemap db,
+    'constructorModemap,'dbConstructorModemap,file)
 
 writeDualSignature(db,file) ==
   writeInfo(dbConstructor db,dbDualSignature db,
     'dualSignature,'dbDualSignature,file)
 
-writeAncestors(ctor,x,file) ==
-  writeInfo(ctor,x,'ancestors,'dbAncestors,file)
+writeAncestors(db,file) ==
+  writeInfo(dbConstructor db,dbAncestors db,'ancestors,'dbAncestors,file)
 
-writePrincipals(ctor,x,file) ==
-  writeInfo(ctor,x,'parents,'dbPrincipals,file)
+writePrincipals(db,file) ==
+  writeInfo(dbConstructor db,dbPrincipals db,'parents,'dbPrincipals,file)
 
-writeCapsuleLevelDefinitions(ctor,x,file) ==
-  writeInfo(ctor,x,'signaturesAndLocals,'dbCapsuleDefinitions,file)
+writeCapsuleLevelDefinitions(db,file) ==
+  writeInfo(dbConstructor db,dbCapsuleDefinitions db,
+    'signaturesAndLocals,'dbCapsuleDefinitions,file)
 
 ++ If compilation produces an error, issue inform user and
 ++ return to toplevel reader.
@@ -537,41 +544,39 @@ leaveIfErrors(libName,kind) ==
     spadThrow()
 
 ++ Finalize `libName' compilation; returns true if everything is OK.
-finalizeLisplib(ctor,libName) ==
-  db := constructorDB ctor
-  kind := dbConstructorKind db
+finalizeLisplib(db,libName) ==
   form := dbConstructorForm db
-  mm := getConstructorModemap ctor
   writeTemplate(db,$libFile)
   writeLookupFunction(db,$libFile)
-  writeConstructorForm(ctor,form,$libFile)
-  writeKind(ctor,kind,$libFile)
-  writeConstructorModemap(ctor,mm,$libFile)
+  writeConstructorForm(db,$libFile)
+  writeKind(db,$libFile)
+  writeConstructorModemap(db,$libFile)
   writeDualSignature(db,$libFile)
-  -- set to target of mm for package/domain constructors;
+  -- set to target of dbConstructorModemap for package/domain constructors;
   -- to the right-hand sides (the definition) for category constructors
   if dbConstructorKind db = 'category then
-    writeCategory(ctor,dbCategory db,$libFile)
-  lisplibWrite('"sourceFile",namestring _/EDITFILE,$libFile)
+    writeCategory(db,$libFile)
+  lisplibWrite('"sourceFile",dbSourceFile db,$libFile)
   lisplibWrite('"modemaps",dbModemaps db,$libFile)
   opsAndAtts :=
-    kind = 'category => getCategoryOpsAndAtts form
-    getFunctorOpsAndAtts(form,mm.mmTarget)
-  writeOperations(ctor,first opsAndAtts,$libFile)
-  if kind='category then
+    dbConstructorKind db = 'category => getCategoryOpsAndAtts db
+    getFunctorOpsAndAtts db
+  writeOperations(dbConstructor db,first opsAndAtts,$libFile)
+  if dbConstructorKind db = 'category then
      $NRTslot1PredicateList : local := []
      NRTgenInitialAttributeAlist(db,rest opsAndAtts)
-  writeSuperDomain(ctor,dbSuperDomain db,$libFile)
-  writeCapsuleLevelDefinitions(ctor,dbCapsuleDefinitions db,$libFile)
-  writeAttributes(ctor,dbAttributes db,$libFile)
-  writePredicates(ctor,dbPredicates db,$libFile)
+  writeSuperDomain(db,$libFile)
+  writeCapsuleLevelDefinitions(db,$libFile)
+  writeAttributes(db,$libFile)
+  writePredicates(db,$libFile)
   writeAbbreviation(db,$libFile)
-  writePrincipals(ctor,dbPrincipals db,$libFile)
-  writeAncestors(ctor,dbAncestors db,$libFile)
+  writePrincipals(db,$libFile)
+  writeAncestors(db,$libFile)
   if not $bootStrapMode then
-    lisplibWrite('"documentation",finalizeDocumentation ctor,$libFile)
+    lisplibWrite('"documentation",
+      finalizeDocumentation dbConstructor db,$libFile)
   if $profileCompiler then profileWrite()
-  leaveIfErrors(libName,kind)
+  leaveIfErrors(libName,dbConstructorKind db)
   true
 
 lisplibDoRename(libName) ==
@@ -590,14 +595,15 @@ getPartialConstructorModemapSig(c) ==
   (s := getConstructorSignature c) => rest s
   throwEvalTypeMsg("S2IL0015",[c])
  
-getCategoryOpsAndAtts(catForm) ==
+getCategoryOpsAndAtts db ==
+  catForm := dbConstructorForm db
   -- returns [operations,:attributes] of first catForm
   [transformOperationAlist getSlotFromCategoryForm(catForm,1),
     :getSlotFromCategoryForm(catForm,2)]
  
-getFunctorOpsAndAtts(form,target) ==
+getFunctorOpsAndAtts db ==
   [transformOperationAlist $lisplibOperationAlist,
-    :getSlotFromFunctor target]
+    :getSlotFromFunctor dbConstructorModemap(db).mmTarget]
  
 getSlotFromFunctor(target) ==
   t := compMakeCategoryObject(target,$e) or
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 1a097549..b19aa5cf 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -176,7 +176,11 @@ restart() ==
 
 initializeDatabases firstTime? ==
   getOptionValue "build-initdb" => nil
-  initdb := getOptionValue "initial-db" => populateDBFromFile initdb
+  --initdb := getOptionValue "initial-db" => populateDBFromFile initdb
+  --FIXME: Ideally we should execute the previous line.  The next line is
+  --FIXME: a short-term stopgap until build dependencies are in place.
+  if initdb := getOptionValue "initial-db" then
+    populateDBFromFile initdb
   not firstTime? => openDatabases()
   fillDatabasesInCore()
   mkLowerCaseConTable()
@@ -196,7 +200,6 @@ initializeGlobalState() ==
   $buildingSystemAlgebra := getOptionValue "system-algebra"
   $verbose := getOptionValue "verbose"
   $bootStrapMode := getOptionValue "bootstrap"
-  $compileDefaultsOnly := getOptionValue "defaults-only"
   $reportOptimization := getOptionValue "show-insn"
   $optimizeRep := getOptionValue "inline-rep"
   setCompilerOptimizations(getOptionValue "optimize" or
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 86fcf9cf..5304caea 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -428,11 +428,6 @@ $buildingSystemAlgebra := false
 ++ code generation, etc.
 $verbose := true
 
-++ True if the compiler is invoked to produce implementation
-++ of category defaults only.  This is meaningful only when
-++ compiling categories.
-$compileDefaultsOnly := false
-
 ++ True if we should consider the representation domain (`Rep')
 ++ as candidate for inlining, for the purpose of reducing
 ++ abstraction penalty.