github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-04-29 05:16:11 +00:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into mth12--Fix-1727-Edit-from-MASTERSCOPE-graph-can-lock-mouse-process

Browse Source
This commit is contained in:
Matt Heffron
2024-05-24 21:45:49 -07:00
committed by GitHub
parent 40ae5fb9b3 eda9863432
commit 10cd51e5b1
3 changed files with 243 additions and 265 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@@ -19,7 +19,8 @@ loadups/exports.all
library/RDSYS* library/RDSYS*
loadups/lisp.sysout loadups/lisp.sysout
loadups/full.sysout loadups/full.sysout
loadups/fuller.sysout # not currently included but might as well ignore it # not currently included but might as well ignore it
loadups/fuller.sysout
loadups/*.dribble loadups/*.dribble
loadups/whereis.hash loadups/whereis.hash
loadups/apps.sysout loadups/apps.sysout

505
sources/NSFILING
View File

@@ -1,19 +1,18 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jun-99 17:07:34" {DSK}<project>medley3.5>sources>NSFILING.;2 294552
changes to%: (FNS \NSFILING.GENERATEFILES) (FILECREATED "23-May-2024 23:20:49" {DSK}<home>frank>il>medley>sources>NSFILING.;2 293309
previous date%: "19-Jan-93 10:59:09" {DSK}<project>medley3.5>sources>NSFILING.;1) :EDIT-BY "frank"
:CHANGES-TO (FNS \NSRANDOM.CREATE.STREAM \NSFILING.GETFILE)
:PREVIOUS-DATE "28-Jun-99 17:07:34" {DSK}<home>frank>il>medley>sources>NSFILING.;1)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NSFILINGCOMS) (PRETTYCOMPRINT NSFILINGCOMS)
(RPAQQ NSFILINGCOMS (RPAQQ NSFILINGCOMS
[(COMS (* ; "Filing Protocol") [(COMS (* ; "Filing Protocol")
(COURIERPROGRAMS FILING FILING.4) (COURIERPROGRAMS FILING FILING.4)
(DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * NSFILINGCONSTANTS) (DECLARE%: EVAL@COMPILE DONTCOPY (CONSTANTS * NSFILINGCONSTANTS)
(RECORDS NSFILINGSTREAM FILINGSESSION FILINGHANDLE NSFILESERVER (RECORDS NSFILINGSTREAM FILINGSESSION FILINGHANDLE NSFILESERVER
@@ -54,24 +53,24 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(*NSFILING-PAGE-CACHE-INCREMENT* 4) (*NSFILING-PAGE-CACHE-INCREMENT* 4)
(*NSFILING-SESSION-TIMEOUT* '(900 . 21600)) (*NSFILING-SESSION-TIMEOUT* '(900 . 21600))
(\NSRANDOM.CHECK.CACHE)) (\NSRANDOM.CHECK.CACHE))
(COMS (* ; "Connection maintenance") (COMS (* ; "Connection maintenance")
(FNS \GETFILINGCONNECTION \NSFILING.GET.NEW.SESSION \NSFILING.GET.STREAM (FNS \GETFILINGCONNECTION \NSFILING.GET.NEW.SESSION \NSFILING.GET.STREAM
\NSFILING.COURIER.OPEN \NSFILING.CLOSE.BULKSTREAM \NSFILING.RELEASE.BULKSTREAM \NSFILING.COURIER.OPEN \NSFILING.CLOSE.BULKSTREAM \NSFILING.RELEASE.BULKSTREAM
FILING.CALL \NSFILING.LOGIN \NSFILING.AFTER.LOGIN \NSFILING.SET.CONTINUANCE FILING.CALL \NSFILING.LOGIN \NSFILING.AFTER.LOGIN \NSFILING.SET.CONTINUANCE
\NSFILING.LOGOUT \NSFILING.DISCARD.SESSION \VALID.FILING.CONNECTIONP \NSFILING.LOGOUT \NSFILING.DISCARD.SESSION \VALID.FILING.CONNECTIONP
\NSFILING.CLOSE.CONNECTIONS BREAK.NSFILING.CONNECTION) \NSFILING.CLOSE.CONNECTIONS BREAK.NSFILING.CONNECTION)
(ADDVARS (\AFTERLOGINFNS \NSFILING.AFTER.LOGIN))) (ADDVARS (\AFTERLOGINFNS \NSFILING.AFTER.LOGIN)))
(COMS (* ; "Support") (COMS (* ; "Support")
(FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \NSFILING.REMOVEQUOTES (FNS \NSFILING.CONNECT \NSFILING.MAYBE.CREATE \NSFILING.REMOVEQUOTES
\NSFILING.ADDQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE \NSFILING.ADDQUOTES \FILING.ATTRIBUTE.TYPE.SEQUENCE \FILING.ATTRIBUTE.TYPE
\LISP.TO.NSFILING.ATTRIBUTE)) \LISP.TO.NSFILING.ATTRIBUTE))
(COMS (* ; "FILINGHANDLE stuff") (COMS (* ; "FILINGHANDLE stuff")
(FNS \NSFILING.GETFILE \NSFILING.LOOKUP.CACHE \NSFILING.ADD.TO.CACHE (FNS \NSFILING.GETFILE \NSFILING.LOOKUP.CACHE \NSFILING.ADD.TO.CACHE
\NSFILING.OPEN.HANDLE \NSFILING.CONFLICTP \NSFILING.CHECK.ACCESS \NSFILING.OPEN.HANDLE \NSFILING.CONFLICTP \NSFILING.CHECK.ACCESS
\NSFILING.FILLIN.ATTRIBUTES \NSFILING.COMPOSE.PATHNAME \NSFILING.PARSE.FILENAME \NSFILING.FILLIN.ATTRIBUTES \NSFILING.COMPOSE.PATHNAME \NSFILING.PARSE.FILENAME
\NSFILING.ERRORHANDLER \NSFILING.WHENCLOSED \NSFILING.CLOSE.HANDLE \NSFILING.ERRORHANDLER \NSFILING.WHENCLOSED \NSFILING.CLOSE.HANDLE
\NSFILING.FULLNAME)) \NSFILING.FULLNAME))
(COMS (* ; "NSFILING device") (COMS (* ; "NSFILING device")
(FNS \NSFILING.OPENFILE \NSFILING.HANDLE.ERROR \NSFILING.CLOSEFILE \NSFILING.EVENTFN (FNS \NSFILING.OPENFILE \NSFILING.HANDLE.ERROR \NSFILING.CLOSEFILE \NSFILING.EVENTFN
\NSFILING.DELETEFILE \NSFILING.CHILDLESS-P \NSFILING.DIRECTORYNAMEP \NSFILING.DELETEFILE \NSFILING.CHILDLESS-P \NSFILING.DIRECTORYNAMEP
\NSFILING.HOSTNAMEP \NSFILING.GETFILENAME \NSFILING.GETFILEINFO \NSFILING.HOSTNAMEP \NSFILING.GETFILENAME \NSFILING.GETFILEINFO
@@ -80,21 +79,20 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
\NSFILING.GETEOFPTR \NSFILING.GENERATEFILES \NSFILING.GENERATE.STARS \NSFILING.GETEOFPTR \NSFILING.GENERATEFILES \NSFILING.GENERATE.STARS
\NSFILING.NEXTFILE \NSFILING.FILEINFOFN \NSFILING.RENAMEFILE \NSFILING.COPYFILE \NSFILING.NEXTFILE \NSFILING.FILEINFOFN \NSFILING.RENAMEFILE \NSFILING.COPYFILE
\NSFILING.COPY/RENAME)) \NSFILING.COPY/RENAME))
(COMS (* ; "Random access methods") (COMS (* ; "Random access methods")
(FNS \NSRANDOM.CLOSEFILE \NSRANDOM.RELEASE.HANDLE \NSRANDOM.RELEASE.LOCK (FNS \NSRANDOM.CLOSEFILE \NSRANDOM.RELEASE.HANDLE \NSRANDOM.RELEASE.LOCK
\NSRANDOM.RELEASE.IF.ERROR \NSRANDOM.CREATE.STREAM \NSRANDOM.READPAGES \NSRANDOM.RELEASE.IF.ERROR \NSRANDOM.CREATE.STREAM \NSRANDOM.READPAGES
\NSRANDOM.READ.SEGMENT \NSRANDOM.PREPARE.CACHE \NSRANDOM.FETCH.CACHE \NSRANDOM.READ.SEGMENT \NSRANDOM.PREPARE.CACHE \NSRANDOM.FETCH.CACHE
\NSRANDOM.CHECK.CACHE \NSRANDOM.WRITEPAGES \NSRANDOM.WRITE.SEGMENT \NSRANDOM.CHECK.CACHE \NSRANDOM.WRITEPAGES \NSRANDOM.WRITE.SEGMENT
\NSRANDOM.WROTE.HANDLE \NSRANDOM.SETEOFPTR \NSRANDOM.TRUNCATEFILE \NSRANDOM.WROTE.HANDLE \NSRANDOM.SETEOFPTR \NSRANDOM.TRUNCATEFILE
\NSRANDOM.UPDATE.VALIDATION \NSRANDOM.OPENFILE) \NSRANDOM.UPDATE.VALIDATION \NSRANDOM.OPENFILE)
(* ; "error handling") (* ; "error handling")
(FNS \NSRANDOM.HANDLE.ERROR \NSRANDOM.PROCEEDABLE.ERROR \NSRANDOM.REESTABLISH (FNS \NSRANDOM.HANDLE.ERROR \NSRANDOM.PROCEEDABLE.ERROR \NSRANDOM.REESTABLISH
\NSRANDOM.STREAM.CHANGED \NSRANDOM.DESTROY.STREAM \NSRANDOM.SESSION.WATCHER \NSRANDOM.STREAM.CHANGED \NSRANDOM.DESTROY.STREAM \NSRANDOM.SESSION.WATCHER
\NSRANDOM.ENSURE.WATCHER)) \NSRANDOM.ENSURE.WATCHER))
(COMS (* ; "Cleaning up directories") (COMS (* ; "Cleaning up directories")
(FNS GC-FILING-DIRECTORY \NSGC.COLLECT.DIRECTORIES)) (FNS GC-FILING-DIRECTORY \NSGC.COLLECT.DIRECTORIES))
(COMS (* ; (COMS (* ; "Deserialize (special for NSMAIL)")
 "Deserialize (special for NSMAIL)")
(FNS \NSFILING.DESERIALIZE \NSFILING.DESERIALIZE1)) (FNS \NSFILING.DESERIALIZE \NSFILING.DESERIALIZE1))
[COMS (FNS \NSFILING.INIT) [COMS (FNS \NSFILING.INIT)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT] (DECLARE%: DONTEVAL@LOAD DOCOPY (P (\NSFILING.INIT]
@@ -418,106 +416,100 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(ACCESSFNS NSFILINGSTREAM ( (* ; (ACCESSFNS NSFILINGSTREAM ( (* ;
 "Overlays STREAM. F1-2 and FW6-8 are used by the bulkdata device")  "Overlays STREAM. F1-2 and FW6-8 are used by the bulkdata device")
(NSFILING.CONNECTION (fetch F3 of DATUM) (NSFILING.CONNECTION (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE)) (replace F3 of DATUM with NEWVALUE))
(* ; (* ;
 "Session on which this stream is open")  "Session on which this stream is open")
(NSFILING.HANDLE (fetch F4 of DATUM) (NSFILING.HANDLE (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE)) (replace F4 of DATUM with NEWVALUE))
(* ; "Filing HANDLE") (* ; "Filing HANDLE")
(NSFILING.NEW.ATTRIBUTES (fetch F5 of DATUM) (NSFILING.NEW.ATTRIBUTES (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE)) (replace F5 of DATUM with NEWVALUE))
(* ; (* ;
 "For output sequential files, the attributes to install after we write the file")  "For output sequential files, the attributes to install after we write the file")
(NSFILING.PAGE.CACHE (fetch F1 of DATUM) (NSFILING.PAGE.CACHE (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE)) (replace F1 of DATUM with NEWVALUE))
(* ; (* ;
 "Cache of pages read from server but not yet read by client")  "Cache of pages read from server but not yet read by client")
(NSFILING.SERVER.LENGTH (fetch F2 of DATUM) (NSFILING.SERVER.LENGTH (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE)) (replace F2 of DATUM with NEWVALUE))
(* ; (* ;
 "For random-access streams, actual length of file on server")  "For random-access streams, actual length of file on server")
(NSFILING.LAST.REQUEST (fetch FW6 of DATUM) (NSFILING.LAST.REQUEST (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE)) (replace FW6 of DATUM with NEWVALUE))
(* ; (* ;
 "Last page requested to be read or written")  "Last page requested to be read or written")
)) ))
(DATATYPE FILINGSESSION ((FSLOGINCHANGED FLAG) (* ; (DATATYPE FILINGSESSION ((FSLOGINCHANGED FLAG) (* ;
 "True if login info changes for this host")  "True if login info changes for this host")
(FSREALACTIVITY FLAG) (* ; (FSREALACTIVITY FLAG) (* ;
 "Set true when there have been non-CONTINUE calls made on this session")  "Set true when there have been non-CONTINUE calls made on this session")
(NIL BITS 6) (NIL BITS 6)
(FSPARSEDNAME POINTER) (* ; "Canonical NSNAME of server") (FSPARSEDNAME POINTER) (* ; "Canonical NSNAME of server")
(FSNAMESTRING POINTER) (* ; "same as a Lisp string") (FSNAMESTRING POINTER) (* ; "same as a Lisp string")
(FSADDRESS POINTER) (* ; "NSADDRESS of server") (FSADDRESS POINTER) (* ; "NSADDRESS of server")
(FSPROCESSNAME POINTER) (* ; (FSPROCESSNAME POINTER) (* ;
 "Courier stream open for this session, or NIL if none")  "Courier stream open for this session, or NIL if none")
(FSSESSIONHANDLE POINTER) (* ; "Handle for this session") (FSSESSIONHANDLE POINTER) (* ; "Handle for this session")
(FSSESSIONLOCK POINTER) (FSSESSIONLOCK POINTER)
(FSLASTREALACTIVITYTIMER POINTER) (FSLASTREALACTIVITYTIMER POINTER) (* ; "Time of last interesting activity")
(* ; (FSDEVICENAME POINTER)
 "Time of last interesting activity") (FSCOURIERSTREAMS POINTER) (* ; "Courier streams usable by session")
(FSDEVICENAME POINTER) (FSCACHEDHANDLES POINTER) (* ;
(FSCOURIERSTREAMS POINTER) (* ;  "Zero or more instances of FILINGHANDLE describing handles we have open in this session")
 "Courier streams usable by session") (FSLOGINNAME POINTER) (* ;
(FSCACHEDHANDLES POINTER) (* ;  "Name under which this session is logged in")
 "Zero or more instances of FILINGHANDLE describing handles we have open in this session") (FSPROTOCOLNAME POINTER) (* ; "FILING or OLDFILING")
(FSLOGINNAME POINTER) (* ; (FSPROTOCOLDEF POINTER) (* ;
 "Name under which this session is logged in")  "Courier def for FILING.CALL to use")
(FSPROTOCOLNAME POINTER) (* ; "FILING or OLDFILING") (FSSESSIONTIMER POINTER) (* ;
(FSPROTOCOLDEF POINTER) (* ;  "Time we last did anything at all in this session")
 "Courier def for FILING.CALL to use") (FSCONTINUANCE WORD) (* ;
(FSSESSIONTIMER POINTER) (* ;  "How long in msecs we can be idle without having server close session")
 "Time we last did anything at all in this session") (FSVERSION WORD) (* ;
(FSCONTINUANCE WORD) (* ;  "Version of the protocol in use by this server")
 "How long in msecs we can be idle without having server close session") (* ; "Spares")
(FSVERSION WORD) (* ; (NIL POINTER)
 "Version of the protocol in use by this server") (NIL POINTER)
(* ; "Spares") (NIL POINTER)))
(NIL POINTER)
(NIL POINTER)
(NIL POINTER)))
(DATATYPE FILINGHANDLE ((NSHDIRECTORYP FLAG) (* ; "Handle is a directory") (DATATYPE FILINGHANDLE ((NSHDIRECTORYP FLAG) (* ; "Handle is a directory")
(NSHWASREAD FLAG) (* ; (NSHWASREAD FLAG) (* ;
"True if we have read file since we obtained the handle (in which case read date has been updated)")  "True if we have read file since we obtained the handle (in which case read date has been updated)")
(NSHWASWRITTEN FLAG) (NSHWASWRITTEN FLAG)
(NSHWASMODIFIED FLAG) (NSHWASMODIFIED FLAG)
(NIL BITS 4) (NIL BITS 4)
(NSHDATUM POINTER) (* ; (NSHDATUM POINTER) (* ;
 "The file handle datum used in Courier calls")  "The file handle datum used in Courier calls")
(NSHFILEID POINTER) (* ; "FILE.ID of file") (NSHFILEID POINTER) (* ; "FILE.ID of file")
(NSHNAME POINTER) (* ; (NSHNAME POINTER) (* ; "Full name of the file referenced")
 "Full name of the file referenced") (NSHPATHNAME POINTER) (* ; "Canonical pathname of file")
(NSHPATHNAME POINTER) (* ; "Canonical pathname of file") (NSHATTRIBUTES POINTER) (* ; "Cached attributes")
(NSHATTRIBUTES POINTER) (* ; "Cached attributes") (NSHACCESS POINTER) (* ; "Current access controls on handle")
(NSHACCESS POINTER) (* ; (NSHTIMER POINTER) (* ; "Last reference to this handle")
 "Current access controls on handle") (NSHBUSYCOUNT WORD) (* ; "Number of current users of handle")
(NSHTIMER POINTER) (* ; "Last reference to this handle") (NIL WORD)
(NSHBUSYCOUNT WORD) (* ; (NSHDIRECTORYPATH POINTER) (* ;
 "Number of current users of handle")  "For directories, the list of component dirs")
(NIL WORD) (NIL POINTER))
(NSHDIRECTORYPATH POINTER) (* ; NSHTIMER _ (SETUPTIMER 0)
 "For directories, the list of component dirs") NSHDIRECTORYPATH _ T)
(NIL POINTER))
NSHTIMER _ (SETUPTIMER 0)
NSHDIRECTORYPATH _ T)
(RECORD NSFILESERVER (NSFSPARSEDNAME . NSFSADDRESSES)) (RECORD NSFILESERVER (NSFSPARSEDNAME . NSFSADDRESSES))
(RECORD NSFILINGDEVICEINFO (NSFILESERVER NSWATCHERPROC NSFILINGLOCK NSFILINGNAME NSRANDOMDEVICE (RECORD NSFILINGDEVICEINFO (NSFILESERVER NSWATCHERPROC NSFILINGLOCK NSFILINGNAME NSRANDOMDEVICE
. NSCONNECTIONS)) . NSCONNECTIONS))
(RECORD \NSFILING.GENFILESTATE (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES (RECORD \NSFILING.GENFILESTATE (CURRENTINFO NSCONNECTION NSGENERATOR NSFILTER NSIGNOREDIRECTORIES
NSBULKSTREAM)) NSBULKSTREAM))
(RECORD NSFILINGPARSE (NSDIRECTORIES NSROOTNAME NSVERSION NSDIRECTORYP NSHASPERIOD)) (RECORD NSFILINGPARSE (NSDIRECTORIES NSROOTNAME NSVERSION NSDIRECTORYP NSHASPERIOD))
(RECORD NSPAGECACHE (NSPSIZE . NSPHEADER) (RECORD NSPAGECACHE (NSPSIZE . NSPHEADER)
(RECORD NSPHEADER (NSPTAIL . NSPBUFFERS))) (RECORD NSPHEADER (NSPTAIL . NSPBUFFERS)))
) )
(/DECLAREDATATYPE 'FILINGSESSION (/DECLAREDATATYPE 'FILINGSESSION
@@ -571,13 +563,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(DECLARE%: EVAL@COMPILE (DECLARE%: EVAL@COMPILE
(PUTPROPS WITHOUT.SESSION.MONITOR MACRO (PUTPROPS WITHOUT.SESSION.MONITOR MACRO [(SESSION . FORMS)
[(SESSION . FORMS) (LET ((LOCK (fetch FSSESSIONLOCK of SESSION)))
(LET ((LOCK (fetch FSSESSIONLOCK of SESSION))) (DECLARE (LOCALVARS LOCK))
(DECLARE (LOCALVARS LOCK)) (RELEASE.MONITORLOCK LOCK)
(RELEASE.MONITORLOCK LOCK) (PROG1 (PROGN . FORMS)
(PROG1 (PROGN . FORMS) (OBTAIN.MONITORLOCK LOCK])
(OBTAIN.MONITORLOCK LOCK])
) )
(DECLARE%: DOEVAL@COMPILE DONTCOPY (DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -749,10 +740,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(RPAQQ \NSFILING.NULL.HANDLE (0 0)) (RPAQQ \NSFILING.NULL.HANDLE (0 0))
(RPAQQ \NSFILING.PROTECTION.BITS ((READ . 16) (RPAQQ \NSFILING.PROTECTION.BITS ((READ . 16)
(WRITE . 8) (WRITE . 8)
(DELETE . 1) (DELETE . 1)
(CREATE . 2) (CREATE . 2)
(MODIFY . 4))) (MODIFY . 4)))
(RPAQQ \NSFILING.ATTRIBUTES (RPAQQ \NSFILING.ATTRIBUTES
((CHECKSUM 0 CARDINAL) ((CHECKSUM 0 CARDINAL)
@@ -801,11 +792,9 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(FILETYPE FILE.TYPE))) (FILETYPE FILE.TYPE)))
(RPAQ \NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE '(CREATED.ON FILE.ID (RPAQ \NSFILING.USEFUL.ATTRIBUTE.TYPES (\FILING.ATTRIBUTE.TYPE.SEQUENCE '(CREATED.ON FILE.ID
IS.DIRECTORY IS.DIRECTORY PATHNAME
PATHNAME SIZE.IN.BYTES
SIZE.IN.BYTES FILE.TYPE VERSION)))
FILE.TYPE VERSION
)))
) )
(RPAQ? FILING.CACHE.LIMIT 6) (RPAQ? FILING.CACHE.LIMIT 6)
@@ -1608,6 +1597,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(\NSFILING.GETFILE (\NSFILING.GETFILE
[LAMBDA (DEVICE FILENAME ACCESS RECOG OPTION PARAMETERS DIROK SEQUENTIAL OLDSTREAM) [LAMBDA (DEVICE FILENAME ACCESS RECOG OPTION PARAMETERS DIROK SEQUENTIAL OLDSTREAM)
(* ; "Edited 23-May-2024 23:12 by frank")
(* ; "Edited 19-Aug-88 17:17 by bvm") (* ; "Edited 19-Aug-88 17:17 by bvm")
(* ;; "Opens FILENAME for specified ACCESS and RECOG, returning a stream. If OPTION is NAME, ATTRIBUTES, or HANDLE, just return the appropriate information instead of a stream. If OPTION is DIRECTORY, return T or NIL if FILENAME is a directory or not -- PARAMETERS gives the CREATE? option in case the directory doesn't exist. If ACCESS is not NONE, then PARAMETERS gives extra parameters for the open.") (* ;; "Opens FILENAME for specified ACCESS and RECOG, returning a stream. If OPTION is NAME, ATTRIBUTES, or HANDLE, just return the appropriate information instead of a stream. If OPTION is DIRECTORY, return T or NIL if FILENAME is a directory or not -- PARAMETERS gives the CREATE? option in case the directory doesn't exist. If ACCESS is not NONE, then PARAMETERS gives extra parameters for the open.")
@@ -1621,56 +1611,53 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(RETURN NIL))) (RETURN NIL)))
[COND [COND
((EQ ACCESS 'SERIALIZE) (* ; ((EQ ACCESS 'SERIALIZE) (* ;
 "Like INPUT, but retrieve a serialized stream on file")  "Like INPUT, but retrieve a serialized stream on file")
(SETQ ACCESS 'INPUT) (SETQ ACCESS 'INPUT)
(SETQ SERIALIZE 'SERIALIZE) (SETQ SERIALIZE 'SERIALIZE)
(SETQ SEQUENTIAL T)) (SETQ SEQUENTIAL T))
((AND (NOT SEQUENTIAL) ((AND (NOT SEQUENTIAL)
(NOT OPTION) (NOT OPTION)
*NSFILING-RANDOM-ACCESS*) (* ; *NSFILING-RANDOM-ACCESS*) (* ;
 "RANDEVICE set if we want to open a randaccess stream")  "RANDEVICE set if we want to open a randaccess stream")
(SETQ RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of (SETQ RANDEVICE (fetch NSRANDOMDEVICE of (fetch DEVICEINFO of DEVICE]
DEVICE]
RETRY RETRY
[COND [COND
[(SETQ HANDLE (\NSFILING.LOOKUP.CACHE SESSION FILENAME)) [(SETQ HANDLE (\NSFILING.LOOKUP.CACHE SESSION FILENAME))
(* ; "Cache hit") (* ; "Cache hit")
(COND (COND
(OPTION (* ; (OPTION (* ;
 "Got handle, so just do what the option said (else fall thru and try to open a file)")  "Got handle, so just do what the option said (else fall thru and try to open a file)")
(GO HANDLE.OPTION] (GO HANDLE.OPTION]
((AND (LISTP FILENAME) ((AND (LISTP FILENAME)
(EQ (CAR FILENAME) (EQ (CAR FILENAME)
'FILE.ID)) (* ; "Identifying file by ID, take shortcut. Do this second just in case we have cached this file already") 'FILE.ID)) (* ; "Identifying file by ID, take shortcut. Do this second just in case we have cached this file already")
(SETQ FILE.ID (CADR FILENAME))) (SETQ FILE.ID (CADR FILENAME)))
(T (* ; (T (* ;
 "Parse the name and go thru all this hassle")  "Parse the name and go thru all this hassle")
(SETQ PARSE (\NSFILING.PARSE.FILENAME FILENAME)) (SETQ PARSE (\NSFILING.PARSE.FILENAME FILENAME))
(SETQ DIRPATH (fetch NSDIRECTORIES of PARSE)) (SETQ DIRPATH (fetch NSDIRECTORIES of PARSE))
(COND (COND
((NULL DIRPATH) (* ; ((NULL DIRPATH) (* ;
 "No directories specified, so is illegal name")  "No directories specified, so is illegal name")
(GO FILE.NOT.FOUND)) (GO FILE.NOT.FOUND))
[(EQ OPTION 'DIRECTORY) [(EQ OPTION 'DIRECTORY)
(RETURN (AND (fetch NSDIRECTORYP of PARSE) (RETURN (AND (fetch NSDIRECTORYP of PARSE)
(SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T PARAMETERS (SETQ HANDLE (\NSFILING.CONNECT SESSION DIRPATH T PARAMETERS))
))
(GO HANDLE.OPTION] (GO HANDLE.OPTION]
((AND (fetch NSDIRECTORYP of PARSE) ((AND (fetch NSDIRECTORYP of PARSE)
(NOT DIROK)) (* ; (NOT DIROK)) (* ;
 "No name, just a directory. Failure unless caller said a directory file is ok")  "No name, just a directory. Failure unless caller said a directory file is ok")
(GO FILE.NOT.FOUND))) (GO FILE.NOT.FOUND)))
(SETQ EXPLICIT-VERSION (fetch NSVERSION of PARSE)) (SETQ EXPLICIT-VERSION (fetch NSVERSION of PARSE))
(SETQ ROOTNAME (fetch NSROOTNAME of PARSE] (SETQ ROOTNAME (fetch NSROOTNAME of PARSE]
[COND [COND
(HANDLE (* ; (HANDLE (* ;
 "We have an open file handle from the cache")  "We have an open file handle from the cache")
) )
[FILE.ID (* ; [FILE.ID (* ;
 "Try to open an existing file by ID.")  "Try to open an existing file by ID.")
(COND (COND
([SETQ HANDLE (\NSFILING.OPEN.HANDLE SESSION ([SETQ HANDLE (\NSFILING.OPEN.HANDLE SESSION `((FILE.ID ,FILE.ID))
`((FILE.ID ,FILE.ID))
(AND RANDEVICE (SELECTQ ACCESS (AND RANDEVICE (SELECTQ ACCESS
((BOTH APPEND) ((BOTH APPEND)
'OUTPUT) 'OUTPUT)
@@ -1680,16 +1667,15 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(T (* ; "open by name") (T (* ; "open by name")
(SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE (SETQ OLDHANDLE (\NSFILING.OPEN.HANDLE
SESSION SESSION
[\NSFILING.COMPOSE.PATHNAME [\NSFILING.COMPOSE.PATHNAME DIRPATH ROOTNAME
DIRPATH ROOTNAME (OR EXPLICIT-VERSION (OR EXPLICIT-VERSION (SELECTQ RECOG
(SELECTQ RECOG (OLDEST '-)
(OLDEST '-) '+]
'+]
(AND RANDEVICE (SETQ HAVELOCK (AND RANDEVICE (SETQ HAVELOCK
(SELECTQ ACCESS (SELECTQ ACCESS
((OUTPUT BOTH APPEND) ((OUTPUT BOTH APPEND)
(* ; (* ;
"When opening for output, only get lock right now if we know we will be playing with the old file.")  "When opening for output, only get lock right now if we know we will be playing with the old file.")
(AND (OR EXPLICIT-VERSION (AND (OR EXPLICIT-VERSION
(NEQ RECOG 'NEW)) (NEQ RECOG 'NEW))
'OUTPUT)) 'OUTPUT))
@@ -1703,18 +1689,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
'ACCESS.ERROR) 'ACCESS.ERROR)
(EQ (CADDR OLDHANDLE) (EQ (CADDR OLDHANDLE)
'FileNotFound] (* ; 'FileNotFound] (* ;
 "No file of any version exists by this name")  "No file of any version exists by this name")
(SETQ HAVELOCK NIL) (SETQ HAVELOCK NIL)
(SELECTQ RECOG (SELECTQ RECOG
((OLD OLDEST) (* ; ((OLD OLDEST) (* ;
 "No version exists, so certainly this one doesn't")  "No version exists, so certainly this one doesn't")
(RETURN NIL)) (RETURN NIL))
(COND (COND
((EQ ACCESS 'INPUT) (* ; ((EQ ACCESS 'INPUT) (* ;
 "Version given explicitly, file does not exist")  "Version given explicitly, file does not exist")
(RETURN NIL)) (RETURN NIL))
((NULL EXPLICIT-VERSION) (* ; ((NULL EXPLICIT-VERSION) (* ;
 "No extant version, so create number 1")  "No extant version, so create number 1")
(OR RANDEVICE (SETQ VERSION 1))) (OR RANDEVICE (SETQ VERSION 1)))
(T (SETQ VERSION EXPLICIT-VERSION] (T (SETQ VERSION EXPLICIT-VERSION]
((LISTP OLDHANDLE) (* ; "Error case") ((LISTP OLDHANDLE) (* ; "Error case")
@@ -1723,11 +1709,11 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(GO HANDLE.ERROR)) (GO HANDLE.ERROR))
((AND (fetch NSHDIRECTORYP of OLDHANDLE) ((AND (fetch NSHDIRECTORYP of OLDHANDLE)
(NOT DIROK)) (* ; (NOT DIROK)) (* ;
 "It's a directory, don't try to treat as ordinary file")  "It's a directory, don't try to treat as ordinary file")
(GO FILE.NOT.FOUND)) (GO FILE.NOT.FOUND))
[(OR EXPLICIT-VERSION (NEQ RECOG 'NEW)) [(OR EXPLICIT-VERSION (NEQ RECOG 'NEW))
(* ; (* ;
 "Old file exists, use it unless we explicitly requested a new version")  "Old file exists, use it unless we explicitly requested a new version")
(SETQ HANDLE OLDHANDLE) (SETQ HANDLE OLDHANDLE)
(COND (COND
(EXPLICIT-VERSION (SETQ VERSION EXPLICIT-VERSION] (EXPLICIT-VERSION (SETQ VERSION EXPLICIT-VERSION]
@@ -1735,7 +1721,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(SETQ VERSION (ADD1 (OR [CADR (ASSOC 'VERSION (OR (fetch NSHATTRIBUTES (SETQ VERSION (ADD1 (OR [CADR (ASSOC 'VERSION (OR (fetch NSHATTRIBUTES
of OLDHANDLE) of OLDHANDLE)
( (
 \NSFILING.FILLIN.ATTRIBUTES  \NSFILING.FILLIN.ATTRIBUTES
SESSION OLDHANDLE] SESSION OLDHANDLE]
(GO FILE.NOT.FOUND] (GO FILE.NOT.FOUND]
@@ -1745,7 +1731,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
VERSION)) VERSION))
(COND (COND
(OPTION (* ; (OPTION (* ;
 "Not opening file, something simpler")  "Not opening file, something simpler")
(GO HANDLE.OPTION)) (GO HANDLE.OPTION))
((AND HANDLE (NOT OLDSTREAM) ((AND HANDLE (NOT OLDSTREAM)
(\NSFILING.CONFLICTP DEVICE SESSION HANDLE ACCESS)) (\NSFILING.CONFLICTP DEVICE SESSION HANDLE ACCESS))
@@ -1753,10 +1739,10 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(SELECTQ ACCESS (SELECTQ ACCESS
(INPUT (COND (INPUT (COND
((NULL HANDLE) (* ; ((NULL HANDLE) (* ;
 "Odd to get here. E.g., open for INPUT recog NEW.")  "Odd to get here. E.g., open for INPUT recog NEW.")
(GO FILE.NOT.FOUND)) (GO FILE.NOT.FOUND))
(RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE (RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION HANDLE
'INPUT HAVELOCK OLDSTREAM))) RANDEVICE 'INPUT HAVELOCK OLDSTREAM)))
[(NEQ (fetch NSHACCESS of HANDLE) [(NEQ (fetch NSHACCESS of HANDLE)
'OUTPUT) (* ; "Just retrieve old file") 'OUTPUT) (* ; "Just retrieve old file")
(SETQ FILESTREAM (FILING.CALL SESSION (OR SERIALIZE 'RETRIEVE) (SETQ FILESTREAM (FILING.CALL SESSION (OR SERIALIZE 'RETRIEVE)
@@ -1767,18 +1753,18 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(COND (COND
((AND (NEQ ACCESS 'OUTPUT) ((AND (NEQ ACCESS 'OUTPUT)
(NOT RANDEVICE)) (* ; (NOT RANDEVICE)) (* ;
 "Sequential can only write whole files")  "Sequential can only write whole files")
(GO FILE.WONT.OPEN))) (GO FILE.WONT.OPEN)))
(COND (COND
[HANDLE (* ; [HANDLE (* ;
 "File already exists, need to overwrite")  "File already exists, need to overwrite")
(COND (COND
(RANDEVICE (SETQ FILESTREAM (\NSRANDOM.CREATE.STREAM SESSION (RANDEVICE (SETQ FILESTREAM
HANDLE ACCESS HAVELOCK (\NSRANDOM.CREATE.STREAM SESSION HANDLE RANDEVICE
OLDSTREAM T))) ACCESS HAVELOCK OLDSTREAM T)))
[(NULL (fetch NSHACCESS of HANDLE)) [(NULL (fetch NSHACCESS of HANDLE))
(* ; (* ;
 "Overwrite existing file sequentially")  "Overwrite existing file sequentially")
[SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS SESSION HANDLE [SETQ FILESTREAM (OR (\NSFILING.CHECK.ACCESS SESSION HANDLE
'WRITE) 'WRITE)
(FILING.CALL SESSION 'REPLACE (FILING.CALL SESSION 'REPLACE
@@ -1788,15 +1774,16 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(COND (COND
((type? STREAM FILESTREAM) ((type? STREAM FILESTREAM)
(* ; (* ;
 "Cache of saved attributes is now wrong")  "Cache of saved attributes is now wrong")
(replace NSHATTRIBUTES of HANDLE with NIL) (replace NSHATTRIBUTES of HANDLE with NIL)
(* ; (* ;
 "Save attributes to change after file is stored")  "Save attributes to change after file is stored")
(replace NSFILING.NEW.ATTRIBUTES of FILESTREAM (replace NSFILING.NEW.ATTRIBUTES of FILESTREAM with
with PARAMETERS] PARAMETERS
]
(T (GO FILE.BUSY] (T (GO FILE.BUSY]
(OLDSTREAM (* ; (OLDSTREAM (* ;
 "Trying to reopen old stream, failed.")  "Trying to reopen old stream, failed.")
(RETURN NIL)) (RETURN NIL))
[(SETQ OLDHANDLE (\NSFILING.CONNECT SESSION DIRPATH T T)) [(SETQ OLDHANDLE (\NSFILING.CONNECT SESSION DIRPATH T T))
(* ; "Need to create the file, so first had to get a handle on the parent (CREATE and STORE procedures do not permit PATHNAME as one of the specifying attributes).") (* ; "Need to create the file, so first had to get a handle on the parent (CREATE and STORE procedures do not permit PATHNAME as one of the specifying attributes).")
@@ -1808,7 +1795,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
'CREATE 'CREATE
(fetch NSHDATUM of OLDHANDLE) (fetch NSHDATUM of OLDHANDLE)
`([NAME ,(\NSFILING.REMOVEQUOTES (fetch NSROOTNAME `([NAME ,(\NSFILING.REMOVEQUOTES (fetch NSROOTNAME
of PARSE] of PARSE]
,@[AND VERSION `((VERSION ,VERSION] ,@[AND VERSION `((VERSION ,VERSION]
,@PARAMETERS) ,@PARAMETERS)
'((LOCK EXCLUSIVE)) '((LOCK EXCLUSIVE))
@@ -1824,43 +1811,41 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
NSHDATUM _ HANDLE NSHDATUM _ HANDLE
NSHACCESS _ 'OUTPUT] NSHACCESS _ 'OUTPUT]
(* ; (* ;
 "Create failed or we can't read its attributes! Fall thru to error handler")  "Create failed or we can't read its attributes! Fall thru to error handler")
(SETQ FILESTREAM HANDLE) (SETQ FILESTREAM HANDLE)
(GO HANDLE.ERROR)) (GO HANDLE.ERROR))
((type? STREAM (SETQ FILESTREAM ((type? STREAM (SETQ FILESTREAM
(\NSRANDOM.CREATE.STREAM SESSION (\NSRANDOM.CREATE.STREAM SESSION HANDLE
HANDLE ACCESS T))) RANDEVICE ACCESS T)))
(* ; (* ;
 "Succeeded in opening stream, i.e., no further conflicts detected.")  "Succeeded in opening stream, i.e., no further conflicts detected.")
(SETQ FULLNAME (\NSFILING.FULLNAME SESSION HANDLE))) (SETQ FULLNAME (\NSFILING.FULLNAME SESSION HANDLE)))
(T (GO HANDLE.ERROR] (T (GO HANDLE.ERROR]
(T (* ; "Start writing new file, guessing the version. Ideally we shouldn't guess the version, but Lisp wants a full file name NOW (grumble).") (T (* ; "Start writing new file, guessing the version. Ideally we shouldn't guess the version, but Lisp wants a full file name NOW (grumble).")
(SETQ FILESTREAM (SETQ FILESTREAM
(OR (\NSFILING.CHECK.ACCESS SESSION OLDHANDLE 'ADD) (OR (\NSFILING.CHECK.ACCESS SESSION OLDHANDLE 'ADD)
(FILING.CALL SESSION 'STORE (fetch NSHDATUM (FILING.CALL SESSION 'STORE (fetch NSHDATUM of OLDHANDLE)
of OLDHANDLE) `([NAME ,(\NSFILING.REMOVEQUOTES (fetch NSROOTNAME
`([NAME ,(\NSFILING.REMOVEQUOTES (fetch of PARSE]
NSROOTNAME
of PARSE]
(VERSION ,VERSION) (VERSION ,VERSION)
,@PARAMETERS) ,@PARAMETERS)
NIL NIL SESSION 'RETURNERRORS 'KEEPSTREAM] NIL NIL SESSION 'RETURNERRORS 'KEEPSTREAM]
(T (GO FILE.NOT.FOUND)))) (T (GO FILE.NOT.FOUND))))
(\ILLEGAL.ARG ACCESS)) (\ILLEGAL.ARG ACCESS))
(COND (COND
((NOT (type? STREAM FILESTREAM)) (* ; ((NOT (type? STREAM FILESTREAM)) (* ;
 "Had handle, but failed to open it.")  "Had handle, but failed to open it.")
(GO HANDLE.ERROR))) (GO HANDLE.ERROR)))
(replace FULLFILENAME of FILESTREAM with (COND (replace FULLFILENAME of FILESTREAM with (COND
(*UPPER-CASE-FILE-NAMES* (*UPPER-CASE-FILE-NAMES*
(MKATOM (U-CASE FULLNAME))) (MKATOM (U-CASE FULLNAME)))
(T FULLNAME))) (T FULLNAME)))
(replace NSFILING.CONNECTION of FILESTREAM with SESSION) (replace NSFILING.CONNECTION of FILESTREAM with SESSION)
(replace NSFILING.HANDLE of FILESTREAM with HANDLE) (replace NSFILING.HANDLE of FILESTREAM with HANDLE)
(replace DEVICE of FILESTREAM with (OR RANDEVICE DEVICE)) (replace DEVICE of FILESTREAM with (OR RANDEVICE DEVICE))
(COND (COND
(HANDLE (add (fetch NSHBUSYCOUNT of HANDLE) (HANDLE (add (fetch NSHBUSYCOUNT of HANDLE)
1))) 1)))
(RETURN FILESTREAM) (RETURN FILESTREAM)
HANDLE.OPTION HANDLE.OPTION
@@ -1870,12 +1855,12 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(RETURN (SELECTQ OPTION (RETURN (SELECTQ OPTION
(NAME (if HANDLE (NAME (if HANDLE
then (\NSFILING.FULLNAME SESSION HANDLE NIL then (\NSFILING.FULLNAME SESSION HANDLE NIL
*UPPER-CASE-FILE-NAMES*) *UPPER-CASE-FILE-NAMES*)
else (* ; else (* ;
 "OUTFILEP case: no handle, but we have computed the name")  "OUTFILEP case: no handle, but we have computed the name")
FULLNAME)) FULLNAME))
(DIRECTORY (* ; (DIRECTORY (* ;
 "I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")  "I'm pretty sure HANDLE can't be NIL at this point, but a little test never hurt anyone.")
(AND HANDLE (fetch NSHDIRECTORYP of HANDLE) (AND HANDLE (fetch NSHDIRECTORYP of HANDLE)
(\NSFILING.FULLNAME SESSION HANDLE NIL (\NSFILING.FULLNAME SESSION HANDLE NIL
*UPPER-CASE-FILE-NAMES*))) *UPPER-CASE-FILE-NAMES*)))
@@ -1898,7 +1883,7 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(SETQ HAVELOCK (SETQ HANDLE (SETQ VERSION NIL))) (SETQ HAVELOCK (SETQ HANDLE (SETQ VERSION NIL)))
(GO RETRY)) (GO RETRY))
(T (* ; (T (* ;
 "Can't get connection at all? OH well, die as if it were true from the start.")  "Can't get connection at all? OH well, die as if it were true from the start.")
(RETURN NIL))) (RETURN NIL)))
FILE.NOT.FOUND FILE.NOT.FOUND
(COND (COND
@@ -3480,7 +3465,8 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(AND RESETSTATE (\NSRANDOM.RELEASE.LOCK SESSION HANDLE]) (AND RESETSTATE (\NSRANDOM.RELEASE.LOCK SESSION HANDLE])
(\NSRANDOM.CREATE.STREAM (\NSRANDOM.CREATE.STREAM
[LAMBDA (SESSION HANDLE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS) [LAMBDA (SESSION HANDLE DEVICE ACCESS GOTCONTROLS OLDSTREAM CHECKACCESS)
(* ; "Edited 23-May-2024 23:07 by frank")
(* ; "Edited 19-Aug-88 17:24 by bvm") (* ; "Edited 19-Aug-88 17:24 by bvm")
(PROG NIL (PROG NIL
[COND [COND
@@ -3492,38 +3478,35 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
ERROR) ERROR)
[COND [COND
((SELECTQ OLDACCESS ((SELECTQ OLDACCESS
((NIL) (* ; ((NIL) (* ; "Just a cached handle, no controls")
 "Just a cached handle, no controls")
NIL) NIL)
(OUTPUT (* ; (OUTPUT (* ;
 "Handle already open for write, can't do anything else")  "Handle already open for write, can't do anything else")
T) T)
(INPUT (* ; (INPUT (* ;
 "Open for input, so only other input streams allowed.")  "Open for input, so only other input streams allowed.")
(NEQ ACCESS 'INPUT)) (NEQ ACCESS 'INPUT))
(SHOULDNT)) (SHOULDNT))
(RETURN (LISPERROR "FILE WON'T OPEN" (\NSFILING.FULLNAME SESSION HANDLE] (RETURN (LISPERROR "FILE WON'T OPEN" (\NSFILING.FULLNAME SESSION HANDLE]
(COND (COND
((NEQ OLDACCESS 'INPUT) (* ; ((NEQ OLDACCESS 'INPUT) (* ;
 "Get a share/exclusive control. If OLDACCESS is INPUT, we have already obtained this control")  "Get a share/exclusive control. If OLDACCESS is INPUT, we have already obtained this control")
(COND (COND
((SETQ ERROR (FILING.CALL ((SETQ ERROR (FILING.CALL SESSION 'CHANGE.CONTROLS (fetch NSHDATUM
SESSION of HANDLE)
'CHANGE.CONTROLS `[(LOCK ,(SELECTQ ACCESS
(fetch NSHDATUM of HANDLE) (INPUT 'SHARE)
`[(LOCK ,(SELECTQ ACCESS 'EXCLUSIVE]
(INPUT 'SHARE) SESSION
'EXCLUSIVE] 'RETURNERRORS))
SESSION
'RETURNERRORS))
(RETURN ERROR))) (RETURN ERROR)))
(RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR) (RESETSAVE NIL (LIST (FUNCTION \NSRANDOM.RELEASE.IF.ERROR)
SESSION HANDLE)) (* ; SESSION HANDLE)) (* ;
 "If this open doesn't succeed, be sure to release this lock.")  "If this open doesn't succeed, be sure to release this lock.")
(replace NSHACCESS of HANDLE with (SELECTQ ACCESS (replace NSHACCESS of HANDLE with (SELECTQ ACCESS
((BOTH APPEND) ((BOTH APPEND)
'OUTPUT) 'OUTPUT)
ACCESS] ACCESS]
[COND [COND
(CHECKACCESS (CHECKACCESS
@@ -3536,37 +3519,33 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(LEN (CADR (ASSOC 'SIZE.IN.BYTES ATTRS))) (LEN (CADR (ASSOC 'SIZE.IN.BYTES ATTRS)))
S EOF) S EOF)
[COND [COND
(OLDSTREAM [LET [(OLDATTRS (fetch NSHATTRIBUTES of (fetch (OLDSTREAM [LET [(OLDATTRS (fetch NSHATTRIBUTES of (fetch NSFILING.HANDLE
NSFILING.HANDLE of OLDSTREAM]
of OLDSTREAM]
(COND (COND
([OR (NOT (EQUAL LEN (fetch NSFILING.SERVER.LENGTH ([OR (NOT (EQUAL LEN (fetch NSFILING.SERVER.LENGTH of OLDSTREAM
of OLDSTREAM))) )))
(NOT (EQUAL (CADR (ASSOC 'CREATED.ON ATTRS)) (NOT (EQUAL (CADR (ASSOC 'CREATED.ON ATTRS))
(CADR (ASSOC 'CREATED.ON OLDATTRS] (CADR (ASSOC 'CREATED.ON OLDATTRS]
(* ; "file has changed!") (* ; "file has changed!")
(\NSRANDOM.STREAM.CHANGED OLDSTREAM HANDLE] (\NSRANDOM.STREAM.CHANGED OLDSTREAM HANDLE]
(* ; (* ; "If got here, user let us continue")
 "If got here, user let us continue")
(replace NSFILING.HANDLE of (SETQ S OLDSTREAM) with HANDLE)) (replace NSFILING.HANDLE of (SETQ S OLDSTREAM) with HANDLE))
(T (SETQ EOF (SELECTQ ACCESS (T (SETQ EOF (SELECTQ ACCESS
(OUTPUT 0) (OUTPUT 0)
LEN)) LEN))
(SETQ S (create STREAM (SETQ S (create STREAM
DEVICE _ DEVICE
EPAGE _ (FOLDLO EOF BYTESPERPAGE) EPAGE _ (FOLDLO EOF BYTESPERPAGE)
EOFFSET _ (IMOD EOF BYTESPERPAGE) EOFFSET _ (IMOD EOF BYTESPERPAGE)
MULTIBUFFERHINT _ T)) MULTIBUFFERHINT _ T))
(if (EQ ACCESS 'APPEND) (if (EQ ACCESS 'APPEND)
then (* ; "File pos at end") then (* ; "File pos at end")
(freplace (STREAM CPAGE) of S with (fetch (freplace (STREAM CPAGE) of S with (fetch (STREAM EPAGE) of S))
(STREAM EPAGE) (freplace (STREAM COFFSET) of S with (fetch (STREAM EOFFSET)
of S)) of S))
(freplace (STREAM COFFSET) of S with (fetch else (* ; "File pos at start")
(STREAM EOFFSET) (freplace (STREAM CPAGE) of S with 0)
of S)) (freplace (STREAM COFFSET) of S with 0]
else (* ; "File pos at start")
(freplace (STREAM CPAGE) of S with 0)
(freplace (STREAM COFFSET) of S with 0]
(replace NSFILING.SERVER.LENGTH of S with LEN) (replace NSFILING.SERVER.LENGTH of S with LEN)
(RETURN S]) (RETURN S])
@@ -4657,49 +4636,47 @@ Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1993, 1999 by Venue & Xe
(ADDTOVAR LAMA FILING.CALL) (ADDTOVAR LAMA FILING.CALL)
) )
(PUTPROPS NSFILING COPYRIGHT ("Venue & Xerox Corporation" 1983 1984 1985 1986 1987 1988 1990 1993 1999
))
(DECLARE%: DONTCOPY (DECLARE%: DONTCOPY
(FILEMAP (NIL (34234 35080 (\FILINGSESSION.DEFPRINT 34244 . 34758) (\FILINGHANDLE.DEFPRINT 34760 . (FILEMAP (NIL (33827 34673 (\FILINGSESSION.DEFPRINT 33837 . 34351) (\FILINGHANDLE.DEFPRINT 34353 .
35078)) (35081 38808 (\GET.FILING.ATTRIBUTE 35091 . 36404) (\PUT.FILING.ATTRIBUTE 36406 . 37604) ( 34671)) (34674 38401 (\GET.FILING.ATTRIBUTE 34684 . 35997) (\PUT.FILING.ATTRIBUTE 35999 . 37197) (
\GET.SESSION.HANDLE 37606 . 38025) (\PUT.SESSION.HANDLE 38027 . 38806)) (41840 77789 ( \GET.SESSION.HANDLE 37199 . 37618) (\PUT.SESSION.HANDLE 37620 . 38399)) (41234 77183 (
\GETFILINGCONNECTION 41850 . 43745) (\NSFILING.GET.NEW.SESSION 43747 . 44232) (\NSFILING.GET.STREAM \GETFILINGCONNECTION 41244 . 43139) (\NSFILING.GET.NEW.SESSION 43141 . 43626) (\NSFILING.GET.STREAM
44234 . 46010) (\NSFILING.COURIER.OPEN 46012 . 46277) (\NSFILING.CLOSE.BULKSTREAM 46279 . 46557) ( 43628 . 45404) (\NSFILING.COURIER.OPEN 45406 . 45671) (\NSFILING.CLOSE.BULKSTREAM 45673 . 45951) (
\NSFILING.RELEASE.BULKSTREAM 46559 . 47488) (FILING.CALL 47490 . 56089) (\NSFILING.LOGIN 56091 . 69270 \NSFILING.RELEASE.BULKSTREAM 45953 . 46882) (FILING.CALL 46884 . 55483) (\NSFILING.LOGIN 55485 . 68664
) (\NSFILING.AFTER.LOGIN 69272 . 69803) (\NSFILING.SET.CONTINUANCE 69805 . 70478) (\NSFILING.LOGOUT ) (\NSFILING.AFTER.LOGIN 68666 . 69197) (\NSFILING.SET.CONTINUANCE 69199 . 69872) (\NSFILING.LOGOUT
70480 . 70661) (\NSFILING.DISCARD.SESSION 70663 . 72360) (\VALID.FILING.CONNECTIONP 72362 . 73958) ( 69874 . 70055) (\NSFILING.DISCARD.SESSION 70057 . 71754) (\VALID.FILING.CONNECTIONP 71756 . 73352) (
\NSFILING.CLOSE.CONNECTIONS 73960 . 76822) (BREAK.NSFILING.CONNECTION 76824 . 77787)) (77867 91247 ( \NSFILING.CLOSE.CONNECTIONS 73354 . 76216) (BREAK.NSFILING.CONNECTION 76218 . 77181)) (77261 90641 (
\NSFILING.CONNECT 77877 . 80294) (\NSFILING.MAYBE.CREATE 80296 . 83335) (\NSFILING.REMOVEQUOTES 83337 \NSFILING.CONNECT 77271 . 79688) (\NSFILING.MAYBE.CREATE 79690 . 82729) (\NSFILING.REMOVEQUOTES 82731
. 83962) (\NSFILING.ADDQUOTES 83964 . 86702) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86704 . 86918) ( . 83356) (\NSFILING.ADDQUOTES 83358 . 86096) (\FILING.ATTRIBUTE.TYPE.SEQUENCE 86098 . 86312) (
\FILING.ATTRIBUTE.TYPE 86920 . 87423) (\LISP.TO.NSFILING.ATTRIBUTE 87425 . 91245)) (91283 144407 ( \FILING.ATTRIBUTE.TYPE 86314 . 86817) (\LISP.TO.NSFILING.ATTRIBUTE 86819 . 90639)) (90677 143609 (
\NSFILING.GETFILE 91293 . 112576) (\NSFILING.LOOKUP.CACHE 112578 . 114640) (\NSFILING.ADD.TO.CACHE \NSFILING.GETFILE 90687 . 111778) (\NSFILING.LOOKUP.CACHE 111780 . 113842) (\NSFILING.ADD.TO.CACHE
114642 . 117005) (\NSFILING.OPEN.HANDLE 117007 . 119110) (\NSFILING.CONFLICTP 119112 . 120606) ( 113844 . 116207) (\NSFILING.OPEN.HANDLE 116209 . 118312) (\NSFILING.CONFLICTP 118314 . 119808) (
\NSFILING.CHECK.ACCESS 120608 . 121971) (\NSFILING.FILLIN.ATTRIBUTES 121973 . 123720) ( \NSFILING.CHECK.ACCESS 119810 . 121173) (\NSFILING.FILLIN.ATTRIBUTES 121175 . 122922) (
\NSFILING.COMPOSE.PATHNAME 123722 . 124223) (\NSFILING.PARSE.FILENAME 124225 . 129762) ( \NSFILING.COMPOSE.PATHNAME 122924 . 123425) (\NSFILING.PARSE.FILENAME 123427 . 128964) (
\NSFILING.ERRORHANDLER 129764 . 134582) (\NSFILING.WHENCLOSED 134584 . 135856) (\NSFILING.CLOSE.HANDLE \NSFILING.ERRORHANDLER 128966 . 133784) (\NSFILING.WHENCLOSED 133786 . 135058) (\NSFILING.CLOSE.HANDLE
135858 . 136151) (\NSFILING.FULLNAME 136153 . 144405)) (144440 212555 (\NSFILING.OPENFILE 144450 . 135060 . 135353) (\NSFILING.FULLNAME 135355 . 143607)) (143642 211757 (\NSFILING.OPENFILE 143652 .
149642) (\NSFILING.HANDLE.ERROR 149644 . 150522) (\NSFILING.CLOSEFILE 150524 . 153147) ( 148844) (\NSFILING.HANDLE.ERROR 148846 . 149724) (\NSFILING.CLOSEFILE 149726 . 152349) (
\NSFILING.EVENTFN 153149 . 155907) (\NSFILING.DELETEFILE 155909 . 157577) (\NSFILING.CHILDLESS-P \NSFILING.EVENTFN 152351 . 155109) (\NSFILING.DELETEFILE 155111 . 156779) (\NSFILING.CHILDLESS-P
157579 . 158282) (\NSFILING.DIRECTORYNAMEP 158284 . 158691) (\NSFILING.HOSTNAMEP 158693 . 161788) ( 156781 . 157484) (\NSFILING.DIRECTORYNAMEP 157486 . 157893) (\NSFILING.HOSTNAMEP 157895 . 160990) (
\NSFILING.GETFILENAME 161790 . 162050) (\NSFILING.GETFILEINFO 162052 . 165460) ( \NSFILING.GETFILENAME 160992 . 161252) (\NSFILING.GETFILEINFO 161254 . 164662) (
\NSFILING.GET.ATTRIBUTES 165462 . 165858) (\NSFILING.GETFILEINFO.FROM.PLIST 165860 . 168820) ( \NSFILING.GET.ATTRIBUTES 164664 . 165060) (\NSFILING.GETFILEINFO.FROM.PLIST 165062 . 168022) (
\NSFILING.GDATE 168822 . 169012) (\NSFILING.SETFILEINFO 169014 . 172196) (\NSFILING.GET/SETINFO 172198 \NSFILING.GDATE 168024 . 168214) (\NSFILING.SETFILEINFO 168216 . 171398) (\NSFILING.GET/SETINFO 171400
. 173662) (\NSFILING.UPDATE.ATTRIBUTES 173664 . 174635) (\NSFILING.GETEOFPTR 174637 . 175171) ( . 172864) (\NSFILING.UPDATE.ATTRIBUTES 172866 . 173837) (\NSFILING.GETEOFPTR 173839 . 174373) (
\NSFILING.GENERATEFILES 175173 . 191035) (\NSFILING.GENERATE.STARS 191037 . 191627) ( \NSFILING.GENERATEFILES 174375 . 190237) (\NSFILING.GENERATE.STARS 190239 . 190829) (
\NSFILING.NEXTFILE 191629 . 193207) (\NSFILING.FILEINFOFN 193209 . 193436) (\NSFILING.RENAMEFILE \NSFILING.NEXTFILE 190831 . 192409) (\NSFILING.FILEINFOFN 192411 . 192638) (\NSFILING.RENAMEFILE
193438 . 194038) (\NSFILING.COPYFILE 194040 . 194638) (\NSFILING.COPY/RENAME 194640 . 212553)) (212594 192640 . 193240) (\NSFILING.COPYFILE 193242 . 193840) (\NSFILING.COPY/RENAME 193842 . 211755)) (211796
263202 (\NSRANDOM.CLOSEFILE 212604 . 214400) (\NSRANDOM.RELEASE.HANDLE 214402 . 215595) ( 262065 (\NSRANDOM.CLOSEFILE 211806 . 213602) (\NSRANDOM.RELEASE.HANDLE 213604 . 214797) (
\NSRANDOM.RELEASE.LOCK 215597 . 215936) (\NSRANDOM.RELEASE.IF.ERROR 215938 . 216138) ( \NSRANDOM.RELEASE.LOCK 214799 . 215138) (\NSRANDOM.RELEASE.IF.ERROR 215140 . 215340) (
\NSRANDOM.CREATE.STREAM 216140 . 222206) (\NSRANDOM.READPAGES 222208 . 226998) (\NSRANDOM.READ.SEGMENT \NSRANDOM.CREATE.STREAM 215342 . 221069) (\NSRANDOM.READPAGES 221071 . 225861) (\NSRANDOM.READ.SEGMENT
227000 . 237526) (\NSRANDOM.PREPARE.CACHE 237528 . 244860) (\NSRANDOM.FETCH.CACHE 244862 . 247035) ( 225863 . 236389) (\NSRANDOM.PREPARE.CACHE 236391 . 243723) (\NSRANDOM.FETCH.CACHE 243725 . 245898) (
\NSRANDOM.CHECK.CACHE 247037 . 248082) (\NSRANDOM.WRITEPAGES 248084 . 253627) (\NSRANDOM.WRITE.SEGMENT \NSRANDOM.CHECK.CACHE 245900 . 246945) (\NSRANDOM.WRITEPAGES 246947 . 252490) (\NSRANDOM.WRITE.SEGMENT
253629 . 255223) (\NSRANDOM.WROTE.HANDLE 255225 . 257031) (\NSRANDOM.SETEOFPTR 257033 . 258562) ( 252492 . 254086) (\NSRANDOM.WROTE.HANDLE 254088 . 255894) (\NSRANDOM.SETEOFPTR 255896 . 257425) (
\NSRANDOM.TRUNCATEFILE 258564 . 261478) (\NSRANDOM.UPDATE.VALIDATION 261480 . 262383) ( \NSRANDOM.TRUNCATEFILE 257427 . 260341) (\NSRANDOM.UPDATE.VALIDATION 260343 . 261246) (
\NSRANDOM.OPENFILE 262385 . 263200)) (263234 277742 (\NSRANDOM.HANDLE.ERROR 263244 . 265690) ( \NSRANDOM.OPENFILE 261248 . 262063)) (262097 276605 (\NSRANDOM.HANDLE.ERROR 262107 . 264553) (
\NSRANDOM.PROCEEDABLE.ERROR 265692 . 266948) (\NSRANDOM.REESTABLISH 266950 . 268422) ( \NSRANDOM.PROCEEDABLE.ERROR 264555 . 265811) (\NSRANDOM.REESTABLISH 265813 . 267285) (
\NSRANDOM.STREAM.CHANGED 268424 . 269694) (\NSRANDOM.DESTROY.STREAM 269696 . 270466) ( \NSRANDOM.STREAM.CHANGED 267287 . 268557) (\NSRANDOM.DESTROY.STREAM 268559 . 269329) (
\NSRANDOM.SESSION.WATCHER 270468 . 276377) (\NSRANDOM.ENSURE.WATCHER 276379 . 277740)) (277783 288993 \NSRANDOM.SESSION.WATCHER 269331 . 275240) (\NSRANDOM.ENSURE.WATCHER 275242 . 276603)) (276646 287856
(GC-FILING-DIRECTORY 277793 . 285216) (\NSGC.COLLECT.DIRECTORIES 285218 . 288991)) (289043 293734 ( (GC-FILING-DIRECTORY 276656 . 284079) (\NSGC.COLLECT.DIRECTORIES 284081 . 287854)) (287906 292597 (
\NSFILING.DESERIALIZE 289053 . 291155) (\NSFILING.DESERIALIZE1 291157 . 293732)) (293735 294222 ( \NSFILING.DESERIALIZE 287916 . 290018) (\NSFILING.DESERIALIZE1 290020 . 292595)) (292598 293085 (
\NSFILING.INIT 293745 . 294220))))) \NSFILING.INIT 292608 . 293083)))))
STOP STOP

BIN
sources/NSFILING.LCOM
View File

Binary file not shown.