github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-25 20:01:51 +00:00
Code Issues Projects Releases Wiki Activity

All source files converted to LF (#315)

Browse Source 
* All source files converted to LF

Also, HPRINT:  EQUALALL knows about CL arrays
FILEIO:  STREAM record with fields for external format functions

* Delete makeinit.dribble

* Converted CR to LF on internal/library and docs/Documentation Tools
This commit is contained in:
rmkaplan
2021-04-28 15:36:03 -07:00
committed by GitHub
parent 179325c528
commit f0ad3c5f60
736 changed files with 532174 additions and 5581 deletions
Download Patch File Download Diff File Expand all files Collapse all files

206
library/DATABASEFNS
View File

@@ -1,4 +1,61 @@
(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
(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.
@@ -27,7 +84,9 @@
(T (FINDFILE FILE]
(CONS (FILEDATE FILE)
FILE]
(ADDVARS (MAKEFILEFORMS (MAKEDB 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.
@@ -50,7 +109,9 @@
'*
'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)
@@ -66,23 +127,110 @@
(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)))
COMPILE.EXT) (* Map compiled file into symbolic
FILE])
(LOADFROM
[LAMBDA (FILE FNS LDFLG) (* lmm "29-APR-81 20:27")
(SETQ FILE (OLDLOADFROM FILE FNS LDFLG))
(LOADDB FILE T)
[(AND (NULL (FILENAMEFIELD FILE 'VERSION))
FILE])
(MAKEFILE
[LAMBDA (FILE OPTIONS REPRINTFNS SOURCEFILE) (* lmm "29-APR-81 20:27")
(SETQ FILE (OLDMAKEFILE FILE OPTIONS REPRINTFNS SOURCEFILE))
(DUMPDB FILE T)
(ASKFLAG (INFILEP FILE))
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)
'YES)
(EQ SAVEDBFLG 'YES)
(AND MSFILETABLE (TESTTABLE FL (CADR MSFILETABLE]
(* If MSHASH is loaded, only dump
 functions in the local database)
[COND
(MSHASHFILENAME (SETQ FNS (for FN in FNS
when (PROGN (UPDATEFN FN)
(LOCALFNP FN)) collect FN]
(RESETLST
[RESETSAVE (SETQ DBFILE (OPENSTREAM (PACKFILENAME 'EXTENSION 'DATABASE
'VERSION NIL 'BODY FILE)
'OUTPUT
'NEW))
'(PROGN (CLOSEF? OLDVALUE)
(AND RESETSTATE (DELFILE OLDVALUE]
(RESETSAVE (OUTPUT DBFILE))
(RESETSAVE (SETREADTABLE (FIND-READTABLE "INTERLISP")))
(RESETSAVE (CL:IN-PACKAGE "INTERLISP")
(LIST 'CL:IN-PACKAGE (CL:PACKAGE-NAME *PACKAGE*)))
(PRIN1 "(PROGN (PRIN1 %"Use LOADDB to load database files!%
%" T) (ERROR!))%
(CONS (FILEDATE FILE)
"
)
[AND MSFILETABLE (STORETABLE FL MSFILETABLE (PRINT (CAR (GETPROP FL
'FILEDATES]
(COND
(MSHASHFILENAME (UPDATECONTAINS FL FFNS T)))
(* T flag means that the function
 won't be erased--it might still be
 interesting)
(printout NIL "FNS " .P2 FFNS T) (* So the database file knows which
 functions are on the file)
(COND
(FNS (DUMPDATABASE FNS))
(T (printout NIL "STOP" T))))
[COND
(PROPFLG (PRINT (FULLNAME DBFILE)
T))
(T (/PUT FL 'DATABASEFILENAME DBFILE) (* Remember that we have this file
 valid already.)
(/PUT FL 'DATABASE 'YES] (* Take future note of the databae
 on a user call)
(RETURN (FULLNAME DBFILE])
(LOADDB
[LAMBDA (FILE ASKFLAG) (* ; "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.")
@@ -163,7 +311,9 @@
(SETQ DBFILE NIL)))
(/PUT NF 'DATABASEFILENAME DBFILE) (* ;
 "Remember the name of the database we just loaded.")
 the options)
(RETURN (FULLNAME DBFILE])])
(MAKEDB
[LAMBDA (F) (* DECLARATIONS%: UNDOABLE)
(* rmk%: " 9-NOV-83 02:56")
(DECLARE (GLOBALVARS SAVEDBFLG MSFILETABLE DWIMWAIT))
@@ -184,4 +334,40 @@
"Do you want a Masterscope Database for this file? ")
)
'YES)
(EQ (GETPROP FL 'DATABASE)
(T 'NO])
)
(PUTPROPS DATABASE PROPTYPE IGNORE)
(RPAQ? LOADDBFLG 'ASK)
(RPAQ? SAVEDBFLG 'ASK)
(ADDTOVAR MAKEFILEFORMS (MAKEDB FILE))
(* To permit MSHASH interface)
(RPAQ? MSHASHFILENAME )
(RPAQ? MSFILETABLE )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK%: LOADDB LOADDB DBFILE DBFILE1 DBFILE2 (NOLINKFNS . T))
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(RESETSAVE DWIMIFYCOMPFLG T)
)
(PUTPROPS DATABASEFNS COPYRIGHT ("Xerox Corporation" 1986 1990 1991 1992 1993))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1637 6218 (DBFILE 1647 . 3295) (DBFILE1 3297 . 4820) (DBFILE2 4822 . 5584) (LOAD 5586
. 5816) (LOADFROM 5818 . 6006) (MAKEFILE 6008 . 6216)) (6274 16706 (DUMPDB 6284 . 10572) (LOADDB
10574 . 15618) (MAKEDB 15620 . 16704)))))
STOP