aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--Makefile.am5
-rw-r--r--Makefile.in5
-rw-r--r--src/ChangeLog16
-rw-r--r--src/algebra/Makefile.in2
-rw-r--r--src/interp/br-con.boot3
-rw-r--r--src/interp/br-saturn.boot2
-rw-r--r--src/interp/br-util.boot9
-rw-r--r--src/interp/daase.lisp114
-rw-r--r--src/interp/database.boot15
-rw-r--r--src/interp/g-cndata.boot8
-rw-r--r--src/interp/spad-parser.boot9
-rw-r--r--src/interp/sys-driver.boot12
13 files changed, 135 insertions, 70 deletions
diff --git a/ChangeLog b/ChangeLog
index 5f9dca70..5a9355a3 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2011-08-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * Makefile.am (OA_SRC_TARGETS): Include all-algstrap
+ (all-algstrap): Require all-interpsys, and all-gcl if building GCL.
+
2011-07-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
* OpenAxiom-1.4.1 released.
diff --git a/Makefile.am b/Makefile.am
index 191f6deb..d20715f3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -55,6 +55,7 @@ OA_SRC_TARGETS = \
all-local \
all-src \
all-algebra \
+ all-algstrap \
all-asq \
all-axiomsys \
all-boot \
@@ -77,7 +78,7 @@ OA_SRC_TARGETS = \
if OA_BUILD_GCL
all-recursive all-boot all-lisp all-interpsys all-axiomsys \
- all-algebra all-input all-src all-local: all-gcl
+ all-algebra all-algstrap all-input all-src all-local: all-gcl
endif
all: all-local
@@ -85,7 +86,7 @@ $(OA_SRC_TARGETS):
cd src && $(MAKE) $@
.PHONY: all-algstrap
-all-algstrap:
+all-algstrap: all-interpsys
cd src/algebra && $(MAKE) $@
.PHONY: all-gcl
diff --git a/Makefile.in b/Makefile.in
index bec203ff..4a9dbc40 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -360,6 +360,7 @@ OA_SRC_TARGETS = \
all-local \
all-src \
all-algebra \
+ all-algstrap \
all-asq \
all-axiomsys \
all-boot \
@@ -915,14 +916,14 @@ uninstall-am:
.PHONY: $(OA_SRC_TARGETS)
@OA_BUILD_GCL_TRUE@all-recursive all-boot all-lisp all-interpsys all-axiomsys \
-@OA_BUILD_GCL_TRUE@ all-algebra all-input all-src all-local: all-gcl
+@OA_BUILD_GCL_TRUE@ all-algebra all-algstrap all-input all-src all-local: all-gcl
all: all-local
$(OA_SRC_TARGETS):
cd src && $(MAKE) $@
.PHONY: all-algstrap
-all-algstrap:
+all-algstrap: all-interpsys
cd src/algebra && $(MAKE) $@
.PHONY: all-gcl
diff --git a/src/ChangeLog b/src/ChangeLog
index 92b7bfee..ac934e10 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,19 @@
+2011-08-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/sys-driver.boot (initializeDatabases): New.
+ (initializeGlobalState): Use it.
+ * interp/spad-parser.boot (parseSpadFile): Tidy.
+ * interp/g-cndata.boot (installConstructor): Exit early it global
+ table not initialized.
+ * interp/database.boot (makeInitialDB): New.
+ (populateDBFromFile): Likewise.
+ * interp/daase.lisp: Introduce more DB accessors.
+ * interp/br-util.boot (dbSourceFile): Remove.
+ * interp/br-con.boot (kdPageInfo): Use
+ getConstructorSourceFileFromDB instead of dbSourceFile.
+ (kPage): Likewise.
+ * algebra/Makefile.in (SPADFILES): Include domain.spad
+
2011-08-22 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/sys-driver.boot (initializeGlobalState): Construct
diff --git a/src/algebra/Makefile.in b/src/algebra/Makefile.in
index a24f4218..15966c3f 100644
--- a/src/algebra/Makefile.in
+++ b/src/algebra/Makefile.in
@@ -542,7 +542,7 @@ SPADFILES= \
${OUTSRC}/annacat.spad ${OUTSRC}/any.spad ${OUTSRC}/array1.spad \
${OUTSRC}/array2.spad ${OUTSRC}/asp.spad ${OUTSRC}/attreg.spad \
${OUTSRC}/bags.spad ${OUTSRC}/bezout.spad ${OUTSRC}/boolean.spad \
- ${OUTSRC}/brill.spad \
+ ${OUTSRC}/brill.spad ${OUTSRC}/domain.spad \
${OUTSRC}/c02.spad ${OUTSRC}/c05.spad ${OUTSRC}/c06.spad \
${OUTSRC}/card.spad ${OUTSRC}/carten.spad ${OUTSRC}/catdef.spad \
${OUTSRC}/cden.spad ${OUTSRC}/clifford.spad ${OUTSRC}/clip.spad \
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index f2b87dd3..2b8f5cd9 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -116,7 +116,6 @@ kdPageInfo(name,abbrev,nargs,conform,signature,file?) ==
htSayStandard '"\indentrel{-2}"
if isDefautPackageName makeSymbol name then
name := subSequence(name, 0, #name-1)
---sourceFileName := dbSourceFile makeSymbol name
sourceFileName := getConstructorSourceFileFromDB makeSymbol name
filename := extractFileNameFromPath sourceFileName
if filename ~= '"" then
@@ -692,7 +691,7 @@ conOpPage1(conform,:options) ==
conform := mkConform(kind,name,args)
capitalKind := capitalize kind
signature := ncParseFromString sig
- sourceFileName := dbSourceFile makeSymbol name
+ sourceFileName := getContructorSourceFileFromDB makeSymbol name
emString := ['"{\sf ",constring,'"}"]
heading := [capitalKind,'" ",:emString]
if not isExposedConstructor conname then heading := ['"Unexposed ",:heading]
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 1cfb4703..547b193c 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -626,7 +626,7 @@ kPage(line,:options) == --any cat, dom, package, default package
conname := opOf conform
capitalKind := capitalize kind
signature := ncParseFromString sig
- sourceFileName := dbSourceFile makeSymbol name
+ sourceFileName := getConstructorSourceFileFromDB makeSymbol name
constrings :=
KDR form => dbConformGenUnder form
[strconc(name,args)]
diff --git a/src/interp/br-util.boot b/src/interp/br-util.boot
index 873dfa56..7e8f6830 100644
--- a/src/interp/br-util.boot
+++ b/src/interp/br-util.boot
@@ -347,13 +347,6 @@ bcStarConform form ==
bcStar opOf form
bcConform form
-dbSourceFile name ==
- u:= getConstructorSourceFileFromDB name
- null u => '""
- n := PATHNAME_-NAME u
- t := PATHNAME_-TYPE u
- strconc(n,'".",t)
-
extractFileNameFromPath s == fn(s,0,#s) where
fn(s,i,m) ==
k := charPosition(char "/",s,i)
@@ -491,7 +484,7 @@ dbSayItems(countOrPrefix,singular,plural,:options) ==
if count ~= 0 then bcHt '":"
dbBasicConstructor? conname ==
- dbSourceFile conname in '("catdef" "coerce")
+ getConstructorSourceFileFromDB conname in '("catdef" "coerce")
nothingFoundPage(:options) ==
htInitPage('"Sorry, no match found",nil)
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 74b6ba9c..50b6b63e 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -232,6 +232,9 @@
(defmacro |dbAbbreviation| (db)
`(database-abbreviation ,db))
+(defmacro |dbConstructor| (db)
+ `(database-constructor ,db))
+
(defmacro |dbConstructorKind| (db)
`(database-constructorkind ,db))
@@ -241,12 +244,44 @@
(defmacro |dbOperations| (db)
`(database-operationalist ,db))
+(defmacro |dbModemaps| (db)
+ `(database-modemaps ,db))
+
(defmacro |dbConstructorModemap| (db)
`(database-constructormodemap ,db))
+(defmacro |dbDualSignature| (db)
+ `(database-cosig ,db))
+
(defmacro |dbSuperDomain| (db)
`(database-superdomain ,db))
+(defmacro |dbCategory| (db)
+ `(database-constructorcategory ,db))
+
+(defmacro |dbAncestors| (db)
+ `(database-ancestors ,db))
+
+(defmacro |dbDefaultDomain| (db)
+ `(database-defaultdomain ,db))
+
+(defmacro |dbAttributes| (db)
+ `(database-attributes ,db))
+
+(defmacro |dbPredicates| (db)
+ `(database-predicates ,db))
+
+(defmacro |dbSourceFile| (db)
+ `(database-sourcefile ,db))
+
+(defmacro |dbModule| (db)
+ `(database-object ,db))
+
+(defun |makeDB| (c)
+ (let ((db (make-database)))
+ (setf (|dbConstructor| db) c)
+ (setf (|constructorDB| c) db)))
+
; there are only a small number of domains that have default domains.
; rather than keep this slot in every domain we maintain a list here.
@@ -591,14 +626,14 @@
(setf (|constructorDB| (car item)) dbstruct)
(setf (|dbOperations| dbstruct) (second item))
(setf (|dbConstructorModemap| dbstruct) (third item))
- (setf (database-modemaps dbstruct) (fourth item))
- (setf (database-object dbstruct) (fifth item))
- (setf (database-constructorcategory dbstruct) (sixth item))
+ (setf (|dbModemaps| dbstruct) (fourth item))
+ (setf (|dbModule| dbstruct) (fifth item))
+ (setf (|dbCategory| dbstruct) (sixth item))
(setf (|dbAbbreviation| dbstruct) (seventh item))
(setf (get (seventh item) 'abbreviationfor) (first item)) ;invert
- (setf (database-cosig dbstruct) (eighth item))
+ (setf (|dbDualSignature| dbstruct) (eighth item))
(setf (|dbConstructorKind| dbstruct) (ninth item))
- (setf (database-ancestors dbstruct) (nth 10 item))
+ (setf (|dbAncestors| dbstruct) (nth 10 item))
(setf (|dbSuperDomain| dbstruct) (nth 11 item))
))
@@ -655,8 +690,8 @@
(setf (database-sourcefile dbstruct) (second item))
(setf (|dbConstructorForm| dbstruct) (third item))
(setf (database-documentation dbstruct) (fourth item))
- (setf (database-attributes dbstruct) (fifth item))
- (setf (database-predicates dbstruct) (sixth item))
+ (setf (|dbAttributes| dbstruct) (fifth item))
+ (setf (|dbPredicates| dbstruct) (sixth item))
(setf (database-parents dbstruct) (seventh item))))
(format t "~&")))
@@ -758,8 +793,7 @@
(let (struct)
(when (symbolp constructor)
(unless (setq struct (|constructorDB| constructor))
- (setq struct (make-database))
- (setf (|constructorDB| constructor) struct))
+ (setq struct (|makeDB| constructor)))
(case key
(abbreviation
(setf (|dbAbbreviation| struct) value)
@@ -798,7 +832,7 @@
(cosig
(setq stream *interp-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-cosig struct))))
+ (setq data (|dbDualSignature| struct))))
(operation
(setq stream *operation-stream*)
(setq data (gethash constructor *operation-hash*)))
@@ -809,7 +843,7 @@
(constructorcategory
(setq stream *interp-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-constructorcategory struct))
+ (setq data (|dbCategory| struct))
(when (null data) ;domain or package then subfield of constructormodemap
(setq data (cadar (|getConstructorModemap| constructor))))))
(operationalist
@@ -819,7 +853,7 @@
(modemaps
(setq stream *interp-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-modemaps struct))))
+ (setq data (|dbModemaps| struct))))
(hascategory
(setq table *hasCategory-hash*)
(setq stream *category-stream*)
@@ -827,7 +861,7 @@
(object
(setq stream *interp-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-object struct))))
+ (setq data (|dbModule| struct))))
(constructor?
(|fatalError| "GETDATABASE called with CONSTRUCTOR?"))
(superdomain
@@ -841,7 +875,7 @@
(ancestors
(setq stream *interp-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-ancestors struct))))
+ (setq data (|dbAncestors| struct))))
(sourcefile
(setq stream *browse-stream*)
(when (setq struct (|constructorDB| constructor))
@@ -855,11 +889,11 @@
(attributes
(setq stream *browse-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-attributes struct))))
+ (setq data (|dbAttributes| struct))))
(predicates
(setq stream *browse-stream*)
(when (setq struct (|constructorDB| constructor))
- (setq data (database-predicates struct))))
+ (setq data (|dbPredicates| struct))))
(documentation
(setq stream *browse-stream*)
(when (setq struct (|constructorDB| constructor))
@@ -896,29 +930,29 @@
(constructorkind
(setf (|dbConstructorKind| struct) data))
(cosig
- (setf (database-cosig struct) data))
+ (setf (|dbDualSignature| struct) data))
(constructormodemap
(setf (|dbConstructorModemap| struct) data))
(constructorcategory
- (setf (database-constructorcategory struct) data))
+ (setf (|dbCategory| struct) data))
(operationalist
(setf (|dbOperations| struct) data))
(modemaps
- (setf (database-modemaps struct) data))
+ (setf (|dbModemaps| struct) data))
(object
- (setf (database-object struct) data))
+ (setf (|dbModule| struct) data))
(abbreviation
(setf (|dbAbbreviation| struct) data))
(constructor
- (setf (database-constructor struct) data))
+ (setf (|dbConstructor| struct) data))
(ancestors
- (setf (database-ancestors struct) data))
+ (setf (|dbAncestors| struct) data))
(constructorform
(setf (|dbConstructorForm| struct) data))
(attributes
- (setf (database-attributes struct) data))
+ (setf (|dbAttributes| struct) data))
(predicates
- (setf (database-predicates struct) data))
+ (setf (|dbPredicates| struct) data))
(documentation
(setf (database-documentation struct) data))
(parents
@@ -1050,7 +1084,7 @@
(setf (|constructorDB| key) dbstruct) ; store the struct, side-effect it...
(setf (|dbConstructorForm| dbstruct) constructorform)
(setq *allOperations* nil) ; force this to recompute
- (setf (database-object dbstruct) object)
+ (setf (|dbModule| dbstruct) object)
(setq abbrev
(intern (pathname-name (first (last (pathname-directory object))))))
(setf (|dbAbbreviation| dbstruct) abbrev)
@@ -1060,7 +1094,7 @@
(fetchdata alist in "operationAlist"))
(setf (|dbConstructorModemap| dbstruct)
(fetchdata alist in "constructorModemap"))
- (setf (database-modemaps dbstruct)
+ (setf (|dbModemaps| dbstruct)
(fetchdata alist in "modemaps"))
(setf (database-sourcefile dbstruct)
(fetchdata alist in "sourceFile"))
@@ -1069,20 +1103,20 @@
(file-namestring (database-sourcefile dbstruct))))
(setf (|dbConstructorKind| dbstruct)
(setq kind (fetchdata alist in "constructorKind")))
- (setf (database-constructorcategory dbstruct)
+ (setf (|dbCategory| dbstruct)
(fetchdata alist in "constructorCategory"))
(setf (database-documentation dbstruct)
(fetchdata alist in "documentation"))
- (setf (database-attributes dbstruct)
+ (setf (|dbAttributes| dbstruct)
(fetchdata alist in "attributes"))
- (setf (database-predicates dbstruct)
+ (setf (|dbPredicates| dbstruct)
(fetchdata alist in "predicates"))
(setf (|dbSuperDomain| dbstruct)
(fetchdata alist in "superDomain"))
(addoperations key oldmaps)
(unless make-database?
(if (eq kind '|category|)
- (setf (database-ancestors dbstruct)
+ (setf (|dbAncestors| dbstruct)
(|applySubst|
(|pairList| (cdr constructorform)
|$FormalMapVariableList|)
@@ -1092,7 +1126,7 @@
(|updateCategoryTable| key kind)
(if |$InteractiveMode|
(setq |$CategoryFrame| |$EmptyEnvironment|)))
- (setf (database-cosig dbstruct)
+ (setf (|dbDualSignature| dbstruct)
(cons nil (mapcar #'|categoryForm?|
(cddar (|dbConstructorModemap| dbstruct)))))
(remprop key 'loaded)
@@ -1192,7 +1226,7 @@
(dolist (con (|allConstructors|))
(let (dbstruct)
(when (setq dbstruct (|constructorDB| con))
- (setf (database-cosig dbstruct)
+ (setf (|dbDualSignature| dbstruct)
(cons nil (mapcar #'|categoryForm?|
(cddar (|dbConstructorModemap| dbstruct)))))
(when (and (|categoryForm?| con)
@@ -1200,7 +1234,7 @@
(setq d (caar d))
(when (= (length d) (length (|getConstructorForm| con)))
(format t " ~a has a default domain of ~a~%" con (car d))
- (setf (database-defaultdomain dbstruct) (car d)))))))
+ (setf (|dbDefaultDomain| dbstruct) (car d)))))))
; note: genCategoryTable creates *ancestors-hash*. write-interpdb
; does gethash calls into it rather than doing a getdatabase call.
(write-interpdb)
@@ -1296,9 +1330,9 @@
(print (squeeze (|dbConstructorModemap| struct)) out)
(finish-output out)
(setq modemapspos (file-position out))
- (print (squeeze (database-modemaps struct)) out)
+ (print (squeeze (|dbModemaps| struct)) out)
(finish-output out)
- (let ((entry (database-object struct)))
+ (let ((entry (|dbModule| struct)))
(cond ((consp entry)
(setq obj (cons (pathname-name (car entry))
(cdr entry))))
@@ -1306,7 +1340,7 @@
(setq obj (pathname-name
(first (last (pathname-directory entry))))))
(t (setq obj nil))))
- (setq concategory (squeeze (database-constructorcategory struct)))
+ (setq concategory (squeeze (|dbCategory| struct)))
(if concategory ; if category then write data else write nil
(progn
(setq categorypos (file-position out))
@@ -1314,9 +1348,9 @@
(finish-output out))
(setq categorypos nil))
(setq abbrev (|dbAbbreviation| struct))
- (setq cosig (database-cosig struct))
+ (setq cosig (|dbDualSignature| struct))
(setq kind (|dbConstructorKind| struct))
- (setq defaultdomain (database-defaultdomain struct))
+ (setq defaultdomain (|dbDefaultDomain| struct))
(setq ancestors (squeeze (gethash constructor *ancestors-hash*))) ;cattable.boot
(if ancestors
(progn
@@ -1364,10 +1398,10 @@
(print (database-documentation struct) out)
(finish-output out)
(setq attpos (file-position out))
- (print (squeeze (database-attributes struct)) out)
+ (print (squeeze (|dbAttributes| struct)) out)
(finish-output out)
(setq predpos (file-position out))
- (print (squeeze (database-predicates struct)) out)
+ (print (squeeze (|dbPredicates| struct)) out)
(finish-output out)
(push (list constructor src formpos docpos attpos predpos) master)))
(finish-output out)
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 58abfb6b..7f6849a3 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -782,3 +782,18 @@ squeezeAll: %List %Code -> %List %Code
squeezeAll x ==
[SQUEEZE t for t in x]
+makeInitialDB [form,kind,abbrev,srcfile] ==
+ db := makeDB form.op
+ dbConstructorForm(db) := form
+ dbConstructorKind(db) := kind
+ dbAbbreviation(db) := abbrev
+ property(abbrev,'ABBREVIATIONFOR) := form.op
+ dbSourceFile(db) := srcfile
+ setAutoLoadProperty form.op
+
+populateDBFromFile path ==
+ try
+ dbfile := inputTextFile path
+ while (entry := readExpr dbfile) ~= %nothing repeat
+ makeInitialDB entry
+ finally closeStream dbfile
diff --git a/src/interp/g-cndata.boot b/src/interp/g-cndata.boot
index 70f40c52..ccf402ce 100644
--- a/src/interp/g-cndata.boot
+++ b/src/interp/g-cndata.boot
@@ -41,6 +41,8 @@ namespace BOOT
--=======================================================================
-- Build Table of Lower Case Constructor Names
--=======================================================================
+$lowerCaseConTb := nil
+
mkLowerCaseConTable() ==
--Called at system build time by function BUILD-INTERPSYS (see util.lisp)
--Table is referenced by functions conPageFastPath and grepForAbbrev
@@ -119,11 +121,11 @@ abbQuery(x) ==
sayKeyedMsg("S2IZ0003",[x])
installConstructor(cname,type) ==
+ $lowerCaseConTb = nil => nil
(entry := getCDTEntry(cname,true)) => entry
item := [cname,getConstructorAbbreviationFromDB cname,nil]
- if $lowerCaseConTb then
- tableValue($lowerCaseConTb,cname) := item
- tableValue($lowerCaseConTb,DOWNCASE cname) := item
+ tableValue($lowerCaseConTb,cname) := item
+ tableValue($lowerCaseConTb,DOWNCASE cname) := item
constructorNameConflict(name,kind) ==
userError
diff --git a/src/interp/spad-parser.boot b/src/interp/spad-parser.boot
index 8c61cf97..eab3bbec 100644
--- a/src/interp/spad-parser.boot
+++ b/src/interp/spad-parser.boot
@@ -1,4 +1,4 @@
--- Copyright (C) 2007-2009, Gabriel Dos Reis.
+-- Copyright (C) 2007-2011, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -61,8 +61,7 @@ parseSpadFile sourceFile ==
-- we need to tell the post-parsing transformers that we're compiling
-- Spad because few parse forms have slightly different representations
-- depending on whether we are interpreter mode or compiler mode.
- savedInteractiveMode := $InteractiveMode
- $InteractiveMode := false
+ $InteractiveMode: local := false
INIT_-BOOT_/SPAD_-READER()
-- we need to restore the global input stream state after we
-- finished messing with it.
@@ -71,7 +70,6 @@ parseSpadFile sourceFile ==
-- If soureFile cannot be processed for whatever reasons
-- get out of here instead of being stuck later.
not (IN_-STREAM := MAKE_-INSTREAM sourceFile) =>
- $InteractiveMode := savedInteractiveMode
IN_-STREAM := savedInStream
systemError '"cannot open input source file"
INITIALIZE_-PREPARSE IN_-STREAM
@@ -81,13 +79,12 @@ parseSpadFile sourceFile ==
while not (_*EOF_* or FILE_-CLOSED) repeat
BOOT_-LINE_-STACK : local := PREPARSE IN_-STREAM
LINE : local := CDAR BOOT_-LINE_-STACK
- PARSE_-NewExpr()
+ CATCH('SPAD__READER,PARSE_-NewExpr())
asts := [parseTransform postTransform POP_-STACK_-1(), :asts]
-- clean up the mess, and get out of here
IOCLEAR(IN_-STREAM, OUT_-STREAM)
SHUT IN_-STREAM
IN_-STREAM := savedInStream
- $InteractiveMode := savedInteractiveMode
-- we accumulated the parse trees in reverse order
reverse! asts
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index f101bf6d..e2116f08 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -174,6 +174,12 @@ restart() ==
--%
+initializeDatabases firstTime? ==
+ initdb := getOptionValue "initial-db" => populateDBFromFile initdb
+ not firstTime? => openDatabases()
+ fillDatabasesInCore()
+ mkLowerCaseConTable()
+
++ Initialize all global states that need to. Sub-routine of the command
++ line compiler, the script executor, etc. Mess with care.
initializeGlobalState() ==
@@ -211,11 +217,7 @@ initializeGlobalState() ==
-- 3. Databases
if $verbose and $displayStartMsgs then
sayKeyedMsg("S2IZ0053",['"database"])
- if init? then
- fillDatabasesInCore()
- mkLowerCaseConTable()
- else
- openDatabases()
+ initializeDatabases init?
-- 4. Constructors
if $verbose and $displayStartMsgs then