(FILECREATED "19-Sep-85 15:28:45" {ERIS}<LISPCORE>LIBRARY>FILECACHE.;9 145590
changes to: (VARS FILECACHECOMS)
(FNS \FCACHE.CANONICAL.HOSTNAME)
previous date: "16-Sep-85 18:27:44" {ERIS}<LISPCORE>LIBRARY>FILECACHE.;7)
(* Copyright (c) 1983, 1985 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.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)
(MACROS WITHOUT.FCACHE)
(PROP ARGNAMES WITHOUT.FCACHE)
(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.VERSION.DATE FCACHE.VERSION.NUMBER
FCACHE.GENERIC.DEVICE.TYPES))
(COMS (* * Data access functions)
(MACROS \FCACHE.PROPERTY \FCACHE.PROPERTY.PUT \FCACHE.LOCALDEVICE)
(RECORDS CACHEDEVINFO CACHENTRY CACHEDEVICE)
(FNS \FCACHE.DEVINFO \FCACHE.PUT.DEVINFO)
(INITVARS (\FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE
10000 MAXFILEPAGES 400 UNSAFE ASK SILENT
NIL DUMPSLEEP 10000 DUMPIDLE 20 FASTDIR
NIL KEEPVERSIONS 2 BADDEVICES NIL)))
(\FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(\FCACHE.PROMPT.WINDOW.MONITORLOCK (CREATE.MONITORLOCK (QUOTE
\FCACHE.PROMPT.WINDOW.MONITORLOCK)))
(\FCACHE.GENERIC.DEVICES NIL))
(GLOBALVARS \FCACHE.PROMPT.WINDOW \FCACHE.PROMPT.WINDOW.MONITORLOCK \FCACHE.PROPERTIES
\FCACHE.GENERIC.DEVICES))
(COMS (* * Functions for producing the device given the name)
(FNS \GETUSERDEVICEFROMNAME \GETCACHEDEVICEFROMHOSTNAME \GETREALDEVICEFROMHOSTNAME
\FCACHE.CANONICAL.HOSTNAME))
(COMS (* * Functions for loading or removing a file into the cache)
(INITVARS (\FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(\FCACHE.LIST NIL)
(\FCACHE.LIST.CHANGED? NIL)
(\FCACHE.LOGFILE NIL))
(GLOBALVARS \FCACHE.CACHELOCK \FCACHE.LIST \FCACHE.LIST.CHANGED? \FCACHE.LOGFILE)
(FNS \FCACHE.DELETE.ENTRY \FCACHE.INVENTNAME \FCACHE.KEEPVERSIONS \FCACHE.LOAD
\FCACHE.MAKE.LEGAL.FILENAME \FCACHE.MAKEROOM \FCACHE.MAKEROOM.DELETEABLE?))
(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)
(DOLPHIN 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 (* * 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))
(COMS (* * Directory enumeration functions)
(FNS \FCACHE.GENERATE.FILEINFO \FCACHE.GENERATE.LOCAL.FILES \FCACHE.NEXT.LOCAL.FILE)
(FNS MERGE.FILEGENERATORS MERGED.FILEINFOFN MERGED.NEXTFILEFN FILES.IN.ORDER?)
(RECORDS MERGEDFILEGENSTATE))
(COMS (* * Functions for finding a file in the cache)
(FNS \FCACHE.LOOKUP \FCACHE.PROMOTE \FCACHE.VERIFY))
(COMS (* * Try to figure out if a host is up)
(INITVARS (FCACHE.DEAD.HOSTS NIL))
(FNS \FCACHE.HOSTUP? \NSFILING.ADDRESS \FCACHE.IGNOREDATECHECK?
\FCACHE.USELOCALDIRECTORY?)
(GLOBALVARS \FCACHE.HOSTUP.ECHOSTREAM \FCACHE.HOSTUP.ECHOSTREAM.MONITORLOCK
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))
(COMS (* * Functions for dumping and restoring information about the contents of the cache)
(FNS \FCACHE.ADDENTRY FCACHE.DUMP \FCACHE.DUMP.ENTRY \FCACHE.FILEMATCH?
\FCACHE.LOGENTRY \FCACHE.RESTORE \FCACHE.RESTORE.ENTRY))
(COMS (* * Functions for inspecting the cache)
(FNS \FCACHE.ENTRYINFO \FCACHE.FLUSH.INFOHOOK \FCACHE.INSPECT.PROPCOMMANDFN
\FCACHE.INSPECT.TITLEFN \FCACHE.INSPECT.ENTRYCOMMAND \FCACHE.INSPECT.FILEINFO
\FCACHE.INSPECT.FILESLST \FCACHE.INSPECT.VALUES \FCACHE.PROPERTY.NAMES)
(BITMAPS \FCACHE.ICON)
(GLOBALVARS \FCACHE.ICON))
(* * Initialize things)
(FNS \FCACHE.INITIALIZE FCACHE.VANQUISH)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\FCACHE.INITIALIZE)))
[COMS * (BQUOTE ((VARS (FCACHE.VERSION.DATE , (DATE))
(FCACHE.VERSION.NUMBER 3.0]
(* * This all depends on record defns from the system)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS REALDEVOP VersionlessFileName)
(I.S.OPRS INUNSORTEDFILES)
DONTEVAL@LOAD
[P (DOFILESLOAD (SELECTQ MAKESYSNAME (LISPCORE (QUOTE (ABC)))
(QUOTE (SYSEDIT]
(FILES (LOADCOMP)
NSFILING LLNS))))
(* * The FileCache package, here before your eyes! * *)
(* * Public functions for manipulating the cache)
(DEFINEQ
(ADD.FILE.TO.CACHE?
[LAMBDA (fullName) (* smL " 9-Aug-85 14:06")
(* * Should the file be added to the cache?)
(NOT (for fileSpec in DON'T.CACHE.FILES thereis (\FCACHE.FILEMATCH? fullName
(DIRECTORY.FILL.PATTERN
fileSpec "" "*"])
(CACHE.FILE
[LAMBDA (fileName) (* smL " 8-Aug-85 15:04")
(* * Load the file into the cache)
(LET ((fullName (INFILEP fileName)))
(if (NULL fullName)
then NIL
elseif (\FCACHE.LOAD fullName)
then fullName
else NIL])
(FCACHE.DUMP.ALL
[LAMBDA NIL (* smL "22-Aug-85 16:44")
(* * Cause an immediate flush of all dirty files)
(ALLOW.BUTTON.EVENTS)
(FCACHE.DUMP T)
(PROMPTPRINT "Done writing out cache"])
(FCACHE.GENERIC.START
[LAMBDA (deviceType) (* smL "12-Aug-85 11:48")
(* * remember that cache devices for this device are to be created on the fly)
(DECLARE (GLOBALVARS \FILEDEVICES))
(LET [(device (for dev in \FILEDEVICES thereis (EQ (fetch DEVICENAME of dev)
(U-CASE deviceType]
(if (NULL device)
then NIL
else (UNDOSAVE (LIST (FUNCTION FCACHE.GENERIC.STOP)
deviceType))
(pushnew \FCACHE.GENERIC.DEVICES device)
device])
(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 "14-Aug-85 13:30")
(* * 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)
(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 "14-Aug-85 13:44")
(* * Turn on caching for the given device)
(if (NULL (\FCACHE.PROPERTY (QUOTE PREFIX)))
then (PROMPTPRINT "No cache prefix, so can't start cache for " devname)
NIL
else (LET ((canonicalName (\FCACHE.CANONICAL.HOSTNAME devname)))
(if (NULL canonicalName)
then (printout PROMPTWINDOW "No such host " devname T)
NIL
elseif (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
canonicalName))
then (* Caching already started)
NIL
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 (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (printout PROMPTWINDOW "Creating cache device for host " canonicalName
T))
(replace CACHEDEVINFO of cacheDevice
with (create CACHEDEVINFO
CACHEDEV ← cacheDevice
REALDEVICENAME ← canonicalName))
(\DEFINEDEVICE (PACK* canonicalName (QUOTE -CACHE))
cacheDevice) (* Make this UNDOable)
(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 " 7-Aug-85 17:15")
(* * Is the entry for this file dirty?)
(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 " 7-Aug-85 17:15")
(* * Flush a single file to the server)
(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])
)
(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))
(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.VERSION.DATE FCACHE.VERSION.NUMBER
FCACHE.GENERIC.DEVICE.TYPES)
)
(* * Data access functions)
(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 (\GETDEVICEFROMNAME (\FCACHE.PROPERTY
(QUOTE PREFIX]
)
[DECLARE: EVAL@COMPILE
(RECORD CACHEDEVINFO (REALDEVICENAME (* The remote device for these operations)
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)
)
CACHELOCK ←(CREATE.MONITORLOCK (QUOTE CACHELOCK))
(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))
(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)))
(QUOTE 16))
(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])
)
(RPAQ? \FCACHE.PROPERTIES (QUOTE (USECACHE T DEVICES NIL PREFIX NIL SIZE 0 MAXSIZE 10000 MAXFILEPAGES
400 UNSAFE ASK SILENT NIL DUMPSLEEP 10000 DUMPIDLE 20
FASTDIR NIL KEEPVERSIONS 2 BADDEVICES NIL)))
(RPAQ? \FCACHE.PROMPT.WINDOW (CREATEW (CREATEREGION 200 200 500 100)
"File cache prompt window" 15 T))
(RPAQ? \FCACHE.PROMPT.WINDOW.MONITORLOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.PROMPT.WINDOW.MONITORLOCK)
))
(RPAQ? \FCACHE.GENERIC.DEVICES NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.PROMPT.WINDOW \FCACHE.PROMPT.WINDOW.MONITORLOCK \FCACHE.PROPERTIES
\FCACHE.GENERIC.DEVICES)
)
(* * 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?) (* lmm "14-Sep-85 16:54")
(* * Return the cache device, if it exists, otherwise the real device)
(LET (canonicalName devInfo)
(COND
((SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
devname))) (* already have a cache device, so use it)
(fetch (CACHEDEVINFO CACHEDEV) of devInfo))
((\GETDEVICEFROMNAME devname T T))
([AND (SETQ canonicalName (\FCACHE.CANONICAL.HOSTNAME devname))
(NEQ devname canonicalName)
(SETQ devInfo (for info in (\FCACHE.PROPERTY (QUOTE DEVICES))
thereis (EQ (fetch (CACHEDEVINFO REALDEVICENAME) of info)
canonicalName]
(fetch (CACHEDEVINFO CACHEDEV) of devInfo))
((AND (NOT dontCreate?)
(NOT (for name in (\FCACHE.PROPERTY (QUOTE BADDEVICES))
thereis (EQ (OR canonicalName devname)
name)))
(for dev in \FCACHE.GENERIC.DEVICES thereis (FDEVOP (QUOTE HOSTNAMEP)
dev devname)))
(* we should create the device on the fly)
(OR (FCACHE.START devname)
(\GETDEVICEFROMNAME devname noError? dontCreate?)))
(T (* nope, so just go with the generic system code)
(\GETDEVICEFROMNAME devname 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) (* lmm "19-Sep-85 13:31")
(* * 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)
(U-CASE (MKATOM (LET ((dev (\GETDEVICEFROMNAME name T T)))
(if [AND dev (NOT (FMEMB (SETQ dev (fetch DEVICENAME of dev))
(QUOTE (DPUPFTP LEAF NSFILING]
then 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])
)
(* * Functions for loading or removing a file into the cache)
(RPAQ? \FCACHE.CACHELOCK (CREATE.MONITORLOCK (QUOTE \FCACHE.CACHELOCK)))
(RPAQ? \FCACHE.LIST NIL)
(RPAQ? \FCACHE.LIST.CHANGED? NIL)
(RPAQ? \FCACHE.LOGFILE NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.CACHELOCK \FCACHE.LIST \FCACHE.LIST.CHANGED? \FCACHE.LOGFILE)
)
(DEFINEQ
(\FCACHE.DELETE.ENTRY
[LAMBDA (entry) (* smL " 6-Aug-85 14:06")
(* * Delete a cache entry)
(WITH.MONITOR \FCACHE.CACHELOCK (WITH.MONITOR (fetch CACHELOCK of entry)
(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)
(if (NOT (\FCACHE.PROPERTY (QUOTE SILENT?)))
then (printout PROMPTWINDOW T
"Deleting cache entry for file "
(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))
(if (NOT (\FCACHE.PROPERTY (QUOTE SILENT?)))
then (printout PROMPTWINDOW "done" T))
(* 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 "11-Sep-85 17:07")
(* * Load up a global file into the cache, returning the entry, or NIL if the load fails)
(RESETLST (PROG ([inStream (OPENSTREAM fullName (QUOTE INPUT)
(QUOTE OLD)
(QUOTE (DON'TCACHE SEQUENTIAL]
remoteDevice outStream localFileName length)
(if (NULL inStream)
then (RETURN NIL))
(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)) (* Make sure there is enough room for the file)
(\FCACHE.KEEPVERSIONS fullName (\FCACHE.PROPERTY (QUOTE KEEPVERSIONS)))
(if (OR (LET [(maxLength (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
(AND maxLength (IGREATERP length maxLength)))
(NOT (ADD.FILE.TO.CACHE? fullName))
(NOT (\FCACHE.MAKEROOM length)))
then (RETURN NIL))
[if (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (RESETSAVE (printout PROMPTWINDOW T "Caching " fullName "...")
(QUOTE (COND (RESETSTATE (PRINT (QUOTE aborted.)
PROMPTWINDOW))
(T (PRINT (QUOTE done)
PROMPTWINDOW]
(RETURN (WITH.MONITOR \FCACHE.CACHELOCK
[SETQ outStream
(OPENSTREAM (\FCACHE.INVENTNAME fullName)
(QUOTE OUTPUT)
(QUOTE NEW)
NIL
(BQUOTE (DON'TCACHE
SEQUENTIAL
(TYPE , (FDEVOP (QUOTE GETFILEINFO)
remoteDevice
inStream
(QUOTE TYPE)
remoteDevice))
(CREATIONDATE ,
(FDEVOP (QUOTE
GETFILEINFO)
remoteDevice
inStream
(QUOTE
CREATIONDATE)
remoteDevice))
(length , (FDEVOP (QUOTE
GETFILEINFO)
remoteDevice
inStream
(QUOTE LENGTH)
remoteDevice]
(if outStream
then (RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
outStream))
(replace USERVISIBLE of outStream with NIL)
(SETQ localFileName (fetch FULLFILENAME
of outStream))
(COPYBYTES inStream outStream)
(CLOSEF inStream)
(CLOSEF outStream)
(\FCACHE.ADDENTRY localFileName fullName
(GETFILEINFO inStream
(QUOTE
ICREATIONDATE))
(GETFILEINFO inStream
(QUOTE PLIST))
length)
else NIL])
(\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 "11-Sep-85 14:23")
(* * Make sure that there is enough room in the cache to hold this file)
(LET [(cacheMaxTotal (\FCACHE.PROPERTY (QUOTE MAXSIZE)))
(freePages (OR [CAR (NLSETQ (DIFFERENCE (DISKFREEPAGES (\FCACHE.PROPERTY (QUOTE PREFIX)))
(SELECTQ (MACHINETYPE)
((DORADO DOLPHIN)
50)
100]
length))
(cacheSize (\FCACHE.PROPERTY (QUOTE SIZE]
(SETQ length (if (NUMBERP length)
then length
else 0))
(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...)
(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])
)
(* * 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) (* smL "11-Sep-85 11:42")
(* * 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)))
stream expr)
(* * First try some magic based on the file name. If that doesn't work, try some generic method to find the remote
file. * *)
(OR (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 (LISTGET fileNameFields (QUOTE EXTENSION))
COMPILE.EXT)
then (* a compiled file -- try to find a FILECREATED expr in
it)
[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)
(for file
inunsortedfiles
(CONCAT [LET [(fileName (CADR (CADDR expr]
(SUBATOM fileName 1 (SUB1 (OR (STRPOS "." fileName)
(STRPOS ";" fileName)
(ADD1 (NCHARS fileName]
"." COMPILE.EXT ";*")
thereis (\FCACHE.REPAIR.VERIFY localFileName file))
else NIL))
(if (MEMB (LISTGET fileNameFields (QUOTE EXTENSION))
(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 LAFITEFORMDIRECTORIES (EQ (LISTGET fileNameFields (QUOTE EXTENSION))
LAFITEFORM.EXT))
then (* a LAFITE form, so check the form directory)
(\FCACHE.REPAIR.FINDFILE localFileName (MKLIST LAFITEFORMDIRECTORIES)))
(if (MEMB (LISTGET fileNameFields (QUOTE EXTENSION))
(CONS (QUOTE WD)
DISPLAYFONTEXTENSIONS))
then (* a font file, so check the font directories)
(\FCACHE.REPAIR.FINDFILE localFileName (UNION DISPLAYFONTDIRECTORIES
INTERPRESSFONTDIRECTORIES)))
(if (AND (EQ (LISTGET fileNameFields (QUOTE NAME))
(QUOTE FONTS))
(EQ (LISTGET fileNameFields (QUOTE EXTENSION))
(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 "13-Aug-85 14:56")
(* * Kind of like FINDFILE, but keeps looking on the directories untill a file matches)
(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 " 8-Aug-85 15:34")
(* * Is the local file a copy of the remote file?)
(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)
(DOLPHIN 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) (* smL " 2-Jul-85 18:44")
(* * Turn off the cache device)
[\FCACHE.PROPERTY.PUT (QUOTE DEVICES)
(REMOVE (fetch (CACHEDEVICE CACHEDEVINFO) of device)
(\FCACHE.PROPERTY (QUOTE DEVICES]
(\REMOVEDEVICE device])
)
(* * Functions for dealing with device events, like LOGOUT)
(DEFINEQ
(\FCACHE.DEVICE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL "16-Aug-85 17:49")
(* * The event fn for the dummy FCACHE device)
(SELECTQ EVENT
((AFTERSYSOUT AFTERMAKESYS AFTERLOGOUT AFTERSAVEVM)
(* Restore the cache devices and info)
(\FCACHE.INITIALIZE.PROPS))
((AFTERDOMAKESYS AFTERDOSYSOUT AFTERDOSAVEVM) (* Don't need to do anything here)
NIL)
((BEFORESYSOUT BEFOREMAKESYS) (* Don't need to do anything here)
NIL)
(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 " 9-Aug-85 17:13")
(* * Reinitialize the cache properties.)
(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 (WITH.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK
(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 " 6-Aug-85 13:46")
(* * 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)
(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)
(OR (\FCACHE.PROPERTY (QUOTE SILENT))
(printout PROMPTWINDOW "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)))
(FCACHE.DUMP)
(OR (\FCACHE.PROPERTY (QUOTE SILENT))
(printout PROMPTWINDOW "done." T))
(RETURN T])
)
(* * 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 " 7-Aug-85 16:35")
(* * Implements the CLOSEFILE method for the {FCACHE} device.)
(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-Sep-85 16:39")
(* * Implements the DELETEFILE method for the {FCACHE} device.)
(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 (HOST/DIR DEVICE) (* smL " 9-Aug-85 17:14")
(* * Implements the DIRECTORYNAMEP method for the {FCACHE} device)
(OR (AND (if (\FCACHE.HOSTUP? (fetch (CACHEDEVICE REALDEVICENAME) of DEVICE))
then NIL
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 PROMPTWINDOW T (fetch (CACHEDEVICE REALDEVICENAME)
of DEVICE)
,
"does not seem to be responding for directory name verification."
T "Trusting that" , HOST/DIR , "is OK.")
T)
[ASK (* Ask to find out what to do)
(WITH.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK
(LET (answer)
(CLEARW \FCACHE.PROMPT.WINDOW)
(printout \FCACHE.PROMPT.WINDOW
(fetch (CACHEDEVICE REALDEVICENAME)
of DEVICE)
,
"does not seem to be responding for directory name verification."
T)
(SETQ answer (RESETBUFS (PROMPTFORWORD
(CONCAT
"Should I trust that "
HOST/DIR
" is OK (Y/N)? ")
"Yes" NIL
\FCACHE.PROMPT.WINDOW NIL
T)))
(CLOSEW \FCACHE.PROMPT.WINDOW)
(MEMBER (U-CASE answer)
(QUOTE ("YES" "Y"]
(NIL (* We are running in cautious mode)
NIL)
NIL))
HOST/DIR)
(REALDEVOP (QUOTE DIRECTORYNAMEP)
DEVICE HOST/DIR DEVICE])
(\FCACHE.EVENTFN
[LAMBDA (DEVICE EVENT) (* smL "22-Aug-85 15:31")
(* * 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)
(printout PROMPTWINDOW "No cache prefix, so turning off cache for "
(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE)
T)
(\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 (printout PROMPTWINDOW (fetch (CACHEDEVICE REALDEVICENAME)
of DEVICE)
" no longer a known host, do turning off its cache" T)
(\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 (NAME/STREAM ATTRIBUTE DEVICE) (* smL " 7-Aug-85 18:09")
(* * Implements the GETFILEINFO method for {FCACHE}. If the file is cached, try to fetch the property locally.
Otherwise, pass on the the remote host.)
(LET ((entry (\FCACHE.LOOKUP DEVICE NAME/STREAM T)))
(if entry
then (\FCACHE.ENTRYINFO DEVICE entry ATTRIBUTE)
else (REALDEVOP (QUOTE GETFILEINFO)
DEVICE
(if (STREAMP NAME/STREAM)
then (fetch FULLFILENAME of NAME/STREAM)
else NAME/STREAM)
ATTRIBUTE DEVICE])
(\FCACHE.GETFILENAME
[LAMBDA (NAME RECOG DEVICE) (* smL "12-Sep-85 10:04")
(* * Implements the GETFILENAME method for the {FCACHE} file device.)
(DECLARE (GLOBALVARS \CONNECTED.DIRECTORY))
(for entry in \FCACHE.LIST
bind (filter ←(DIRECTORY.MATCH.SETUP (PACKFILENAME (QUOTE VERSION)
"*"
(QUOTE BODY)
NAME
(QUOTE DIRECTORY)
\CONNECTED.DIRECTORY)))
(RECOG ←(OR RECOG (QUOTE OLD)))
(givenVersion ←(FILENAMEFIELD NAME (QUOTE VERSION)))
(hostName ←(fetch (CACHEDEVICE REALDEVICENAME) of DEVICE))
file fileVersion entryVersion
first
(* * 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.)
when [AND (DIRECTORY.MATCH filter (fetch MATCHFILENAME of entry))
(EQ hostName (\FCACHE.CANONICAL.HOSTNAME (FILENAMEFIELD (fetch MATCHFILENAME
of entry)
(QUOTE HOST]
do (if (NOT (\FCACHE.VERIFY entry DEVICE))
then (* oops, a bad entry!)
(\FCACHE.DELETE.ENTRY entry)
(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) (* lmm "14-Sep-85 17:16")
(* * Implements the OPENFILE method for the {FCACHE-whatever} file device.)
(PROG (cacheStream cacheEntry fullName fileExisted? latestVersion
(filePages (OR (CADR (ASSOC (QUOTE SIZE)
PARAMETERS))
(FOLDHI (OR (CADR (ASSOC (QUOTE LENGTH)
PARAMETERS))
0)
BYTESPERPAGE)))
(localDevice (\FCACHE.LOCALDEVICE)))
(* If we should use the cache, go ahead and try)
(if [AND (MEMB (\FCACHE.PROPERTY (QUOTE USECACHE))
(SELECTQ ACCESS
(INPUT (QUOTE (T Read)))
((OUTPUT BOTH APPEND)
(QUOTE (T Write)))
(\ILLEGAL.ARG ACCESS)))
(NOT (MEMB (QUOTE DON'TCACHE)
PARAMETERS))
(NOT (CADR (ASSOC (QUOTE DON'TCACHE)
PARAMETERS)))
(NOT (AND filePages (GREATERP filePages (\FCACHE.PROPERTY (QUOTE MAXFILEPAGES]
then (SELECTQ ACCESS
[INPUT
(* * Open the file for INPUT)
(* First, do a cheap lookup to see if we have been given a full file name for a file that is already cached.
If not, compute the true full file name and get the cache entry for it. Of course, this may entail loading it into
the cache.)
(SETQ cacheEntry (if (\FCACHE.LOOKUP DEVICE (SETQ fullName NAME)
T)
elseif (NULL (SETQ fullName
(FDEVOP (QUOTE GETFILENAME)
DEVICE NAME
(QUOTE OLD)
DEVICE)))
then NIL
elseif (AND (NEQ NAME fullName)
(\FCACHE.LOOKUP DEVICE fullName T))
else (\FCACHE.LOAD fullName)))
(if cacheEntry
then (WITH.MONITOR (fetch CACHELOCK of cacheEntry)
(SETQ cacheStream
(FDEVOP (QUOTE OPENFILE)
localDevice
(fetch LOCALFILENAME
of cacheEntry)
ACCESS RECOG PARAMETERS
localDevice]
[(OUTPUT BOTH APPEND)
(* * Open the file for OUTPUT, BOTH, or APPEND)
(* set the default RECOG)
[OR RECOG (SETQ RECOG (if (EQ ACCESS (QUOTE OUTPUT))
then (QUOTE NEW)
else (QUOTE OLD/NEW]
(* figure out what version to use -
also remember if the file existed so when we get around to writing it out we can check to see if it changed)
(COND
((SETQ fullName (FDEVOP (QUOTE GETFILENAME)
DEVICE NAME RECOG DEVICE))
(SETQ fileExisted? (FDEVOP (QUOTE GETFILENAME)
DEVICE fullName (QUOTE OLD)
DEVICE))
(* get the cache entry for the file)
(SETQ cacheEntry (if fileExisted?
then (OR (\FCACHE.LOOKUP DEVICE fullName T)
(\FCACHE.LOAD fullName))
elseif (ADD.FILE.TO.CACHE? fullName)
then (\FCACHE.KEEPVERSIONS
fullName
(\FCACHE.PROPERTY (QUOTE KEEPVERSIONS)))
(\FCACHE.ADDENTRY
(OUTFILEP (\FCACHE.INVENTNAME fullName))
fullName
(if fileExisted?
then (GETFILEINFO fullName
(QUOTE
ICREATIONDATE))
else (IDATE))
(if fileExisted?
then (GETFILEINFO fullName
(QUOTE PLIST))
else NIL)
filePages)))
(if cacheEntry
then (WITH.MONITOR (fetch CACHELOCK of cacheEntry)
(SETQ cacheStream
(\OPENFILE (fetch LOCALFILENAME
of cacheEntry)
ACCESS RECOG PARAMETERS]
(\ILLEGAL.ARG ACCESS))) (* If we are lucky and managed to cache, we have an
open stream...)
(RETURN (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.)
(STREAMPROP cacheStream (QUOTE cacheEntry)
cacheEntry)
(replace FULLFILENAME of cacheStream with (fetch REMOTEFILENAME
of cacheEntry))
(replace DEVICE of cacheStream with DEVICE)
(* 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))
(\FCACHE.PROMOTE cacheEntry DEVICE)
(* Return the cache stream)
cacheStream
else (* the cache failed us, or we had the DON'TCACHE flag
in the PARAMETERS list)
(REALDEVOP (QUOTE OPENFILE)
DEVICE NAME ACCESS RECOG PARAMETERS DEVICE])
(\FCACHE.RENAMEFILE
[LAMBDA (OLDNAME NEWNAME DEVICE) (* smL " 7-Aug-85 18:45")
(* * Impelments the RENAMEFILE method for the {FCACHE} file device.)
(PROG ((OldRemoteName (\FCACHE.GETFILENAME OLDNAME (QUOTE OLD)
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 NEWNAME DEVICE)
else (\GENERIC.RENAMEFILE OldRemoteName NEWNAME]
(* 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 (U-CASE newRemoteName)))
(RETURN newRemoteName])
(\FCACHE.REOPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE OLDSTREAM) (* smL "11-Sep-85 11:34")
(* * 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 (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 (name/stream attribute value device) (* smL "22-Aug-85 16:31")
(* * The SETFILEINFO method for a cached device)
(LET ((localDevice (\FCACHE.LOCALDEVICE))
(entry (\FCACHE.LOOKUP device name/stream T))
result)
(if (NULL entry)
then (* no cached copy, so do it on the remote one)
(SETQ result (REALDEVOP (QUOTE SETFILEINFO)
device
(if (STREAMP name/stream)
then (fetch FULLFILENAME of name/stream)
else name/stream)
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 name/stream)
then (fetch FULLFILENAME of name/stream)
else name/stream)
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])
)
(* * Directory enumeration functions)
(DEFINEQ
(\FCACHE.GENERATE.FILEINFO
[LAMBDA (genfilestate attribute) (* smL " 1-May-85 10:21")
(* * FILEINFOFN for the local directory generator)
(if (CAR genfilestate)
then (GETFILEINFO (fetch LOCALFILENAME of (CAR genfilestate))
attribute])
(\FCACHE.GENERATE.LOCAL.FILES
[LAMBDA (device pattern desiredprops options dirtyOnly?) (* smL "17-Jul-85 18:27")
(* * 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]
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \FCACHE.NEXT.LOCAL.FILE)
FILEINFOFN ←(FUNCTION \FCACHE.GENERATE.FILEINFO)
GENFILESTATE ←(CONS NIL (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])
(\FCACHE.NEXT.LOCAL.FILE
[LAMBDA (genfilestate nameonly) (* smL " 1-May-85 10:19")
(* * The NEXTFILEFN for local file generation)
(RPLNODE2 genfilestate (CDR genfilestate))
(if (CAR genfilestate)
then (fetch REMOTEFILENAME of (CAR genfilestate])
)
(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 "28-Jun-85 16:51")
(* * The NEXTFILEFN for a merged filegenerator)
(with MERGEDFILEGENSTATE genState (PROG (file gen1File gen2File)
LOOP(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))
(if (NULL file)
then (SETQ gen1Empty? T)
(GO LOOP)
else (SETQ lastUsedGen gen1)
(push gen1Info
(MKATOM (U-CASE file)))
(RETURN file))
else (SETQ file (\GENERATENEXTFILE gen2
nameOnly))
(if (NULL file)
then (SETQ gen2Empty? T)
(SETQ lastUsedGen gen2)
(RETURN file)
elseif (FMEMB (MKATOM (U-CASE file))
gen1Info)
then
(* ignore files that already appeard in the first one)
(GO LOOP)
else (SETQ lastUsedGen gen2)
(RETURN 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)
(RETURN gen2File)
elseif (NOT gen2File)
then (SETQ gen1Info NIL)
(SETQ lastUsedGen gen1)
(RETURN gen1File)
else (* use the one that occurs first in order, but remember
the unused one)
(SELECTQ (FILES.IN.ORDER? gen1File gen2File)
(EQUAL (SETQ gen1Info NIL)
(SETQ gen2Info NIL)
(SETQ lastUsedGen gen1)
(RETURN gen1File))
(LESSP (SETQ gen1Info NIL)
(SETQ gen2Info gen2File)
(SETQ lastUsedGen gen1)
(RETURN gen1File))
(GREATERP (SETQ gen1Info gen1File)
(SETQ gen2Info NIL)
(SETQ lastUsedGen gen2)
(RETURN gen2File))
(SHOULDNT])
(FILES.IN.ORDER?
[LAMBDA (file1 file2) (* smL "14-Aug-85 10:23")
(* * Are the two files in correct order for a directory generation?)
(LET [[testFile1 (U-CASE (SUBATOM file1 (ADD1 (OR (STRPOS "}" file1)
0]
(testFile2 (U-CASE (SUBATOM file2 (ADD1 (OR (STRPOS "}" file2)
0]
(if (EQ testFile1 testFile2)
then (QUOTE EQUAL)
else (LET [[versionlessFile1 (SUBATOM testFile1 1 (SUB1 (OR (STRPOS ";" testFile1)
(ADD1 (NCHARS testFile1]
(versionlessFile2 (SUBATOM testFile2 1 (SUB1 (OR (STRPOS ";" testFile2)
(ADD1 (NCHARS testFile2]
(if (EQ versionlessFile1 versionlessFile2)
then (LET [(version1 (FILENAMEFIELD file1 (QUOTE VERSION)))
(version2 (FILENAMEFIELD file2 (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)))
elseif (ALPHORDER versionlessFile1 versionlessFile2)
then (QUOTE LESSP)
else (QUOTE GREATERP])
)
[DECLARE: EVAL@COMPILE
(RECORD MERGEDFILEGENSTATE (gen1 gen2 lastUsedGen gen1Info gen2Info gen1Empty? gen2Empty? sorted?)
(SYSTEM))
]
(* * Functions for finding a file in the cache)
(DEFINEQ
(\FCACHE.LOOKUP
[LAMBDA (DEVICE NAME/STREAM Verify?) (* smL "16-Aug-85 11:07")
(* * Find the matching entry in the cache)
(OR (AND (STREAMP NAME/STREAM)
(STREAMPROP NAME/STREAM (QUOTE cacheEntry)))
(PROG ((ListOfEntries \FCACHE.LIST)
entry DAT) (* 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 (NEQ (fetch MATCHFILENAME of entry)
NAME/STREAM)
then (GO SkipThisEntry))
(if (NOT (INFILEP (fetch LOCALFILENAME of entry)))
then (* The cache thinks the file is local, but the local
version has gone away!)
(\FCACHE.DELETE.ENTRY entry)
elseif (OR (NOT Verify?)
(\FCACHE.VERIFY entry DEVICE))
then (* it matches!)
(RETURN entry)
elseif (NULL (fetch CACHEISDIRTY of entry))
then (* the file doesn't match, and is not dirty, so get rid
of it)
(\FCACHE.DELETE.ENTRY entry))
SkipThisEntry
(SETQ ListOfEntries (CDR ListOfEntries))
(GO TryNextEntry])
(\FCACHE.PROMOTE
[LAMBDA (ENTRY DEVICE) (* smL "20-Jun-85 13:50")
(* * 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)
[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.VERIFY
[LAMBDA (entry cacheDevice) (* smL "12-Sep-85 10:03")
(* * 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)))
(OR (\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)
[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]
else (* it is the most recent, so it is up to date)
T])
)
(* * Try to figure out if a host is up)
(RPAQ? FCACHE.DEAD.HOSTS NIL)
(DEFINEQ
(\FCACHE.HOSTUP?
[LAMBDA (name) (* lmm "14-Sep-85 16:35")
(* * 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 T))
NDEV)
(SELECTQ (COND
(DEV (* the real DEV is already around, so use it to
determine the DEV type)
(SELECTQ (fetch OPENFILE of DEV)
((\LEAF.OPENFILE \FTP.OPENFILE)
(QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
(fetch DEVICENAME of DEV)))
((SETQ NDEV (for dev in \FILEDEVICES thereis (FDEVOP (QUOTE HOSTNAMEP)
dev name)))
(* we know what device will create it, so use that)
(fetch DEVICENAME of NDEV))
((SETQ NDEV (\GETDEVICEFROMNAME name T NIL))
(* we got away with creating the device, so use it)
(SELECTQ (fetch OPENFILE of NDEV)
((\LEAF.OPENFILE \FTP.OPENFILE)
(QUOTE LEAF))
(\NSFILING.OPENFILE (QUOTE NSFILING))
(fetch DEVICENAME of DEV)))
(T (* we have no idea what kind of DEV it is)
(QUOTE UNKNOWN)))
[LEAF (* We think its a LEAF server, so try PUP.ECHOUSER)
(RESETLST (PROG ((i 1)
(interval 1000)
(PORT (BESTPUPADDRESS name PROMPTWINDOW))
(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)
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 "16-Aug-85 11:06")
(* * Should we ignore the date check, or not?)
(if (OR (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then T
elseif (\FCACHE.HOSTUP? (fetch (CACHEDEVICE REALDEVICENAME) of cacheDevice))
then NIL
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 PROMPTWINDOW "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.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK
(LET (answer)
(CLEARW \FCACHE.PROMPT.WINDOW)
(printout \FCACHE.PROMPT.WINDOW
"It doesn't look like I can check to see if"
,
(fetch LOCALFILENAME of entry)
, "is a valid cache for" , (fetch REMOTEFILENAME
of entry)
T)
(SETQ answer (RESETBUFS (PROMPTFORWORD
"Should I accept it on faith anyway? "
"Yes" NIL
\FCACHE.PROMPT.WINDOW NIL
T)))
(CLOSEW \FCACHE.PROMPT.WINDOW)
(MEMBER (U-CASE answer)
(QUOTE ("YES" "Y"]
(NIL (* We are running in cautious mode)
NIL)
NIL])
(\FCACHE.USELOCALDIRECTORY?
[LAMBDA (hostName filePattern) (* smL " 9-Aug-85 17:13")
(* * The hostName is down, should we use the cached files to generate a directory?)
(if (\FCACHE.HOSTUP? hostName)
then NIL
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 PROMPTWINDOW 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.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK
(LET (answer)
(CLEARW \FCACHE.PROMPT.WINDOW)
(printout \FCACHE.PROMPT.WINDOW hostName ,
"does not seem to be responding for directory lookup "
"for file pattern " filePattern T)
(SETQ answer (RESETBUFS (PROMPTFORWORD
"Should I use the local cache list instead (Y/N)? "
"Yes" NIL
\FCACHE.PROMPT.WINDOW NIL
T)))
(CLOSEW \FCACHE.PROMPT.WINDOW)
(MEMBER (U-CASE answer)
(QUOTE ("YES" "Y"]
(NIL (* We are running in cautious mode)
NIL)
NIL])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FCACHE.HOSTUP.ECHOSTREAM \FCACHE.HOSTUP.ECHOSTREAM.MONITORLOCK FCACHE.DEAD.HOSTS)
)
(* * Functions for dealing with overflow of the cache)
(DEFINEQ
(\FCACHE.RESOURCES.ERROR
[LAMBDA (file) (* smL "22-Aug-85 17:00")
(* * Called when there is a "FILE SYSTEM RESOURCES EXCEEDED" error.)
(LET [(stream (AND (OPENP file)
(GETSTREAM file] (* NOTE: this counts on the fact that there is only one
stream per file name!)
(if (NOT (STREAMP stream))
then (* we can't figure out what file/stream caused the
error, so punt)
NIL
elseif (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 (STRPOS (\FCACHE.PROPERTY (QUOTE PREFIX))
(fetch FULLFILENAME of stream)
1 NIL NIL NIL (UPPERCASEARRAY))
then (* happened while writing some other file to the cache
-
forget it for now)
NIL
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) (* lmm "14-Sep-85 17:22")
(* * Write a cache entry out to the remote host)
(RESETLST (WITH.MONITOR
(fetch CACHELOCK of entry)
(PROG ((originalFileName (fetch REMOTEFILENAME of entry))
(fileName (fetch REMOTEFILENAME of entry))
(localDevice (\FCACHE.LOCALDEVICE))
newFileName remoteDevice inStream outStream errorN (errorCount 0))
(* * 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!)
(ERROR (CONCAT "The cached version of " fileName
" has disappeared before it could be written out!"))
(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 [SETQ newFileName
(BREAK1 fileName T "FCache dump"
((printout NIL "When the cached file " fileName ,
"was created, a remote version of the file existed."
T
"It is now time to write out the cached version,"
, "but the remote file has disappeared!"
T T
"If you want to write the file someplace else,"
, "RETURN the new file name." T
"RETURN NIL or OK will write the file to the same place."
T]
elseif (NOT (EQUAL (fetch CACHEFILEDATE of entry)
(FDEVOP (QUOTE GETFILEINFO)
remoteDevice fileName (QUOTE
ICREATIONDATE)
remoteDevice)))
then [SETQ newFileName
(BREAK1 fileName T "FCache dump"
((printout NIL "The remote version of " fileName ,
"has changed since you wrote the cached file."
,,
"Where do you want to dump the new (cached) version of the file?"
T
"If you want to write the file someplace else,"
, "RETURN the new file name." T
"RETURN NIL or OK will write the file to the same place."
T]
else (GO OpenFiles))
else (if (FDEVOP (QUOTE GETFILENAME)
remoteDevice fileName (QUOTE OLD)
remoteDevice)
then [SETQ newFileName
(BREAK1 fileName T "FCache dump"
((printout NIL "When the cached file " fileName ,
"was created, no remote version of the file existed."
T
"It is now time to write out the cached version,"
,
"but a remote version of the file has since appeared!"
T
"If you want to write the file someplace else,"
, "RETURN the new file name." T
"RETURN NIL or OK will write the file to the same place."
T]
else (GO OpenFiles)))
SetDumpFileName
[if newFileName
then (SETQ fileName (FULLNAME (PACKFILENAME (QUOTE BODY)
newFileName
(QUOTE VERSION)
NIL
(QUOTE BODY)
(fetch REMOTEFILENAME
of entry))
(QUOTE OLD/NEW)))
(replace REMOTEFILENAME of entry with fileName)
(replace MATCHFILENAME of entry with (U-CASE (MKATOM fileName]
(* * 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 outStream
(CAR (NLSETQ (OPENSTREAM fileName (QUOTE OUTPUT)
(QUOTE OLD/NEW)
NIL
(BQUOTE (DON'TCACHE
SEQUENTIAL
(TYPE , (FDEVOP (QUOTE GETFILEINFO)
localDevice inStream
(QUOTE TYPE)
localDevice))
(CREATIONDATE ,
(OR (FDEVOP (QUOTE
GETFILEINFO)
localDevice
inStream
(QUOTE
CREATIONDATE)
localDevice)
(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)
[SETQ newFileName
(BREAK1 fileName T "FCache dump"
((printout NIL
"You do not have write privilege for the file "
fileName T
"If you want to write the file someplace else,"
, "RETURN the new file name." T
"RETURN NIL or OK will try the same name again."
T]
(GO SetDumpFileName))
(42 (* the file name was bad)
[SETQ newFileName
(BREAK1 fileName T "FCache dump"
((printout NIL "The cached file " fileName ,
"does not appear to have a legal file name."
T
"If you want to write the file someplace else,"
, "RETURN the new file name." T
"RETURN NIL or OK will try the same name again."
T]
(GO SetDumpFileName))
(22 (* there was no room for the file)
(BREAK1 T T "FCache dump"
((printout NIL
"There is not enough space on the server to write out the cached file "
fileName T
"Try to correct the situation and then continue from this break."
T)))
(GO StartAgain))
(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)
(BREAK1 T T "FCache dump"
((printout NIL "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
fileName T
"Try to correct the situation and then continue from this break."
T)))
(GO StartAgain)))
(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)
(BREAK1 T T "FCache dump"
((printout NIL "The error '"
(ERRORSTRING (CAR ERRORN))
"'" ,
"occured while trying to write out the cache file "
fileName T
"Try to correct the situation and then continue from this break."
T)))
(GO StartAgain]
(* * Copy it out)
[if (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (RESETSAVE (printout PROMPTWINDOW T "Writing out " fileName "...")
(QUOTE (COND (RESETSTATE (PRINT (QUOTE aborted.)
PROMPTWINDOW))
(T (PRINT (QUOTE done.)
PROMPTWINDOW]
(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)
(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)
(if (NEQ originalFileName fileName)
then (printout NIL "--------------------" T
"WARNING: the file that was supposed to be "
originalFileName , "was actually stored as "
fileName T
"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."
T "--------------------" T))
(RETURN T)
else (RETURN NIL])
)
(* * Functions for dumping and restoring information about the contents of the cache)
(DEFINEQ
(\FCACHE.ADDENTRY
[LAMBDA (LOCALNAME REMOTENAME ICREATIONDATE PROPS PAGES) (* smL " 2-Aug-85 16:34")
(* * Add an entry to the cache directory. This goes on the front of the directory so it will be found quickly in the
future.)
(LET ((ENTRY (create CACHENTRY
REMOTEFILENAME ← REMOTENAME
LOCALFILENAME ← LOCALNAME
MATCHFILENAME ←(MKATOM (U-CASE REMOTENAME))
CACHEFILEPROPS ← PROPS
CACHEFILEDATE ← ICREATIONDATE
CACHEFILELENGTH ← PAGES)))
(push \FCACHE.LIST ENTRY)
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(PLUS (\FCACHE.PROPERTY (QUOTE SIZE))
PAGES))
(\FCACHE.LOGENTRY ENTRY)
ENTRY])
(FCACHE.DUMP
[LAMBDA (onlyIfChanged) (* smL "22-Aug-85 16:44")
(* * Dump out the cache info)
(* always dump out dirty files)
(if (\FCACHE.PROPERTY (QUOTE PREFIX))
then (for entry in \FCACHE.LIST do (\FCACHE.WRITEOUT 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 [if (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (RESETSAVE (printout PROMPTWINDOW T "Dumping cache listing...")
(QUOTE (COND (RESETSTATE (PRINT (QUOTE aborted.)
PROMPTWINDOW))
(T (PRINT (QUOTE done)
PROMPTWINDOW]
(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))
(* 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])
(\FCACHE.DUMP.ENTRY
[LAMBDA (entry stream) (* smL "23-Jul-85 15:57")
(* * 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 , .P2 MATCHFILENAME ")" 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 "12-Sep-85 10:15")
(* * Restore the cache info dumped out by a previous system -- return T if success, NIL if failure)
(RESETLST (if (NULL prefix)
then (* disable the cache)
(OR (\FCACHE.PROPERTY (QUOTE SILENT))
(PROMPTPRINT "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 (OR (NEQ (SUBATOM prefix 1 1)
(QUOTE {))
(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 oldFCacheVersion)
(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]
[OR (\FCACHE.PROPERTY (QUOTE SILENT))
(RESETSAVE (printout PROMPTWINDOW "Restoring cache")
(QUOTE (COND (RESETSTATE (PRINT (QUOTE aborted.)
PROMPTWINDOW))
(T (PRINT (QUOTE done)
PROMPTWINDOW]
(* 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 oldFCacheVersion (OR (LISTGET plist
(QUOTE
FCacheVersion))
0))
[if (GEQ oldFCacheVersion 1)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXSIZE)
(LISTGET plist (QUOTE MaxSize]
(if (GEQ oldFCacheVersion 1.6)
then (\FCACHE.PROPERTY.PUT
(QUOTE MAXFILEPAGES)
(LISTGET plist (QUOTE MaxFilePages]
T
else NIL)))
then (WITH.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK (CLEARW
\FCACHE.PROMPT.WINDOW)
(printout \FCACHE.PROMPT.WINDOW
"WARNING: The file cache directory file was trashed!"
"The cacher has lost track of all the files in the cache."
"This is not dangerous, but it does waste disk space."
T
"You should run FCACHE.SCAVENGE soon to clean up your disk."))
(GO BADINFOFILE))
NEXTENTRY
(if (EOFP stream)
then (WITH.MONITOR \FCACHE.PROMPT.WINDOW.MONITORLOCK (CLEARW
\FCACHE.PROMPT.WINDOW)
(printout \FCACHE.PROMPT.WINDOW
"WARNING: The file cache directory file was not completly dumped."
"The cacher may have lost track of some files."
"This is not dangerous, but it does waste disk space."
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 (\FCACHE.RESTORE.ENTRY entryDef)
then (* a good entry def)
(if (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (printout PROMPTWINDOW ".")
(FORCEOUTPUT PROMPTWINDOW T))
else (* a bad entry def)
(if (NOT (\FCACHE.PROPERTY (QUOTE SILENT)))
then (printout PROMPTWINDOW "?")
(FORCEOUTPUT PROMPTWINDOW T)))
(GO NEXTENTRY)
BADINFOFILE
(CLOSEF? stream)
(DELFILE name)
(RETURN T)
DONE(CLOSEF? stream)
(RETURN T))
else (* nope, can't access the directory at that prefix)
(OR (\FCACHE.PROPERTY (QUOTE SILENT))
(PROMPTPRINT "Cache can't write to " prefix "!"])
(\FCACHE.RESTORE.ENTRY
[LAMBDA (entryList first?) (* smL "12-Aug-85 10:17")
(* * 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 (CAR (NLSETQ (create CACHENTRY
REMOTEFILENAME ←(CAR (NTH entryList 1))
LOCALFILENAME ←(CAR (NTH entryList 2))
CACHEISDIRTY ←(CAR (NTH entryList 3))
FILEXISTED ←(CAR (NTH entryList 4))
CACHEFILELENGTH ←(CAR (NTH entryList 5))
CACHEFILEPROPS ←(CAR (NTH entryList 6))
CACHEFILEDATE ←(CAR (NTH entryList 7))
CACHETIMECLOSED ←(CAR (NTH entryList 8))
MATCHFILENAME ←(CAR (NTH entryList 9]
(oldEntry (for x in \FCACHE.LIST bind (name ←(CAR (NTH entryList 2)))
thereis (EQ name (fetch LOCALFILENAME of x]
(if entry
then (* the entry parsed OK)
[if oldEntry
then (SETQ \FCACHE.LIST (DREMOVE oldEntry \FCACHE.LIST))
(\FCACHE.PROPERTY.PUT (QUOTE SIZE)
(DIFFERENCE (\FCACHE.PROPERTY (QUOTE SIZE))
(fetch CACHEFILELENGTH of oldEntry]
(if (INFILEP (fetch LOCALFILENAME of entry))
then (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)))
entry)
else (* there was an error parsing the entry)
NIL])
)
(* * Functions for inspecting the cache)
(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])
(\FCACHE.FLUSH.INFOHOOK
[LAMBDA NIL (* smL " 9-Aug-85 14:27")
(* * The info hook function for the CACHE-FLUSH proc)
(LET ((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 info")))
(WINDOWPROP inspectWindow (QUOTE ICON)
\FCACHE.ICON)
(WINDOWADDPROP inspectWindow (QUOTE EXPANDFN)
(FUNCTION INSPECTW.REDISPLAY])
(\FCACHE.INSPECT.PROPCOMMANDFN
[LAMBDA (property object inspectw) (* smL " 9-Aug-85 14:28")
(* * 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)
(LET ((pwindow (GETPROMPTWINDOW inspectw 2)))
(CLEARW pwindow)
(printout pwindow "Can't set that field!")))
[PREFIX (if (MENU set?menu)
then (LET ((pwindow (GETPROMPTWINDOW inspectw 2)))
(CLEARW pwindow)
(if [NLSETQ (FCACHE.PUTPROP (QUOTE PREFIX)
(MKATOM (PROMPTFORWORD
"New cache prefix: "
NIL NIL pwindow]
then (INSPECTW.REDISPLAY inspectw)
else (printout pwindow T "Bad cache prefix"]
((MAXSIZE MAXFILEPAGES DUMPSLEEP DUMPIDLE KEEPVERSIONS)
(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)))
(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)
(DEFAULT.INSPECTW.PROPCOMMANDFN property object inspectw])
(\FCACHE.INSPECT.TITLEFN
[LAMBDA (inspectw object) (* smL " 1-May-85 16:32")
(* * The title was bugged in the inspectw)
(SELECTQ [MENU (CONSTANT (create MENU
ITEMS ←(QUOTE (("Inspect entries" (QUOTE ENTRIES)
"Inspect the list of cache entries")
(ReFetch (QUOTE REFETCH)
"Recompute the inspect window"]
(REFETCH (INSPECTW.REDISPLAY inspectw))
(ENTRIES (INSPECTW.CREATE \FCACHE.LIST (FUNCTION \FCACHE.INSPECT.FILESLST)
(FUNCTION \FCACHE.INSPECT.FILEINFO)
(FUNCTION NILL)
(FUNCTION \FCACHE.INSPECT.ENTRYCOMMAND)
(FUNCTION NILL)
(FUNCTION \FCACHE.INSPECT.TITLEFN)
"FCache entries"))
(NIL NIL)
(SHOULDNT])
(\FCACHE.INSPECT.ENTRYCOMMAND
[LAMBDA (file devinfo inspectw) (* smL "30-Jul-85 18:09")
(* * Inspect the entry?)
(SELECTQ [MENU (CONSTANT (create MENU
ITEMS ←(QUOTE ((Inspect (QUOTE INSPECT)
"Inspect this cache entry")
(Delete (QUOTE DELETE)
"Delete from the cache")
(Flush (QUOTE FLUSH)
"Flush the file to the server, if it is dirty"]
(INSPECT (INSPECT (\FCACHE.LOOKUP (fetch (CACHEDEVINFO CACHEDEV) of devinfo)
file)))
(DELETE [if (MOUSECONFIRM (CONCAT "Delete cache entry for file " file))
then (LET ((dev (fetch (CACHEDEVINFO CACHEDEV) of devinfo)))
(\FCACHE.DELETE.ENTRY (\FCACHE.LOOKUP dev file]
(INSPECTW.REDISPLAY inspectw))
(FLUSH (FCACHE.DUMP.FILE file)
(INSPECTW.REDISPLAY inspectw))
(NIL NIL)
(SHOULDNT])
(\FCACHE.INSPECT.FILEINFO
[LAMBDA (devinfo file) (* smL "14-Jun-85 12:21")
(* * What info is dispayed for the file)
(LET ((entry (for entry in \FCACHE.LIST thereis (EQ (fetch REMOTEFILENAME of entry)
file)))
(info NIL))
(if (\FCACHE.ENTRYOPEN? entry)
then (push info (QUOTE Open)))
(if (fetch CACHEISDIRTY of entry)
then (push info (QUOTE Dirty)))
info])
(\FCACHE.INSPECT.FILESLST
[LAMBDA (entryList) (* smL "29-Apr-85 09:51")
(* * Return a list of cached files)
(for entry in entryList collect (fetch REMOTEFILENAME of entry])
(\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])
)
(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.ICON)
)
(* * Initialize things)
(DEFINEQ
(\FCACHE.INITIALIZE
[LAMBDA NIL (* lmm "15-Sep-85 22:17")
(* * 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)
(\FCACHE.DEVICE.EVENTFN \FCACHE.DEVICE (QUOTE AFTERLOGOUT))
(* * Add the cache flushing process)
(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)))
(* * 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")))
(SETQ BackgroundMenu NIL))
(* * add a report form item to the Lafite forms menu)
(* * start the generic cache on LEAF and NS devices)
(for devName in FCACHE.GENERIC.DEVICE.TYPES do (FCACHE.GENERIC.START devName))
(* * Make it all undoable)
(UNDOSAVE (QUOTE (FCACHE.VANQUISH])
(FCACHE.VANQUISH
[LAMBDA NIL (* lmm "14-Sep-85 19:05")
(* * Unload the cacher from the system, removing any and all traces that it ever existed)
(DECLARE (GLOBALVARS BackgroundMenu BackgroundMenuCommands LAFITESPECIALFORMS LAFITEFORMSMENU
ERRORTYPELST))
(change LAFITESPECIALFORMS (DREMOVE (for item in DATUM thereis (EQUAL (CAR item)
"FileCache report"))
DATUM))
(SETQ LAFITEFORMSMENU NIL)
(for dev in \FCACHE.GENERIC.DEVICES do (FCACHE.GENERIC.STOP dev))
[for entry in \FCACHE.LIST do (if (AND (fetch CACHEISDIRTY of entry)
(\FCACHE.ENTRYOPEN? entry))
then (ERROR
"Can't -- a (cached) file is open and needs to be flushed!"
(fetch REMOTEFILENAME of entry]
(\FCACHE.DEVICE.EVENTFN \FCACHE.DEVICE (QUOTE BEFORELOGOUT))
(for dev in (\FCACHE.PROPERTY (QUOTE DEVICES)) do (FCACHE.STOP (CAR dev)))
(DREMOVE (for X in BackgroundMenuCommands thereis (EQ (CAR X)
(QUOTE DumpCache)))
BackgroundMenuCommands)
(SETQ BackgroundMenu NIL)
(PUTASSOC 22 NIL ERRORTYPELST)
(DEL.PROCESS (QUOTE DUMP-FCACHE))
(\REMOVEDEVICE \FCACHE.DEVICE)
(for fn in (QUOTE (\DELETEFILE \GENERATEFILES \GETFILENAME \GETFILENAME.OR.STREAM \OPENFILE
\RENAMEFILE DIRECTORYNAMEP GETFILEINFO SETFILEINFO))
do (CHANGENAME fn (QUOTE \GETUSERDEVICEFROMNAME)
(QUOTE \GETDEVICEFROMNAME)))
(for fn in (QUOTE (DIRECTORYNAME)) do (CHANGENAME fn (QUOTE \GETUSERDEVICEFROMNAME)
(QUOTE \GETDEVICEFROMHOSTNAME)))
(for var in (QUOTE (\FCACHE.PROPERTIES \FCACHE.LIST \FCACHE.LIST.CHANGED? FCACHE.VERSION.NUMBER
FCACHE.SCAVENGE.IGNORE \FCACHE.GENERIC.DEVICES
\FCACHE.LOGFILE \FCACHE.DEVICE))
do (SET var (QUOTE NOBIND])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\FCACHE.INITIALIZE)
)
(RPAQ FCACHE.VERSION.DATE "19-Sep-85 15:30:05")
(RPAQQ FCACHE.VERSION.NUMBER 3.0)
(* * This all depends on record defns from the system)
(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]
)
(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
[DOFILESLOAD (SELECTQ MAKESYSNAME (LISPCORE (QUOTE (ABC)))
(QUOTE (SYSEDIT]
(FILESLOAD (LOADCOMP)
NSFILING LLNS)
)
(PUTPROPS FILECACHE COPYRIGHT ("Xerox Corporation" 1983 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6786 15940 (ADD.FILE.TO.CACHE? 6796 . 7139) (CACHE.FILE 7141 . 7471) (FCACHE.DUMP.ALL
7473 . 7753) (FCACHE.GENERIC.START 7755 . 8361) (FCACHE.GENERIC.STOP 8363 . 8887) (FCACHE.GETPROP 8889
. 9374) (FCACHE.PRIVATE.FILE? 9376 . 9681) (FCACHE.PUTPROP 9683 . 11329) (FCACHE.START 11331 . 13129)
(FCACHE.STOP 13131 . 14783) (FCACHE.CACHELIST 14785 . 15050) (FCACHE.DIRTY? 15052 . 15440) (
FCACHE.DUMP.FILE 15442 . 15938)) (19271 19946 (\FCACHE.DEVINFO 19281 . 19588) (\FCACHE.PUT.DEVINFO
19590 . 19944)) (20670 25197 (\GETUSERDEVICEFROMNAME 20680 . 21426) (\GETCACHEDEVICEFROMHOSTNAME 21428
. 23068) (\GETREALDEVICEFROMHOSTNAME 23070 . 24235) (\FCACHE.CANONICAL.HOSTNAME 24237 . 25195)) (
25565 34940 (\FCACHE.DELETE.ENTRY 25575 . 27298) (\FCACHE.INVENTNAME 27300 . 27811) (
\FCACHE.KEEPVERSIONS 27813 . 29056) (\FCACHE.LOAD 29058 . 32064) (\FCACHE.MAKE.LEGAL.FILENAME 32066 .
32574) (\FCACHE.MAKEROOM 32576 . 34711) (\FCACHE.MAKEROOM.DELETEABLE? 34713 . 34938)) (34974 40749 (
FCACHE.SCAVENGE 34984 . 40747)) (40750 46724 (\FCACHE.REPAIR 40760 . 44873) (\FCACHE.REPAIR.FINDFILE
44875 . 46192) (\FCACHE.REPAIR.VERIFY 46194 . 46722)) (47499 49454 (\FCACHE.BUILD.DEVICE 47509 . 49102
) (\FCACHE.OFF 49104 . 49452)) (49521 53472 (\FCACHE.DEVICE.EVENTFN 49531 . 51927) (
\FCACHE.INITIALIZE.PROPS 51929 . 53470)) (53683 54545 (\FCACHE.GLOBAL.EVENT 53693 . 54543)) (54695
56399 (\FCACHE.AROUNDEXIT 54705 . 56397)) (56629 80909 (\FCACHE.CLOSEFILE 56639 . 58398) (
\FCACHE.DELETEFILE 58400 . 59309) (\FCACHE.DIRECTORYNAMEP 59311 . 61119) (\FCACHE.EVENTFN 61121 .
62882) (\FCACHE.GENERATEFILES 62884 . 63689) (\FCACHE.GETFILEINFO 63691 . 64323) (\FCACHE.GETFILENAME
64325 . 68834) (\FCACHE.HOSTNAMEP 68836 . 69022) (\FCACHE.OPENFILE 69024 . 74703) (\FCACHE.RENAMEFILE
74705 . 76856) (\FCACHE.REOPENFILE 76858 . 78367) (\FCACHE.SETFILEINFO 78369 . 80907)) (80954 82909 (
\FCACHE.GENERATE.FILEINFO 80964 . 81288) (\FCACHE.GENERATE.LOCAL.FILES 81290 . 82565) (
\FCACHE.NEXT.LOCAL.FILE 82567 . 82907)) (82910 88495 (MERGE.FILEGENERATORS 82920 . 83337) (
MERGED.FILEINFOFN 83339 . 83694) (MERGED.NEXTFILEFN 83696 . 87036) (FILES.IN.ORDER? 87038 . 88493)) (
88696 92576 (\FCACHE.LOOKUP 88706 . 90588) (\FCACHE.PROMOTE 90590 . 91196) (\FCACHE.VERIFY 91198 .
92574)) (92658 101341 (\FCACHE.HOSTUP? 92668 . 97756) (\NSFILING.ADDRESS 97758 . 97982) (
\FCACHE.IGNOREDATECHECK? 97984 . 99775) (\FCACHE.USELOCALDIRECTORY? 99777 . 101339)) (101535 103020 (
\FCACHE.RESOURCES.ERROR 101545 . 103018)) (103086 114765 (\FCACHE.ENTRYOPEN? 103096 . 103429) (
\FCACHE.FLUSH 103431 . 104144) (\FCACHE.WRITEOUT 104146 . 114763)) (114858 127032 (\FCACHE.ADDENTRY
114868 . 115576) (FCACHE.DUMP 115578 . 117799) (\FCACHE.DUMP.ENTRY 117801 . 118303) (
\FCACHE.FILEMATCH? 118305 . 118838) (\FCACHE.LOGENTRY 118840 . 119829) (\FCACHE.RESTORE 119831 .
125177) (\FCACHE.RESTORE.ENTRY 125179 . 127030)) (127080 136686 (\FCACHE.ENTRYINFO 127090 . 128955) (
\FCACHE.FLUSH.INFOHOOK 128957 . 129727) (\FCACHE.INSPECT.PROPCOMMANDFN 129729 . 133481) (
\FCACHE.INSPECT.TITLEFN 133483 . 134363) (\FCACHE.INSPECT.ENTRYCOMMAND 134365 . 135378) (
\FCACHE.INSPECT.FILEINFO 135380 . 135907) (\FCACHE.INSPECT.FILESLST 135909 . 136171) (
\FCACHE.INSPECT.VALUES 136173 . 136376) (\FCACHE.PROPERTY.NAMES 136378 . 136684)) (139179 144178 (
\FCACHE.INITIALIZE 139189 . 142070) (FCACHE.VANQUISH 142072 . 144176)))))
STOP