diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/daase.lisp | 48 | ||||
| -rw-r--r-- | src/interp/database.boot | 12 | ||||
| -rw-r--r-- | src/interp/util.lisp | 1 |
3 files changed, 26 insertions, 35 deletions
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index d65a1812..b422cf01 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -332,6 +332,14 @@ (concatenate 'string (|systemRootDirectory|) "/compiler/bin/axiomxl") (list flags file))) + +(defun |closeAllDatabases| nil + (close *interp-stream*) + (close *operation-stream*) + (close *category-stream*) + (close *browse-stream*)) + + (defun resethashtables () "set all -hash* to clean values. used to clean up core before saving system" (setq *hascategory-hash* (make-hash-table :test #'equal)) @@ -350,10 +358,6 @@ (categoryopen) ;note: this depends on constructorform in browse.daase (unless (|getOptionValue| (|Option| "system-algebra") (|%systemOptions|)) (initial-getdatabase)) - (close *interp-stream*) - (close *operation-stream*) - (close *category-stream*) - (close *browse-stream*) #+:AKCL (gbc t) ) @@ -557,7 +561,7 @@ (defun interpOpen () "open the interpreter database and hash the keys" (let (constructors pos stamp dbstruct) - (setq *interp-stream* (open (DaaseName "interp.daase" nil))) + (setq *interp-stream* (open (|pathToDatabase| "interp.daase"))) (setq stamp (read *interp-stream*)) (unless (equal stamp *interp-stream-stamp*) (format t " Re-reading interp.daase") @@ -612,7 +616,7 @@ (defun browseOpen () "open the constructor database and hash the keys" (let (constructors pos stamp dbstruct) - (setq *browse-stream* (open (DaaseName "browse.daase" nil))) + (setq *browse-stream* (open (|pathToDatabase| "browse.daase"))) (setq stamp (read *browse-stream*)) (unless (equal stamp *browse-stream-stamp*) (format t " Re-reading browse.daase") @@ -641,7 +645,7 @@ (defun categoryOpen () "open category.daase and hash the keys" (let (pos keys stamp) - (setq *category-stream* (open (DaaseName "category.daase" nil))) + (setq *category-stream* (open (|pathToDatabase| "category.daase"))) (setq stamp (read *category-stream*)) (unless (equal stamp *category-stream-stamp*) (format t " Re-reading category.daase") @@ -658,7 +662,7 @@ (defun operationOpen () "read operation database and hash the keys" (let (operations pos stamp) - (setq *operation-stream* (open (DaaseName "operation.daase" nil))) + (setq *operation-stream* (open (|pathToDatabase| "operation.daase"))) (setq stamp (read *operation-stream*)) (unless (equal stamp *operation-stream-stamp*) (format t " Re-reading operation.daase") @@ -1339,36 +1343,10 @@ (rename-file "category.build" (final-name "category"))))) -(defun DaaseName (name erase?) - (let (daase filename) - (if (setq daase (|systemAlgebraDirectory|)) - (progn - (setq filename (concatenate 'string daase name)) - (format t " Using local database ~a.." filename)) - (setq filename (concatenate 'string - (|systemRootDirectory|) - "/algebra/" - name))) - (when erase? (|removeFile| filename)) - filename)) - -;; rewrite this so it works in mnt -;;(defun DaaseName (name erase?) -;; (let (daase filename) -;; (declare (special $spadroot)) -;; (if (setq daase (|systemDatabaseDirectory|)) -;; (progn -;; (setq filename (concatenate 'string daase "/algebra/" name)) -;; (format t " Using local database ~a.." filename)) -;; (setq filename (concatenate 'string $spadroot "/algebra/" name))) -;; (when erase? (|removeFile| filename)) -;; filename)) - - (defun compressOpen () (let (lst stamp pos) (setq *compress-stream* - (open (DaaseName "compress.daase" nil) :direction :input)) + (open (|pathToDatabase| "compress.daase") :direction :input)) (setq stamp (read *compress-stream*)) (unless (equal stamp *compress-stream-stamp*) (format t " Re-reading compress.daase") diff --git a/src/interp/database.boot b/src/interp/database.boot index 47cd3ec7..68300521 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -42,6 +42,18 @@ namespace BOOT $getUnexposedOperations := true $globalExposureGroupAlist := [] + +--% + +pathToDatabase name == + if dbdir := systemAlgebraDirectory() then + path := strconc(dbdir,name) + FORMAT(true,'" Using local database ~a..",path) + else + path := strconc(systemRootDirectory(),'"algebra/",name) + path + + --% getConstructorAbbreviationFromDB: %Symbol -> %Maybe %Symbol diff --git a/src/interp/util.lisp b/src/interp/util.lisp index 17e6c26c..d18e2d37 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -510,6 +510,7 @@ (|setBootAutloadProperties| asauto-functions asauto-files) (setf (symbol-function '|addConsDB|) #'identity) (resethashtables) ; the databases into core, then close the streams + (|closeAllDatabases|) ) |