(FILECREATED "13-Mar-86 15:27:02" {PHYLUM}<LANNING>FILECACHE>FILECACHE.;21 191070
changes to: (MACROS \FCACHE.LOCALDEVICE MatchFileName KLUDGE WITH.FCACHE.ABORT.WINDOW)
(VARS FILECACHECOMS)
(FNS \FCACHE.CREATE.MSG.WINDOW \FCACHE.BUILD.DEVICE \FCACHE.BEFORELOGIN
\FCACHE.\INTERNAL/SETPASSWORD \FCACHE.CLOSEFILE \FCACHE.GETFILENAME
\FCACHE.OPENFILE \FCACHE.RENAMEFILE \FCACHE.REOPENFILE \FCACHE.SETFILEINFO
\FCACHE.ENTRYINFO \FCACHE.RESOURCES.ERROR \FCACHE.WRITEOUT \FCACHE.RESTORE
\FCACHE.LOOKUP \FCACHE.VERIFY FCACHE.DUMP \FCACHE.LOAD \FCACHE.MAKEROOM
\FCACHE.DEVICE.EVENTFN \FCACHE.INITIALIZE.PROPS \FCACHE.USECACHE?
\FCACHE.INITIALIZE FCACHE.VANQUISH \FCACHE.DIRECTORYNAMEP
\FCACHE.IGNOREDATECHECK? \FCACHE.USELOCALDIRECTORY? \FCACHE.ADDENTRY
\FCACHE.DUMP.ENTRY \FCACHE.RESTORE.ENTRY FCACHE.START
\FCACHE.WRITEOUT.READNEWFILENAME \FCACHE.WRITEOUT.NEWFILENAME
\FCACHE.BROWSE.CACHE \FCACHE.BROWSE.WHENSELECTEDFN CACHE.FILE
FCACHE.DELETE.CACHE.ENTRY FCACHE.DIRTY? FCACHE.DUMP.FILE
\FCACHE.DONE.OR.ABORTED.MSG \FCACHE.DELETE.ENTRY \FCACHE.AROUNDEXIT
\FCACHE.DELETEFILE \FCACHE.GETFILEINFO FCACHE.DUMP.ALL \FCACHE.EVENTFN
\FCACHE.CANONICAL.HOSTNAME \FCACHE.PRINT.PROMPT \FCACHE.INSPECT.PROPCOMMANDFN
\FCACHE.GENERATE.LOCAL.FILES FILES.IN.ORDER? \FCACHE.GENERIC.DEVICE.TYPE
\FCACHE.PRINT.MESSAGE? \FCACHE.HOSTUP? \FCACHE.FLUSH.INFOHOOK
\FCACHE.WRITEOUT.WHENSELECTEDFN \FCACHE.GENERATE.FILES.DEPTH
\FCACHE.NEXT.LOCAL.FILE MERGED.NEXTFILEFN \MERGED.NEXTFILEFN1
\FCACHE.REPAIR.FINDFILE \FCACHE.REPAIR.VERIFY \FCACHE.HOSTDEAD.WHENSELECTEDFN
FCACHE.GENERIC.START \GETCACHEDEVICEFROMHOSTNAME \FCACHE.GENERATE.FILEINFO
\FCACHE.BROWSE.COPYFN FCACHE.PUTPROP \FCACHE.BROWSE.REPAINTFN
\FCACHE.INSPECT.TITLEFN \FCACHE.BROWSE.RECOMPUTE \FCACHE.BROWSER.SCAVENGE)
(RECORDS MERGEDFILEGENSTATE LocalFileGenerator CACHENTRY)
previous date: " 3-Feb-86 17:49:02" {PHYLUM}<LANNING>FILECACHE>FILECACHE.;3)
(* Copyright (c) 1983, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT FILECACHECOMS)
(RPAQQ FILECACHECOMS ((* * The FileCache package, here before your eyes! * *)
(COMS (* * Public functions for manipulating the cache)
(FNS ADD.FILE.TO.CACHE? CACHE.FILE FCACHE.DELETE.CACHE.ENTRY FCACHE.DUMP.ALL
FCACHE.GENERIC.START FCACHE.GENERIC.STOP FCACHE.GETPROP FCACHE.PRIVATE.FILE?
FCACHE.PUTPROP FCACHE.START FCACHE.STOP FCACHE.CACHELIST FCACHE.DIRTY?
FCACHE.DUMP.FILE FCACHE.DUMP)
(PROP SETFN FCACHE.GETPROP)
(TEMPLATES FCACHE.GETPROP FCACHE.PUTPROP)
(INITVARS (FCACHE.GENERIC.DEVICE.TYPES (QUOTE (LEAF NSFILING)))
(DON'T.CACHE.FILES NIL)
(PRIVATE.FILES NIL))
(GLOBALVARS DON'T.CACHE.FILES PRIVATE.FILES FCACHE.GENERIC.DEVICE.TYPES))
(COMS (* * Used to be public, but now aren't advertised)
(MACROS WITHOUT.FCACHE)
(PROP ARGNAMES WITHOUT.FCACHE))
(COMS (* * Status messages to the user)
(FNS \FCACHE.DONE.OR.ABORTED.MSG \FCACHE.PRINT.MESSAGE?)
(INITVARS (*FILE-CACHE-MESSAGE-STREAM* PROMPTWINDOW))
(GLOBALVARS *FILE-CACHE-MESSAGE-STREAM* \FCACHE.MESSAGE.WINDOW.LOCK))
(COMS (* * Unscheduled user interaction stuff)
(FNS \FCACHE.PRINT.PROMPT \FCACHE.CREATE.MSG.WINDOW)
(DECLARE: DONTCOPY (MACROS WITH.FCACHE.ABORT.WINDOW))
(INITVARS (\ABORT.WINDOW.LOCK (CREATE.MONITORLOCK (QUOTE \ABORT.WINDOW.LOCK)))
(\ABORT.WINDOW.LEFT 350)
(\ABORT.WINDOW.BOTTOM 200)
(\ABORT.WINDOW.WIDTH 425)
(\ABORT.WINDOW.HEIGHT 150)
(\FREE.ABORT.WINDOWS NIL))
(GLOBALVARS \ABORT.WINDOW.LOCK \ABORT.WINDOW.LEFT \ABORT.WINDOW.BOTTOM
\ABORT.WINDOW.WIDTH \ABORT.WINDOW.HEIGHT \FREE.ABORT.WINDOWS))
(COMS (* * Functions for producing the device given the name)
(FNS \GETUSERDEVICEFROMNAME \GETCACHEDEVICEFROMHOSTNAME \GETREALDEVICEFROMHOSTNAME
\FCACHE.CANONICAL.HOSTNAME \FCACHE.GENERIC.DEVICE.TYPE))
(COMS (* * Functions for loading or removing a file into the cache)
(FNS \FCACHE.DELETE.ENTRY \FCACHE.INVENTNAME \FCACHE.KEEPVERSIONS \FCACHE.LOAD
\FCACHE.MAKE.LEGAL.FILENAME \FCACHE.MAKEROOM \FCACHE.MAKEROOM.DELETEABLE?)
(INITVARS (\FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(\FCACHE.CACHE.CHANGED.EVENT (CREATE.EVENT (QUOTE FCACHE.CHANGED)))
(\FCACHE.CACHING.FILES NIL)
(\FCACHE.LIST NIL)
(\FCACHE.LIST.CHANGED? NIL)
(\FCACHE.LOGFILE NIL))
(GLOBALVARS \FCACHE.CACHELOCK \FCACHE.CACHE.CHANGED.EVENT \FCACHE.CACHING.FILES
\FCACHE.LIST \FCACHE.LIST.CHANGED? \FCACHE.LOGFILE))
(COMS (* * Scavenging functions)
(FNS FCACHE.SCAVENGE)
(FNS \FCACHE.REPAIR \FCACHE.REPAIR.FINDFILE \FCACHE.REPAIR.VERIFY)
[INITVARS (FCACHE.SCAVENGE.IGNORE (QUOTE ((DANDELION FCACHE.POINTER FCACHE.LISTING
FCACHE.LOG)
(DOVE FCACHE.POINTER FCACHE.LISTING
FCACHE.LOG)
(DORADO FCACHE.POINTER FCACHE.LISTING
FCACHE.LOG COM.CM DISKDESCRIPTOR.
DMT.BOOT DUMPER.BOOT EXECUTIVE.RUN
FTP.LOG FTP.RUN REM.CM SWAT. SWATEE.
SYS.BOOT SYS.ERRORS SYSDIR.
SYSFONT.AL USER.CM]
(GLOBALVARS FCACHE.SCAVENGE.IGNORE))
(COMS (* * Functions for creating or destroying a cache device)
(FNS \FCACHE.BUILD.DEVICE \FCACHE.OFF))
(COMS (* * Functions for dealing with device events, like LOGOUT)
(FNS \FCACHE.DEVICE.EVENTFN \FCACHE.INITIALIZE.PROPS)
(GLOBALVARS \FCACHE.DEVICE)
(* Make sure the cache devices are at the top of the list of known devices before we do
any device event -- in other words, a big HACK)
(FNS \FCACHE.GLOBAL.EVENT)
(APPENDVARS (AROUNDEXITFNS \FCACHE.GLOBAL.EVENT))
(* Before revalidating files, load the LOG file, if any -- in other words, a big HACK)
(FNS \FCACHE.AROUNDEXIT))
(COMS (* * Catch changes to the current user / password)
(* This is a HACK)
(FNS \FCACHE.BEFORELOGIN \FCACHE.\INTERNAL/SETPASSWORD)
(ADDVARS (\BEFORELOGINFNS \FCACHE.BEFORELOGIN))
(GLOBALVARS \BEFORELOGINFNS))
(COMS (* * Methods for the {FCACHE} file device. Note that methods that are not defined are
not really needed since {FCACHE} is a specialization of the local device that holds
the cache, and inherits all bin/bout like methods)
(FNS \FCACHE.CLOSEFILE \FCACHE.DELETEFILE \FCACHE.DIRECTORYNAMEP \FCACHE.EVENTFN
\FCACHE.GENERATEFILES \FCACHE.GETFILEINFO \FCACHE.GETFILENAME \FCACHE.HOSTNAMEP
\FCACHE.OPENFILE \FCACHE.RENAMEFILE \FCACHE.REOPENFILE \FCACHE.SETFILEINFO)
(* Helper fns)
(FNS \FCACHE.ENTRYINFO))
(COMS (* * Directory enumeration functions)
(FNS \FCACHE.GENERATE.FILEINFO \FCACHE.GENERATE.FILES.DEPTH
\FCACHE.GENERATE.LOCAL.FILES \FCACHE.NEXT.LOCAL.FILE)
(* Merging together two file generators)
(FNS MERGE.FILEGENERATORS MERGED.FILEINFOFN MERGED.NEXTFILEFN \MERGED.NEXTFILEFN1
FILES.IN.ORDER?)
(DECLARE: DONTCOPY (RECORDS MERGEDFILEGENSTATE LocalFileGenerator)))
(COMS (* * Functions for finding a file in the cache)
(FNS \FCACHE.LOOKUP \FCACHE.PROMOTE \FCACHE.USECACHE? \FCACHE.VERIFY)
(MACROS MatchFileName))
(COMS (* * Try to figure out if a host is up)
(FNS \FCACHE.HOSTUP? \NSFILING.ADDRESS \FCACHE.IGNOREDATECHECK?
\FCACHE.USELOCALDIRECTORY? \FCACHE.HOSTDEAD.WHENSELECTEDFN)
(INITVARS (FCACHE.DEAD.HOSTS NIL))
(GLOBALVARS FCACHE.DEAD.HOSTS))
(COMS (* * Functions for dealing with overflow of the cache)
(FNS \FCACHE.RESOURCES.ERROR))
(COMS (* * Functions for writing out dirty files from the cache)
(FNS \FCACHE.ENTRYOPEN? \FCACHE.FLUSH \FCACHE.WRITEOUT \FCACHE.WRITEOUT.NEWFILENAME
\FCACHE.WRITEOUT.READNEWFILENAME \FCACHE.WRITEOUT.WHENSELECTEDFN)
(VARS (\FCACHE.DUMPLOCK (CREATE.MONITORLOCK "File cache writout")))
(GLOBALVARS \FCACHE.DUMPLOCK))
(COMS (* * Functions for dumping and restoring information about the contents of the cache)
(FNS \FCACHE.ADDENTRY \FCACHE.DUMP.ENTRY \FCACHE.FILEMATCH? \FCACHE.LOGENTRY
\FCACHE.RESTORE \FCACHE.RESTORE.ENTRY)
(VARS (\FCACHE.LISTING.VERSION.NUMBER NIL))
(GLOBALVARS \FCACHE.LISTING.VERSION.NUMBER))
(COMS (* * Functions for inspecting the cache)
(FNS \FCACHE.FLUSH.INFOHOOK)
(* Browsing thru the cache)
(FNS \FCACHE.BROWSE.CACHE \FCACHE.BROWSE.COPYFN \FCACHE.BROWSE.PRINTFN
\FCACHE.BROWSE.RECOMPUTE \FCACHE.BROWSE.WHENSELECTEDFN)
(FILES READNUMBER TABLEBROWSER)
(DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD (FILES TABLEBROWSERDECLS))
(INITVARS (\FCACHE.BROWSER NIL))
(BITMAPS \FCACHE.ICON)
(GLOBALVARS \FCACHE.BROWSER \FCACHE.ICON)
(* Inspecting the cache properties)
(FNS \FCACHE.INSPECT.PROPCOMMANDFN \FCACHE.INSPECT.TITLEFN \FCACHE.INSPECT.VALUES
\FCACHE.PROPERTY.NAMES))
(COMS (* * Data access functions)
(DECLARE: DONTCOPY (MACROS \FCACHE.PROPERTY \FCACHE.PROPERTY.PUT \FCACHE.LOCALDEVICE))
(RECORDS CACHEDEVINFO CACHENTRY CACHEDEVICE)
(FNS \FCACHE.DEVINFO \FCACHE.PUT.DEVINFO)
(ADDVARS (\SYSTEMCACHEVARS \FCACHE.LOCALDEVICE))
(INITVARS (\FCACHE.LOCALDEVICE NIL)
(\FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE
10000 MAXFILEPAGES 600 UNSAFE ASK
UNSAFE.TIMEOUT 30 UNSAFE.DEFAULT NIL
SILENT NIL DUMPSLEEP 10000 DUMPIDLE 20
FASTDIR NIL KEEPVERSIONS 2 TIMETOVERIFY
5 BADDEVICES NIL)))
(\FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(\FCACHE.GENERIC.DEVICES NIL))
(GLOBALVARS \FCACHE.LOCALDEVICE \FCACHE.PROMPT.WINDOW \FCACHE.PROMPT.WINDOW.MONITORLOCK
\FCACHE.PROPERTIES \FCACHE.GENERIC.DEVICES))
(* * Initialize things)
(FNS \FCACHE.INITIALIZE FCACHE.VANQUISH)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\FCACHE.INITIALIZE)))
[COMS * (BQUOTE ((VARS (FCACHE.VERSION.DATE , (DATE))
(FCACHE.VERSION.NUMBER 5.1))
(GLOBALVARS FCACHE.VERSION.DATE FCACHE.VERSION.NUMBER]
(* * Compile time magic)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS REALDEVOP VersionlessFileName KLUDGE)
(I.S.OPRS INUNSORTEDFILES)
DONTEVAL@LOAD
(* * This all depends on record defns from the system)
(FILES NSFILING LLNS))))
(* * The FileCache package, here before your eyes! * *)
(* * Public functions for manipulating the cache)
(DEFINEQ
(ADD.FILE.TO.CACHE?
[LAMBDA (fileName) (* smL "30-Jan-86 17:06")
(* * Should the file be added to the cache?)
(NOT (for fileSpec in DON'T.CACHE.FILES thereis (\FCACHE.FILEMATCH? fileName
(
DIRECTORY.FILL.PATTERN
fileSpec "" "*"])
(CACHE.FILE
[LAMBDA (fileName) (* smL "11-Feb-86 18:58")
(* * Load the file into the cache)
(RESETLST (LET ((fullName (INFILEP fileName)))
(if (NULL fullName)
then NIL
elseif (\FCACHE.LOAD fullName)
then fullName
else NIL])
(FCACHE.DELETE.CACHE.ENTRY
[LAMBDA (fileName) (* smL "11-Feb-86 18:54")
(* * Delete the cache entry for the given file)
(LET ((fullName (FINDFILE fileName)))
(if fullName
then (RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETUSERDEVICEFROMNAME fullName)
fullName)))
(if entry
then (\FCACHE.DELETE.ENTRY entry)
else NIL)))
else NIL])
(FCACHE.DUMP.ALL
[LAMBDA NIL (* smL "11-Feb-86 16:11")
(* * Cause an immediate flush of all dirty files)
(ALLOW.BUTTON.EVENTS)
(FCACHE.DUMP T)
(printout *FILE-CACHE-MESSAGE-STREAM* T "Done writing out cache"])
(FCACHE.GENERIC.START
[LAMBDA (deviceType) (* smL " 4-Feb-86 12:58")
(* * remember that cache devices for this device are to be created on the fly)
(DECLARE (GLOBALVARS \FILEDEVICES))
(LET [(genericDevice (for dev in \FILEDEVICES thereis (EQ (fetch DEVICENAME
of dev)
(U-CASE deviceType]
(if (NULL genericDevice)
then NIL
else (* Make this undoable)
(UNDOSAVE (LIST (FUNCTION FCACHE.GENERIC.STOP)
deviceType))
(pushnew \FCACHE.GENERIC.DEVICES genericDevice)
(for dev in \FILEDEVICES when (EQ (U-CASE deviceType)
(\FCACHE.GENERIC.DEVICE.TYPE dev))
do (FCACHE.START (fetch DEVICENAME of dev)))
genericDevice])
(FCACHE.GENERIC.STOP
[LAMBDA (deviceType) (* smL "12-Aug-85 11:48")
(* * undo the effect of an FCACHE.GENERIC.START)
(DECLARE (GLOBALVARS \FILEDEVICES))
(LET [(device (for dev in \FILEDEVICES thereis (EQ (fetch DEVICENAME of dev)
(U-CASE deviceType]
(if (NULL device)
then NIL
else (SETQ \FCACHE.GENERIC.DEVICES (DREMOVE device \FCACHE.GENERIC.DEVICES))
device])
(FCACHE.GETPROP
[LAMBDA (name) (* smL " 5-Aug-85 17:04")
(* * Public function for getting file cache properties)
(SELECTQ name
(ENTRIES (LENGTH \FCACHE.LIST))
(DEVICES (for info in (\FCACHE.PROPERTY (QUOTE DEVICES)) collect (fetch REALDEVICENAME
of info)))
(DUMPSLEEP (QUOTIENT (\FCACHE.PROPERTY name)
1000))
(\FCACHE.PROPERTY name])
(FCACHE.PRIVATE.FILE?
[LAMBDA (fullName) (* smL " 9-Aug-85 14:06")
(* * Is this a private file)
(for fileSpec in PRIVATE.FILES thereis (\FCACHE.FILEMATCH? fullName (DIRECTORY.FILL.PATTERN
fileSpec "" "*"])
(FCACHE.PUTPROP
[LAMBDA (name value) (* smL " 4-Feb-86 09:48")
(* * Public function for setting file cache properties)
(SELECTQ name
((DEVICES ENTRIES)
(ERROR "Can't set that cache property " name))
[PREFIX (SETQ value (MKATOM value))
(if (for entry in \FCACHE.LIST thereis (NOT (\FCACHE.WRITEOUT
entry)))
then (ERROR "Can't flush a file, so can't switch cache prefix")
else (FCACHE.DUMP T)
(if (\FCACHE.RESTORE value)
then (* update the cache devices)
(for devInfo in (\FCACHE.PROPERTY (QUOTE DEVICES))
do (\FCACHE.EVENTFN (fetch CACHEDEV of devInfo)
(QUOTE AFTERLOGOUT)))
(* update the pointer file)
(LET [(file (OPENFILE (QUOTE {DSK}FCache.pointer;1)
(QUOTE OUTPUT)
(QUOTE OLD/NEW]
(PRINT value file)
(CLOSEF file))
else (ERROR "Bad prefix " value]
((MAXSIZE MAXFILEPAGES UNSAFE.TIMEOUT TIMETOVERIFY)
(if (NUMBERP value)
then (SETQ \FCACHE.LIST.CHANGED? T)
(\FCACHE.PROPERTY.PUT name value)
else (ERROR "Value not a number" value)))
(DUMPSLEEP (\FCACHE.PROPERTY.PUT name (TIMES value 1000)))
[BADDEVICES (\FCACHE.PROPERTY.PUT name (for devName in value
join (MKLIST (
\FCACHE.CANONICAL.HOSTNAME
devName]
(\FCACHE.PROPERTY.PUT name value))
value])
(FCACHE.START
[LAMBDA (devname) (* smL "24-Feb-86 13:58")
(* * Turn on caching for the given device)
(if (NULL (\FCACHE.PROPERTY (QUOTE PREFIX)))
then (printout *FILE-CACHE-MESSAGE-STREAM* T "No cache prefix, so can't start cache for "
devname)
NIL
else (LET ((canonicalName (\FCACHE.CANONICAL.HOSTNAME devname)))
(if (NULL canonicalName)
then (printout *FILE-CACHE-MESSAGE-STREAM* T "No such host " devname)
NIL
elseif (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
canonicalName))
elseif (MEMB (GETHOSTINFO canonicalName (QUOTE OS))
(QUOTE (UNIX)))
then (* can't work with UNIX hosts.
Sorry.)
NIL
else (LET ((cacheDevice (\FCACHE.BUILD.DEVICE canonicalName)))
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"Creating cache device for host "
canonicalName))
(replace CACHEDEVINFO of cacheDevice
with (create CACHEDEVINFO
CACHEDEV ← cacheDevice
REALDEVICENAME ← canonicalName))
(\DEFINEDEVICE (PACK* canonicalName (QUOTE -CACHE))
cacheDevice)
(* Make this UNDOable)
(if (NOT (FIND.PROCESS (QUOTE DUMP-FCACHE)))
then (ADD.PROCESS (QUOTE (\FCACHE.FLUSH))
(QUOTE NAME)
(QUOTE DUMP-FCACHE)
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE INFOHOOK)
(QUOTE \FCACHE.FLUSH.INFOHOOK)))
(UNDOSAVE (LIST (FUNCTION FCACHE.STOP)
canonicalName))
[FCACHE.PUTPROP (QUOTE BADDEVICES)
(DREMOVE canonicalName (FCACHE.GETPROP
(QUOTE BADDEVICES]
cacheDevice])
(FCACHE.STOP
[LAMBDA (devname) (* smL "14-Aug-85 14:01")
(* * Turn off caching for the given device)
(DECLARE (GLOBALVARS \OPENFILES))
(LET ((dev (\GETCACHEDEVICEFROMHOSTNAME devname T T))
stream entry)
(if (NULL dev)
then (* not turned on)
NIL
elseif [SETQ stream (for stream in \OPENFILES thereis (AND (EQ dev (fetch DEVICE
of stream))
(STREAMPROP stream (QUOTE
cacheEntry]
then (* there is an open stream on the cache, so you can't
turn off that device)
(ERROR "Can't turn off cache -- file is open " (fetch FULLFILENAME of stream))
elseif [SETQ entry (for entry in \FCACHE.LIST
thereis (AND (EQ dev (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
(fetch
REMOTEFILENAME
of entry)
(QUOTE HOST))
T T))
(NOT (\FCACHE.WRITEOUT entry]
then (* can't flush a file on that device)
(ERROR "Can't turn off cache because I can't write out the file "
(fetch REMOTEFILENAME of entry))
else (* really can turn off caching)
(pushnew (FCACHE.GETPROP (QUOTE BADDEVICES))
devname)
(\FCACHE.OFF dev])
(FCACHE.CACHELIST
[LAMBDA NIL (* smL "26-Apr-85 14:58")
(* * What files are cached for this device)
(for entry in \FCACHE.LIST collect (fetch REMOTEFILENAME of entry])
(FCACHE.DIRTY?
[LAMBDA (fileName) (* smL "11-Feb-86 18:54")
(* * Is the entry for this file dirty?)
(RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
fileName
(QUOTE HOST)))
fileName T)))
(if entry
then (fetch CACHEISDIRTY of entry)
else NIL])
(FCACHE.DUMP.FILE
[LAMBDA (fileName) (* smL "11-Feb-86 18:55")
(* * Flush a single file to the server)
(RESETLST (LET ((entry (\FCACHE.LOOKUP (\GETCACHEDEVICEFROMHOSTNAME (FILENAMEFIELD
fileName
(QUOTE HOST)))
fileName T)))
(if (AND entry (fetch CACHEISDIRTY of entry)
(NOT (\FCACHE.ENTRYOPEN? entry)))
then (\FCACHE.WRITEOUT entry)
fileName
else NIL])
(FCACHE.DUMP
[LAMBDA (onlyIfChanged) (* smL "12-Mar-86 13:31")
(* * Dump out the cache info)
(* always dump out dirty files)
(WITH.MONITOR \FCACHE.DUMPLOCK [if (\FCACHE.PROPERTY (QUOTE PREFIX))
then (for entry in \FCACHE.LIST
do (if (NOT (\FCACHE.WRITEOUT entry))
then
(* could not dump the file, so warn the user)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout
*FILE-CACHE-MESSAGE-STREAM* T
"Could not dump the file "
(fetch
REMOTEFILENAME
of entry]
(if (AND onlyIfChanged (NOT \FCACHE.LIST.CHANGED?))
then (* nothing changed, so don't bother to dump)
NIL
elseif (\FCACHE.PROPERTY (QUOTE PREFIX))
then (RESETLST
(\FCACHE.DONE.OR.ABORTED.MSG "Dumping cache listing")
(LET [(stream (OPENSTREAM (PACK* (\FCACHE.PROPERTY (QUOTE PREFIX)
)
"FCache.Listing;1")
(QUOTE OUTPUT)
(QUOTE OLD/NEW]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
stream))
(* Put a warning message at the head of the info file)
(PRINT [BQUOTE (ERROR
"This file cannot be LOADed. Do not delete or alter this file!"
(QUOTE (FCacheVersion
, FCACHE.VERSION.NUMBER
MaxSize ,
(\FCACHE.PROPERTY
(QUOTE MAXSIZE))
MaxFilePages ,
(\FCACHE.PROPERTY
(QUOTE MAXFILEPAGES]
stream)
(for f in \FCACHE.LIST
do (\FCACHE.DUMP.ENTRY f stream)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* ".")
(FORCEOUTPUT *FILE-CACHE-MESSAGE-STREAM*)))
(* Print out a little msg so we can tell if the whole
file got written out.)
(PRINT (QUOTE STOP)
stream)
(CLOSEF? stream))
(if (AND (STREAMP \FCACHE.LOGFILE)
(OPENP \FCACHE.LOGFILE))
then (replace USERCLOSEABLE of \FCACHE.LOGFILE with T)
(DELFILE (CLOSEF \FCACHE.LOGFILE))
(SETQ \FCACHE.LOGFILE NIL))
(SETQ \FCACHE.LIST.CHANGED? NIL])
)
(PUTPROPS FCACHE.GETPROP SETFN FCACHE.PUTPROP)
(SETTEMPLATE (QUOTE FCACHE.GETPROP)
(QUOTE (EVAL PROP . PPE)))
(SETTEMPLATE (QUOTE FCACHE.PUTPROP)
(QUOTE (EVAL PROP EVAL . PPE)))
(RPAQ? FCACHE.GENERIC.DEVICE.TYPES (QUOTE (LEAF NSFILING)))
(RPAQ? DON'T.CACHE.FILES NIL)
(RPAQ? PRIVATE.FILES NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DON'T.CACHE.FILES PRIVATE.FILES FCACHE.GENERIC.DEVICE.TYPES)
)
(* * Used to be public, but now aren't advertised)
(DECLARE: EVAL@COMPILE
[PUTPROPS WITHOUT.FCACHE MACRO (...forms (BQUOTE (RESETLST [RESETSAVE (FCACHE.PUTPROP (QUOTE USECACHE)
NIL)
(LIST (QUOTE FCACHE.PUTPROP)
(QUOTE USECACHE)
(FCACHE.GETPROP
(QUOTE USECACHE]
,@ ...forms]
)
(PUTPROPS WITHOUT.FCACHE ARGNAMES (form1 ... formN))
(* * Status messages to the user)
(DEFINEQ
(\FCACHE.DONE.OR.ABORTED.MSG
[LAMBDA (entermsg) (* smL "11-Feb-86 18:21")
(* * Printout the entermsg when starting, then printout a "done" or "aborted" message in the FCache message window,
depending how we are unwinding. Assumes we are inside of a RESETLST)
(if (\FCACHE.PRINT.MESSAGE?)
then (RESETSAVE (printout *FILE-CACHE-MESSAGE-STREAM* T "[" entermsg "]")
(LIST (FUNCTION [LAMBDA (msg)
(printout *FILE-CACHE-MESSAGE-STREAM* T "["
(if RESETSTATE
then "Aborted"
else "Done")
": " msg "]"])
entermsg])
(\FCACHE.PRINT.MESSAGE?
[LAMBDA NIL (* smL " 6-Feb-86 16:26")
(* * Is printing to the file cache message stream enabled?)
(AND *FILE-CACHE-MESSAGE-STREAM* (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
(if (WINDOWP *FILE-CACHE-MESSAGE-STREAM*)
then (OPENWP *FILE-CACHE-MESSAGE-STREAM*)
elseif (STREAMP *FILE-CACHE-MESSAGE-STREAM*)
then (OPENP *FILE-CACHE-MESSAGE-STREAM* (QUOTE OUTPUT))
else NIL])
)
(RPAQ? *FILE-CACHE-MESSAGE-STREAM* PROMPTWINDOW)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS *FILE-CACHE-MESSAGE-STREAM* \FCACHE.MESSAGE.WINDOW.LOCK)
)
(* * Unscheduled user interaction stuff)
(DEFINEQ
(\FCACHE.PRINT.PROMPT
[LAMBDA (window msgsLines) (* smL "10-Feb-86 18:07")
(* * Clears the windows promptwindow and prints the msgs to it. If the promptwindow isn't big enough, makes it grow
grow. Return the prompt window.)
(LET* [(pwindow (GETPROMPTWINDOW (MAINWINDOW window T)))
(font (DSPFONT NIL pwindow))
(width (WINDOWPROP pwindow (QUOTE WIDTH]
[SETQ pwindow (GETPROMPTWINDOW (MAINWINDOW window T)
(for line in msgsLines
sum (FIX (PLUS .9 (FQUOTIENT (STRINGWIDTH
line font)
width]
(CLEARW pwindow)
(for line in msgsLines do (printout pwindow T line))
pwindow])
(\FCACHE.CREATE.MSG.WINDOW
[LAMBDA NIL (* smL "13-Mar-86 14:16")
(* * Create a new window to display an error msg from the cacher)
(CREATEW (CREATEREGION 550 100 450 300)
"FileCache ERROR" 10])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(DEFMACRO WITH.FCACHE.ABORT.WINDOW (windowVar &REST forms)
(* * Evaluate the forms with the windowVar bound to an unused abort window - Note that this
assumes it is operating within a RESETLST)
(BQUOTE (LET [(, windowVar (WITH.MONITOR \ABORT.WINDOW.LOCK
(OR (pop \FREE.ABORT.WINDOWS)
(PROGN (SETQ \ABORT.WINDOW.LEFT
(MAX 0 (DIFFERENCE
\ABORT.WINDOW.LEFT 20))
)
(SETQ \ABORT.WINDOW.BOTTOM
(MAX 0 (DIFFERENCE
\ABORT.WINDOW.BOTTOM 20))
)
(CREATEW (CREATEREGION
\ABORT.WINDOW.LEFT
\ABORT.WINDOW.BOTTOM
\ABORT.WINDOW.WIDTH
\ABORT.WINDOW.HEIGHT)
NIL NIL T]
(RESETSAVE NIL (LIST (FUNCTION [LAMBDA (abortWindow)
(WINDOWPROP abortWindow (QUOTE TITLE)
NIL)
(for menu in (WINDOWPROP abortWindow
(QUOTE MENU))
do
(DELETEMENU menu NIL abortWindow))
(CLEARW abortWindow)
(CLOSEW abortWindow)
(push \FREE.ABORT.WINDOWS abortWindow])
, windowVar))
,@ forms)))
)
)
(RPAQ? \ABORT.WINDOW.LOCK (CREATE.MONITORLOCK (QUOTE \ABORT.WINDOW.LOCK)))
(RPAQ? \ABORT.WINDOW.LEFT 350)
(RPAQ? \ABORT.WINDOW.BOTTOM 200)
(RPAQ? \ABORT.WINDOW.WIDTH 425)
(RPAQ? \ABORT.WINDOW.HEIGHT 150)
(RPAQ? \FREE.ABORT.WINDOWS NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \ABORT.WINDOW.LOCK \ABORT.WINDOW.LEFT \ABORT.WINDOW.BOTTOM \ABORT.WINDOW.WIDTH
\ABORT.WINDOW.HEIGHT \FREE.ABORT.WINDOWS)
)
(* * Functions for producing the device given the name)
(DEFINEQ
(\GETUSERDEVICEFROMNAME
[LAMBDA (name noError? dontCreate?) (* smL "16-Aug-85 16:04")
(* * Replaces the function \GETDEVICEFROMNAME so that generic file system code will go thru the cache)
(OR [if (AND (OR (LITATOM name)
(STRINGP name))
(\FCACHE.PROPERTY (QUOTE USECACHE))
(\FCACHE.PROPERTY (QUOTE PREFIX)))
then (LET ((hostName (OR (FILENAMEFIELD name (QUOTE HOST))
name)))
(OR (\GETCACHEDEVICEFROMHOSTNAME hostName T dontCreate?)
(\GETREALDEVICEFROMHOSTNAME hostName dontCreate? (\GETCACHEDEVICEFROMHOSTNAME
hostName T T]
(\GETDEVICEFROMNAME name noError? dontCreate?])
(\GETCACHEDEVICEFROMHOSTNAME
[LAMBDA (devname noError? dontCreate?) (* smL " 4-Feb-86 12:59")
(* * Return the cache device, if it exists, otherwise the real device)
(PROG (devInfo canonicalName realDevice)
(* * Works like this -
if there is already a cache device by the given name, use it -
if the canonical name is different, see if there is a cache device by that name -
if there is already a real device, use it -
it we are told to create a device and this is a genericly started cache device, start up the cache on it -
finally just create and return the real device)
(* If there is already a cache device, use it)
(SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
devname)))
[COND
(devInfo (RETURN (fetch (CACHEDEVINFO CACHEDEV) of devInfo]
(* See if there is a cache device for this host under
a different name)
(SETQ canonicalName (OR (\FCACHE.CANONICAL.HOSTNAME devname)
devname))
[COND
((AND canonicalName (NEQ devname canonicalName))
(SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME)
of info)
canonicalName)))
(COND
(devInfo (RETURN (fetch (CACHEDEVINFO CACHEDEV) of devInfo]
(* If we should generically start it, go ahead and
make a new cache devcie)
(SETQ realDevice (\GETDEVICEFROMNAME canonicalName T T))
[COND
([AND (NOT dontCreate?)
(NOT (for name in (\FCACHE.PROPERTY (QUOTE BADDEVICES))
thereis (EQ canonicalName name)))
(if realDevice
then (for dev in \FCACHE.GENERIC.DEVICES
thereis (EQ (\FCACHE.GENERIC.DEVICE.TYPE realDevice)
(fetch DEVICENAME of dev)))
else (for dev in \FCACHE.GENERIC.DEVICES thereis (FDEVOP
(QUOTE HOSTNAMEP)
dev canonicalName]
(* we should create the device on the fly)
(RETURN (OR (FCACHE.START canonicalName)
(\GETDEVICEFROMNAME canonicalName noError? dontCreate?]
(* nope, so just go with the generic system code)
(RETURN (OR realDevice (\GETDEVICEFROMNAME canonicalName noError? dontCreate?])
(\GETREALDEVICEFROMHOSTNAME
[LAMBDA (name dontCreate? ignoreDevice) (* smL " 7-Aug-85 17:06")
(* * Used by the cacher to get the REAL device for this name. This is a clone of the function
\GETDEVICEFROMHOSTNAME, except that this excludes the given device from consideration.)
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \FILEDEVICES))
(OR [CDR (for devNamePair in \DEVICENAMETODEVICE when (NEQ ignoreDevice (CDR devNamePair))
thereis (EQ name (CAR devNamePair]
[PROGN (SETQ name (U-CASE name))
(CDR (for devNamePair in \DEVICENAMETODEVICE when (NOT (EQ ignoreDevice (CDR
devNamePair)))
thereis (EQ name (CAR devNamePair]
(AND (NOT dontCreate?)
(for dev in \FILEDEVICES bind temp when (AND (NEQ ignoreDevice dev)
(SETQ temp (FDEVOP (QUOTE HOSTNAMEP)
dev name dev)))
do (if (type? FDEV temp)
then (SETQ dev temp))
(\DEFINEDEVICE name dev)
(RETURN dev])
(\FCACHE.CANONICAL.HOSTNAME
[LAMBDA (name) (* smL "11-Feb-86 16:25")
(* * Get the "canonical" hostname for the device)
(* * This is more or less what the standard CANONICAL.HOSTNAME function should be doing, but doesn't.
In fact, this is the same as CANONICAL.HOSTNAME except for the first test in the COND)
(* * NOTE that for "internal" predefined device, this will NOT talk on the net)
(U-CASE (MKATOM (LET ((dev (\GETDEVICEFROMNAME name T T)))
(if [AND dev (NOT (MEMB (fetch DEVICENAME of dev)
(QUOTE (DPUPFTP]
then (* It's a good bet that the device is an internal one)
(fetch DEVICENAME of dev)
elseif (STRPOS ":" (OR (FILENAMEFIELD name (QUOTE HOST))
name))
then (\CANONICAL.NSHOSTNAME (OR (FILENAMEFIELD name
(QUOTE
HOST))
name))
else (\CANONICAL.HOSTNAME (OR (FILENAMEFIELD name
(QUOTE HOST))
name])
(\FCACHE.GENERIC.DEVICE.TYPE
[LAMBDA (device) (* smL " 6-Feb-86 14:09")
(* * HACK: This tries to figure out what the "generic" type of a device is, either LEAF or NSFILING.
Should be a field in the device or something.)
(KLUDGE (SELECTQ (fetch OPENFILE of device)
(\LEAF.OPENFILE (QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
NIL])
)
(* * Functions for loading or removing a file into the cache)
(DEFINEQ
(\FCACHE.DELETE.ENTRY
[LAMBDA (entry) (* smL "12-Feb-86 09:43")
(* * Delete a cache entry)
(WITH.MONITOR \FCACHE.CACHELOCK (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(LET ((size (fetch CACHEFILELENGTH of entry)))
(* Flush the entry if it is dirty)
(if (\FCACHE.ENTRYOPEN? entry)
then (ERROR "Cached file is open, so can't delete entry for file "
(fetch REMOTEFILENAME of entry)))
(* Get rid of the file)
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Deleting entry "
(fetch REMOTEFILENAME of entry)))
(* A hack to make sure that the server is really
ready)
(CLEAR.LEAF.CACHE (FILENAMEFIELD (fetch REMOTEFILENAME of entry)
(QUOTE HOST)))
(DELFILE (fetch LOCALFILENAME of entry))
(* Now forget about the entry)
(change \FCACHE.LIST (DREMOVE entry DATUM))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
size])
(\FCACHE.INVENTNAME
[LAMBDA (REMOTENAME) (* smL "22-Jul-85 10:35")
(* * Remote files are cached in a file with the same name)
(LET ((FIELDS (UNPACKFILENAME REMOTENAME)))
(PACK* (\FCACHE.PROPERTY (QUOTE PREFIX))
(OR (\FCACHE.MAKE.LEGAL.FILENAME (LISTGET FIELDS (QUOTE NAME)))
"")
(QUOTE ".")
(OR (\FCACHE.MAKE.LEGAL.FILENAME (LISTGET FIELDS (QUOTE EXTENSION)))
""])
(\FCACHE.KEEPVERSIONS
[LAMBDA (fullFileName keepVersions) (* smL "14-Aug-85 10:26")
(* * Take older versions of the file and put them at the end of the cache list)
(if [OR (NOT (NUMBERP keepVersions))
(LESSP keepVersions 1)
(NOT (NUMBERP (FILENAMEFIELD fullFileName (QUOTE VERSION]
then (* don't bother)
NIL
else (for e in (for entry in \FCACHE.LIST
bind (versionlessName ←(U-CASE (VersionlessFileName fullFileName)))
(oldestVersion ←(ADD1 (DIFFERENCE (FILENAMEFIELD fullFileName
(QUOTE VERSION))
keepVersions)))
when (AND (EQ versionlessName (VersionlessFileName (fetch MATCHFILENAME
of entry)))
(LESSP (OR (FILENAMEFIELD (fetch MATCHFILENAME of entry)
(QUOTE VERSION))
oldestVersion)
oldestVersion))
collect entry)
do (* move the entry to the end)
(SETQ \FCACHE.LIST (NCONC1 (DREMOVE e \FCACHE.LIST)
e])
(\FCACHE.LOAD
[LAMBDA (fullName) (* smL "13-Mar-86 10:04")
(* * Load up a global file into the cache, returning the entry, or NIL if the load fails -
NOTE: This fn returns holding the entry's CACHELOCK. It should only be called within a RESETLST!)
(PROG (inStream remoteDevice outStream localFileName length idate entry inProgress?)
(* This first loop takes care of the possibility that
another process is already busy caching the file)
CheckCache
[WITH.MONITOR \FCACHE.CACHELOCK (SETQ entry (\FCACHE.LOOKUP (\GETUSERDEVICEFROMNAME
fullName)
fullName T))
(if (NULL entry)
then (SETQ inProgress? (MEMBER fullName \FCACHE.CACHING.FILES]
(if entry
then (GO Exit)
elseif inProgress?
then (AWAIT.EVENT \FCACHE.CACHE.CHANGED.EVENT)
(GO CheckCache)
else (RESETSAVE (push \FCACHE.CACHING.FILES fullName)
(LIST (FUNCTION [LAMBDA (file)
(SETQ \FCACHE.CACHING.FILES (DREMOVE file
\FCACHE.CACHING.FILES))
(NOTIFY.EVENT \FCACHE.CACHE.CHANGED.EVENT])
fullName))) (* Try to open the remote file)
[SETQ inStream (OPENSTREAM fullName (QUOTE INPUT)
(QUOTE OLD)
(QUOTE (FCACHE.INTERNAL SEQUENTIAL]
(if (NULL inStream)
then (GO Exit)
else (push \FCACHE.CACHING.FILES fullName))
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
inStream))
(replace USERVISIBLE of inStream with NIL)
(SETQ fullName (fetch FULLFILENAME of inStream))
(SETQ remoteDevice (fetch DEVICE of inStream))
(SETQ length (OR (GETFILEINFO inStream (QUOTE SIZE))
0)) (* See if the file is too big to cache)
(if (LET [(maxLength (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
(AND maxLength (IGREATERP length maxLength)))
then (CLOSEF? inStream)
(GO Exit)) (* Make sure there is enough room for the file)
(\FCACHE.KEEPVERSIONS fullName (\FCACHE.PROPERTY (QUOTE KEEPVERSIONS)))
(if (OR (NOT (ADD.FILE.TO.CACHE? fullName))
(NOT (\FCACHE.MAKEROOM length)))
then (CLOSEF? inStream)
(GO Exit))
(SETQ idate (FDEVOP (QUOTE GETFILEINFO)
remoteDevice inStream (QUOTE ICREATIONDATE)
remoteDevice))
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Caching " fullName))
[SETQ outStream (OPENSTREAM (\FCACHE.INVENTNAME fullName)
(QUOTE OUTPUT)
(QUOTE NEW)
NIL
(BQUOTE (FCACHE.INTERNAL
SEQUENTIAL
(TYPE , (FDEVOP (QUOTE GETFILEINFO)
remoteDevice inStream
(QUOTE TYPE)
remoteDevice))
(ICREATIONDATE , idate)
(LENGTH , (OR (FDEVOP (QUOTE
GETFILEINFO)
remoteDevice
inStream
(QUOTE LENGTH)
remoteDevice)
0]
(if outStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
outStream))
(replace USERVISIBLE of outStream with NIL)
(SETQ localFileName (fetch FULLFILENAME of outStream))
(COPYCHARS inStream outStream)
(CLOSEF inStream)
(CLOSEF outStream)
(* this SETFILEINFO is needed in case the local device does not do the right thing with the ICREATIONDATE in the
OPENSTREAM above. This ensures that the date of the local file matches the remote file)
(SETFILEINFO outStream (QUOTE ICREATIONDATE)
idate)
(SETQ entry (\FCACHE.ADDENTRY localFileName fullName idate
(GETFILEINFO inStream (QUOTE PLIST))
length))
(replace TIMELASTVERIFIED of entry with (OR (IDATE)
0)))
Exit(SETQ \FCACHE.CACHING.FILES (DREMOVE fullName \FCACHE.CACHING.FILES))
(if entry
then (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T))
(RETURN entry])
(\FCACHE.MAKE.LEGAL.FILENAME
[LAMBDA (file) (* smL "19-Feb-85 09:19")
(* * Convert a potential file name into something that the local file system will accept)
(PACK (for c inchars file
collect (SELCHARQ c
((A B C D E F G H I J K L M N O P Q R S T U V W X Y Z a b c d e f g h
i j k l m n o p q r s t u v w x y z 1 2 3 4 5 6 7 8 9 0 + - $
< >)
(CHARACTER c))
"$"])
(\FCACHE.MAKEROOM
[LAMBDA (length) (* smL "12-Mar-86 17:11")
(* * Make sure that there is enough room in the cache to hold this file)
(SETQ length (OR length 0))
(LET [(cacheMaxTotal (\FCACHE.PROPERTY (QUOTE MAXSIZE)))
(cacheSize (\FCACHE.PROPERTY (QUOTE SIZE)))
(freePages (OR [CAR (NLSETQ (SELECTQ (MACHINETYPE)
((DORADO DOLPHIN)
(* \GETDEVICEFROMNAME is a hack to program around bug)
(DIFFERENCE
[DISKFREEPAGES
(\GETDEVICEFROMNAME
(\FCACHE.PROPERTY (QUOTE PREFIX]
50))
(DIFFERENCE (DISKFREEPAGES
(\FCACHE.PROPERTY
(QUOTE PREFIX)))
100]
(ADD1 length]
(SETQ cacheMaxTotal (if (NUMBERP cacheMaxTotal)
then (MIN cacheMaxTotal (PLUS freePages cacheSize))
else (PLUS freePages cacheSize)))
(if (ILESSP cacheMaxTotal length)
then (* the file wont ever fit, so dont even try)
NIL
elseif (ILESSP (PLUS length cacheSize)
cacheMaxTotal)
then (* the file will fit w/o having to get rid of any old
cached files)
T
else (* delete some old files until it fits)
(* NOTE: this is ugly -- perhaps I would be better off if I maintained the cache list in the other order? But then
looking up files would be slowed. Oh well...)
(RESETLST (\FCACHE.DONE.OR.ABORTED.MSG "Making some room in the cache")
(for entry in (REVERSE \FCACHE.LIST)
bind (desiredLength ←(IDIFFERENCE cacheMaxTotal length))
do (WITH.MONITOR (fetch CACHELOCK of entry)
(if (AND (NOT (fetch CACHEISDIRTY
of entry))
(NOT (\FCACHE.ENTRYOPEN? entry))
(\FCACHE.MAKEROOM.DELETEABLE?
(fetch REMOTEFILENAME
of entry)))
then (\FCACHE.DELETE.ENTRY entry)))
(if (ILESSP (\FCACHE.PROPERTY (QUOTE SIZE))
desiredLength)
then (RETURN T))
finally (RETURN NIL])
(\FCACHE.MAKEROOM.DELETEABLE?
[LAMBDA (fileName) (* smL "11-Sep-85 13:17")
(* * Is this cache entry deleteable to make room for some new cache entry?)
T])
)
(RPAQ? \FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(RPAQ? \FCACHE.CACHE.CHANGED.EVENT (CREATE.EVENT (QUOTE FCACHE.CHANGED)))
(RPAQ? \FCACHE.CACHING.FILES NIL)
(RPAQ? \FCACHE.LIST NIL)
(RPAQ? \FCACHE.LIST.CHANGED? NIL)
(RPAQ? \FCACHE.LOGFILE NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.CACHELOCK \FCACHE.CACHE.CHANGED.EVENT \FCACHE.CACHING.FILES \FCACHE.LIST
\FCACHE.LIST.CHANGED? \FCACHE.LOGFILE)
)
(* * Scavenging functions)
(DEFINEQ
(FCACHE.SCAVENGE
[LAMBDA (options) (* smL "11-Sep-85 11:47")
(* * Build a list of all files in the cache directory that are not known to the cacher, and not on the list
FCACHE.SCAVENGE.IGNORE)
(WITHOUT.FCACHE (WITH.MONITOR
\FCACHE.CACHELOCK
(LET ((options (MKLIST options))
badList) (* make sure the cache size is correct)
(if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Recomputing cache size..." T))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(for entry in \FCACHE.LIST
sum (fetch CACHEFILELENGTH of entry)))
(* get rid of all entries that don't have coresponding
cached files)
(if (MEMB (QUOTE EXISTS)
options)
then (if (MEMB (QUOTE SILENT)
options)
then (for entry in \FCACHE.LIST
do (if (NOT (INFILEP (fetch LOCALFILENAME of entry)))
then (\FCACHE.DELETE.ENTRY entry)))
else (printout NIL "Verifying that cache files exist")
(for entry in \FCACHE.LIST
do (if (NOT (INFILEP (fetch LOCALFILENAME of entry)))
then (printout NIL "?")
(\FCACHE.DELETE.ENTRY entry)
else (printout NIL ".")))
(printout NIL T))) (* if we should, verify all files in the cache)
[if (MEMB (QUOTE VERIFY)
options)
then (if (MEMB (QUOTE SILENT)
options)
then (for entry in \FCACHE.LIST
do (if [NOT (WITH.MONITOR (fetch CACHELOCK of entry)
(\FCACHE.REPAIR.VERIFY
(fetch LOCALFILENAME
of entry)
(fetch REMOTEFILENAME
of entry]
then (\FCACHE.DELETE.ENTRY entry)))
else (printout NIL "Verifying that cache files are valid copies" T)
(for entry in \FCACHE.LIST
do (if [NOT (WITH.MONITOR (fetch CACHELOCK of entry)
(\FCACHE.REPAIR.VERIFY
(fetch LOCALFILENAME
of entry)
(fetch REMOTEFILENAME
of entry]
then (printout NIL "?")
(\FCACHE.DELETE.ENTRY entry)
else (printout NIL "."]
(* now collect the list of all files on the local disk
that are not cached files)
(if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Collecting unknown files from the cache..." T))
(SETQ badList (for file inunsortedfiles (CONCAT (FCACHE.GETPROP (QUOTE PREFIX)
)
"*.*;*")
eachtime (SETQ file (MKATOM (U-CASE file)))
when [NOT (for entry in \FCACHE.LIST
thereis (EQ file (fetch LOCALFILENAME
of entry]
collect file)) (* and then remove the files that match any on
FCACHE.SCAVENGE.IGNORE)
[for fileSpec in (CDR (ASSOC (MACHINETYPE)
FCACHE.SCAVENGE.IGNORE))
bind (host ←(FILENAMEFIELD (\FCACHE.PROPERTY (QUOTE PREFIX))
(QUOTE HOST)))
(dir ←(FILENAMEFIELD (\FCACHE.PROPERTY (QUOTE PREFIX))
(QUOTE DIRECTORY)))
while (NOT (NULL badList)) do (for file in badList
when (\FCACHE.FILEMATCH?
file
(PACKFILENAME (QUOTE BODY)
fileSpec
(QUOTE DIRECTORY)
dir
(QUOTE HOST)
host
(QUOTE VERSION)
"*"))
do (SETQ badList (DREMOVE file badList]
(* try to repair files if we are told to.)
[if (MEMB (QUOTE REPAIR)
options)
then (if (NOT (MEMB (QUOTE SILENT)
options))
then (printout NIL "Trying to repair unknown files..." T))
(for file in badList bind remoteFile alreadyCached
do [SETQ remoteFile (MKATOM (U-CASE (\FCACHE.REPAIR file]
[SETQ alreadyCached
(AND remoteFile (for entry in \FCACHE.LIST
when (EQ remoteFile
(fetch LOCALFILENAME
of entry))
thereis (\FCACHE.VERIFY
entry
(FILENAMEFIELD (fetch
REMOTEFILENAME
of entry)
(QUOTE HOST]
(if (NOT (MEMB (QUOTE SILENT)
options))
then (if alreadyCached
then (printout NIL file
" is a duplicate copy of "
remoteFile T)
elseif remoteFile
then (printout NIL file " is a copy of "
remoteFile T)
else (printout NIL "Can't match the file " file T)))
(if (AND (NOT alreadyCached)
remoteFile)
then (\FCACHE.ADDENTRY file remoteFile
(GETFILEINFO file (QUOTE
ICREATIONDATE))
(GETFILEINFO remoteFile
(QUOTE PLIST))
(GETFILEINFO file (QUOTE SIZE)))
(SETQ badList (DREMOVE file badList]
badList])
)
(DEFINEQ
(\FCACHE.REPAIR
[LAMBDA (localFileName) (* lmm " 6-Nov-85 15:58")
(* * Try to figure out what file this is a cached version of. RETURN the remote file name if you can)
(DECLARE (GLOBALVARS COMPILE.EXT LAFITEMAIL.EXT LAFITETOC.EXT LAFITEFORM.EXT
LAFITEFORMDIRECTORIES LAFITEDEFAULTHOST&DIR DISPLAYFONTDIRECTORIES
FILERDTBL DISPLAYFONTDIRECTORIES INTERPRESSFONTDIRECTORIES
PRESSFONTWIDTHSFILES LOGINHOST/DIR DIRECTORIES LISPUSERSDIRECTORIES))
(RESETLST (LET ((fileNameFields (U-CASE (UNPACKFILENAME localFileName)))
name ext stream expr)
(SETQ name (LISTGET fileNameFields (QUOTE NAME)))
(SETQ ext (LISTGET fileNameFields (QUOTE EXTENSION)))
(* * First try some magic based on the file name. If that doesn't work, try some generic method to find the remote
file. * *)
(OR (for lf in LOADEDFILELST when (STRPOS name lf)
when (EQ (PACKFILENAME (QUOTE NAME)
name
(QUOTE EXTENSION)
ext)
(NAMEFIELD lf T))
do (AND (\FCACHE.REPAIR.VERIFY localFileName lf)
(RETURN lf)))
(if (LISPSOURCEFILEP localFileName)
then (* possibly a LISP file -- see if the first expr in
the file is a FILECREATED expression)
[RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ stream (OPENSTREAM
localFileName
(QUOTE INPUT]
[SETQ expr (CAR (NLSETQ (READ stream FILERDTBL]
(if (AND (EQ (CAR expr)
(QUOTE FILECREATED))
(\FCACHE.REPAIR.VERIFY localFileName
(CADDR expr)))
then (CADDR expr)
else NIL))
(if (EQ ext COMPILE.EXT)
then [RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
(SETQ stream (OPENSTREAM
localFileName
(QUOTE INPUT]
[SETQ expr (CAR (NLSETQ (READ stream FILERDTBL]
(if (EQ (CAR expr)
(QUOTE FILECREATED))
then
(* now (CADR (CADDR expr)) is a pointer to the source file, so we need to figure out what DCOM file this is)
[CAR (NLSETQ (for file
inunsortedfiles
(PACKFILENAME.STRING
(QUOTE EXTENSION)
COMPILE.EXT
(QUOTE VERSION)
(QUOTE *)
(QUOTE BODY)
(CADR (CADDR expr)))
thereis (
\FCACHE.REPAIR.VERIFY
localFileName file]
else NIL))
(if (MEMB ext (LIST LAFITEMAIL.EXT (PACK* LAFITEMAIL.EXT
LAFITETOC.EXT)
LAFITEFORM.EXT))
then (* a LAFITE file, so look in the users mail directory)
(\FCACHE.REPAIR.FINDFILE localFileName (OR
LAFITEDEFAULTHOST&DIR
LOGINHOST/DIR)))
(if (AND (BOUNDP (QUOTE LAFITEFORMDIRECTORIES))
LAFITEFORMDIRECTORIES
(EQ ext LAFITEFORM.EXT))
then (* a LAFITE form, so check the form directory)
(\FCACHE.REPAIR.FINDFILE localFileName (MKLIST
LAFITEFORMDIRECTORIES)))
(if (MEMB ext (CONS (QUOTE WD)
DISPLAYFONTEXTENSIONS))
then (* a font file, so check the font directories)
(\FCACHE.REPAIR.FINDFILE localFileName (UNION
DISPLAYFONTDIRECTORIES
INTERPRESSFONTDIRECTORIES)))
(if (AND (EQ name (QUOTE FONTS))
(EQ ext (QUOTE WIDTHS)))
then (* a fonts widths file)
(for file in PRESSFONTWIDTHSFILES
when (NOT (EQ (U-CASE (FILENAMEFIELD file
(QUOTE
HOST)))
(QUOTE DSK)))
thereis (\FCACHE.REPAIR.VERIFY localFileName file)))
(\FCACHE.REPAIR.FINDFILE localFileName (UNION (LIST LOGINHOST/DIR)
DIRECTORIES
LISPUSERSDIRECTORIES])
(\FCACHE.REPAIR.FINDFILE
[LAMBDA (localFile dirList) (* smL " 5-Feb-86 14:13")
(* * Kind of like FINDFILE, but keeps looking on the directories untill a file matches)
(CAR (NLSETQ (OR (for dir inside dirList bind full
when (AND (NOT (STRPOS "DSK" dir NIL NIL NIL NIL (
UPPERCASEARRAY)))
(SETQ full (INFILEP (PACKFILENAME.STRING
(QUOTE VERSION)
NIL
(QUOTE DIRECTORY)
dir
(QUOTE BODY)
localFile)))
(\FCACHE.REPAIR.VERIFY localFile full))
do (RETURN full))
(for dir inside dirList
bind (name ←(FILENAMEFIELD localFile (QUOTE NAME)))
(extension ←(FILENAMEFIELD localFile (QUOTE EXTENSION)))
remoteFile
when (NOT (STRPOS "DSK" dir NIL NIL NIL NIL (UPPERCASEARRAY)))
do (SETQ remoteFile (for file inunsortedfiles
(PACKFILENAME.STRING
(QUOTE DIRECTORY)
dir
(QUOTE NAME)
name
(QUOTE EXTENSION)
extension)
thereis (\FCACHE.REPAIR.VERIFY localFile
file)))
(if remoteFile
then (RETURN remoteFile])
(\FCACHE.REPAIR.VERIFY
[LAMBDA (localFile remoteFile) (* smL " 5-Feb-86 14:11")
(* * Is the local file a copy of the remote file?)
(CAR (NLSETQ (AND (INFILEP localFile)
(INFILEP remoteFile)
(for prop in (QUOTE (ICREATIONDATE LENGTH)) bind info
always (AND (SETQ info (GETFILEINFO localFile prop))
(EQUAL info (GETFILEINFO remoteFile prop])
)
(RPAQ? FCACHE.SCAVENGE.IGNORE (QUOTE ((DANDELION FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DOVE FCACHE.POINTER FCACHE.LISTING FCACHE.LOG)
(DORADO FCACHE.POINTER FCACHE.LISTING FCACHE.LOG COM.CM
DISKDESCRIPTOR. DMT.BOOT DUMPER.BOOT EXECUTIVE.RUN
FTP.LOG FTP.RUN REM.CM SWAT. SWATEE. SYS.BOOT
SYS.ERRORS SYSDIR. SYSFONT.AL USER.CM))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FCACHE.SCAVENGE.IGNORE)
)
(* * Functions for creating or destroying a cache device)
(DEFINEQ
(\FCACHE.BUILD.DEVICE
[LAMBDA (devname) (* smL " 7-Aug-85 11:36")
(* * Build a cache device trying to inherit as much as possible from the local device)
(LET [(cacheDevice (create FDEV using (\FCACHE.LOCALDEVICE]
(replace DEVICENAME of cacheDevice with devname)
(replace NODIRECTORIES of cacheDevice with T)
(* other methods are special for the cache device)
(replace GENERATEFILES of cacheDevice with (QUOTE \FCACHE.GENERATEFILES))
(replace EVENTFN of cacheDevice with (QUOTE \FCACHE.EVENTFN))
(replace OPENFILE of cacheDevice with (QUOTE \FCACHE.OPENFILE))
(replace CLOSEFILE of cacheDevice with (QUOTE \FCACHE.CLOSEFILE))
(replace HOSTNAMEP of cacheDevice with (QUOTE \FCACHE.HOSTNAMEP))
(replace DIRECTORYNAMEP of cacheDevice with (QUOTE \FCACHE.DIRECTORYNAMEP))
(replace REOPENFILE of cacheDevice with (QUOTE \FCACHE.REOPENFILE))
(replace GETFILENAME of cacheDevice with (QUOTE \FCACHE.GETFILENAME))
(replace DELETEFILE of cacheDevice with (QUOTE \FCACHE.DELETEFILE))
(replace GETFILEINFO of cacheDevice with (QUOTE \FCACHE.GETFILEINFO))
(replace SETFILEINFO of cacheDevice with (QUOTE \FCACHE.SETFILEINFO))
(replace RENAMEFILE of cacheDevice with (QUOTE \FCACHE.RENAMEFILE))
cacheDevice])
(\FCACHE.OFF
[LAMBDA (device) (* lmm "22-Oct-85 16:05")
(* * Turn off the cache device)
(OR [\FCACHE.PROPERTY.PUT (QUOTE DEVICES)
(REMOVE (fetch (CACHEDEVICE CACHEDEVINFO) of device)
(\FCACHE.PROPERTY (QUOTE DEVICES]
(DEL.PROCESS (QUOTE DUMP-FCACHE)))
(\REMOVEDEVICE device])
)
(* * Functions for dealing with device events, like LOGOUT)
(DEFINEQ
(\FCACHE.DEVICE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL "13-Mar-86 10:33")
(* * The event fn for the dummy FCACHE device)
(SELECTQ EVENT
((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(if \FCACHE.LOGFILE
then (* the logfile was left open, so we had better get rid
of it quick -
this can only happen AFTERSAVEVM)
(SETQ \OPENFILES (DREMOVE \FCACHE.LOGFILE \OPENFILES))
(SETQ \FCACHE.LOGFILE NIL)) (* Restore the cache devices and info)
(\FCACHE.INITIALIZE.PROPS))
((AFTERDOMAKESYS AFTERDOSYSOUT AFTERDOSAVEVM)
(* Don't need to do anything here)
NIL)
((BEFORESYSOUT BEFOREMAKESYS BEFORESAVEVM) (* Dump out the cache listings)
(FCACHE.DUMP T))
(BEFORELOGOUT (* Dump the cache info)
[for entry in \FCACHE.LIST bind fileName
when (fetch CACHEISDIRTY of entry)
do (SETQ fileName (fetch REMOTEFILENAME of entry))
(if (\FCACHE.ENTRYOPEN? entry)
then (OR (BREAK1 T T "Can't flush file"
((printout NIL
"The cached version of the file "
fileName ,
"needs to be dumped to the fileserver, "
"but I can't because the file is open."
T
"If you continue with OK, I will continue with the LOGOUT."
T
"RETURN NIL will abort the LOGOUT."
T)))
(ERROR "Can't dump file " fileName))
elseif (\FCACHE.WRITEOUT entry)
then (* ok, the file was written out)
T
else (* can't dump the file!)
(OR (BREAK1 T T "Can't flush file"
((printout NIL
"The cached version of the file "
fileName ,
"needs to be dumped to the fileserver, "
"but I can't do it." T
"If you continue with OK, I will continue with the LOGOUT."
T
"RETURN NIL will abort the LOGOUT."
T)))
(ERROR "Can't dump file " fileName]
(for entry in \FCACHE.LIST when (FCACHE.PRIVATE.FILE?
(fetch REMOTEFILENAME
of entry))
do (\FCACHE.DELETE.ENTRY entry))
(FCACHE.DUMP T))
(\ILLEGAL.ARG EVENT])
(\FCACHE.INITIALIZE.PROPS
[LAMBDA NIL (* smL "12-Mar-86 13:47")
(* * Reinitialize the cache properties.)
(SETQ \FCACHE.LOGFILE NIL)
(if (INFILEP (QUOTE {DSK}FCache.pointer;1))
then (LET [(f (OPENFILE (QUOTE {DSK}FCache.pointer;1)
(QUOTE INPUT]
[\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
(MKATOM (CAR (NLSETQ (READ f]
(CLOSEF f))
(OR (\FCACHE.RESTORE (\FCACHE.PROPERTY (QUOTE PREFIX)))
(\FCACHE.RESTORE NIL))
else (PROG ((f (OPENFILE (QUOTE {DSK}FCache.pointer;1)
(QUOTE OUTPUT)))
prefix)
(CLEARW \FCACHE.PROMPT.WINDOW)
TryAgain
[SETQ prefix (MKATOM (RESETBUFS (PROMPTFORWORD
"What should the file cache prefix be (NIL to disable)? "
(SELECTQ (MACHINETYPE)
((DORADO
DOLPHIN)
"{DSK1}")
(DANDELION
"{DSK}<LispFiles>Cache>")
NIL)
NIL \FCACHE.PROMPT.WINDOW
NIL T]
(if (\FCACHE.RESTORE prefix)
then (CLOSEW \FCACHE.PROMPT.WINDOW)
(printout f .P2 (\FCACHE.PROPERTY (QUOTE PREFIX))
T)
(CLOSEF f)
else (printout \FCACHE.PROMPT.WINDOW T "Bad device specification: " prefix T)
(GO TryAgain])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.DEVICE)
)
(* Make sure the cache devices are at the top of the list of known devices before we do any
device event -- in other words, a big HACK)
(DEFINEQ
(\FCACHE.GLOBAL.EVENT
[LAMBDA (EVENT) (* lmm "14-Sep-85 19:03")
(* * Before doing a device event, make sure the cache devices are the last devices defined. The dummey one should be
positioned so that it gets the event first after a logout.)
(\REMOVEDEVICE \FCACHE.DEVICE)
(\DEFINEDEVICE (QUOTE FCACHE)
\FCACHE.DEVICE)
(for x in (\FCACHE.PROPERTY (QUOTE DEVICES)) do (LET ((device (fetch CACHEDEV of x)))
(\REMOVEDEVICE device)
(\DEFINEDEVICE (PACK* (fetch REALDEVICENAME
of x)
(QUOTE -CACHE))
device)))
(SELECTQ EVENT
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(\FCACHE.AROUNDEXIT))
NIL])
)
(APPENDTOVAR AROUNDEXITFNS \FCACHE.GLOBAL.EVENT)
(* Before revalidating files, load the LOG file, if any -- in other words, a big HACK)
(DEFINEQ
(\FCACHE.AROUNDEXIT
[LAMBDA NIL (* smL "11-Feb-86 18:17")
(* * Called before revalidating files after a logout -- make sure that the cache info is up to date.
In other words, after an event, check for a log file)
(RESETLST (PROG (prefix logfileName) (* forget it if there is no cache)
(SETQ prefix (\FCACHE.PROPERTY (QUOTE PREFIX)))
(if (NULL prefix)
then (RETURN NIL))
(SETQ logfileName (PACK* prefix "FCache.Log;1"))
(* close the log file if it is open)
(if (OPENP logfileName)
then (SETQ \FCACHE.LOGFILE (GETSTREAM logfileName))
(replace USERCLOSEABLE of \FCACHE.LOGFILE with T)
(CLOSEF? \FCACHE.LOGFILE))
(* skip loading the entries it if there is no log
file)
(if (NOT (INFILEP logfileName))
then (RETURN T)) (* load the entries from the log file)
(\FCACHE.DONE.OR.ABORTED.MSG "Restoring log entries")
(SETQ \FCACHE.LOGFILE (OPENSTREAM logfileName (QUOTE INPUT)))
[bind entrydef while (NOT (EOFP \FCACHE.LOGFILE))
do (SETQ entrydef (NLSETQ (READ \FCACHE.LOGFILE)))
(if entrydef
then (\FCACHE.RESTORE.ENTRY (CAR entrydef)
T)
else (LET ((errorWindow (CREATEW (create REGION
LEFT ← 250
BOTTOM ← 250
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache log file was not completly dumped."
"The cacher may have lost track of some files."
"If there were any files that needed to be dumped, "
"they may have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."]
(FCACHE.DUMP)
(RETURN T])
)
(* * Catch changes to the current user / password)
(* This is a HACK)
(DEFINEQ
(\FCACHE.BEFORELOGIN
[LAMBDA (HOST) (* smL "13-Mar-86 13:12")
(* * The user is about to be changed. Make sure that all dirty files have been dumped.)
(if (NULL HOST)
then (for entry in \FCACHE.LIST bind fileName when (fetch CACHEISDIRTY
of entry)
do (SETQ fileName (fetch REMOTEFILENAME of entry))
(if (\FCACHE.ENTRYOPEN? entry)
then (OR (BREAK1 T T "Can't flush file"
((printout NIL "The cached version of the file "
fileName ,
"needs to be dumped to the fileserver, "
"but I can't because the file is open."
T "If you continue with OK, "
"I will continue with changing the password."
T "RETURN NIL will abort it." T)))
(ERROR "Can't dump file " fileName))
elseif (\FCACHE.WRITEOUT entry)
then (* ok, the file was written out)
T
else (* can't dump the file!)
(OR (BREAK1 T T "Can't flush file"
((printout NIL "The cached version of the file "
fileName ,
"needs to be dumped to the fileserver, "
"but I can't do it." T
"If you continue with OK, "
"I will continue with changing the password."
T "RETURN NIL will abort it." T)))
(ERROR "Can't dump file " fileName])
(\FCACHE.\INTERNAL/SETPASSWORD
[LAMBDA (HOST NEWNAME/PASS DIRECTORY ALWAYSASK MSG DEFAULTNAME OSTYPE)
(* smL "13-Mar-86 13:13")
(* * A replacement for \INTERNAL/SETPASSWORD)
(for fn in \BEFORELOGINFNS do (APPLY* fn HOST NEWNAME/PASS DIRECTORY ALWAYSASK MSG
DEFAULTNAME OSTYPE))
(\OLD\INTERNAL/SETPASSWORD HOST NEWNAME/PASS DIRECTORY ALWAYSASK MSG DEFAULTNAME OSTYPE])
)
(ADDTOVAR \BEFORELOGINFNS \FCACHE.BEFORELOGIN)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \BEFORELOGINFNS)
)
(* * Methods for the {FCACHE} file device. Note that methods that are not defined are not
really needed since {FCACHE} is a specialization of the local device that holds the cache, and
inherits all bin/bout like methods)
(DEFINEQ
(\FCACHE.CLOSEFILE
[LAMBDA (STREAM) (* smL "11-Feb-86 18:55")
(* * Implements the CLOSEFILE method for the {FCACHE} device.)
(RESETLST (PROG (cacheDevice localDevice entry result)
(SETQ cacheDevice (fetch DEVICE of STREAM))
(SETQ localDevice (\FCACHE.LOCALDEVICE))
(if (NULL (SETQ entry (\FCACHE.LOOKUP cacheDevice STREAM NIL)))
then (ERROR "Lost the cache entry for " STREAM))
(if (SETQ result (FDEVOP (QUOTE CLOSEFILE)
localDevice STREAM))
then (* For some reason, if we don't do this OPENP thinks
the local file is still open)
(CLOSEF? (fetch LOCALFILENAME of entry))
(if (fetch CACHEISDIRTY of entry)
then (* Update the file size, since it probably changed)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE
(\FCACHE.PROPERTY (QUOTE
SIZE))
(fetch CACHEFILELENGTH
of entry)))
(replace CACHEFILELENGTH of entry
with (FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
(QUOTE SIZE)
localDevice))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY
(QUOTE SIZE))
(fetch CACHEFILELENGTH
of entry)))
(\FCACHE.MAKEROOM))
(replace CACHETIMECLOSED of entry with (IDATE))
(RETURN result)
else (ERROR "Can't close the cache file " (fetch LOCALFILENAME
of entry])
(\FCACHE.DELETEFILE
[LAMBDA (NAME DEVICE) (* smL "11-Feb-86 18:56")
(* * Implements the DELETEFILE method for the {FCACHE} device.)
(RESETLST (LET ((fullName (\FCACHE.GETFILENAME NAME (QUOTE OLDEST)
DEVICE))
entry)
(SETQ entry (if fullName
then (\FCACHE.LOOKUP DEVICE fullName T)))
(if (OR (NULL fullName)
(AND entry (\FCACHE.ENTRYOPEN? entry)))
then NIL
else (* delete the cache entry, then the remote file)
(if entry
then (\FCACHE.DELETE.ENTRY entry))
(if (AND entry (fetch CACHEISDIRTY of entry)
(NOT (fetch FILEXISTED of entry)))
then fullName
else (REALDEVOP (QUOTE DELETEFILE)
DEVICE fullName DEVICE])
(\FCACHE.DIRECTORYNAMEP
[LAMBDA (HostAndDir DEVICE) (* smL "27-Feb-86 11:20")
(* * Implements the DIRECTORYNAMEP method for the {FCACHE} device)
(RESETLST
(LET ((hostName (fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)))
(OR
(AND
(if (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
FCACHE.DEAD.HOSTS)
then T
else (SELECTQ
(\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T (fetch (CACHEDEVICE
REALDEVICENAME)
of DEVICE)
,
"does not seem to be responding for directory name verification."
T "Trusting that" , HostAndDir , "is OK.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT "Can't verify if" T .FONT
BOLDFONT .CENTER 0 HostAndDir .FONT DEFAULTFONT T
"is a valid directory name"
T T .CENTER 0 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache" Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow (QUOTE
ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead (pushnew FCACHE.DEAD.HOSTS
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL))
HostAndDir)
(REALDEVOP (QUOTE DIRECTORYNAMEP)
DEVICE HostAndDir DEVICE])
(\FCACHE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL "11-Feb-86 16:13")
(* * EVENT method for the cached device)
(SELECTQ EVENT
((BEFORESYSOUT BEFOREMAKESYS BEFORELOGOUT BEFORESAVEVM)
(* Don't need to do anything here)
NIL)
[(AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(* Restore the device)
(if (NULL (\FCACHE.PROPERTY (QUOTE PREFIX)))
then (* no cache prefix, so delete this cache device)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"No cache prefix, so turning off cache for "
(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)))
(\FCACHE.OFF DEVICE)
elseif [NOT (for stream in \OPENFILES thereis (EQ DEVICE
(fetch DEVICE
of stream]
then (* there is no open file on this device, so forget it)
(\FCACHE.OFF DEVICE)
else (LET [(newDevice (\FCACHE.BUILD.DEVICE (fetch (CACHEDEVICE
REALDEVICENAME)
of DEVICE]
(if (type? FDEV newDevice)
then (for descr in (GETDESCRIPTORS (QUOTE FDEV))
do (REPLACEFIELD descr DEVICE (FETCHFIELD descr
newDevice)))
else (if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
(fetch (CACHEDEVICE REALDEVICENAME)
of DEVICE)
" no longer a known host, do turning off its cache"))
(\FCACHE.OFF DEVICE]
((AFTERDOMAKESYS AFTERDOSYSOUT AFTERDOSAVEVM)
(* Don't need to do anything here)
NIL)
(\ILLEGAL.ARG EVENT])
(\FCACHE.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* smL " 7-Aug-85 18:09")
(* * Implements the GENERATEFILES method for the {FCACHE} device.)
(if (\FCACHE.USELOCALDIRECTORY? (fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)
PATTERN)
then (\FCACHE.GENERATE.LOCAL.FILES DEVICE PATTERN DESIREDPROPS OPTIONS)
elseif (\FCACHE.PROPERTY (QUOTE FASTDIR))
then (REALDEVOP (QUOTE GENERATEFILES)
DEVICE DEVICE PATTERN DESIREDPROPS OPTIONS)
else (MERGE.FILEGENERATORS (REALDEVOP (QUOTE GENERATEFILES)
DEVICE DEVICE PATTERN DESIREDPROPS OPTIONS)
(\FCACHE.GENERATE.LOCAL.FILES DEVICE PATTERN DESIREDPROPS OPTIONS T)
(FMEMB (QUOTE SORT)
OPTIONS])
(\FCACHE.GETFILEINFO
[LAMBDA (NameOrStream Attribute Device) (* smL "12-Feb-86 11:33")
(* * Implements the GETFILEINFO method for {FCACHE}. If the file is cached, try to fetch the property locally.
Otherwise, pass on the the remote host.)
(RESETLST (LET ((entry (\FCACHE.LOOKUP Device NameOrStream T)))
(if entry
then (\FCACHE.ENTRYINFO Device entry Attribute)
else (REALDEVOP (QUOTE GETFILEINFO)
Device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME of NameOrStream)
else NameOrStream)
Attribute Device])
(\FCACHE.GETFILENAME
[LAMBDA (NAME RECOG DEVICE) (* smL "13-Mar-86 14:27")
(* * Implements the GETFILENAME method for the {FCACHE} file device.)
(DECLARE (GLOBALVARS \CONNECTED.DIRECTORY))
(for entry in \FCACHE.LIST
bind (RECOG ←(OR RECOG (QUOTE OLD)))
(givenVersion ←(FILENAMEFIELD NAME (QUOTE VERSION)))
(hostName ←(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE))
filter file fileVersion entryVersion
first
(* * Try to get the file from the remote host)
(if [AND givenVersion (MEMB RECOG (QUOTE (NEW OLD/NEW]
then (* we are given a full name, so return it)
(RETURN NAME)
elseif (NOT (\FCACHE.USELOCALDIRECTORY? hostName NAME))
then (SETQ file (REALDEVOP (QUOTE GETFILENAME)
DEVICE NAME RECOG DEVICE))
(if [AND file givenVersion (MEMB RECOG (QUOTE (OLDEST OLD]
then (* in this case, we don't need to check the local
files at all)
(RETURN file)))
(* * Now we need to check the local files to see if that would change the answer from the remote host.
Ugh.)
[SETQ filter (if givenVersion
then (MatchFileName (PACKFILENAME.STRING (QUOTE BODY)
NAME
(QUOTE HOST)
hostName
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY))
else (DIRECTORY.MATCH.SETUP (PACKFILENAME.STRING (QUOTE
VERSION)
"*"
(QUOTE
BODY)
NAME
(QUOTE
HOST)
hostName
(QUOTE
DIRECTORY)
\CONNECTED.DIRECTORY]
when [if givenVersion
then (EQ filter (fetch MATCHFILENAME of entry))
else (AND (DIRECTORY.MATCH filter (fetch MATCHFILENAME of entry))
(EQ hostName (\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD
(fetch MATCHFILENAME
of entry)
(QUOTE HOST]
do (if (WITH.MONITOR (fetch CACHELOCK of entry)
(if (NOT (\FCACHE.VERIFY entry DEVICE))
then (* oops, a bad entry!)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM*
"[Invalid cache file!]"
T))
(\FCACHE.DELETE.ENTRY entry)
T
else NIL))
then (GO $$ITERATE))
(SETQ fileVersion (FILENAMEFIELD file (QUOTE VERSION)))
(SETQ entryVersion (FILENAMEFIELD (fetch REMOTEFILENAME of entry)
(QUOTE VERSION)))
(if (NULL givenVersion)
then (SELECTQ RECOG
[OLDEST (if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LESSP entryVersion fileVersion)))
then (* this entry is an older one, so update the oldest)
(SETQ file (fetch REMOTEFILENAME
of entry]
[(OLD/NEW OLD)
(if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LESSP fileVersion entryVersion)))
then (* this entry is newer than the current guess, so
update the guess)
(SETQ file (fetch REMOTEFILENAME of entry]
[NEW (if (OR (NULL file)
(AND (NUMBERP fileVersion)
(NUMBERP entryVersion)
(LEQ fileVersion entryVersion)))
then (* this entry is at least as new as the current guess,
so update the guess)
(SETQ file
(if (NUMBERP entryVersion)
then (PACK* (VersionlessFileName
(fetch REMOTEFILENAME
of entry))
";"
(ADD1 entryVersion))
else (fetch REMOTEFILENAME of entry]
(\ILLEGAL.ARG RECOG))
elseif (EQP entryVersion givenVersion)
then (* we have a match, so go with it)
(RETURN (fetch REMOTEFILENAME of entry))
else (* given an explicit version number, but this entry
doesn't match it, so do nothing)
NIL)
finally
(* * if we found no matching file, and RECOG is NEW or OLD/NEW, then create one with version = 1)
[if [AND (NULL file)
(MEMB RECOG (QUOTE (NEW OLD/NEW]
then (* no old file, so create a new one)
(SETQ file (if (STRPOS "." NAME)
then (PACK* (VersionlessFileName NAME)
";1")
else (PACK* (VersionlessFileName NAME)
".;1"]
(RETURN file])
(\FCACHE.HOSTNAMEP
[LAMBDA (hostName device) (* smL " 8-Aug-85 13:23")
(* * The HOSTNAMEP method of a cached device)
NIL])
(\FCACHE.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* smL "12-Mar-86 16:55")
(* * Implements the OPENFILE method for the {FCACHE-whatever} file device.)
(* Why is this RESETLST here, you ask? So that the cache lookup can return us a cache entry with the lock on that
entry in our possesion, knowing that the lock will be released in the enclosing RESETLST)
(RESETLST (LET ((localDevice (\FCACHE.LOCALDEVICE))
fullName cacheStream cacheEntry fileExisted? filePages)
(* * Set the default RECOG)
[SETQ RECOG (OR RECOG (SELECTQ ACCESS
(INPUT (QUOTE OLD))
(OUTPUT (QUOTE NEW))
((BOTH APPEND)
(QUOTE OLD/NEW))
(\ILLEGAL.ARG ACCESS]
(* * Try to get a cache entry)
(SETQ filePages (OR (CADR (ASSOC (QUOTE SIZE)
PARAMETERS))
(FOLDHI (OR (CADR (ASSOC (QUOTE LENGTH)
PARAMETERS))
0)
BYTESPERPAGE)))
(SETQ fullName (\FCACHE.USECACHE? NAME ACCESS RECOG PARAMETERS DEVICE
filePages))
(if (type? CACHENTRY fullName)
then (* We already have the cache entry, go ahead and use
it)
(SETQ fileExisted? T)
(SETQ cacheEntry fullName)
(SETQ fullName (fetch REMOTEFILENAME of cacheEntry))
elseif fullName
then (* We should use the cache, but there is no cache
entry available)
(SELECTQ ACCESS
(INPUT (SETQ cacheEntry (\FCACHE.LOAD fullName)))
[(OUTPUT BOTH APPEND)
(SETQ fileExisted? (FDEVOP (QUOTE GETFILENAME)
DEVICE fullName
(QUOTE OLD)
DEVICE))
(if fileExisted?
then (SETQ cacheEntry (\FCACHE.LOAD fullName))
else (* We get to add a brand new file to the cache)
(\FCACHE.KEEPVERSIONS fullName
(\FCACHE.PROPERTY
(QUOTE KEEPVERSIONS)
))
(SETQ cacheEntry (\FCACHE.ADDENTRY
(OUTFILEP (\FCACHE.INVENTNAME fullName))
fullName
(IDATE)
NIL filePages]
(\ILLEGAL.ARG ACCESS)))
(* * Now if we have a cache entry, try to open it)
(if cacheEntry
then (SETQ cacheStream (FDEVOP (QUOTE OPENFILE)
localDevice
(fetch LOCALFILENAME of cacheEntry)
ACCESS RECOG PARAMETERS localDevice)))
(* * If we are lucky and managed to cache, we have an open stream...)
(if cacheStream
then (* we succeeded in our attempts to cache the file.
Patch up the FULLFILENAME and DEVICE fields to fool
any consumers of this stream.)
(replace FULLFILENAME of cacheStream
with (fetch REMOTEFILENAME of cacheEntry))
(replace DEVICE of cacheStream with DEVICE)
(* Store a pointer on the cache stream back to the
cache entry)
(STREAMPROP cacheStream (QUOTE cacheEntry)
cacheEntry) (* Fill in appropriate fields in the cache entry)
(if (MEMB ACCESS (QUOTE (OUTPUT BOTH APPEND)))
then (replace CACHEISDIRTY of cacheEntry with T)
(replace CACHETIMECLOSED of cacheEntry with NIL)
(replace FILEXISTED of cacheEntry
with (AND fileExisted? T))
(\FCACHE.LOGENTRY cacheEntry))
(* Advance this entry to the head of the list)
(\FCACHE.PROMOTE cacheEntry DEVICE)
(* Return the cache stream)
cacheStream
else (* For one reason or another, we don't cache this
file)
(REALDEVOP (QUOTE OPENFILE)
DEVICE NAME ACCESS RECOG PARAMETERS DEVICE])
(\FCACHE.RENAMEFILE
[LAMBDA (OLDNAME NEWNAME DEVICE) (* smL "27-Feb-86 13:14")
(* * Impelments the RENAMEFILE method for the {FCACHE} file device.)
(RESETLST (PROG ((OldRemoteName (\FCACHE.GETFILENAME OLDNAME (QUOTE OLD)
DEVICE))
(fullNewName (FDEVOP (QUOTE GETFILENAME)
DEVICE NEWNAME (QUOTE NEW)
DEVICE))
(localDevice (\FCACHE.LOCALDEVICE))
entry newLocalName newRemoteName oldStream)
(* can't rename open files)
(if (SETQ oldStream (AND (OPENP OldRemoteName)
(GETSTREAM OldRemoteName)))
then (ERROR "File open, can't rename " OLDNAME))
(* flush the cache if it is dirty)
(if (AND (SETQ entry (\FCACHE.LOOKUP DEVICE OldRemoteName T))
(NOT (\FCACHE.WRITEOUT entry)))
then (ERROR "Can't flush file, so can't rename " OLDNAME))
(* Then do the rename on the remote host)
[SETQ newRemoteName (INFILEP (LET ((realDevice (fetch (CACHEDEVICE
REALDEVICE)
of DEVICE)))
(if (fetch RENAMEFILE of
realDevice)
then (REALDEVOP (QUOTE
RENAMEFILE)
DEVICE
OldRemoteName
fullNewName
DEVICE)
else (\GENERIC.RENAMEFILE
OldRemoteName
fullNewName]
(* Now fix up the cache -- recompute the entry in case
the rename of the file changed the cache -- like
\GENERIC.RENAMEFILE does)
(if (SETQ entry (\FCACHE.LOOKUP DEVICE OldRemoteName T))
then (SETQ newLocalName (\FCACHE.INVENTNAME newRemoteName))
(FDEVOP (QUOTE RENAMEFILE)
localDevice
(fetch LOCALFILENAME entry)
newLocalName localDevice)
(replace LOCALFILENAME of entry with (INFILEP newLocalName)
)
(replace REMOTEFILENAME of entry with newRemoteName)
(replace MATCHFILENAME of entry with (MatchFileName
newRemoteName)))
(RETURN newRemoteName])
(\FCACHE.REOPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* smL "11-Feb-86 18:57")
(* * Implements the REOPENFILE method for the {FCACHE} file device.)
(if (NOT (STREAMPROP OLDSTREAM (QUOTE cacheEntry)))
then (* it was not a cached file, so we shouldn't be here.
But just to be safe...)
NIL
else (RESETLST (LET ((entry (\FCACHE.LOOKUP DEVICE (fetch FULLFILENAME of OLDSTREAM)
T))
(localDevice (\FCACHE.LOCALDEVICE))
newStream)
(if entry
then (STREAMPROP OLDSTREAM (QUOTE cacheEntry)
entry)
(OR (RESETLST (RESETSAVE
(replace DEVICE of OLDSTREAM
with localDevice)
(LIST (FUNCTION [LAMBDA (stream
device)
(replace DEVICE
of stream with device]
)
OLDSTREAM DEVICE))
(SETQ newStream
(FDEVOP (QUOTE REOPENFILE)
localDevice
(fetch LOCALFILENAME
of entry)
ACCESS RECOG PARAMETERS
localDevice OLDSTREAM))
(if newStream
then (replace DEVICE of
newStream
with DEVICE)
(STREAMPROP newStream
(QUOTE
cacheEntry)
entry))
newStream)
(\FCACHE.OPENFILE NAME ACCESS RECOG PARAMETERS
DEVICE))
else (* it wasn't -- so punt!)
NIL])
(\FCACHE.SETFILEINFO
[LAMBDA (NameOrStream attribute value device) (* smL "12-Feb-86 11:33")
(* * The SETFILEINFO method for a cached device)
(RESETLST (LET ((localDevice (\FCACHE.LOCALDEVICE))
(entry (\FCACHE.LOOKUP device NameOrStream T))
result)
(if (NULL entry)
then (* no cached copy, so do it on the remote one)
(SETQ result (REALDEVOP (QUOTE SETFILEINFO)
device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME
of NameOrStream)
else NameOrStream)
attribute value device))
elseif (AND (fetch CACHEISDIRTY of entry)
(NOT (fetch FILEXISTED of entry)))
then (* there is no remote file, so do it on the local one)
(SETQ result (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice))
elseif (AND (fetch CACHEISDIRTY of entry)
(EQ attribute (QUOTE LENGTH)))
then (* we can get away with doing it on the local one
only, as long as we are careful)
(SETQ result (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice))
else (* we really need to do it on the remote file)
(SETQ result (REALDEVOP (QUOTE SETFILEINFO)
device
(if (STREAMP NameOrStream)
then (fetch FULLFILENAME
of NameOrStream)
else NameOrStream)
attribute value device))
(if result
then (FDEVOP (QUOTE SETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute value localDevice)))
(* patch up any fields in the cache entry)
(if (AND result entry)
then (SELECTQ attribute
(LENGTH (replace CACHEFILELENGTH of entry
with value))
(CREATIONDATE (replace CACHEFILEDATE of entry
with (IDATE value)))
(ICREATIONDATE (replace CACHEFILEDATE of entry
with value))
(PLIST (replace CACHEFILEPROPS of entry with value))
NIL))
result])
)
(* Helper fns)
(DEFINEQ
(\FCACHE.ENTRYINFO
[LAMBDA (cacheDevice entry attribute) (* smL " 7-Aug-85 18:25")
(* * Get file information for a cache entry)
(SELECTQ attribute
(ICREATIONDATE (* this prop is stored in the entry)
(fetch CACHEFILEDATE of entry))
(CREATIONDATE (* this prop is stored in the entry)
(GDATE (fetch CACHEFILEDATE of entry)))
(SIZE (* this prop is stored in the entry)
(if (fetch CACHEISDIRTY of entry)
then (LET ((localDevice (\FCACHE.LOCALDEVICE)))
(FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute localDevice))
else (fetch CACHEFILELENGTH of entry)))
(CACHEDIRTY (* Is the local cache dirty?)
(fetch CACHEISDIRTY of entry))
(CACHEFILE (* We add a file attribute, the CACHEFILE property
that tells where a given remote file is cached)
(fetch LOCALFILENAME of entry))
((TYPE LENGTH) (* For these file props, the local device holds the
info)
(LET ((localDevice (\FCACHE.LOCALDEVICE)))
(FDEVOP (QUOTE GETFILEINFO)
localDevice
(fetch LOCALFILENAME of entry)
attribute localDevice)))
(AND (REALDEVOP (QUOTE GETFILENAME)
cacheDevice
(fetch REMOTEFILENAME of entry)
(QUOTE OLD)
cacheDevice)
(REALDEVOP (QUOTE GETFILEINFO)
cacheDevice
(fetch REMOTEFILENAME of entry)
attribute cacheDevice])
)
(* * Directory enumeration functions)
(DEFINEQ
(\FCACHE.GENERATE.FILEINFO
[LAMBDA (genfilestate attribute) (* smL " 4-Feb-86 14:17")
(* * FILEINFOFN for the local directory generator)
(if (fetch (LocalFileGenerator FileGenPrevEntry) of genfilestate)
then (GETFILEINFO (fetch LOCALFILENAME of (fetch (LocalFileGenerator
FileGenPrevEntry)
of genfilestate))
attribute])
(\FCACHE.GENERATE.FILES.DEPTH
[LAMBDA (pattern) (* smL " 5-Feb-86 10:05")
(* * How many subdirectories are specified in the file pattern?)
(PROG ((count 0)
(pos 0))
LOOP(SETQ pos (STRPOS ">" pattern (ADD1 pos)))
(if (NULL pos)
then (RETURN count)
else (add count 1)
(GO LOOP])
(\FCACHE.GENERATE.LOCAL.FILES
[LAMBDA (device pattern desiredprops options dirtyOnly?) (* smL "10-Feb-86 19:15")
(* * Use the currently cached files to look up files)
(LET [(entries (for entry in \FCACHE.LIST
bind (filter ←(DIRECTORY.MATCH.SETUP pattern))
(hostName ←(fetch (CACHEDEVICE REALDEVICENAME) of device))
collect entry when (AND (OR (NOT dirtyOnly?)
(fetch CACHEISDIRTY of entry))
(DIRECTORY.MATCH filter (fetch REMOTEFILENAME
of entry))
[EQ hostName
(\FCACHE.CANONICAL.HOSTNAME
(FILENAMEFIELD (fetch REMOTEFILENAME
of entry)
(QUOTE HOST]
(if (NEQ (QUOTE NSFILING)
(\FCACHE.GENERIC.DEVICE.TYPE
(fetch (CACHEDEVICE REALDEVICE)
of device)))
then T
elseif (EQ FILING.ENUMERATION.DEPTH T)
then T
else (LESSP (\FCACHE.GENERATE.FILES.DEPTH
(fetch REMOTEFILENAME
of entry))
(PLUS (
\FCACHE.GENERATE.FILES.DEPTH
pattern)
FILING.ENUMERATION.DEPTH]
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \FCACHE.NEXT.LOCAL.FILE)
FILEINFOFN ←(FUNCTION \FCACHE.GENERATE.FILEINFO)
GENFILESTATE ←(create LocalFileGenerator
FileGenEntryList ←(if (MEMB (QUOTE SORT)
options)
then
[SORT
entries
(FUNCTION (LAMBDA (X Y)
(FMEMB (FILES.IN.ORDER?
(fetch
MATCHFILENAME
of X)
(fetch
MATCHFILENAME
of Y))
(QUOTE
(EQUAL LESSP]
else entries)
FileGenDirtyOnly? ← dirtyOnly?])
(\FCACHE.NEXT.LOCAL.FILE
[LAMBDA (genfilestate nameonly) (* smL " 5-Feb-86 11:18")
(* * The NEXTFILEFN for local file generation)
(LET [(entry (pop (fetch (LocalFileGenerator FileGenEntryList) of genfilestate]
(if (NULL entry)
then (* at the end)
(replace (LocalFileGenerator FileGenPrevEntry) of genfilestate with NIL)
NIL
elseif (AND (fetch (LocalFileGenerator FileGenDirtyOnly?) of genfilestate)
(NOT (fetch CACHEISDIRTY of entry)))
then (* skip this entry, it isn't dirty)
(\FCACHE.NEXT.LOCAL.FILE genfilestate nameonly)
else (* use this entry)
(replace (LocalFileGenerator FileGenPrevEntry) of genfilestate with entry)
(fetch REMOTEFILENAME of entry])
)
(* Merging together two file generators)
(DEFINEQ
(MERGE.FILEGENERATORS
[LAMBDA (gen1 gen2 sorted?) (* smL "28-Jun-85 15:49")
(* * Merge the two file generators into one)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION MERGED.NEXTFILEFN)
FILEINFOFN ←(FUNCTION MERGED.FILEINFOFN)
GENFILESTATE ←(create MERGEDFILEGENSTATE
gen1 ← gen1
gen2 ← gen2
sorted? ← sorted?])
(MERGED.FILEINFOFN
[LAMBDA (genState attribute) (* smL "28-Jun-85 15:42")
(* * The FILEINFOFN for a merged filegenerator)
(with MERGEDFILEGENSTATE genState (if lastUsedGen
then (\GENERATEFILEINFO lastUsedGen attribute)
else (ERROR "No files generated yet!"])
(MERGED.NEXTFILEFN
[LAMBDA (genState nameOnly) (* smL " 4-Feb-86 18:12")
(* * The NEXTFILEFN for a merged filegenerator)
(with MERGEDFILEGENSTATE genState (PROG (nextFile)
TRYNEXTFILE
(SETQ nextFile (\MERGED.NEXTFILEFN1 genState
nameOnly))
(if (NULL nextFile)
then
(* no more files)
(RETURN NIL)
elseif (MEMB (MKATOM (U-CASE nextFile))
genedFiles)
then
(* don't include the file twice)
(GO TRYNEXTFILE)
else (push genedFiles (MKATOM (U-CASE
nextFile)))
(RETURN nextFile])
(\MERGED.NEXTFILEFN1
[LAMBDA (genState nameOnly) (* smL " 4-Feb-86 18:06")
(* * Almost the NEXTFILEFN for a merged filegenerator, but doesn't worry about replications)
(with MERGEDFILEGENSTATE genState (LET (file gen1File gen2File)
(if (NOT sorted?)
then (* easy -- just use the first one till it is done,
then switch to the second one)
(if (NOT gen1Empty?)
then (SETQ file (\GENERATENEXTFILE
gen1 nameOnly))
(SETQ lastUsedGen gen1)
(if (NULL file)
then (SETQ gen1Empty? T)
(\MERGED.NEXTFILEFN1
genState nameOnly)
else file)
else (SETQ file (\GENERATENEXTFILE
gen2 nameOnly))
(SETQ lastUsedGen gen2)
(if (NULL file)
then (SETQ gen2Empty? T)
file
else file))
else (* sorted is more difficult --)
[SETQ gen1File
(OR gen1Info (AND (NOT gen1Empty?)
(\GENERATENEXTFILE
gen1 nameOnly]
[SETQ gen2File
(OR gen2Info (AND (NOT gen2Empty?)
(\GENERATENEXTFILE
gen2 nameOnly]
(if (AND (NOT gen1File)
(NOT gen2File)
gen1Empty? gen2Empty?)
then
(* bad boy, you shouldnt be doing this)
(ERROR "File generator exhausted!")
)
(if (NOT gen1File)
then (SETQ gen1Empty? T))
(if (NOT gen2File)
then (SETQ gen2Empty? T))
(* if either gen1File or gen2File is NIL, things are
easy)
(if (NOT gen1File)
then (SETQ gen2Info NIL)
(SETQ lastUsedGen gen2)
gen2File
elseif (NOT gen2File)
then (SETQ gen1Info NIL)
(SETQ lastUsedGen gen1)
gen1File
else
(* use the one that occurs first in order, but
remember the unused one)
(SELECTQ (FILES.IN.ORDER? gen1File
gen2File)
((EQUAL LESSP)
(SETQ gen1Info NIL)
(SETQ gen2Info gen2File)
(SETQ lastUsedGen gen1)
gen1File)
(GREATERP (SETQ
gen1Info
gen1File)
(SETQ
gen2Info NIL)
(SETQ
lastUsedGen
gen2)
gen2File)
(SHOULDNT])
(FILES.IN.ORDER?
[LAMBDA (file1 file2) (* smL " 7-Feb-86 15:08")
(* * Are the two files in correct order for a directory generation?)
(LET ((testFile1 (U-CASE file1))
(testFile2 (U-CASE file2)))
(if (EQ testFile1 testFile2)
then (QUOTE EQUAL)
else (OR [for field in (QUOTE (DIRECTORY NAME EXTENSION)) bind file1Field
file2Field
do (SETQ file1Field (UNPACKFILENAME.STRING testFile1 field))
(SETQ file2Field (UNPACKFILENAME.STRING testFile2 field))
(if (AND (NULL file1Field)
(NULL file2Field))
then NIL
elseif (NULL file1Field)
then (RETURN (QUOTE LESSP))
elseif (NULL file2Field)
then (RETURN (QUOTE GREATERP))
elseif (STRING-EQUAL file1Field file2Field)
then NIL
elseif (ALPHORDER file1Field file2Field)
then (RETURN (QUOTE LESSP))
else (RETURN (QUOTE GREATERP]
(LET [(version1 (FILENAMEFIELD testFile1 (QUOTE VERSION)))
(version2 (FILENAMEFIELD testFile2 (QUOTE VERSION]
(if (AND (NUMBERP version1)
(NUMBERP version2))
then (if (LESSP version1 version2)
then (QUOTE LESSP)
else (QUOTE GREATERP))
elseif (ALPHORDER testFile1 testFile2)
then (QUOTE LESSP)
else (QUOTE GREATERP])
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD MERGEDFILEGENSTATE (gen1 gen2 lastUsedGen gen1Info gen2Info gen1Empty? gen2Empty? sorted?
genedFiles)
(SYSTEM))
(RECORD LocalFileGenerator (FileGenEntryList FileGenDirtyOnly? FileGenPrevEntry)
(SYSTEM))
]
)
(* * Functions for finding a file in the cache)
(DEFINEQ
(\FCACHE.LOOKUP
[LAMBDA (DEVICE NAME/STREAM Verify?) (* smL "13-Mar-86 14:45")
(* * Find the matching entry in the cache)
(* * NOTE: This fn returns holding the entries CACHELOCK. It should only be called from within a RESETLST!)
(OR (AND (STREAMP NAME/STREAM)
(STREAMPROP NAME/STREAM (QUOTE cacheEntry)))
(PROG ((ListOfEntries \FCACHE.LIST)
entry DAT verified?) (* First get the upper case file name)
(if (LITATOM NAME/STREAM)
then (SETQ NAME/STREAM (U-CASE NAME/STREAM))
elseif (STREAMP NAME/STREAM)
then (SETQ NAME/STREAM (U-CASE (fetch FULLFILENAME of NAME/STREAM)))
elseif (STRINGP NAME/STREAM)
then (SETQ NAME/STREAM (MKATOM (U-CASE NAME/STREAM)))
else (\ILLEGAL.ARG NAME/STREAM)) (* Now hunt for a cache entry that matches)
TryNextEntry
[SETQ entry (CAR (OR (LISTP ListOfEntries)
(RETURN NIL]
(if (EQ (fetch MATCHFILENAME of entry)
NAME/STREAM)
then (OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(if (NOT (MEMB entry \FCACHE.LIST))
then (* The entry has been deleted by some other process!)
NIL
elseif (OR (NOT Verify?)
(\FCACHE.VERIFY entry DEVICE))
then (* it matches!)
(RETURN entry)
else (* The cache is invalid, so get rid of it)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM*
"[Invalid cache file!]"
T))
(\FCACHE.DELETE.ENTRY entry)))
(SETQ ListOfEntries (CDR ListOfEntries))
(GO TryNextEntry])
(\FCACHE.PROMOTE
[LAMBDA (ENTRY DEVICE) (* smL "23-Sep-85 13:27")
(* * Promote ENTRY to head of cache so that is will be found faster the next time -- and won't be deleted to make
space for new files in the cache. It turns out that searching doing an \FCACHE.LOOKUP with about 200 entries in the
cache takes less than .4 seconds on a DTiger, even if the file is not found. This is quick enough that there no need
to try to speed up cache file lookup.)
[if (NEQ ENTRY (CAR \FCACHE.LIST))
then (for TAIL on \FCACHE.LIST when (EQ (CADR TAIL)
ENTRY)
do (RETURN (UNINTERRUPTABLY
(SETQ \FCACHE.LIST (CONS ENTRY \FCACHE.LIST))
(RPLACD TAIL (CDDR TAIL)))]
ENTRY])
(\FCACHE.USECACHE?
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE FILEPAGES) (* smL "13-Mar-86 10:02")
(* * Used by \FCACHE.OPENFILE to determine if opening a file should go thru the cache. -
Return NIL if the cache should be avoided -
a CACHENTRY if it is the entry that should be used -
the FULLNAME of the file if it is OK to cache it, but it isn't cached now)
(if (MEMB (QUOTE FCACHE.INTERNAL)
PARAMETERS)
then (* A FILECACHE internal call to OPENSTREAM)
NIL
else (LET* [[Don'tCacheFlag? (OR (MEMB (QUOTE DON'TCACHE)
PARAMETERS)
(CADR (ASSOC (QUOTE DON'TCACHE)
PARAMETERS]
(fullName (FDEVOP (QUOTE GETFILENAME)
DEVICE NAME RECOG DEVICE))
(cacheEntry (AND fullName (\FCACHE.LOOKUP DEVICE fullName T]
(if (NOT fullName)
then (* Can't even find the full file name)
NIL
elseif (AND cacheEntry (fetch CACHEISDIRTY of cacheEntry))
then (* The cache entry is the only valid copy of the file,
so we have to use it)
cacheEntry
elseif cacheEntry
then (SELECTQ ACCESS
(INPUT (* Perfectly safe to use the cache as we are not going
to be writing the file)
cacheEntry)
((OUTPUT BOTH APPEND)
(* Only use the cache entry if the cache is write
enabled.)
(if [AND (NOT Don'tCacheFlag?)
(MEMB (\FCACHE.PROPERTY (QUOTE USECACHE))
(QUOTE (T Write]
then cacheEntry
else NIL))
(\ILLEGAL.ARG ACCESS))
elseif [NOT (MEMB (\FCACHE.PROPERTY (QUOTE USECACHE))
(SELECTQ ACCESS
(INPUT (QUOTE (T Read)))
((OUTPUT BOTH APPEND)
(QUOTE (T Write)))
(\ILLEGAL.ARG ACCESS]
then (* Cache not enabled for the access mode)
NIL
elseif Don'tCacheFlag?
then (* We are told to not add the file to the cache)
NIL
elseif (NOT (ADD.FILE.TO.CACHE? fullName))
then (* The file is on the list of DONT.CACHE.FILES so
don't add it to the cache)
NIL
elseif [AND FILEPAGES (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES))
(GREATERP FILEPAGES (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
then (* File too big, don't bother)
NIL
else (* Go ahead and add it if you like)
fullName])
(\FCACHE.VERIFY
[LAMBDA (entry cacheDevice) (* smL "13-Mar-86 14:39")
(* * Verify that the entry is valid)
(* It is possible to pass in a name instead of a
device)
(if (OR (LITATOM cacheDevice)
(STRINGP cacheDevice))
then (SETQ cacheDevice (\GETCACHEDEVICEFROMHOSTNAME cacheDevice T)))
(AND (INFILEP (fetch LOCALFILENAME of entry))
(OR [ILESSP (IDATE)
(PLUS (fetch TIMELASTVERIFIED of entry)
(TIMES (CONSTANT (DIFFERENCE (IDATE "1-JAN-80 12:00:01")
(IDATE "1-JAN-80 12:00:00")))
(\FCACHE.PROPERTY (QUOTE TIMETOVERIFY]
(\FCACHE.IGNOREDATECHECK? entry cacheDevice)
(WITH.MONITOR (fetch CACHELOCK of entry)
(if (OR (NOT (fetch CACHEISDIRTY of entry))
(fetch FILEXISTED of entry))
then (* entry is valid iff it matches the one out there)
(if [AND (REALDEVOP (QUOTE GETFILENAME)
cacheDevice
(fetch REMOTEFILENAME
of entry)
(QUOTE OLD)
cacheDevice)
(LET ((idate (REALDEVOP (QUOTE GETFILEINFO)
cacheDevice
(fetch
REMOTEFILENAME
of entry)
(QUOTE ICREATIONDATE)
cacheDevice)))
(AND (NUMBERP idate)
(IEQP idate
(fetch CACHEFILEDATE
of entry]
then (replace TIMELASTVERIFIED of entry
with (OR (IDATE)
0))
T)
else (* it is the most recent, so it is up to date)
T])
)
(DECLARE: EVAL@COMPILE
[DEFMACRO MatchFileName (fileName)
(* * Compute the match file name from a given filename)
(BQUOTE (MKATOM (U-CASE , fileName]
)
(* * Try to figure out if a host is up)
(DEFINEQ
(\FCACHE.HOSTUP?
[LAMBDA (name) (* smL " 6-Feb-86 16:16")
(* * Try to determine if the host if able to respond)
(if (MEMB (U-CASE (MKATOM name))
FCACHE.DEAD.HOSTS)
then NIL
else (LET ((DEV (\GETDEVICEFROMNAME name T NIL)))
(SELECTQ (COND
(DEV (* use real DEV to determine the DEV type)
(SELECTQ (fetch OPENFILE of DEV)
((\LEAF.OPENFILE \FTP.OPENFILE)
(QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
(fetch DEVICENAME of DEV)))
(T (* the FDEV doesn't exist, and we can't create one for
it, so it must be down)
(QUOTE NOFDEV)))
[LEAF (* We think its a LEAF server, so try PUP.ECHOUSER)
(RESETLST (PROG ((i 1)
(interval 1000)
(PORT (BESTPUPADDRESS name
*FILE-CACHE-MESSAGE-STREAM*))
(SOC (OPENPUPSOCKET))
echo OPUP IPUP ECHOPUPLENGTH I)
(RESETSAVE NIL (LIST (QUOTE
CLOSEPUPSOCKET)
SOC))
(OR PORT (RETURN))
TryAgain
(if (IGREATERP i 3)
then (RETURN NIL))
(SETQ OPUP (ALLOCATE.PUP))
(SETUPPUP OPUP PORT \PUPSOCKET.ECHO
\PT.ECHOME NIL SOC T)
(PUTPUPWORD OPUP 0 (SETQ I 1))
(add (fetch PUPLENGTH of OPUP)
BYTESPERWORD)
(SETQ ECHOPUPLENGTH (fetch PUPLENGTH
of OPUP))
(SENDPUP SOC OPUP)
[COND
((SETQ IPUP (GETPUP SOC interval))
(COND
((PROG1 (AND (EQ (fetch PUPTYPE
of IPUP)
\PT.IAMECHO)
(EQ (fetch PUPIDHI
of IPUP)
(fetch PUPIDHI
of OPUP))
(EQ (fetch PUPIDLO
of IPUP)
(fetch PUPIDLO
of OPUP))
(EQ (fetch
PUPLENGTH
of IPUP)
ECHOPUPLENGTH)
(IEQP (GETPUPWORD
IPUP 0)
I))
(RELEASE.PUP IPUP))
(RETURN T]
(SETQ i (ADD1 i))
(SETQ interval (ITIMES interval 2))
(GO TryAgain]
[NSFILING (* We think its an NSFILING server, so try
NS.ECHOUSER)
(RESETLST (PROG ((i 1)
(interval 1000)
(ECHOADDRESS (if DEV
then (create NSADDRESS
using (
\NSFILING.ADDRESS
DEV)
NSSOCKET ←
\NS.WKS.Echo)
else (\COERCE.TO.NSADDRESS
name \NS.WKS.Echo)))
(NSOC (OPENNSOCKET))
echo OXIP IXIP ECHOXIPLENGTH XIPBASE NSOC I)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
NSOC))
(OR ECHOADDRESS (RETURN))
TryAgain
(if (IGREATERP i 3)
then (RETURN NIL))
(SETQ OXIP (\FILLINXIP \XIPT.ECHO NSOC
ECHOADDRESS))
(XIPAPPEND.WORD OXIP \XECHO.OP.REQUEST)
(XIPAPPEND.WORD OXIP (SETQ I 1))
(SETQ ECHOXIPLENGTH (fetch XIPLENGTH
of OXIP))
(SENDXIP NSOC OXIP)
[COND
((SETQ IXIP (GETXIP NSOC interval))
(COND
((PROG1
(AND (EQ (fetch XIPTYPE
of IXIP)
\XIPT.ECHO)
(EQ (fetch XIPLENGTH
of IXIP)
ECHOXIPLENGTH)
(EQ (\GETBASE (SETQ XIPBASE
(fetch
XIPCONTENTS
of
IXIP))
0)
\XECHO.OP.REPLY))
(RELEASE.XIP IXIP))
(RETURN T]
(SETQ i (ADD1 i))
(SETQ interval (ITIMES interval 2))
(GO TryAgain]
(FLOPPY (* the FLOPPY disk)
(* Should be (FLOPPY.CAN.READP) but this triggers a
bug in the Floppy handler)
T)
(TCP (* A TCP device. Punt on them)
T)
(NOFDEV (* we can't create an FDEV for the device, so it can't
be up)
NIL)
T])
(\NSFILING.ADDRESS
[LAMBDA (DEV) (* lmm "14-Sep-85 16:27")
(CAR (fetch NSFSADDRESSES of (fetch NSFILESERVER of (fetch DEVICEINFO of DEV])
(\FCACHE.IGNOREDATECHECK?
[LAMBDA (entry cacheDevice) (* smL "27-Feb-86 11:20")
(* * Should we ignore the date check, or not?)
(RESETLST
(LET ((hostName (fetch (CACHEDEVICE REALDEVICENAME) of cacheDevice)))
(if (OR (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then T
elseif (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
FCACHE.DEAD.HOSTS)
then T
else (SELECTQ (\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T
"It doesn't look like I can check to see if"
,
(fetch LOCALFILENAME of entry)
, "is a valid cache for" , (fetch REMOTEFILENAME
of entry)
", but I'm using it anyway.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT "Can't verify if" T .FONT
BOLDFONT .CENTER 0 (fetch LOCALFILENAME
of entry)
.FONT DEFAULTFONT T "is a valid cache entry for"
.FONT BOLDFONT T .CENTER 0 (fetch REMOTEFILENAME
of entry)
.FONT DEFAULTFONT T T .CENTER 0 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache"
Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow
(QUOTE ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead (pushnew
FCACHE.DEAD.HOSTS
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE
UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL])
(\FCACHE.USELOCALDIRECTORY?
[LAMBDA (hostName filePattern) (* smL "27-Feb-86 11:21")
(* * The hostName is down, should we use the cached files to generate a directory?)
(RESETLST (if (\FCACHE.HOSTUP? hostName)
then NIL
elseif (MEMB (U-CASE (MKATOM hostName))
FCACHE.DEAD.HOSTS)
then T
else (SELECTQ
(\FCACHE.PROPERTY (QUOTE UNSAFE))
(T (* We are told to use the local cache)
T)
(NOTIFY (* Use the cache, but notify the user what is going
on)
(printout *FILE-CACHE-MESSAGE-STREAM* T hostName ,
"does not seem to be responding for directory lookup "
"for file pattern " filePattern T
"Using local cache list instead.")
T)
[ASK (* Ask to find out what to do)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
(CONCAT hostName " not responding..."))
(CLEARW msgWindow)
(printout msgWindow .FONT DEFAULTFONT
"Can't use remote host for directory lookup for file"
T .FONT BOLDFONT .CENTER 0 filePattern .FONT DEFAULTFONT
T T .CENTER 0 "I'll keep trying...")
(WINDOWPROP msgWindow (QUOTE ItemPicked)
NIL)
(LET [(menu (create MENU
CENTERFLG ← T
ITEMS ←(QUOTE (("Trust the cache" Use)
("Don't trust the cache"
Don'tUse)
("Add to DEAD.HOSTS"
MakeDead)))
WHENSELECTEDFN ←(FUNCTION
\FCACHE.HOSTDEAD.WHENSELECTEDFN]
(ADDMENU menu msgWindow
(create POSITION
XCOORD ←(IQUOTIENT
(DIFFERENCE (WINDOWPROP
msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 10)))
(during (\FCACHE.PROPERTY (QUOTE UNSAFE.TIMEOUT))
timerUnits (QUOTE SECONDS)
do (BLOCK)
(if (\FCACHE.HOSTUP? hostName)
then (RETURN NIL)
else (SELECTQ (WINDOWPROP msgWindow (QUOTE
ItemPicked))
(Use (RETURN T))
(Don'tUse (RETURN NIL))
(MakeDead (pushnew FCACHE.DEAD.HOSTS
hostName)
(RETURN T))
NIL))
finally (RETURN (\FCACHE.PROPERTY (QUOTE UNSAFE.DEFAULT]
(NIL (* We are running in cautious mode)
NIL)
NIL])
(\FCACHE.HOSTDEAD.WHENSELECTEDFN
[LAMBDA (item menu button) (* smL " 5-Feb-86 13:51")
(* * The WHENSELECTEDFN for the abort windows used to prompt a user when a host is dead)
(LET ((msgWindow (WFROMMENU menu)))
(if [AND item (NOT (WINDOWPROP msgWindow (QUOTE ItemPicked]
then (SHADEITEM item menu GRAYSHADE)
(WINDOWPROP msgWindow (QUOTE ItemPicked)
(if (LITATOM item)
then item
else (CADR item])
)
(RPAQ? FCACHE.DEAD.HOSTS NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FCACHE.DEAD.HOSTS)
)
(* * Functions for dealing with overflow of the cache)
(DEFINEQ
(\FCACHE.RESOURCES.ERROR
[LAMBDA (file) (* smL "13-Mar-86 10:59")
(* * Called when there is a "FILE SYSTEM RESOURCES EXCEEDED" error.)
(* NOTE: this counts on the fact that there is only
one stream per file name!)
(LET [(stream (AND (OPENP file)
(GETSTREAM file]
(if (AND (STREAMP stream)
(STREAMPROP stream (QUOTE cacheEntry)))
then (* The error happened while trying to write to a
cached file, so delete some old entry and try again.)
(* the magic number 10 is just a convienient number.
Nothing special)
(\FCACHE.MAKEROOM 10)
elseif (for fn in (QUOTE (\FCACHE.LOAD \FCACHE.LOGENTRY FCACHE.DUMP))
thereis (STKPOS fn))
then (* inside of a cacher operation, so try to make room)
(\FCACHE.MAKEROOM 10)
elseif (EQ (\FCACHE.LOCALDEVICE)
(if stream
then (fetch DEVICE of stream)
else (\GETDEVICEFROMNAME file T)))
then (* Got the error on the local device, so delete a
couple of cache files and try again)
(\FCACHE.MAKEROOM 10)
else (* we can't do anything about it)
NIL])
)
(* * Functions for writing out dirty files from the cache)
(DEFINEQ
(\FCACHE.ENTRYOPEN?
[LAMBDA (entry) (* smL "14-Jun-85 11:37")
(* * Is the file this entry describes open?)
(DECLARE (GLOBALVARS \OPENFILES))
(for stream in \OPENFILES thereis (EQ entry (STREAMPROP stream (QUOTE cacheEntry])
(\FCACHE.FLUSH
[LAMBDA NIL (* smL "31-Jul-85 17:44")
(* * Background function that flushes dirty files out the the remote hosts)
(PROG NIL
WAIT(BLOCK (\FCACHE.PROPERTY (QUOTE DUMPSLEEP)))
(for entry in \FCACHE.LIST do (if [AND (fetch CACHEISDIRTY of entry)
(NOT (\FCACHE.ENTRYOPEN? entry))
(FIXP (fetch CACHETIMECLOSED of entry))
(GREATERP (IDATE)
(PLUS (fetch CACHETIMECLOSED of entry)
(\FCACHE.PROPERTY (QUOTE DUMPIDLE]
then (\FCACHE.WRITEOUT entry)))
(GO WAIT])
(\FCACHE.WRITEOUT
[LAMBDA (entry) (* smL "13-Mar-86 10:07")
(* * Write a cache entry out to the remote host)
(RESETLST (OBTAIN.MONITORLOCK \FCACHE.DUMPLOCK NIL T)
(OBTAIN.MONITORLOCK (fetch CACHELOCK of entry)
NIL T)
(PROG ((originalFileName (fetch REMOTEFILENAME of entry))
(fileName (fetch REMOTEFILENAME of entry))
(localDevice (\FCACHE.LOCALDEVICE))
newFileName remoteDevice inStream outStream errorN (errorCount 0)
idate)
(* * First make sure that we can and should write out the entry)
StartAgain
(if (NOT (fetch CACHEISDIRTY of entry))
then (* we don't need to flush it)
(RETURN T)
elseif (\FCACHE.ENTRYOPEN? entry)
then (* can't flush files that are open)
(RETURN NIL)
elseif (NOT (INFILEP (fetch LOCALFILENAME of entry)))
then (* Gad, the cached file has disappeared!)
(\FCACHE.DELETE.ENTRY entry)
(LET ((msgWindow (\FCACHE.CREATE.MSG.WINDOW)))
(printout msgWindow "WARNING: the cached version of the file"
T T .FONT BOLDFONT originalFileName .FONT
DEFAULTFONT T T
"was deleted from the cache before it "
"be written to its host!" T T
"The file has been lost forever!"
T T
"Some Interlisp-D utilities might get confused "
"because the file no longer exists."))
(RETURN NIL)
elseif [NOT (AND (\FCACHE.HOSTUP? (FILENAMEFIELD fileName
(QUOTE HOST)))
(type? FDEV (SETQ remoteDevice (
\GETDEVICEFROMNAME fileName T]
then (* can't find the server)
(RETURN NIL))
(* * verify that the state of this file on the server out there has not changed)
(if (fetch FILEXISTED of entry)
then (if (NOT (FDEVOP (QUOTE GETFILENAME)
remoteDevice fileName (QUOTE OLD)
remoteDevice))
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"When the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"was created, a remote version of the file existed."
T
"It is now time to write out the cached version,"
T "but the remote file has disappeared!" T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
elseif (NOT (EQUAL (fetch CACHEFILEDATE of entry)
(FDEVOP (QUOTE GETFILEINFO)
remoteDevice fileName
(QUOTE ICREATIONDATE)
remoteDevice)))
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"The remote version of "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"has changed since you wrote the cached file."
T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
else (GO OpenFiles))
else (if (FDEVOP (QUOTE GETFILENAME)
remoteDevice fileName (QUOTE OLD)
remoteDevice)
then (WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"When the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT
"was created, no remote version of the file existed."
T
"It is now time to write out the cached version,"
T
"but a remote version of the file has since appeared!")
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Write it out anyway"
Same)
(
"Write it out somewhere else" Other)
("Delete the cache file"
Delete]
(Same (CLOSEW msgWindow)
(GO OpenFiles))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL))
else (GO OpenFiles)))
SetDumpFileName
(if newFileName
then (SETQ fileName (FULLNAME newFileName (QUOTE OLD/NEW)))
(replace REMOTEFILENAME of entry with fileName)
(replace MATCHFILENAME of entry with (MatchFileName fileName)
)
(SETQ remoteDevice (\GETDEVICEFROMNAME fileName T)))
(* * open the streams for the copy)
OpenFiles
(if (NULL inStream)
then [SETQ inStream (OPENSTREAM (fetch LOCALFILENAME
of entry)
(QUOTE INPUT)
(QUOTE OLD)
NIL
(QUOTE (SEQUENTIAL]
(if inStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
inStream))
(replace USERVISIBLE of inStream with NIL)
else (RETURN NIL)))
(SETQ idate (OR (FDEVOP (QUOTE GETFILEINFO)
localDevice inStream (QUOTE ICREATIONDATE)
localDevice)
(IDATE)))
[SETQ outStream
(CAR (NLSETQ (OPENSTREAM fileName (QUOTE OUTPUT)
(QUOTE OLD/NEW)
NIL
(BQUOTE (FCACHE.INTERNAL
SEQUENTIAL
(TYPE , (FDEVOP (QUOTE
GETFILEINFO)
localDevice
inStream
(QUOTE TYPE)
localDevice))
(ICREATIONDATE , idate)
(LENGTH , (FDEVOP
(QUOTE GETFILEINFO)
localDevice inStream
(QUOTE LENGTH)
localDevice]
[if outStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
outStream))
(replace USERVISIBLE of outStream with NIL)
else (* ugh -- the remote file won't open!)
(add errorCount 1)
(SETQ errorN (ERRORN))
(SELECTQ
(CAR errorN)
(41 (* the current user does not have write access to the
directory)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"You do not have write privilege for the file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
(42 (* the file name was bad)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The cached file " T .FONT
BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT
"does not appear to have a legal file name."
T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
(22 (* there was no room for the file)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT
"There is not enough space on the server to write out the cached file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
("Write it out somewhere else"
Other)
("Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME fileName
msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL)))
[9 (* a generic "File Won't Open" error.
Possibly caused by the LEAF cache not having closed
the file yet. Try it again.)
(if (LESSP errorCount 4)
then (* try it again, after a delay to let the LEAF cache
get dumped)
(CLEAR.LEAF.CACHE (FILENAMEFIELD fileName
(QUOTE HOST)))
(BLOCK 1000)
(GO OpenFiles)
else (* we have already tried it 3 times, so give up)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE (("Try to write it out again"
TryAgain)
(
"Write it out somewhere else" Other)
("Delete the cache file"
Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName (
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL]
(PROGN (* The default case -- an unknow error)
(if (LESSP errorCount 4)
then (CLEAR.LEAF.CACHE (FILENAMEFIELD fileName
(QUOTE HOST)))
(BLOCK 1000)
(GO OpenFiles)
else (* alter the user and then try again)
(WITH.FCACHE.ABORT.WINDOW
msgWindow
(WINDOWPROP msgWindow (QUOTE TITLE)
"FileCache -- problem writing out file")
(printout msgWindow .FONT DEFAULTFONT "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
T .FONT BOLDFONT .TAB 10 fileName T .FONT
DEFAULTFONT T)
(SELECTQ [CADR (\FCACHE.WRITEOUT.NEWFILENAME
msgWindow
(QUOTE ((
"Try to write it out again" TryAgain)
(
"Write it out somewhere else" Other)
(
"Delete the cache file" Delete]
(TryAgain (CLOSEW msgWindow)
(GO StartAgain))
(Other (SETQ newFileName
(
\FCACHE.WRITEOUT.READNEWFILENAME
fileName msgWindow))
(CLOSEW msgWindow)
(GO SetDumpFileName))
(Delete (CLOSEW msgWindow)
(GO DeleteEntry))
NIL]
(* * Copy it out)
(\FCACHE.DONE.OR.ABORTED.MSG (CONCAT "Writing out " fileName))
(COPYCHARS inStream outStream)
(if (NLSETQ (CLOSEF outStream))
then (replace CACHEISDIRTY of entry with NIL)
(replace FILEXISTED of entry with NIL)
(* set the creationdate for the file -
-
this is needed because some hosts don't set the file creation date correctly as desired in the above OPENSTREAM.
The following code ensures that, after the file has been written out, the cache entry and the local file have the
correct dates.)
(KLUDGE
(* This call to CLEAR.LEAF.CACHE and the delay after is a hack. If we don't do it, we don't always read back the
correct value after the SETFILEINFO above)
(CLEAR.LEAF.CACHE (fetch DEVICENAME of remoteDevice))
(BLOCK 1000))
(FDEVOP (QUOTE SETFILEINFO)
remoteDevice
(fetch REMOTEFILENAME of entry)
(QUOTE ICREATIONDATE)
idate remoteDevice)
(replace CACHEFILEDATE of entry
with (OR (FDEVOP (QUOTE GETFILEINFO)
remoteDevice
(fetch REMOTEFILENAME of entry)
(QUOTE ICREATIONDATE)
remoteDevice)
idate))
(SETFILEINFO inStream (QUOTE ICREATIONDATE)
(fetch CACHEFILEDATE of entry))
(\FCACHE.LOGENTRY entry)
(replace TIMELASTVERIFIED of entry with (IDATE))
(if (NEQ originalFileName fileName)
then (LET ((msgWindow (\FCACHE.CREATE.MSG.WINDOW)))
(printout msgWindow
"WARNING: the file that was supposed to be "
T .FONT BOLDFONT .TAB 10
originalFileName T .FONT DEFAULTFONT
"was actually stored as "
T .FONT BOLDFONT .TAB 10 fileName T
.FONT DEFAULTFONT
"Some Interlisp-D utilities might get "
"confused by the rename, since Lisp thought it wrote out "
originalFileName ,
"but it actually didn't. You should try to clean up "
"before accessing the file again. "
"Close TEdit windows and Get the files anew; "
"close Lafite folders and Browse them again; "
"or do an explicit LOADFROM again for Lisp source files.")))
(RETURN T)
else (RETURN NIL))
DeleteEntry
(CLOSEF? inStream)
(\FCACHE.DELETE.ENTRY entry)
(RETURN NIL])
(\FCACHE.WRITEOUT.NEWFILENAME
[LAMBDA (msgWindow items) (* smL "18-Feb-86 14:07")
(* * Put up a menu in the window and wait for the user to pick one of the items. Return the selected item)
(PROG [(event (CREATE.EVENT (QUOTE \FCACHE.WRITEOUT)))
(menu (create MENU
CENTERFLG ← T
MENUCOLUMNS ← 1
ITEMS ← items
WHENSELECTEDFN ←(FUNCTION \FCACHE.WRITEOUT.WHENSELECTEDFN]
(PUTMENUPROP menu (QUOTE event)
event)
(ADDMENU menu msgWindow (create POSITION
XCOORD ←(QUOTIENT (DIFFERENCE
(WINDOWPROP msgWindow
(QUOTE WIDTH))
(fetch IMAGEWIDTH
of menu))
2)
YCOORD ← 5))
WAIT(AWAIT.EVENT event)
(if (NULL (GETMENUPROP menu (QUOTE selected)))
then (GO WAIT)
else (RETURN (GETMENUPROP menu (QUOTE selected])
(\FCACHE.WRITEOUT.READNEWFILENAME
[LAMBDA (file msgwindow) (* smL "24-Feb-86 13:45")
(* * Prompt the user for a new file name)
(LET [(pwindow (GETPROMPTWINDOW (MAINWINDOW msgWindow T)
(for line in (LIST "Write it out where >" fileName)
bind (font ←(DSPFONT NIL msgwindow))
(width ←(WINDOWPROP msgwindow (QUOTE WIDTH)))
sum (FIX (PLUS .9 (FQUOTIENT (STRINGWIDTH line
font)
width]
(CLEARW pwindow)
(PROMPTFORWORD "Write it out where >" fileName NIL pwindow])
(\FCACHE.WRITEOUT.WHENSELECTEDFN
[LAMBDA (item menu button) (* smL " 5-Feb-86 11:33")
(* * An item has been chosen from a msg window during an \FCACHE.WRITEOUT)
(SHADEITEM item menu GRAYSHADE)
(PUTMENUPROP menu (QUOTE selected)
item)
(NOTIFY.EVENT (GETMENUPROP menu (QUOTE event])
)
(RPAQ \FCACHE.DUMPLOCK (CREATE.MONITORLOCK "File cache writout"))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.DUMPLOCK)
)
(* * Functions for dumping and restoring information about the contents of the cache)
(DEFINEQ
(\FCACHE.ADDENTRY
[LAMBDA (LOCALNAME REMOTENAME ICREATIONDATE PROPS PAGES) (* smL "27-Feb-86 13:15")
(* * Add an entry to the cache directory. This goes on the front of the directory so it will be found quickly in
the future.)
(* * NOTE: This code assumes that it is called within a RESETLST that will release the entry's CACHELOCK)
(LET ((ENTRY (create CACHENTRY
REMOTEFILENAME ← REMOTENAME
LOCALFILENAME ← LOCALNAME
MATCHFILENAME ←(MatchFileName REMOTENAME)
CACHEFILEPROPS ← PROPS
CACHEFILEDATE ← ICREATIONDATE
CACHEFILELENGTH ← PAGES)))
(OBTAIN.MONITORLOCK (fetch CACHELOCK of ENTRY)
NIL T)
(push \FCACHE.LIST ENTRY)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY (QUOTE SIZE))
PAGES))
(\FCACHE.LOGENTRY ENTRY)
ENTRY])
(\FCACHE.DUMP.ENTRY
[LAMBDA (entry stream) (* smL "27-Feb-86 13:08")
(* * Write out a single entry to the info file)
(RESETLST (RESETSAVE (RADIX 10))
(with CACHENTRY entry
(printout stream T "(" .P2 REMOTEFILENAME , .P2 LOCALFILENAME T .P2
CACHEISDIRTY , .P2 FILEXISTED , .P2 CACHEFILELENGTH , .P2
CACHEFILEPROPS , .P2 CACHEFILEDATE , .P2 CACHETIMECLOSED ")" T])
(\FCACHE.FILEMATCH?
[LAMBDA (fullName fileSpec) (* smL " 9-Aug-85 14:10")
(* * Does the file match the spec?)
(AND (DIRECTORY.MATCH (DIRECTORY.MATCH.SETUP fileSpec)
fullName)
(LET [(fileSpecHost (FILENAMEFIELD fileSpec (QUOTE HOST]
(OR (NOT fileSpecHost)
(EQ (\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD fileSpec (QUOTE HOST)))
(\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD fullName (QUOTE HOST])
(\FCACHE.LOGENTRY
[LAMBDA (entry) (* smL " 9-Aug-85 10:18")
(* * Dribble out a bit of into to the cache log file so we know the state of the cache if the system dies an
ungraceful death)
(SETQ \FCACHE.LIST.CHANGED? T)
(if (\FCACHE.PROPERTY (QUOTE PREFIX))
then (if [NOT (AND (STREAMP \FCACHE.LOGFILE)
(OPENP \FCACHE.LOGFILE (QUOTE OUTPUT]
then (if (STREAMP \FCACHE.LOGFILE)
then (CLOSEF? \FCACHE.LOGFILE))
(SETQ \FCACHE.LOGFILE (OPENSTREAM (PACK* (\FCACHE.PROPERTY (QUOTE PREFIX))
"FCache.Log;1")
(QUOTE OUTPUT)
(QUOTE OLD/NEW)))
(replace USERCLOSEABLE of \FCACHE.LOGFILE with NIL)
(replace USERVISIBLE of \FCACHE.LOGFILE with NIL))
(\FCACHE.DUMP.ENTRY entry \FCACHE.LOGFILE)
(FORCEOUTPUT \FCACHE.LOGFILE T])
(\FCACHE.RESTORE
[LAMBDA (prefix) (* smL "13-Mar-86 13:34")
(* * Restore the cache info dumped out by a previous system -- return T if success, NIL if failure)
(RESETLST (* Clear the cache of the local device)
(SETQ \FCACHE.LOCALDEVICE NIL)
(if (NULL prefix)
then (* disable the cache)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T
"Cache prefix is NIL, so disabling cache."))
(SETQ \FCACHE.LIST NIL)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
0)
(\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
prefix)
T
elseif (NULL (\GETDEVICEFROMNAME prefix T))
then (* prefix is bad)
NIL
elseif (LET (testFile) (* can we access that directory?)
[RESETSAVE NIL (LIST [FUNCTION (LAMBDA (s)
(if (STREAMP s)
then (CLOSEF? s)
(DELFILE (fetch
FULLFILENAME
of s]
(SETQ testFile
(CAR (NLSETQ (OPENSTREAM
(PACK* prefix
"fcache.temp")
(QUOTE OUTPUT)
(QUOTE NEW]
testFile)
then
(PROG (name stream entryDef)
(SETQ \FCACHE.LIST NIL)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
0)
(\FCACHE.PROPERTY.PUT (QUOTE PREFIX)
prefix)
(if [NULL (SETQ name (INFILEP (PACK* prefix "FCache.Listing;1"]
then (* nothing to restore)
(RETURN T))
[RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(SETQ stream (OPENSTREAM name (QUOTE
INPUT)
(QUOTE OLD]
(\FCACHE.DONE.OR.ABORTED.MSG "Restoring cache")
(* Read in the warning msg, and make sure that it is
correct.)
(if (NOT (LET [(header (CAR (NLSETQ (READ stream]
(if (AND (EQ (CAR header)
(QUOTE ERROR))
(EQUAL (CADR header)
"This file cannot be LOADed. Do not delete or alter this file!"))
then (* The file header matches, so parse the properties)
[LET [(plist (EVAL (CADDR header]
(SETQ \FCACHE.LISTING.VERSION.NUMBER
(OR (NUMBERP
(LISTGET plist
(QUOTE
FCacheVersion))
0)))
[if (GEQ
\FCACHE.LISTING.VERSION.NUMBER 1)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXSIZE)
(LISTGET plist
(QUOTE
MaxSize]
(if (GEQ
\FCACHE.LISTING.VERSION.NUMBER 1.6)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXFILEPAGES)
(LISTGET plist
(QUOTE
MaxFilePages]
T
else NIL)))
then (LET ((errorWindow (CREATEW (create REGION
LEFT ← 300
BOTTOM ← 300
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache directory file was trashed!"
"The cacher has lost track of all the files in the cache."
"If there were any files that needed to be dumped, "
"they have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."))
(GO BADINFOFILE))
NEXTENTRY
(if (EOFP stream)
then (LET ((errorWindow (CREATEW (create REGION
LEFT ← 300
BOTTOM ← 300
WIDTH ← 425
HEIGHT ← 120)
"File cache warning")))
(printout errorWindow
"WARNING: The file cache directory file was not completly dumped."
"The cacher may have lost track of some files."
"If there were any files that needed to be dumped, "
"they may have been lost!" T T
"You should run FCACHE.SCAVENGE soon to clean up your disk."))
(GO BADINFOFILE)
elseif (EQ [SETQ entryDef (CAR (NLSETQ (READ stream]
(QUOTE STOP))
then (GO DONE)
elseif (NLSETQ (\FCACHE.RESTORE.ENTRY entryDef))
then (* a good entry def)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* "."))
else (* a bad entry def)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* "?")))
(GO NEXTENTRY)
BADINFOFILE
(CLOSEF? stream)
(DELFILE name)
(GO CLEANUP)
DONE(CLOSEF? stream)
CLEANUP
[if (LESSP \FCACHE.LISTING.VERSION.NUMBER 5.0)
then
(* At version 5.0 there was a change in the way that the listing file gets written. If an older version attempts to
read a cache listing created after version 5.0, it will not see any MATCHFILENAME fields in the cache entries.
It might then add a file to the cache that is already cached. Then, if you go back to a more recent version of the
cacher, it would find two different cache enties for the same file. TROUBLE! The following is an attempt to take
care of this odd situation.)
(for entries on \FCACHE.LIST
do (for e in (CDR entries)
when (EQ (fetch MATCHFILENAME of e)
(fetch MATCHFILENAME
of (CAR entries)))
do (if (\FCACHE.PRINT.MESSAGE?)
then (printout
*FILE-CACHE-MESSAGE-STREAM*
"[Duplicate cache file!]"
T))
(\FCACHE.DELETE.ENTRY e]
(RETURN T))
else (* nope, can't access the directory at that prefix)
(if (\FCACHE.PRINT.MESSAGE?)
then (printout *FILE-CACHE-MESSAGE-STREAM* T "Cache can't write to "
prefix "!"])
(\FCACHE.RESTORE.ENTRY
[LAMBDA (entryList first?) (* smL "27-Feb-86 13:16")
(* * Restore an entryList to the cache list. Put it at the end of the list because of the order they are read in.)
(LET [[entry (create CACHENTRY
REMOTEFILENAME ←(CAR entryList)
LOCALFILENAME ←(CADR entryList)
CACHEISDIRTY ←(CADDR entryList)
FILEXISTED ←(CADDDR entryList)
CACHEFILELENGTH ←(CAR (CDDDDR entryList))
CACHEFILEPROPS ←(CADR (CDDDDR entryList))
CACHEFILEDATE ←(CADDR (CDDDDR entryList))
CACHETIMECLOSED ←(CADDDR (CDDDDR entryList))
MATCHFILENAME ←(MatchFileName (CAR entryList]
(oldEntry (for x in \FCACHE.LIST bind (name ←(CADR entryList))
thereis (EQ name (fetch LOCALFILENAME of x]
[if oldEntry
then (SETQ \FCACHE.LIST (DREMOVE oldEntry \FCACHE.LIST))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of oldEntry]
(SETQ \FCACHE.LIST (if first?
then (CONS entry \FCACHE.LIST)
else (NCONC1 \FCACHE.LIST entry)))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of entry])
)
(RPAQQ \FCACHE.LISTING.VERSION.NUMBER NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.LISTING.VERSION.NUMBER)
)
(* * Functions for inspecting the cache)
(DEFINEQ
(\FCACHE.FLUSH.INFOHOOK
[LAMBDA NIL (* smL " 5-Feb-86 18:00")
(* * The info hook function for the CACHE-FLUSH proc)
(if (AND \FCACHE.BROWSER (type? TABLEBROWSER \FCACHE.BROWSER)
(WINDOWP (TB.WINDOW \FCACHE.BROWSER)))
then (OPENW (TB.WINDOW \FCACHE.BROWSER))
(\FCACHE.BROWSE.RECOMPUTE \FCACHE.BROWSER)
else (SETQ \FCACHE.BROWSER (\FCACHE.BROWSE.CACHE])
)
(* Browsing thru the cache)
(DEFINEQ
(\FCACHE.BROWSE.CACHE
[LAMBDA NIL (* smL "14-Feb-86 17:26")
(* * Build a browser for the cache)
(LET* [[menu (create MENU
ITEMS ←(QUOTE (Delete Prune Undelete Inspect Filter Recompute Expunge))
CENTERFLG ← T
MENUROWS ← 1
MENUOUTLINESIZE ← 1
WHENSELECTEDFN ←(FUNCTION \FCACHE.BROWSE.WHENSELECTEDFN)
MENUFONT ←(FONTCREATE (QUOTE Helvetica)
10
(QUOTE BOLD]
(inspectWindow (CREATEW (CREATEREGION SCREENWIDTH SCREENHEIGHT
(TIMES 25 (STRINGWIDTH "A" DEFAULTFONT))
(HEIGHTIFWINDOW
(TIMES (ADD1 (QUOTIENT (LENGTH
\FCACHE.PROPERTIES)
2))
(FONTPROP DEFAULTFONT (QUOTE
HEIGHT)))
T))
"File cache props"))
[cacheBrowserWindowRegion (GETREGION (fetch IMAGEWIDTH of menu)
(PLUS (fetch IMAGEHEIGHT of menu)
(MAX (HEIGHTIFWINDOW 0 T]
(cacheBrowserWindow (CREATEW (CREATEREGION (fetch LEFT of cacheBrowserWindowRegion)
(fetch BOTTOM of
cacheBrowserWindowRegion)
[DIFFERENCE (fetch WIDTH of
cacheBrowserWindowRegion)
(fetch WIDTH
of (WINDOWPROP
inspectWindow
(QUOTE REGION]
(DIFFERENCE (fetch HEIGHT of
cacheBrowserWindowRegion)
(fetch IMAGEHEIGHT
of menu)))
"File cache browser"))
(cacheBrowser (TB.MAKE.BROWSER NIL cacheBrowserWindow
(QUOTE (USERDATA "*.*" PRINTFN \FCACHE.BROWSE.PRINTFN
COPYFN \FCACHE.BROWSE.COPYFN]
(* Glue the inspect window to the right of the browser
window)
(ATTACHWINDOW inspectWindow cacheBrowserWindow (QUOTE RIGHT)
(QUOTE TOP))
[WINDOWPROP inspectWindow (QUOTE MINSIZE)
(CONS (fetch WIDTH of (WINDOWPROP inspectWindow (QUOTE REGION)))
(fetch HEIGHT of (WINDOWPROP inspectWindow (QUOTE REGION]
[WINDOWPROP inspectWindow (QUOTE MAXSIZE)
(CONS (fetch WIDTH of (WINDOWPROP inspectWindow (QUOTE REGION)))
(fetch HEIGHT of (WINDOWPROP inspectWindow (QUOTE REGION]
(WINDOWPROP cacheBrowserWindow (QUOTE inspectWindow)
inspectWindow)
(INSPECTW.CREATE \FCACHE.PROPERTIES (FUNCTION \FCACHE.PROPERTY.NAMES)
(FUNCTION \FCACHE.INSPECT.VALUES)
(FUNCTION [LAMBDA (object property newvalue)
(FCACHE.PUTPROP property newvalue])
(FUNCTION \FCACHE.INSPECT.PROPCOMMANDFN)
(FUNCTION NILL)
(FUNCTION \FCACHE.INSPECT.TITLEFN)
"File cache props" NIL inspectWindow)
(* Glue the menu window to the top of the browser
window)
(PUTMENUPROP menu (QUOTE CacheBrowser)
cacheBrowser)
(ATTACHMENU menu cacheBrowserWindow (QUOTE TOP))
(* Give the window set a cute icon)
(WINDOWPROP cacheBrowserWindow (QUOTE ICON)
\FCACHE.ICON) (* Update the display)
(\FCACHE.BROWSE.RECOMPUTE cacheBrowser)
cacheBrowser])
(\FCACHE.BROWSE.COPYFN
[LAMBDA (cacheBrowser item) (* smL " 4-Feb-86 13:48")
(* * The copybutton went down on the item)
(COPYINSERT (fetch REMOTEFILENAME of (fetch TIDATA of item])
(\FCACHE.BROWSE.PRINTFN
[LAMBDA (cacheBrowser item window) (* smL " 3-Feb-86 17:19")
(* * The PRINTFN for the cache browser)
(LET ((entry (fetch TIDATA of item)))
(printout window (fetch REMOTEFILENAME of entry)
.TAB0
(MAX (ADD1 (POSITION window))
60)
(if (\FCACHE.ENTRYOPEN? entry)
then "Open"
else " ")
.TAB0
(MAX (ADD1 (POSITION window))
65)
(if (fetch CACHEISDIRTY of entry)
then "Dirty"
else " "])
(\FCACHE.BROWSE.RECOMPUTE
[LAMBDA (cacheBrowser) (* smL " 4-Feb-86 10:42")
(* * The REPAINT function for a cache browser)
(LET ((cacheBrowserWindow (TB.WINDOW cacheBrowser)))
(TB.REPLACE.ITEMS cacheBrowser)
(WINDOWPROP cacheBrowserWindow (QUOTE TITLE)
(CONCAT "File cache browser -- files matching " (TB.USERDATA cacheBrowser))
)
(for entry in \FCACHE.LIST do (TB.INSERT.ITEM cacheBrowser
(create TABLEITEM
TIDATA ← entry
TIUNDELETABLE ← T))
when (\FCACHE.FILEMATCH? (fetch REMOTEFILENAME of entry)
(TB.USERDATA cacheBrowser)))
(INSPECTW.REDISPLAY (WINDOWPROP cacheBrowserWindow (QUOTE inspectWindow])
(\FCACHE.BROWSE.WHENSELECTEDFN
[LAMBDA (item menu button) (* smL "14-Feb-86 17:30")
(* * The WHENSELECTEDFN for the FileCache browser)
(RESETLST (if item
then (RESETSAVE (SHADEITEM item menu GRAYSHADE)
(LIST (FUNCTION SHADEITEM)
item menu WHITESHADE))
(LET [(cacheBrowser (GETMENUPROP menu (QUOTE CacheBrowser]
(SELECTQ (if (LITATOM item)
then item
else (CADR item))
[Delete (TB.MAP.SELECTED.ITEMS cacheBrowser
(FUNCTION (LAMBDA (
cacheBrowser item)
(TB.DELETE.ITEM
cacheBrowser item]
[Prune (* Thanks to MikeDixon for this idea)
(bind (old.date ←(DIFFERENCE
(IDATE)
(TIMES (RNUMBER
"Delete files untouched in how many days?"
NIL NIL NIL
T)
86400)))
(numberDeleted ← 0) for tableItem
in (fetch TBITEMS of cacheBrowser)
when (AND (NUMBERP (fetch
CACHETIMECLOSED
of (fetch TIDATA
of
tableItem)))
(LESSP (fetch CACHETIMECLOSED
of (fetch TIDATA
of tableItem)
)
old.date))
do (TB.DELETE.ITEM cacheBrowser tableItem)
(add numberDeleted 1)
finally (\FCACHE.PRINT.PROMPT
(TB.WINDOW cacheBrowser)
(LIST (CONCAT "Marked "
numberDeleted
" cache enties for deletion"]
[Undelete (TB.MAP.SELECTED.ITEMS cacheBrowser
(FUNCTION (LAMBDA (
cacheBrowser
item)
(TB.UNDELETE.ITEM
cacheBrowser item]
[Inspect (LET [(firstSelectedItem (for tableItem
in (fetch TBITEMS
of
cacheBrowser)
thereis
(fetch TISELECTED
of tableItem]
(if firstSelectedItem
then (INSPECT (fetch TIDATA
of
firstSelectedItem]
(Filter (TB.USERDATA cacheBrowser
(PACKFILENAME
(QUOTE BODY)
(PROMPTFORWORD
">"
(TB.USERDATA cacheBrowser)
NIL
(\FCACHE.PRINT.PROMPT
(TB.WINDOW cacheBrowser)
(LIST
"Browse entries matching what ")))
(QUOTE BODY)
"*.*"))
(DOSELECTEDITEM menu (QUOTE Recompute)
button)
(\FCACHE.PRINT.PROMPT (TB.WINDOW cacheBrowser))
)
(Recompute (\FCACHE.BROWSE.RECOMPUTE cacheBrowser))
[Expunge (TB.MAP.DELETED.ITEMS
cacheBrowser
(FUNCTION (LAMBDA (cacheBrowser item)
(if (\FCACHE.DELETE.ENTRY (fetch
TIDATA
of
item))
then (TB.REMOVE.ITEM cacheBrowser
item]
NIL])
)
(FILESLOAD READNUMBER TABLEBROWSER)
(DECLARE: EVAL@COMPILE DONTCOPY DONTEVAL@LOAD
(FILESLOAD TABLEBROWSERDECLS)
)
(RPAQ? \FCACHE.BROWSER NIL)
(RPAQ \FCACHE.ICON (READBITMAP))
(102 76
"D@GF@D@@@@@@@AOLAB@HH@@@@@@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOOOOOOOOOOOOOOL@@"
"OOOOOOOOOOOOCKOOOOOOOONCND@@"
"FMBCOOOOONCMGFNJOOOOOOJBJH@@"
"BAAKOOOKBIGAGJNBMMOOOOKJNL@@"
"OOOOOONJHLC@@@@JMLLOOOOOOL@@"
"OOOOOMJCL@@@@@@@@NHEMOOOOL@@"
"OOOOOMOH@@@@@@@@@@@MJKKOOD@@"
"B@H@DM@@@@@@@@@@@@@AKHEMIH@@"
"NLKNGH@@@@@@@@@@@@@@CIGOGL@@"
"M@@@D@@@@@@@@@@@@@@@@@@@@@@@"
"@@@@@@@@@@@@GL@@@@@@@@@@@@@@"
"@@@@@@@@@@@GOOH@@@@@@@@@@@@@"
"@D@H@@@@@@AOOON@@@@@@@@@@@@@"
"@@@@@@@@@@GOOOOH@@@H@DD@DD@@"
"B@BL@@@@@@OL@@CL@@@H@@@@D@@@"
"@@@@@@@@@AN@@@CN@@@H@@@@@D@@"
"@@@@@@@@@CHO@@GO@@@HB@@BD@@@"
"@@@@@@@@@GHO@@FOH@@@@@@@@@@@"
"@@@@@@@@@OHC@@FGL@@@@@@@@@@@"
"D@@@@@@@@OKDF@CGN@@@@@@@@@@@"
"OL@@@@@@ANCN@@@GN@@@@@@@@@@@"
"OL@@@@@@COHL@@CCO@@@@@@@@@@@"
"ON@@@@@@CONF@@@COH@@@@@@@@@@"
"OOH@@@@@GONB@@@COH@@@BJ@H@@@"
"AOH@@@@@GONB@@@@OL@@@@@@@@@@"
"@OL@@@@@OOOB@JMHGL@@@@@@@@@@"
"HGL@@@@@OOOJMNOHOL@@@@@@L@@@"
"@CL@@@@@OOKCNNOHOL@@@@AMOH@@"
"@CD@@@@@OOHDDBADON@@@@COOD@@"
"@CL@@@@AOONN@B@EON@@@@GNC@@@"
"BCL@@@@AOOON@C@GON@@@@KOO@@@"
"BGL@@@@AOOOO@A@GON@@@AKFGH@@"
"NGL@@@@AOOOO@GLGOO@@@AKGO@@@"
"@OL@@@@AOOOOHGHGOO@@@ACFCD@@"
"COH@@@@AOOOOH@@GOO@@@CKFCL@@"
"OOH@@@@AOOOOLGHGOO@@@CGGOL@@"
"ON@@@@@AOOOONC@GOO@@@CNGOL@@"
"OL@@@@@COOOONCHOOO@@@CNNGL@@"
"O@@@@@@COOOOO@AOOO@@@AKLCL@@"
"D@@@@@@AOOOOOOGOOO@@@AKGOL@@"
"@@@@@@@AOOOOOOOOON@@@AOKAL@@"
"@@@@@@@AOOOOOOIOOO@@@@OOGL@@"
"@@@@@@@AOOOOOOAOOO@@@@GOOL@@"
"HHIHD@@AOOOOO@COON@@@@COOL@@"
"@EE@D@@AOOOOL@COON@@@@AOKH@@"
"@HLDD@@AOOOON@COON@@@@@CL@@@"
"@@DDH@@@OOOON@COOL@@@@@@@@@@"
"@@@@@@@@OOOON@EOOL@@@@@@@@@@"
"@@@@@@@@OOOOO@AOOL@@@@@@@@@@"
"@@@@@@@@GOOOO@AOOL@@@@@@@@@@"
"@@@@@@@@GOOOOH@OOH@@@@@@@@@@"
"@@@@@@@@COOOOL@OOH@@@@@@@@@@"
"@@@DH@@@COOOON@GO@@@@@@@@@@@"
"DCLH@K@@AOOOON@GO@@@@@@G@@@@"
"@@@HAG@@AOOOON@GN@AO@@@@@@@@"
"@@@@@B@@@OOOOO@CH@@C@@@@@@@@"
"@@@@@L@@AKOOIOHCN@@E@@@@@@@@"
"MFOCIH@@AKO@BJ@AD@@@@@@@@@@@"
"@@@@@@@@@CH@CB@AH@@@@@@@@@@@"
"@@@@@@BD@@@NEENAD@DMMLII@@@@"
"@COEMJJLJGGNLDOMKOOOOOOOL@@@"
"@MBOAOLLKEONIEGO@DLOOKOO@@@@"
"@AHHHAEAI@D@@IL@BDIA@IECD@@@"
"FKIHHCC@HLDLHHMBBFAC@HGCNH@@"
"OOILICADHDHIH@EBEBAE@HEIN@@@"
"NOINICEEJLNOJJOFOOOOOOOONL@@"
"OOOOOOO@@@@A@A@@@@AOOOOOOH@@"
"OOOOOOOOKHOADIBGAOMOOOOOOL@@"
"OO@@@@B@CH@F@B@NANAL@BAKOL@@"
"OO@BHHHBAHDDBAANAN@L@B@COL@@"
"OOLCH@DBAHD@BAAJAB@D@F@AOL@@"
"OOLCHLDBCHDDBBA@@AHD@BNCOL@@"
"OONCMMONOOOOOOOOOOOOOOOOOL@@"
"OOOLOOOOOLIN@@@@@@@@@@@@@@@@")
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.BROWSER \FCACHE.ICON)
)
(* Inspecting the cache properties)
(DEFINEQ
(\FCACHE.INSPECT.PROPCOMMANDFN
[LAMBDA (property object inspectw) (* smL "10-Feb-86 18:09")
(* * What to do when the user has selected a property from the cache inspect window)
(LET [(set?menu (CONSTANT (create MENU
ITEMS ←(QUOTE ((SET (QUOTE SET)
"Set the value of the property"]
(SELECTQ
property
(USECACHE (if (MENU set?menu)
then (FCACHE.PUTPROP
property
(SELECTQ (MENU (CONSTANT (create
MENU
ITEMS ←(QUOTE
((T T
"Use cache for Reading and Writing")
(Read (QUOTE Read)
"Use cache for Reading only")
(Write (QUOTE Write)
"Use cache for Writing only")
(NIL (QUOTE OFF)
"Don't use the cache at all")))
TITLE ← "Value for USECACHE")))
(T T)
(Read (QUOTE Read))
(Write (QUOTE Write))
(OFF NIL)
(NIL (FCACHE.GETPROP property))
NIL))
(INSPECTW.REDISPLAY inspectw)))
((DEVICES ENTRIES SIZE)
(\FCACHE.PRINT.PROMPT inspectw (LIST "Can't set that field!")))
[PREFIX (if (MENU set?menu)
then (LET [(pwindow (\FCACHE.PRINT.PROMPT inspectw (LIST
"Enter the new cache prefix"
"The expression read will NOT be EVALuated. "]
(if [NLSETQ (FCACHE.PUTPROP
(QUOTE PREFIX)
(MKATOM (PROMPTFORWORD ">"
(FCACHE.GETPROP
(QUOTE PREFIX))
NIL pwindow]
then (INSPECTW.REDISPLAY inspectw)
else (printout pwindow T "Bad cache prefix"]
((MAXSIZE MAXFILEPAGES DUMPSLEEP DUMPIDLE KEEPVERSIONS UNSAFE.TIMEOUT TIMETOVERIFY)
(if (MENU set?menu)
then (FCACHE.PUTPROP property (RNUMBER (CONCAT "Value for " property)))
(INSPECTW.REDISPLAY inspectw)))
(FASTDIR (if (MENU set?menu)
then (FCACHE.PUTPROP
property
(SELECTQ (MENU (CONSTANT
(create MENU
ITEMS ←[QUOTE
(T (NIL (QUOTE OFF]
TITLE ← "Value for FASTDIR")))
(T T)
(OFF NIL)
(NIL (FCACHE.GETPROP property))
NIL))
(INSPECTW.REDISPLAY inspectw)))
(UNSAFE.DEFAULT (if (MENU set?menu)
then
(FCACHE.PUTPROP
property
(SELECTQ (MENU (CONSTANT (create
MENU
ITEMS ←(QUOTE
((T T
"Go ahead and trust the cache")
(NIL (QUOTE OFF)
"Don't trust the cache")))
TITLE ← "Value for UNSAFE.DEFAULT")
))
(T T)
(OFF NIL)
(NIL (FCACHE.GETPROP property))
NIL))
(INSPECTW.REDISPLAY inspectw)))
(SILENT (if (MENU set?menu)
then (FCACHE.PUTPROP
property
(SELECTQ (MENU (CONSTANT
(create MENU
ITEMS ←[QUOTE
(T (NIL (QUOTE OFF]
TITLE ← "Value for SILENT")))
(T T)
(OFF NIL)
(NIL (FCACHE.GETPROP property))
NIL))
(INSPECTW.REDISPLAY inspectw)))
(UNSAFE (if (MENU set?menu)
then (FCACHE.PUTPROP
property
(SELECTQ (MENU (CONSTANT (create
MENU
ITEMS ←(QUOTE
((T T
"Silently use the cache if a server is down")
(NOTIFY (QUOTE NOTIFY)
"Tell the user when using the cache while a server is down")
(ASK (QUOTE ASK)
"Ask the user whether to use the cache if a server is down")
(NIL (QUOTE OFF)
"Don't use the cache if a server is down")))
TITLE ← "Value for UNSAFE")))
(T T)
(ASK (QUOTE ASK))
(NOTIFY (QUOTE NOTIFY))
(OFF NIL)
(NIL (FCACHE.GETPROP (QUOTE UNSAFE)))
NIL))
(INSPECTW.REDISPLAY inspectw)))
(NIL NIL)
(if (MENU set?menu)
then [FCACHE.PUTPROP property (MKATOM (PROMPTFORWORD
">" NIL NIL
(\FCACHE.PRINT.PROMPT
inspectw
(LIST (CONCAT "Enter the new "
property
" cache property")
"The expression read will be EVALuated. "]
(INSPECTW.REDISPLAY inspectw])
(\FCACHE.INSPECT.TITLEFN
[LAMBDA (inspectw object) (* smL " 3-Feb-86 19:10")
(* * The title was bugged in the inspectw)
(SELECTQ [MENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((ReFetch (QUOTE REFETCH)
"Recompute the inspect window"]
(REFETCH (INSPECTW.REDISPLAY inspectw))
(NIL NIL)
(SHOULDNT])
(\FCACHE.INSPECT.VALUES
[LAMBDA (cachePropList property) (* smL " 2-May-85 10:07")
(* * What is the property value)
(FCACHE.GETPROP property])
(\FCACHE.PROPERTY.NAMES
[LAMBDA NIL (* smL "15-Jul-85 09:41")
(* * Return a list of all current cache properties)
(CONS (QUOTE ENTRIES)
(for p on \FCACHE.PROPERTIES by (CDDR p) collect (CAR p])
)
(* * Data access functions)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \FCACHE.PROPERTY MACRO (OPENLAMBDA (X)
(LISTGET \FCACHE.PROPERTIES X)))
(PUTPROPS \FCACHE.PROPERTY.PUT MACRO (OPENLAMBDA (NAME VALUE)
(LISTPUT \FCACHE.PROPERTIES NAME VALUE)))
[PUTPROPS \FCACHE.LOCALDEVICE MACRO (OPENLAMBDA NIL (OR \FCACHE.LOCALDEVICE
(SETQ \FCACHE.LOCALDEVICE
(\GETDEVICEFROMNAME
(\FCACHE.PROPERTY (QUOTE PREFIX))
T]
)
)
[DECLARE: EVAL@COMPILE
(RECORD CACHEDEVINFO (REALDEVICENAME (* The name of the real device)
CACHEDEV (* The cache device for this remote device)
)
[ACCESSFNS ((REALDEVICE (\GETREALDEVICEFROMHOSTNAME (fetch
REALDEVICENAME
of DATUM)
NIL
(fetch CACHEDEV
of DATUM]
(SYSTEM))
(DATATYPE CACHENTRY (REMOTEFILENAME LOCALFILENAME MATCHFILENAME (CACHEISDIRTY FLAG)
(* True if OPENFILE specified version)
(FILEXISTED FLAG) (* Did the file exist when we started to write it
out?)
(CACHEFILELENGTH INTEGER)
(* in bytes. Not valid while open for write)
CACHEFILEPROPS (* prop list of real file from opening)
(CACHEFILEDATE INTEGER)
(* ICREATIONDATE of remote file)
(CACHEBEINGWRITTEN FLAG)
(* True while writeout in progress)
CACHETIMECLOSED (* The time the cache file was last closed)
CACHELOCK (* A monitor lock for access to the cache)
(TIMELASTVERIFIED INTEGER)
(* When was this entry last verified?)
)
CACHELOCK ←(CREATE.MONITORLOCK (QUOTE CACHELOCK))
TIMELASTVERIFIED ← 0 (SYSTEM))
(ACCESSFNS CACHEDEVICE ((CACHEDEVINFO (\FCACHE.DEVINFO DATUM)
(\FCACHE.PUT.DEVINFO DATUM NEWVALUE)))
(SUBRECORD CACHEDEVINFO)
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE CACHENTRY)
(QUOTE (POINTER POINTER POINTER FLAG FLAG FIXP POINTER FIXP FLAG POINTER POINTER
FIXP))
(QUOTE ((CACHENTRY 0 POINTER)
(CACHENTRY 2 POINTER)
(CACHENTRY 4 POINTER)
(CACHENTRY 4 (FLAGBITS . 0))
(CACHENTRY 4 (FLAGBITS . 16))
(CACHENTRY 6 FIXP)
(CACHENTRY 8 POINTER)
(CACHENTRY 10 FIXP)
(CACHENTRY 8 (FLAGBITS . 0))
(CACHENTRY 12 POINTER)
(CACHENTRY 14 POINTER)
(CACHENTRY 16 FIXP)))
(QUOTE 18))
(DEFINEQ
(\FCACHE.DEVINFO
[LAMBDA (dev) (* smL " 9-Apr-85 12:56")
(* * Get the cache dev info for this cache device)
(for devinfo in (\FCACHE.PROPERTY (QUOTE DEVICES)) thereis (EQ dev (fetch CACHEDEV of devinfo])
(\FCACHE.PUT.DEVINFO
[LAMBDA (dev info) (* smL " 9-Apr-85 13:14")
(* * Replace the device info record for this cache device)
(\FCACHE.PROPERTY.PUT (QUOTE DEVICES)
(CONS info (DREMOVE (\FCACHE.DEVINFO dev)
(\FCACHE.PROPERTY (QUOTE DEVICES])
)
(ADDTOVAR \SYSTEMCACHEVARS \FCACHE.LOCALDEVICE)
(RPAQ? \FCACHE.LOCALDEVICE NIL)
(RPAQ? \FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE 10000
MAXFILEPAGES 600 UNSAFE ASK UNSAFE.TIMEOUT 30
UNSAFE.DEFAULT NIL SILENT NIL DUMPSLEEP 10000 DUMPIDLE
20 FASTDIR NIL KEEPVERSIONS 2 TIMETOVERIFY 5 BADDEVICES
NIL)))
(RPAQ? \FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(RPAQ? \FCACHE.GENERIC.DEVICES NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.LOCALDEVICE \FCACHE.PROMPT.WINDOW \FCACHE.PROMPT.WINDOW.MONITORLOCK
\FCACHE.PROPERTIES \FCACHE.GENERIC.DEVICES)
)
(* * Initialize things)
(DEFINEQ
(\FCACHE.INITIALIZE
[LAMBDA NIL (* smL "12-Mar-86 19:01")
(* * Initialize the FileCache stuff, UNDOably)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands ERRORTYPELST))
(if (NOT (\GETDEVICEFROMHOSTNAME (QUOTE FCACHE)
T))
then
(* * Change the user level IO functions so that they go thru the cache)
(* The lists of functions below is the result of (FINDCALLERS (QUOTE (\GETDEVICEFROMNAME))
(QUOTE ({Eris}<Lisp>Intermezzo>Sources>Fileio))) and (FINDCALLERS (QUOTE (\GETDEVICEFROMHOSTNAME))
(QUOTE ({Eris}<Lisp>Intermezzo>Sources>Fileio))))
(for fn in (QUOTE (\DELETEFILE \GENERATEFILES \GETFILENAME
\GETFILENAME.OR.STREAM \OPENFILE \RENAMEFILE
DIRECTORYNAMEP GETFILEINFO SETFILEINFO))
do (CHANGENAME fn (QUOTE \GETDEVICEFROMNAME)
(QUOTE \GETUSERDEVICEFROMNAME)))
(for fn in (QUOTE (DIRECTORYNAME)) do (CHANGENAME fn (QUOTE
\GETDEVICEFROMHOSTNAME)
(QUOTE
\GETUSERDEVICEFROMNAME)))
(* * The following device is used to catch events...)
(SETQ \FCACHE.DEVICE (create FDEV
EVENTFN ←(FUNCTION \FCACHE.DEVICE.EVENTFN)
DEVICENAME ←(QUOTE FCACHE)
NODIRECTORIES ← T
HOSTNAMEP ←(FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE FCACHE)
\FCACHE.DEVICE)
(* * Catch changes in the user password)
(MOVD? (QUOTE \INTERNAL/SETPASSWORD)
(QUOTE \OLD\INTERNAL/SETPASSWORD))
[UNDOSAVE (QUOTE (MOVD (QUOTE \OLD\INTERNAL/SETPASSWORD)
(QUOTE \INTERNAL/SETPASSWORD]
(MOVD (QUOTE \FCACHE.\INTERNAL/SETPASSWORD)
(QUOTE \INTERNAL/SETPASSWORD))
(* * Set up to catch "FILE SYSTEM RESOURCES EXCEEDED" erorrs)
(PUTASSOC 22 [QUOTE ((\FCACHE.RESOURCES.ERROR (CADR ERRORMESS]
ERRORTYPELST)
(* * Put a flush-cache entry on the background menu)
(if (NOT (ASSOC (QUOTE DumpCache)
BackgroundMenuCommands))
then [push BackgroundMenuCommands (QUOTE
(DumpCache (QUOTE (FCACHE.DUMP.ALL))
"Writes out all dirty files and updates the cache listing"
(SUBITEMS (DumpCache (QUOTE (FCACHE.DUMP.ALL))
"Writes out all dirty files and updates the cache listing")
(BrowseCache (QUOTE (
\FCACHE.FLUSH.INFOHOOK))
"Inspect the cache properties"]
(SETQ BackgroundMenu NIL))
(* * Make it all undoable)
(UNDOSAVE (QUOTE (FCACHE.VANQUISH)))
(* * Now start it all up)
(\FCACHE.INITIALIZE.PROPS)
(for devName in FCACHE.GENERIC.DEVICE.TYPES do (FCACHE.GENERIC.START devName])
(FCACHE.VANQUISH
[LAMBDA NIL (* smL "12-Mar-86 18:49")
(* * Unload the cacher from the system, removing any and all traces that it ever existed)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands ERRORTYPELST))
(if (\GETDEVICEFROMNAME (QUOTE FCACHE)
T)
then [for entry in \FCACHE.LIST do (if (AND (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then (ERROR
"Can't vanquish the file cacher -- a (cached) file is open and needs to be flushed!"
(fetch REMOTEFILENAME
of entry]
(for dev in \FCACHE.GENERIC.DEVICES do (FCACHE.GENERIC.STOP dev))
(\FCACHE.DEVICE.EVENTFN \FCACHE.DEVICE (QUOTE BEFORELOGOUT))
(for dev in (\FCACHE.PROPERTY (QUOTE DEVICES)) do (FCACHE.STOP (CAR dev)))
(if (GETD (QUOTE \OLD\INTERNAL/SETPASSWORD))
then (MOVD (QUOTE \OLD\INTERNAL/SETPASSWORD)
(QUOTE \INTERNAL/SETPASSWORD)))
(\REMOVEDEVICE (\GETDEVICEFROMNAME (QUOTE FCACHE)
T])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\FCACHE.INITIALIZE)
)
(RPAQ FCACHE.VERSION.DATE "13-Mar-86 15:28:16")
(RPAQQ FCACHE.VERSION.NUMBER 5.1)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS FCACHE.VERSION.DATE FCACHE.VERSION.NUMBER)
)
(* * Compile time magic)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS REALDEVOP MACRO (X (LET [(realDevice (GENSYM (QUOTE realDevice]
(BQUOTE (LET [(, realDevice (fetch (CACHEDEVICE REALDEVICE)
of , (CADR X]
(if , realDevice then (FDEVOP ,@ (SUBST realDevice
(CADR X)
X))
else
(ERROR "Host not up" (fetch (CACHEDEVICE
REALDEVICENAME)
of , (CADR X]
[PUTPROPS VersionlessFileName MACRO (OPENLAMBDA (fileName)
(SUBATOM fileName 1
(SUB1 (OR (STRPOS ";" fileName)
(ADD1 (NCHARS fileName]
(DEFMACRO KLUDGE (&REST FORMS)
(* * Just like PROGN, but lets us use MASTERSCOPE to find this kludge)
(BQUOTE (PROGN ., FORMS)))
)
(DECLARE: EVAL@COMPILE
(I.S.OPR (QUOTE INUNSORTEDFILES)
NIL
[QUOTE (SUBST (GENSYM)
(QUOTE GENVAR)
(QUOTE (BIND GENVAR ← (\GENERATEFILES BODY)
EACHTIME
(PROGN (OR (SETQ I.V. (\GENERATENEXTFILE GENVAR))
(GO $$OUT))
(IF (LISTP I.V.)
THEN
(SETQ I.V. (CONCATCODES I.V.]
T)
)
DONTEVAL@LOAD
(FILESLOAD NSFILING LLNS)
)
(PUTPROPS FILECACHE COPYRIGHT ("Xerox Corporation" 1983 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10472 23835 (ADD.FILE.TO.CACHE? 10482 . 10848) (CACHE.FILE 10850 . 11213) (
FCACHE.DELETE.CACHE.ENTRY 11215 . 11716) (FCACHE.DUMP.ALL 11718 . 12021) (FCACHE.GENERIC.START 12023
. 12945) (FCACHE.GENERIC.STOP 12947 . 13471) (FCACHE.GETPROP 13473 . 13958) (FCACHE.PRIVATE.FILE?
13960 . 14265) (FCACHE.PUTPROP 14267 . 16011) (FCACHE.START 16013 . 18180) (FCACHE.STOP 18182 . 19834)
(FCACHE.CACHELIST 19836 . 20101) (FCACHE.DIRTY? 20103 . 20542) (FCACHE.DUMP.FILE 20544 . 21085) (
FCACHE.DUMP 21087 . 23833)) (24734 25977 (\FCACHE.DONE.OR.ABORTED.MSG 24744 . 25421) (
\FCACHE.PRINT.MESSAGE? 25423 . 25975)) (26185 27290 (\FCACHE.PRINT.PROMPT 26195 . 26999) (
\FCACHE.CREATE.MSG.WINDOW 27001 . 27288)) (29048 35522 (\GETUSERDEVICEFROMNAME 29058 . 29804) (
\GETCACHEDEVICEFROMHOSTNAME 29806 . 32687) (\GETREALDEVICEFROMHOSTNAME 32689 . 33854) (
\FCACHE.CANONICAL.HOSTNAME 33856 . 35046) (\FCACHE.GENERIC.DEVICE.TYPE 35048 . 35520)) (35591 46462 (
\FCACHE.DELETE.ENTRY 35601 . 37025) (\FCACHE.INVENTNAME 37027 . 37538) (\FCACHE.KEEPVERSIONS 37540 .
38783) (\FCACHE.LOAD 38785 . 43227) (\FCACHE.MAKE.LEGAL.FILENAME 43229 . 43737) (\FCACHE.MAKEROOM
43739 . 46233) (\FCACHE.MAKEROOM.DELETEABLE? 46235 . 46460)) (46969 52744 (FCACHE.SCAVENGE 46979 .
52742)) (52745 59128 (\FCACHE.REPAIR 52755 . 57184) (\FCACHE.REPAIR.FINDFILE 57186 . 58630) (
\FCACHE.REPAIR.VERIFY 58632 . 59126)) (59636 61738 (\FCACHE.BUILD.DEVICE 59646 . 61332) (\FCACHE.OFF
61334 . 61736)) (61805 65901 (\FCACHE.DEVICE.EVENTFN 61815 . 64416) (\FCACHE.INITIALIZE.PROPS 64418 .
65899)) (66112 66974 (\FCACHE.GLOBAL.EVENT 66122 . 66972)) (67124 69339 (\FCACHE.AROUNDEXIT 67134 .
69337)) (69424 71461 (\FCACHE.BEFORELOGIN 69434 . 70965) (\FCACHE.\INTERNAL/SETPASSWORD 70967 . 71459)
) (71809 97868 (\FCACHE.CLOSEFILE 71819 . 73659) (\FCACHE.DELETEFILE 73661 . 74593) (
\FCACHE.DIRECTORYNAMEP 74595 . 77590) (\FCACHE.EVENTFN 77592 . 79640) (\FCACHE.GENERATEFILES 79642 .
80447) (\FCACHE.GETFILEINFO 80449 . 81124) (\FCACHE.GETFILENAME 81126 . 86433) (\FCACHE.HOSTNAMEP
86435 . 86621) (\FCACHE.OPENFILE 86623 . 90977) (\FCACHE.RENAMEFILE 90979 . 93515) (\FCACHE.REOPENFILE
93517 . 95233) (\FCACHE.SETFILEINFO 95235 . 97866)) (97892 99777 (\FCACHE.ENTRYINFO 97902 . 99775)) (
99822 103739 (\FCACHE.GENERATE.FILEINFO 99832 . 100278) (\FCACHE.GENERATE.FILES.DEPTH 100280 . 100704)
(\FCACHE.GENERATE.LOCAL.FILES 100706 . 102727) (\FCACHE.NEXT.LOCAL.FILE 102729 . 103737)) (103789
110068 (MERGE.FILEGENERATORS 103799 . 104216) (MERGED.FILEINFOFN 104218 . 104573) (MERGED.NEXTFILEFN
104575 . 105449) (\MERGED.NEXTFILEFN1 105451 . 108415) (FILES.IN.ORDER? 108417 . 110066)) (110416
118229 (\FCACHE.LOOKUP 110426 . 112432) (\FCACHE.PROMOTE 112434 . 113293) (\FCACHE.USECACHE? 113295 .
116317) (\FCACHE.VERIFY 116319 . 118227)) (118435 130189 (\FCACHE.HOSTUP? 118445 . 123435) (
\NSFILING.ADDRESS 123437 . 123661) (\FCACHE.IGNOREDATECHECK? 123663 . 126868) (
\FCACHE.USELOCALDIRECTORY? 126870 . 129622) (\FCACHE.HOSTDEAD.WHENSELECTEDFN 129624 . 130187)) (130354
132010 (\FCACHE.RESOURCES.ERROR 130364 . 132008)) (132076 152022 (\FCACHE.ENTRYOPEN? 132086 . 132419)
(\FCACHE.FLUSH 132421 . 133134) (\FCACHE.WRITEOUT 133136 . 149967) (\FCACHE.WRITEOUT.NEWFILENAME
149969 . 150973) (\FCACHE.WRITEOUT.READNEWFILENAME 150975 . 151638) (\FCACHE.WRITEOUT.WHENSELECTEDFN
151640 . 152020)) (152253 163249 (\FCACHE.ADDENTRY 152263 . 153198) (\FCACHE.DUMP.ENTRY 153200 .
153664) (\FCACHE.FILEMATCH? 153666 . 154199) (\FCACHE.LOGENTRY 154201 . 155190) (\FCACHE.RESTORE
155192 . 161804) (\FCACHE.RESTORE.ENTRY 161806 . 163247)) (163426 163933 (\FCACHE.FLUSH.INFOHOOK
163436 . 163931)) (163970 172614 (\FCACHE.BROWSE.CACHE 163980 . 167576) (\FCACHE.BROWSE.COPYFN 167578
. 167840) (\FCACHE.BROWSE.PRINTFN 167842 . 168463) (\FCACHE.BROWSE.RECOMPUTE 168465 . 169308) (
\FCACHE.BROWSE.WHENSELECTEDFN 169310 . 172612)) (175285 180991 (\FCACHE.INSPECT.PROPCOMMANDFN 175295
. 180038) (\FCACHE.INSPECT.TITLEFN 180040 . 180476) (\FCACHE.INSPECT.VALUES 180478 . 180681) (
\FCACHE.PROPERTY.NAMES 180683 . 180989)) (183804 184479 (\FCACHE.DEVINFO 183814 . 184121) (
\FCACHE.PUT.DEVINFO 184123 . 184477)) (185231 189556 (\FCACHE.INITIALIZE 185241 . 188319) (
FCACHE.VANQUISH 188321 . 189554)))))
STOP