massive reorganization

library/DATABASEFNS

@@ -0,0 +1,187 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
+
(FILECREATED " 3-May-93 18:44:36" "{DSK}<project>lfg>parser>DATABASEFNS.;4"
 17283  
+
+      changes to%:  (FNS DUMPDB)
+
+      previous date%: " 7-Jul-92 09:57:14" "{DSK}<project>lfg>parser>DATABASEFNS.;3")
+
+
+(* ; "
+Copyright (c) 1986, 1990, 1991, 1992, 1993 by Xerox Corporation.  All rights reserved.
+")
+
+(PRETTYCOMPRINT DATABASEFNSCOMS)
+
+(RPAQQ DATABASEFNSCOMS

+       [(* Does automatic Masterscope database maintenance)
+        [DECLARE%: FIRST (P (VIRGINFN 'LOAD T)
+                            (MOVD? 'LOAD 'OLDLOAD)
+                            (VIRGINFN 'LOADFROM T)
+                            (MOVD? 'LOADFROM 'OLDLOADFROM)
+                            (VIRGINFN 'MAKEFILE T)
+                            (MOVD? 'MAKEFILE 'OLDMAKEFILE]
+        (FNS DBFILE DBFILE1 DBFILE2 LOAD LOADFROM MAKEFILE)
+        (ADDVARS (LINKEDFNS OLDLOAD))
+        (P (RELINK 'MAKEFILES))
+        (FNS DUMPDB LOADDB MAKEDB)
+        (PROP PROPTYPE DATABASE)
+        (INITVARS (LOADDBFLG 'ASK)
+               (SAVEDBFLG 'ASK))
+        (ADDVARS (MAKEFILEFORMS (MAKEDB FILE)))
+        (* To permit MSHASH interface)
+        (INITVARS (MSHASHFILENAME)
+               (MSFILETABLE))
+        (LOCALVARS . T)
+        (BLOCKS (LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T)))
+        (DECLARE%: EVAL@COMPILE DONTCOPY (P (RESETSAVE DWIMIFYCOMPFLG T])
+
+
+
+(* Does automatic Masterscope database maintenance)

+
+(DECLARE%: FIRST 
+
+(VIRGINFN 'LOAD T)
+
+(MOVD? 'LOAD 'OLDLOAD)
+
+(VIRGINFN 'LOADFROM T)
+
+(MOVD? 'LOADFROM 'OLDLOADFROM)
+
+(VIRGINFN 'MAKEFILE T)
+
+(MOVD? 'MAKEFILE 'OLDMAKEFILE)
+)
+(DEFINEQ
+
+(DBFILE

+  [LAMBDA (FILE ASKFLAG)
                                     (* lmm "29-APR-81 20:27")

+          
+          (* Finds a database file that corresponds to the contents of FILE.
+
          Looks in directory of FILE, and also in the directory that file originally came 
+
          from, if it was copied. Returns NIL if no database file is found, else
+
          (fulldbfilename . filedates)%, where filedates identifies the name under which 
+
          the file that the database corresponds to is currently known.
+
          -
+
          If FILE doesn't have a version, tries to get database for version in core, or 
+
          most recent version if it hasn't been loaded)

+
+    (DECLARE
 (GLOBALVARS COMPILE.EXT FILERDTBL))
+    [COND
+       ((NULL FILE)
+        (SETQ FILE (INPUT)))
+       ((EQ (FILENAMEFIELD FILE 'EXTENSION)
+            COMPILE.EXT)                                     (* Map compiled file into symbolic 
+
                                                             name)

+        (SETQ FILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY FILE]
+    (PROG [(FILEDATES (COND
+                         [(AND (NULL (FILENAMEFIELD FILE 'VERSION))
+                               (CAR (GETPROP (NAMEFIELD FILE)
+                                           'FILEDATES]
+                         ([SETQ FILE (COND
+                                        (ASKFLAG (INFILEP FILE))
+                                        (T (FINDFILE FILE]
+                          (CONS (FILEDATE FILE)
+                                FILE]
+          (AND FILEDATES (RETURN (DBFILE1
 FILE FILEDATES])
+
+(DBFILE1

+  [LAMBDA (F FILEDATES)
                                      (* jds "25-Sep-86 20:04")

+          
+          (* Searches databases based on F to find one that matches FILEDATES.
+
          Returns (dbfilename . filedates) if successful.
+
          For efficiency, checks the most likely highest version first, before doing the 
+
          directory enumeration)

+
+    (PROG ((HIGHEST (INFILEP (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION 'NIL 'BODY F)))
+           DBF)
+          (RETURN (COND
+                     ((NULL HIGHEST)                         (* ; 
+
                                                         "No file matches the name we gave, so punt.")

+                      NIL)
+                     ((SETQ DBF (DBFILE2
 HIGHEST FILEDATES)) (* ; "The most recent one matches.")

+                      (CONS DBF FILEDATES))
+                     (T                                      (* ; 
+
                                           "Hunt back thru back versions looking for a matching one.")

+                        (for
 DBF in
 (REMOVE HIGHEST (FILDIR (PACKFILENAME 'EXTENSION 'DATABASE
+                                                                   'VERSION
+                                                                   '*
+                                                                   'BODY F)))
+                           when
 (SETQ DBF (DBFILE2
 DBF FILEDATES))
+                           do
 (RETURN (CONS DBF FILEDATES])
+
+(DBFILE2

+  [LAMBDA (DBF FILEDATES)
                                (* ; "Edited 28-Nov-90 12:42 by rmk:")

+                                                             (* T if DBF is the name of the 
+
                                                           database file matching FILEDATES)

+    [RESETSAVE (SETQ DBF (OPENSTREAM DBF 'INPUT))
+           '(PROGN (CLOSEF? OLDVALUE]
+
+         (* The close is done in the LOADDB RESETLST, except when a candidate file isn't 
+
       correct)

+
+    (SKREAD DBF)                                             (* Skip LOAD error message)

+    (COND
+       ([STREQUAL (CAR FILEDATES)
+               (CAR (READ DBF (FIND-READTABLE "INTERLISP"]
+        DBF)
+       (T (CLOSEF DBF)
+          NIL])
+
+(LOAD

+  [LAMBDA (FILE LDFLG PRINTFLG)
                              (* lmm "29-APR-81 20:27")

+    (SETQ FILE (OLDLOAD FILE LDFLG PRINTFLG))
+    (COND
+       ((NEQ LDFLG 'SYSLOAD)
+        (LOADDB
 FILE T)))
+    FILE])
+
+(LOADFROM

+  [LAMBDA (FILE FNS LDFLG)
                                   (* lmm "29-APR-81 20:27")

+    (SETQ FILE (OLDLOADFROM FILE FNS LDFLG))
+    (LOADDB
 FILE T)
+    FILE])
+
+(MAKEFILE

+  [LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE)
               (* lmm "29-APR-81 20:27")

+    (SETQ FILE (OLDMAKEFILE FILE OPTIONS REPRINTFNS SOURCEFILE))
+    (DUMPDB
 FILE T)
+    FILE])
+)
+
+(ADDTOVAR LINKEDFNS
 OLDLOAD)
+
+(RELINK 'MAKEFILES)
+(DEFINEQ
+
+(DUMPDB

+  [LAMBDA (FILE PROPFLG)
                                 (* ; "Edited  3-May-93 18:44 by rmk:")

+
+         (* Dumps a Masterscope database for functions in FILE.
+
       Checks the DATABASE property if PROPFLG=T which is how the MAKEFILE advice 
+
       calls it. A user-level call would default PROPFLG to NIL.)

+
+         (* The FILE check is because MAKEFILE returns a list when it doesn't understand 
+
       the options)

+
+    (DECLARE
 (GLOBALVARS MSHASHFILENAME MSFILETABLE SAVEDBFLG))
+    (AND FILE (OR (LITATOM FILE)
+                  (STRINGP FILE))
+         (PROG (DBFILE
 (FL (NAMEFIELD FILE))
+                      FNS
+                      (FFNS (FILEFNSLST FILE)))
+               (COND
+                  (FFNS)
+                  ((AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE)))
+                                                             (* Always dump if this is a known 
+
                                                           file)

+                   (SETQ PROPFLG NIL))
+                  (T (COND
+                        (PROPFLG (/REMPROP FL 'DATABASE))
+                        (T (printout T T FILE " has no functions." T)))
+                     (RETURN)))
+               (SETQ FNS FFNS)
+               (COND
+                  ([OR (NULL PROPFLG)
+                       (EQ (GETPROP FL 'DATABASE)