Compare commits
5 Commits
Ignore-int
...
mth71--DAT
| Author | SHA1 | Date | |
|---|---|---|---|
|
26bba9e432 | ||
|
|
80ac342428 | ||
|
|
ee6b98a0c1 | ||
|
|
fd477027ff | ||
|
|
1d309df26e |
@@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO :PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10)
|
||||
|
||||
(FILECREATED " 2-May-2026 17:38:46" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;4 18684
|
||||
(FILECREATED "11-May-2026 14:41:08" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;3 19373
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS DUMPDB)
|
||||
:CHANGES-TO (FNS DUMPDB DBFILE LOADDB MAKEDB)
|
||||
|
||||
:PREVIOUS-DATE "29-Apr-2026 17:43:56" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;2
|
||||
:PREVIOUS-DATE " 2-May-2026 17:38:46" {DSK}<home>matt>Interlisp>medley>library>DATABASEFNS.;1
|
||||
)
|
||||
|
||||
|
||||
@@ -62,7 +62,8 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DBFILE
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 16:50 by rmk:")
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 11-May-2026 14:35 by mth")
|
||||
(* ; "Edited 24-Oct-2021 16:50 by rmk:")
|
||||
(* 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.")
|
||||
@@ -73,13 +74,13 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
[COND
|
||||
((NULL FILE)
|
||||
(SETQ FILE (INPUT)))
|
||||
((MEMB (FILENAMEFIELD FILE 'EXTENSION)
|
||||
((MEMB (U-CASE (FILENAMEFIELD FILE 'EXTENSION))
|
||||
*COMPILED-EXTENSIONS*) (* ;
|
||||
"Map compiled file into symbolic name")
|
||||
"Map compiled file into symbolic name")
|
||||
(SETQ FILE (PACKFILENAME 'EXTENSION NIL 'VERSION NIL 'BODY FILE]
|
||||
(LET [(FILEDATES (COND
|
||||
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
|
||||
(CAR (GETPROP (NAMEFIELD FILE)
|
||||
(CAR (GETPROP (ROOTFILENAME FILE)
|
||||
'FILEDATES]
|
||||
([SETQ FILE (COND
|
||||
(ASKFLAG (INFILEP FILE))
|
||||
@@ -165,14 +166,20 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(DEFINEQ
|
||||
|
||||
(DUMPDB
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 2-May-2026 17:32 by mth")
|
||||
[LAMBDA (FILE PROPFLG) (* ; "Edited 11-May-2026 14:41 by mth")
|
||||
(* ; "Edited 8-May-2026 16:18 by mth")
|
||||
(* ; "Edited 2-May-2026 17:32 by mth")
|
||||
(* ; "Edited 29-Apr-2026 17:42 by mth")
|
||||
(* ; "Edited 20-Feb-2024 23:45 by mth")
|
||||
(* ; "Edited 7-Feb-2024 18:26 by mth")
|
||||
(* ; "Edited 27-Oct-2021 10:51 by larry")
|
||||
(* ; "Edited 24-Oct-2021 16:24 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.")
|
||||
(* ;; "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")
|
||||
|
||||
@@ -184,7 +191,7 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(SAVEDDEFAULTCOPYRIGHTOWNER DEFAULTCOPYRIGHTOWNER))
|
||||
(CL:UNWIND-PROTECT
|
||||
(PROG (DBFILE DBFN DBROOTFN FLCPR (FL (ROOTFILENAME FILE))
|
||||
(FNS (FILEFNSLST FILE)))
|
||||
(FNS (FILEFNSLST FL)))
|
||||
(SETQ DBFN (PACKFILENAME 'EXTENSION 'DATABASE 'VERSION NIL 'BODY FILE))
|
||||
(SETQ DBROOTFN (ROOTFILENAME DBFN))
|
||||
(CL:UNLESS (OR (EQ COPYRIGHTFLG 'NEVER)
|
||||
@@ -248,7 +255,8 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(SETQ DEFAULTCOPYRIGHTOWNER SAVEDDEFAULTCOPYRIGHTOWNER)))])
|
||||
|
||||
(LOADDB
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 24-Oct-2021 17:44 by rmk:")
|
||||
[LAMBDA (FILE ASKFLAG) (* ; "Edited 11-May-2026 14:37 by mth")
|
||||
(* ; "Edited 24-Oct-2021 17:44 by rmk:")
|
||||
(* ; "Edited 7-Jul-92 09:57 by rmk:")
|
||||
|
||||
(* ;; "Loads the database file corresponding to FILE, asking for confirmation only if ASKFLAG is T, which is the case from the advice on LOAD but not from usual user-level calls. Before asking, it looks around first to see whether a database file of the appropriate name really exists.")
|
||||
@@ -257,7 +265,7 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(RESETLST
|
||||
[PROG* [TEM FORFILE (*READTABLE* (FIND-READTABLE "INTERLISP"))
|
||||
(*PACKAGE* (CL:FIND-PACKAGE "INTERLISP"))
|
||||
(NF (NAMEFIELD FILE))
|
||||
(NF (ROOTFILENAME FILE))
|
||||
(DBSTREAM (DBFILE FILE ASKFLAG))
|
||||
(DBFILE (FULLNAME (CAR DBSTREAM]
|
||||
(COND
|
||||
@@ -265,14 +273,15 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(SETQ DBSTREAM (CAR DBSTREAM)))
|
||||
(T (COND
|
||||
((NULL ASKFLAG)
|
||||
(PRINTOUT T "no database file found for " NF T)))
|
||||
(PRINTOUT T "no database file found for " (NAMEFIELD FILE)
|
||||
T)))
|
||||
(RETURN)))
|
||||
(COND
|
||||
([COND
|
||||
[ASKFLAG (COND
|
||||
((EQ (GETPROP NF 'DATABASEFILENAME)
|
||||
DBFILE) (* ;
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
"If the database for this very file has already been loaded, don't bother doing it again.")
|
||||
(PRINTOUT T "Database " DBFILE " already loaded." T)
|
||||
NIL)
|
||||
(T (SELECTQ (GETPROP NF 'DATABASE)
|
||||
@@ -313,28 +322,29 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
(READATABASE)))
|
||||
(AND MSFILETABLE (STORETABLE NF MSFILETABLE FORFILE))
|
||||
(* ;
|
||||
"This is done whether or not there is a hashfile.")
|
||||
"This is done whether or not there is a hashfile.")
|
||||
(UPDATEFILES) (* ;
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(FOR FN IN (CDR (GETP NF 'FILE))
|
||||
WHEN (OR (EXPRP FN)
|
||||
(GETP FN 'EXPR)) DO (MSMARKCHANGED FN)))
|
||||
"Mark any edited fns as needing to be reanalyzed.")
|
||||
(FOR FN IN (CDR (GETP NF 'FILE)) WHEN (OR (EXPRP FN)
|
||||
(GETP FN 'EXPR))
|
||||
DO (MSMARKCHANGED FN)))
|
||||
(T (PRINTOUT T T DBFILE " is not a database file!" T)
|
||||
(* ; "So that value of LOADDB is NIL")
|
||||
(SETQ DBFILE NIL)))
|
||||
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
|
||||
"Remember the name of the database we just loaded.")
|
||||
"Remember the name of the database we just loaded.")
|
||||
(RETURN (FULLNAME DBFILE])])
|
||||
|
||||
(MAKEDB
|
||||
[LAMBDA (F) (* DECLARATIONS%: UNDOABLE)
|
||||
(* ; "Edited 11-May-2026 14:38 by mth")
|
||||
(* rmk%: " 9-NOV-83 02:56")
|
||||
(DECLARE (GLOBALVARS SAVEDBFLG MSFILETABLE DWIMWAIT))
|
||||
(SETQ F (NAMEFIELD F))
|
||||
|
||||
(* The extension is stripped off for purposes of the DATABASE.
|
||||
This maps compiled files into the root name, but means that we can't have
|
||||
multiple-extension files with different database status)
|
||||
(SETQ F (ROOTFILENAME F))
|
||||
|
||||
(* The extension is stripped off for purposes of the DATABASE.
|
||||
This maps compiled files into the root name, but means that we can't have
|
||||
multiple-extension files with different database status)
|
||||
|
||||
(COND
|
||||
((INFILECOMS? T 'FNS (FILECOMS F))
|
||||
@@ -380,7 +390,7 @@ Copyright (c) 1986, 1990-1993, 2024, 2026 by Xerox Corporation.
|
||||
)
|
||||
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993 2024 2026))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (1783 6808 (DBFILE 1793 . 3438) (DBFILE1 3440 . 4950) (DBFILE2 4952 . 6174) (LOAD 6176
|
||||
. 6406) (LOADFROM 6408 . 6596) (MAKEFILE 6598 . 6806)) (6864 18072 (DUMPDB 6874 . 12107) (LOADDB
|
||||
12109 . 16984) (MAKEDB 16986 . 18070)))))
|
||||
(FILEMAP (NIL (1804 6952 (DBFILE 1814 . 3582) (DBFILE1 3584 . 5094) (DBFILE2 5096 . 6318) (LOAD 6320
|
||||
. 6550) (LOADFROM 6552 . 6740) (MAKEFILE 6742 . 6950)) (7008 18761 (DUMPDB 7018 . 12505) (LOADDB
|
||||
12507 . 17578) (MAKEDB 17580 . 18759)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user