aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ChangeLog16
-rw-r--r--src/algebra/Makefile.in12
-rw-r--r--src/interp/daase.lisp14
-rw-r--r--src/interp/define.boot6
-rw-r--r--src/interp/g-cndata.boot7
-rw-r--r--src/interp/lisplib.boot114
-rw-r--r--src/interp/sys-driver.boot7
-rw-r--r--src/interp/sys-globals.boot5
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.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 20:01:24 +0000