(FILECREATED "14-AUG-83 14:05:06" {PHYLUM}<LISPCORE>SOURCES>LEAF.;53 365556Q
changes to: (FNS \LEAF.WRITEPAGES \LEAF.DELETEFILE \LEAF.OPENFILE)
previous date: "13-AUG-83 17:14:28" {PHYLUM}<LISPCORE>SOURCES>LEAF.;52)
(PRETTYCOMPRINT LEAFCOMS)
(RPAQQ LEAFCOMS ((E (RESETSAVE (RADIX 8)))
(COMS (* SEQUIN protocol)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS SEQUINPACKET SEQUIN)
(CONSTANTS * SEQUINOPS)
(CONSTANTS * SEQUINCONSTANTS)
(CONSTANTS (\SEQUIN.DEFAULT.ALLOCATION 10)
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
(MACROS SEQUINOP))
(INITRECORDS SEQUIN)
(SYSRECORDS SEQUIN)
(FNS CLOSESEQUIN INITSEQUIN GETSEQUIN PUTSEQUIN)
(FNS \SEQUIN.CONTROL \SEQUIN.PUT \SEQUIN.PROCESS \SEQUIN.CLOSE \SEQUIN.FLUSH.CONNECTION
\SEQUIN.FLUSH.RETRANSMIT \SEQUIN.COMPARE \SEQUIN.HANDLE.INPUT
\SEQUIN.OUT.OF.THE.BLUE \SEQUIN.HANDLE.ACK \SEQUIN.RETRANSMIT
\SEQUIN.RETRANSMITNEXT))
(COMS (* LEAF device operations)
(FNS \LEAF.CLOSEFILE \LEAF.DELETEFILE \LEAF.DEVICEP \LEAF.DIRECTORYNAMEP
\LEAF.GENERATEFILES \LEAF.GETFILE \PARSE.REMOTE.FILENAME \LEAF.GETFILEDATES
\LEAF.GETFILEINFO \LEAF.GETFILEINFO.OPEN \LEAF.GETFILENAME \LEAF.OPENFILE
\LEAF.READFILENAME \LEAF.READFILEPROP \LEAF.READPAGES \LEAF.REQUESTPAGE
\LEAF.LOOKUPCACHE CLEAR.LEAF.CACHE \LEAF.RENAMEFILE \LEAF.REOPENFILE
\LEAF.CREATIONDATE \LEAF.SETCREATIONDATE \LEAF.SETFILEINFO \LEAF.SETFILETYPE
\LEAF.SETVALIDATION \LEAF.TRUNCATEFILE \LEAF.WRITEPAGES))
(COMS (FNS \LEAF.CHECKZEROS)
(INITVARS (CHECKFORZEROS))
(GLOBALVARS CHECKFORZEROS))
(COMS (* Main routing point for LEAF pups)
(FNS \SENDLEAF))
(COMS (* Managing LEAF connections)
(FNS BREAKCONNECTION \CLOSELEAFCONNECTION \CLOSELEAFCONNECTIONS \GETLEAFCONNECTION
\OPENLEAFCONNECTION \LEAF.EVENTFN))
(COMS (* Functions called when various SEQUIN events occur)
(FNS \LEAF.ACKED \LEAF.FIX.BROKEN.SEQUIN \LEAF.REPAIR.BROKEN.PUP
\LEAF.USE.NEW.CONNECTION \LEAF.RESENDPUPS \LEAF.HANDLE.INPUT \LEAF.TIMEDOUT
\LEAF.STREAM.IN.QUEUE \LEAF.IDLE \LEAF.WHENCLOSED \LEAF.IDLE?))
(ADDVARS (\LEAFCONNECTIONS)
(\HOSTNAMES)
(NETWORKOSTYPES))
(* Miscellaneous and error handling)
(FNS \ADDLEAFSTRING \CANONICAL.HOSTNAME \FIXPASSWORD \GETLEAFSTRING \IFSERRORSTRING
\LEAF.ERROR \LEAF.DIRECTORYNAMEONLY GETOSTYPE)
[COMS (FNS \LEAFINIT)
(DECLARE: DONTEVAL@LOAD (P (\LEAFINIT]
(COMS (FNS PRINTLEAF)
(ALISTS (PUPPRINTMACROS 176)))
(INITVARS (LEAFDEBUGFLG)
(\MAXLEAFTRIES 6)
(NOFILEPROPERROR)
(DEFAULTFILETYPE (QUOTE TEXT))
(\SEQUIN.TIMEOUTMAX 10000)
(\LEAF.IDLETIMEOUT 1800000)
(\LEAF.CACHETIMEOUT 300000)
(\LEAF.MAXCACHE 10)
(\LEAF.MAXLOOKAHEAD 4)
(\FTPAVAILABLE))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS LEAFDATA LEAFERRORDATA LEAFPARAMSDATA LEAFPACKET
LEAFINFOBLOCK LEAFSTREAM)
(MACROS PUPTRACING .NAMEORSTREAM. .PAGE.IS.AFTER.EOF.)
(CONSTANTS * LEAFOPCODES)
(CONSTANTS * LEAFCONSTANTS)
(CONSTANTS * IFSERRORS)
(CONSTANTS * FILETYPES)
(LOCALVARS . T)
(GLOBALVARS \LEAFDEVICE \LEAFCONNECTIONS LEAFDEBUGFLG PUPTRACEFLG \HOSTNAMES
NOFILEPROPERROR NETWORKOSTYPES LEAFOPCODES SEQUINOPS DEFAULTFILETYPE
\LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT \LEAF.MAXLOOKAHEAD \OPENFILES
\LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE \SEQUIN.TIMEOUTMAX))))
(* SEQUIN protocol)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS SEQUINPACKET ((SEQUINSTART (fetch PUPBASE of DATUM)))
(BLOCKRECORD SEQUINSTART ((NIL 2 WORD)
(* Pup length, typeword)
(ALLOCATE BYTE)
(RECEIVESEQ BYTE)
(SEQCONTROL BYTE)
(SENDSEQ BYTE) (* Sequin uses ID fields of PUP for control info)
)))
(DATATYPE SEQUIN (
(* * First: stuff used by SEQUIN level)
(SEQNAME POINTER) (* Name of partner)
(SEQFRNPORT POINTER) (* Foreign socket)
(SEQSOCKET POINTER) (* Local socket)
(SEQSTATE BYTE) (* Sequin connection state)
(MYSENDSEQ BYTE) (* Number I will next send. These must be byte fields so
that they will wrap around correctly!)
(MYRECEIVESEQ BYTE) (* Number I next expect to receive, i.e. Partner's Send
number of first unacked packet)
(LASTACKEDSEQ BYTE) (* Last Receive seq from partner: all packets with
sequence numbers before this one have been acked)
(SEQOUTALLOC WORD) (* Output allocation: the number of packets I may send
without their being acked)
(SEQINALLOC WORD) (* Input allocation: what I tell my partner)
(#UNACKEDSEQS WORD) (* Number of data packets we have sent for which no acks
have been received)
(SEQTIMEOUT WORD) (* Timeout before retransmission)
(SEQRETRANSMITMAX WORD) (* How many times to retransmit before complaining)
(#SEQRESTARTS WORD) (* Some statistical info...)
(#SEQDUPLICATES WORD)
(#SEQTIMEOUTS WORD)
(SEQRETRANSMITQ POINTER) (* Sequin output queue)
(SEQTIMER POINTER)
(SEQPROCESS POINTER)
(SEQIGNOREDUPLICATES FLAG)
(SEQRETRANSMITTING FLAG)
(SEQCLOSEME FLAG)
(SEQLASTRESTARTTIMER POINTER) (* Allows for some aging of the connection timeout)
(SEQLASTRESTART POINTER)
(* * Second-level functions invoked by SEQUIN)
(SEQACKED POINTER) (* (PUP SEQUIN) called when PUP is acked)
(SEQINPUT POINTER) (* (PUP SEQUIN) called when PUP arrives as input data)
(SEQBROKEN POINTER) (* (SEQUIN PUP) called when a BROKEN sequin arrives
(PUP = NIL) or attempt to send PUP on broken connection)
(SEQABORTED POINTER) (* (SEQUIN) called when PUP arrives with outlandish
sequence numbers)
(SEQTIMEDOUT POINTER) (* (SEQUIN) called when about to retransmit
SEQRETRANSMITMAX times)
(SEQCLOSED POINTER) (* (SEQUIN) called when a connection is flushed, but
before its retransmit queue is flushed)
(SEQIDLETIMEOUTCOMPUTER POINTER) (* Computes timeout before calling SEQIDLEFN when no
activity on connection. T means forever, NIL means
don't)
(SEQIDLEFN POINTER) (* Called when nothing otherwise is happening, after
timeout of SEQIDLETIMEOUT)
(* * Stuff used by clients of SEQUIN, in particular, LEAF)
(SEQDONEQ POINTER) (* Sequins acked but kept around for further handling)
(LOOKUPFILESOCKET POINTER)
(OSTYPE POINTER)
(LEAFCACHEDFILE POINTER) (* Last file accessed, to speed up repeated lookups of
same name)
(LEAFCACHETIMER POINTER) (* To timeout the cache)
(LEAFCACHEHITS WORD)
(LEAFCACHEMISSES WORD)
(LEAFCLOSING FLAG)
(LEAFOPENCLOSELOCK POINTER) (* Monitor lock to keep GETFILE and CLOSEFILE from
stepping on each other)
(SEQRETRANSMITNEXT POINTER)
(SEQEVENT POINTER) (* Signaled when there is input, state changed, or
allocation changed)
(SEQLOCK POINTER) (* Monitor lock for this structure)
)
SEQSTATE ← \SS.CLOSED SEQOUTALLOC ← 1 SEQINALLOC ← \SEQUIN.DEFAULT.ALLOCATION
SEQRETRANSMITMAX ← \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ ←(NCREATE
(QUOTE SYSQUEUE))
SEQTIMEOUT ← \ETHERTIMEOUT SEQTIMER ←(\CREATECELL \FIXP)
SEQLASTRESTARTTIMER ←(\CREATECELL \FIXP)
(SYNONYM SEQDONEQ (INPUTQ)))
]
(/DECLAREDATATYPE (QUOTE SEQUIN)
(QUOTE (POINTER POINTER POINTER BYTE BYTE BYTE BYTE WORD WORD WORD WORD WORD WORD
WORD WORD POINTER POINTER POINTER FLAG FLAG FLAG POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER WORD WORD FLAG POINTER
POINTER POINTER POINTER)))
(RPAQQ SEQUINOPS ((\SEQUIN.DATA 0)
(\SEQUIN.ACK 1)
(\SEQUIN.NOOP 2)
(\SEQUIN.RESTART 3)
(\SEQUIN.OPEN 5)
(\SEQUIN.BREAK 6)
(\SEQUIN.OBSOLETE.CLOSE 7)
(\SEQUIN.DESTROY 11Q)
(\SEQUIN.DALLYING 12Q)
(\SEQUIN.QUIT 13Q)
(\SEQUIN.BROKEN 14Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SEQUIN.DATA 0)
(RPAQQ \SEQUIN.ACK 1)
(RPAQQ \SEQUIN.NOOP 2)
(RPAQQ \SEQUIN.RESTART 3)
(RPAQQ \SEQUIN.OPEN 5)
(RPAQQ \SEQUIN.BREAK 6)
(RPAQQ \SEQUIN.OBSOLETE.CLOSE 7)
(RPAQQ \SEQUIN.DESTROY 11Q)
(RPAQQ \SEQUIN.DALLYING 12Q)
(RPAQQ \SEQUIN.QUIT 13Q)
(RPAQQ \SEQUIN.BROKEN 14Q)
(CONSTANTS (\SEQUIN.DATA 0)
(\SEQUIN.ACK 1)
(\SEQUIN.NOOP 2)
(\SEQUIN.RESTART 3)
(\SEQUIN.OPEN 5)
(\SEQUIN.BREAK 6)
(\SEQUIN.OBSOLETE.CLOSE 7)
(\SEQUIN.DESTROY 11Q)
(\SEQUIN.DALLYING 12Q)
(\SEQUIN.QUIT 13Q)
(\SEQUIN.BROKEN 14Q))
)
(RPAQQ SEQUINCONSTANTS ((\SC.EQUAL 0)
(\SC.PREVIOUS 1)
(\SC.DUPLICATE 2)
(\SC.AHEAD 3)
(\SC.OUTOFRANGE 4)
(\SS.CLOSED 0)
(\SS.OPEN 1)
(\SS.DALLYING 2)
(\SS.ABORT 3)
(\SS.DESTROYED 4)
(\SS.TIMEDOUT 5)
(\SS.CLOSING 6)
(\SS.OPENING 7)
(\PT.SEQUIN 260Q)
(\SS.NOSOCKET 10Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SC.EQUAL 0)
(RPAQQ \SC.PREVIOUS 1)
(RPAQQ \SC.DUPLICATE 2)
(RPAQQ \SC.AHEAD 3)
(RPAQQ \SC.OUTOFRANGE 4)
(RPAQQ \SS.CLOSED 0)
(RPAQQ \SS.OPEN 1)
(RPAQQ \SS.DALLYING 2)
(RPAQQ \SS.ABORT 3)
(RPAQQ \SS.DESTROYED 4)
(RPAQQ \SS.TIMEDOUT 5)
(RPAQQ \SS.CLOSING 6)
(RPAQQ \SS.OPENING 7)
(RPAQQ \PT.SEQUIN 260Q)
(RPAQQ \SS.NOSOCKET 10Q)
(CONSTANTS (\SC.EQUAL 0)
(\SC.PREVIOUS 1)
(\SC.DUPLICATE 2)
(\SC.AHEAD 3)
(\SC.OUTOFRANGE 4)
(\SS.CLOSED 0)
(\SS.OPEN 1)
(\SS.DALLYING 2)
(\SS.ABORT 3)
(\SS.DESTROYED 4)
(\SS.TIMEDOUT 5)
(\SS.CLOSING 6)
(\SS.OPENING 7)
(\PT.SEQUIN 260Q)
(\SS.NOSOCKET 10Q))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \SEQUIN.DEFAULT.ALLOCATION 12Q)
(RPAQQ \SEQUIN.DEFAULT.RETRANSMITMAX 5)
(CONSTANTS (\SEQUIN.DEFAULT.ALLOCATION 12Q)
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS SEQUINOP MACRO ((SEQ OP . ARGS)
(APPLY* (fetch (SEQUIN OP) of SEQ) . ARGS)))
)
)
(/DECLAREDATATYPE (QUOTE SEQUIN)
(QUOTE (POINTER POINTER POINTER BYTE BYTE BYTE BYTE WORD WORD WORD WORD WORD WORD
WORD WORD POINTER POINTER POINTER FLAG FLAG FLAG POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER WORD WORD FLAG POINTER
POINTER POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE SEQUIN (
(* * First: stuff used by SEQUIN level)
(SEQNAME POINTER) (* Name of partner)
(SEQFRNPORT POINTER) (* Foreign socket)
(SEQSOCKET POINTER) (* Local socket)
(SEQSTATE BYTE) (* Sequin connection state)
(MYSENDSEQ BYTE) (* Number I will next send. These must be byte fields so
that they will wrap around correctly!)
(MYRECEIVESEQ BYTE) (* Number I next expect to receive, i.e. Partner's Send
number of first unacked packet)
(LASTACKEDSEQ BYTE) (* Last Receive seq from partner: all packets with
sequence numbers before this one have been acked)
(SEQOUTALLOC WORD) (* Output allocation: the number of packets I may send
without their being acked)
(SEQINALLOC WORD) (* Input allocation: what I tell my partner)
(#UNACKEDSEQS WORD) (* Number of data packets we have sent for which no acks
have been received)
(SEQTIMEOUT WORD) (* Timeout before retransmission)
(SEQRETRANSMITMAX WORD) (* How many times to retransmit before complaining)
(#SEQRESTARTS WORD) (* Some statistical info...)
(#SEQDUPLICATES WORD)
(#SEQTIMEOUTS WORD)
(SEQRETRANSMITQ POINTER) (* Sequin output queue)
(SEQTIMER POINTER)
(SEQPROCESS POINTER)
(SEQIGNOREDUPLICATES FLAG)
(SEQRETRANSMITTING FLAG)
(SEQCLOSEME FLAG)
(SEQLASTRESTARTTIMER POINTER) (* Allows for some aging of the connection timeout)
(SEQLASTRESTART POINTER)
(* * Second-level functions invoked by SEQUIN)
(SEQACKED POINTER) (* (PUP SEQUIN) called when PUP is acked)
(SEQINPUT POINTER) (* (PUP SEQUIN) called when PUP arrives as input data)
(SEQBROKEN POINTER) (* (SEQUIN PUP) called when a BROKEN sequin arrives
(PUP = NIL) or attempt to send PUP on broken connection)
(SEQABORTED POINTER) (* (SEQUIN) called when PUP arrives with outlandish
sequence numbers)
(SEQTIMEDOUT POINTER) (* (SEQUIN) called when about to retransmit
SEQRETRANSMITMAX times)
(SEQCLOSED POINTER) (* (SEQUIN) called when a connection is flushed, but
before its retransmit queue is flushed)
(SEQIDLETIMEOUTCOMPUTER POINTER) (* Computes timeout before calling SEQIDLEFN when no
activity on connection. T means forever, NIL means
don't)
(SEQIDLEFN POINTER) (* Called when nothing otherwise is happening, after
timeout of SEQIDLETIMEOUT)
(* * Stuff used by clients of SEQUIN, in particular, LEAF)
(SEQDONEQ POINTER) (* Sequins acked but kept around for further handling)
(LOOKUPFILESOCKET POINTER)
(OSTYPE POINTER)
(LEAFCACHEDFILE POINTER) (* Last file accessed, to speed up repeated lookups of
same name)
(LEAFCACHETIMER POINTER) (* To timeout the cache)
(LEAFCACHEHITS WORD)
(LEAFCACHEMISSES WORD)
(LEAFCLOSING FLAG)
(LEAFOPENCLOSELOCK POINTER) (* Monitor lock to keep GETFILE and CLOSEFILE from
stepping on each other)
(SEQRETRANSMITNEXT POINTER)
(SEQEVENT POINTER) (* Signaled when there is input, state changed, or
allocation changed)
(SEQLOCK POINTER) (* Monitor lock for this structure)
)
SEQSTATE ← \SS.CLOSED SEQOUTALLOC ← 1 SEQINALLOC ← \SEQUIN.DEFAULT.ALLOCATION
SEQRETRANSMITMAX ← \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ ←(NCREATE
(QUOTE SYSQUEUE))
SEQTIMEOUT ← \ETHERTIMEOUT SEQTIMER ←(\CREATECELL \FIXP)
SEQLASTRESTARTTIMER ←(\CREATECELL \FIXP)
(SYNONYM SEQDONEQ (INPUTQ)))
]
(DEFINEQ
(CLOSESEQUIN
[LAMBDA (SEQUIN) (* bvm: "17-MAY-83 16:44")
(* * Function called to initiate a close connection for a sequin.)
(PROG NIL
(\SEQUIN.CLOSE SEQUIN)
BLK (AWAIT.EVENT (fetch SEQEVENT of SEQUIN)
\ETHERTIMEOUT)
(SELECTC (fetch SEQSTATE of SEQUIN)
(\SS.CLOSED (RETURN T))
(\SS.CLOSING NIL)
(RETURN NIL))
(GO BLK])
(INITSEQUIN
[LAMBDA (SEQUIN PROCNAME) (* bvm: "23-MAY-83 13:39")
(replace SEQSOCKET of SEQUIN with (OPENPUPSOCKET))
(replace SEQSTATE of SEQUIN with \SS.CLOSED)
(replace SEQLOCK of SEQUIN with (CREATE.MONITORLOCK PROCNAME))
(replace SEQEVENT of SEQUIN with (CREATE.EVENT PROCNAME))
(replace MYSENDSEQ of SEQUIN with 0)
(replace MYRECEIVESEQ of SEQUIN with 0)
(replace LASTACKEDSEQ of SEQUIN with 0)
(replace SEQOUTALLOC of SEQUIN with 1)
(replace #UNACKEDSEQS of SEQUIN with 0)
(replace #SEQRESTARTS of SEQUIN with 0)
(replace #SEQDUPLICATES of SEQUIN with 0)
(replace #SEQTIMEOUTS of SEQUIN with 0)
(replace SEQPROCESS of SEQUIN with (ADD.PROCESS (LIST (QUOTE \SEQUIN.PROCESS)
SEQUIN)
(QUOTE NAME)
PROCNAME
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
(QUOTE DELETE])
(GETSEQUIN
[LAMBDA (SEQUIN) (* bvm: "10-APR-83 13:26")
(* * Function to receive sequin packets on SEQUIN.)
(PROG (PACKET)
LOOP(COND
((SETQ PACKET (\DEQUEUE (fetch (SEQUIN INPUTQ) of SEQUIN)))
(* (add (fetch (SEQUIN INPUTC) of SEQUIN) -1))
(* (SEQUIN/CONTROL SEQUIN \SEQUIN.ACK))
(RETURN PACKET))
((EQ (fetch (SEQUIN SEQSTATE) of SEQUIN)
\SS.OPEN)
(BLOCK)
(GO LOOP))
(T (RETURN])
(PUTSEQUIN
[LAMBDA (SEQUIN OPUP) (* bvm: "12-AUG-83 16:38")
(WITH.MONITOR (fetch SEQLOCK of SEQUIN)
(until (AND (SELECTC (fetch (SEQUIN SEQSTATE) of SEQUIN)
(\SS.OPEN (replace SEQCONTROL of OPUP with \SEQUIN.DATA)
T)
(\SS.CLOSED (replace (SEQUIN SEQSTATE) of SEQUIN with
\SS.OPENING)
(replace SEQCONTROL of OPUP with \SEQUIN.OPEN)
T)
(\SS.OPENING NIL)
(PROGN (SETQ SEQUIN (OR (SEQUINOP SEQUIN SEQBROKEN SEQUIN OPUP)
(RETURN)))
NIL))
(ILESSP (fetch #UNACKEDSEQS of SEQUIN)
(fetch SEQOUTALLOC of SEQUIN))
(COND
((NOT (fetch SEQRETRANSMITTING of SEQUIN))
T)
(T (* Should never happen, because \SEQUIN.PROCESS does not
relinquish the lock. Test is here for debugging)
(COND
(LEAFDEBUGFLG (HELP "lock obtained while retransmitting" SEQUIN))
)
NIL)))
do (MONITOR.AWAIT.EVENT (fetch SEQLOCK of SEQUIN)
(fetch SEQEVENT of SEQUIN)
\ETHERTIMEOUT)
finally (COND
([AND CHECKFORZEROS (EQ (fetch LEAFOPCODE
of (fetch PUPCONTENTS of OPUP))
\LEAFOP.WRITE)
(ZEROP (fetch LEAFFIRSTDATAWORD of (fetch PUPCONTENTS
of OPUP]
(\LEAF.CHECKZEROS OPUP)))
(\SEQUIN.PUT SEQUIN OPUP T])
)
(DEFINEQ
(\SEQUIN.CONTROL
[LAMBDA (SEQUIN CONTROL PUP) (* bvm: "12-APR-83 15:09")
(* * Routine to send a control sequin of type CONTROL to the other end)
[COND
(PUP (\ZEROBYTES (LOCF (fetch PUPSOURCE of PUP))
0 5))
(T (SETQ PUP (ALLOCATE.PUP]
(replace PUPLENGTH of PUP with \PUPOVLEN)
(replace (SEQUINPACKET SEQCONTROL) of PUP with CONTROL)
(\SEQUIN.PUT SEQUIN PUP])
(\SEQUIN.PUT
[LAMBDA (SEQUIN PUP ISDATA) (* bvm: "13-APR-83 14:58")
(replace PUPTYPE of PUP with \PT.SEQUIN)
(replace PUPDEST of PUP with (CAR (fetch (SEQUIN SEQFRNPORT) of SEQUIN)))
(replace PUPDESTSOCKET of PUP with (CDR (fetch (SEQUIN SEQFRNPORT) of SEQUIN)))
(UNINTERRUPTABLY
(replace (SEQUINPACKET RECEIVESEQ) of PUP with (fetch (SEQUIN MYRECEIVESEQ) of SEQUIN))
(replace (SEQUINPACKET SENDSEQ) of PUP with (fetch (SEQUIN MYSENDSEQ) of SEQUIN))
[COND
(ISDATA (add (fetch (SEQUIN MYSENDSEQ) of SEQUIN)
1) (* Data packets increment the send sequence, and we have
to keep them around for possible retransmission)
(replace EPREQUEUE of PUP with (fetch (SEQUIN SEQRETRANSMITQ) of SEQUIN))
(add (fetch (SEQUIN #UNACKEDSEQS) of SEQUIN)
1))
(T (replace EPREQUEUE of PUP with (QUOTE FREE]
(replace (SEQUINPACKET ALLOCATE) of PUP with (fetch (SEQUIN SEQINALLOC) of SEQUIN))
(SENDPUP (fetch (SEQUIN SEQSOCKET) of SEQUIN)
PUP)
(\CLOCK0 (fetch SEQTIMER of SEQUIN)) (* Make sure the SEQUIN watcher runs.
Don't need this if we have event wakeups)
(WAKE.PROCESS (fetch SEQPROCESS of SEQUIN)))])
(\SEQUIN.PROCESS
[LAMBDA (SEQUIN) (* bvm: "12-AUG-83 16:48")
(DECLARE (SPECVARS SEQUIN))
(WITH.MONITOR (fetch SEQLOCK of SEQUIN)
[PROCESSPROP (THIS.PROCESS)
(QUOTE INFOHOOK)
(FUNCTION (LAMBDA NIL
(INSPECT SEQUIN]
(PROG ((SOC (fetch SEQSOCKET of SEQUIN))
(RETRANSQ (fetch SEQRETRANSMITQ of SEQUIN))
(CNT 0)
RETRANSMITINCREMENT PUP SOCEVENT TIMEOUT)
(COND
((NOT SOC) (* Sequin was killed)
(RETURN)))
(SETQ SOCEVENT (PUPSOCKETEVENT SOC))
LP [COND
((fetch SEQCLOSEME of SEQUIN)
(RETURN))
((SETQ PUP (GETPUP SOC))
(SELECTC (fetch PUPTYPE of PUP)
[\PT.SEQUIN (COND
((\SEQUIN.HANDLE.INPUT SEQUIN PUP)
(* Something interesting happened)
]
(\PT.ERROR (SELECTC (fetch ERRORPUPCODE of PUP)
[\PUPE.NOSOCKET [COND
((EQ PUPTRACEFLG
(QUOTE PEEK))
(PRINTPUP PUP
(QUOTE GET]
(COND
((EQ (fetch SEQSTATE
of SEQUIN)
\SS.OPENING)
(* Trying to open a connection to someone with no sequin
socket)
(printout PROMPTWINDOW
"[No Sequin socket at "
(fetch SEQNAME
of SEQUIN)
"]" T)
(RETURN (
\SEQUIN.FLUSH.CONNECTION SEQUIN \SS.ABORT \SS.NOSOCKET)))
(T
(* Connection was open and went away?)
(SEQUINOP SEQUIN
SEQBROKEN
SEQUIN]
[\PUPE.NOROUTE [COND
((EQ PUPTRACEFLG
(QUOTE PEEK))
(PRINTPUP PUP
(QUOTE GET]
(COND
((EQ (fetch SEQSTATE
of SEQUIN)
\SS.OPENING)
(* Trying to open a connection to someone inaccessible)
(printout PROMPTWINDOW
"[No route to "
(fetch SEQNAME
of SEQUIN)
"]" T)
(RETURN (
\SEQUIN.FLUSH.CONNECTION SEQUIN]
NIL))
(RELEASE.PUP PUP))
(COND
((fetch SEQCLOSEME of SEQUIN)
(RETURN]
[COND
((fetch SEQRETRANSMITTING of SEQUIN)
(\SEQUIN.RETRANSMITNEXT SEQUIN)
(BLOCK))
((EQ (MONITOR.AWAIT.EVENT (fetch SEQLOCK of SEQUIN)
SOCEVENT
(OR (SETQ TIMEOUT
(AND (ZEROP (fetch #UNACKEDSEQS
of SEQUIN))
(NEQ (fetch SEQSTATE of SEQUIN)
\SS.CLOSING)
(SEQUINOP SEQUIN
SEQIDLETIMEOUTCOMPUTER
SEQUIN)))
(fetch SEQTIMEOUT of SEQUIN)))
PSTAT.TIMEDOUT) (* Nothing urgent happening)
(COND
(TIMEOUT (SEQUINOP SEQUIN SEQIDLEFN SEQUIN))
(T (* Waiting for acks)
(COND
((IGREATERP (CLOCKDIFFERENCE (fetch SEQTIMER of SEQUIN))
(fetch SEQTIMEOUT of SEQUIN))
(* Haven't seen anything in a while, so prod the other
end)
(add (fetch #SEQTIMEOUTS of SEQUIN)
1)
(COND
((NEQ (fetch MYRECEIVESEQ of SEQUIN)
(fetch SEQLASTRESTART of SEQUIN))
(* This is the first time we've had trouble at this
sequence)
(SETQ CNT 1)
(SETQ RETRANSMITINCREMENT
(IMAX 3720Q (LRSH (fetch SEQTIMEOUT of SEQUIN)
1)))
(replace SEQLASTRESTART of SEQUIN
with (fetch MYRECEIVESEQ of SEQUIN))
(SETUPTIMER 0 (fetch SEQLASTRESTARTTIMER of SEQUIN)))
((IGREATERP (add CNT 1)
(fetch SEQRETRANSMITMAX of SEQUIN))
(SEQUINOP SEQUIN SEQTIMEDOUT SEQUIN)
(COND
((fetch SEQCLOSEME of SEQUIN)
(* In case SEQTIMEDOUT closed the connection)
(RETURN)))
(SETQ CNT 0)))
(COND
((ILESSP (fetch SEQTIMEOUT of SEQUIN)
\SEQUIN.TIMEOUTMAX)
(add (fetch SEQTIMEOUT of SEQUIN)
RETRANSMITINCREMENT)))
(COND
((EQ (fetch SEQSTATE of SEQUIN)
\SS.CLOSING)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.DESTROY))
((EQ (fetch #UNACKEDSEQS of SEQUIN)
1) (* Only one thing in queue, just resend it)
(\SEQUIN.RETRANSMIT SEQUIN))
(T (* All our stuff is acked, but client is still waiting
for something; or more than one thing)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.NOOP]
(GO LP])
(\SEQUIN.CLOSE
[LAMBDA (SEQUIN) (* bvm: "17-MAY-83 16:44")
(WITH.FAST.MONITOR (fetch SEQLOCK of SEQUIN)
(COND
((EQ (fetch (SEQUIN SEQSTATE) of SEQUIN)
\SS.OPEN)
(replace (SEQUIN SEQSTATE) of SEQUIN with \SS.CLOSING)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.DESTROY)
T])
(\SEQUIN.FLUSH.CONNECTION
[LAMBDA (SEQUIN FINALSTATE REASON) (* bvm: "14-JUL-83 15:27")
(* * Close a sequin connection)
(PROG ((PROC (fetch SEQPROCESS of SEQUIN)))
(COND
((NULL PROC) (* Cleanup has already been done)
(RETURN)))
(\SEQUIN.FLUSH.RETRANSMIT SEQUIN)
(replace (SEQUIN SEQSTATE) of SEQUIN with (OR FINALSTATE \SS.ABORT))
(NOTIFY.EVENT (fetch SEQEVENT of SEQUIN))
(CLOSEPUPSOCKET (fetch (SEQUIN SEQSOCKET) of SEQUIN))
(replace (SEQUIN SEQSOCKET) of SEQUIN with NIL)
(replace SEQPROCESS of SEQUIN with NIL)
(SEQUINOP SEQUIN SEQCLOSED SEQUIN FINALSTATE REASON)
(COND
((NEQ PROC (THIS.PROCESS))
(DEL.PROCESS PROC))
(T (replace (SEQUIN SEQCLOSEME) of SEQUIN with T])
(\SEQUIN.FLUSH.RETRANSMIT
[LAMBDA (SEQUIN) (* bvm: "29-JUN-83 12:45")
(PROG ((REPUP (fetch SEQRETRANSMITNEXT of SEQUIN)))
(COND
(REPUP (replace SEQRETRANSMITNEXT of SEQUIN with NIL)
(while REPUP do (\ENQUEUE (fetch SEQRETRANSMITQ of SEQUIN)
(PROG1 REPUP (SETQ REPUP (fetch EPLINK of REPUP])
(\SEQUIN.COMPARE
[LAMBDA (X Y) (* bvm: "12-APR-83 18:10")
(* * Function to return sequence comparison on received pups)
(PROG ((DIF (LOGAND (IDIFFERENCE X Y)
377Q)))
(RETURN (COND
((ZEROP DIF)
\SC.EQUAL)
((EQ DIF 377Q)
\SC.PREVIOUS)
((IGEQ DIF 300Q)
\SC.DUPLICATE)
((ILEQ DIF 100Q)
\SC.AHEAD)
(T \SC.OUTOFRANGE])
(\SEQUIN.HANDLE.INPUT
[LAMBDA (SEQUIN PUP) (* bvm: "27-JUL-83 22:54")
(* * Function to handle input pup. Checks that sequence numbers are sensible, takes appropriate action if
retransmission needed or releases packets that are hereby acked. Hands new data packets off to next-level
protocol)
(PROG (ALLOC NEWACKSEQ)
(COND
((NEQ (fetch (PUP PUPTYPE) of PUP)
\PT.SEQUIN)
(RELEASE.PUP PUP)
(RETURN))
((EQ (fetch (SEQUINPACKET SEQCONTROL) of PUP)
\SEQUIN.BROKEN)
(SEQUINOP SEQUIN SEQBROKEN SEQUIN)
(RELEASE.PUP PUP)
(RETURN)))
(SELECTC (\SEQUIN.COMPARE (fetch (SEQUINPACKET SENDSEQ) of PUP)
(fetch (SEQUIN MYRECEIVESEQ) of SEQUIN))
(\SC.OUTOFRANGE (RETURN (\SEQUIN.OUT.OF.THE.BLUE SEQUIN PUP)))
[\SC.AHEAD (* Partner got ahead, ask for retransmission from
MYRECEIVESEQ)
(COND
((NEQ (fetch SEQCONTROL of PUP)
\SEQUIN.RESTART) (* Don't get into a RESTART loop! Do the retransmit
requested by partner and hope that things get better)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.RESTART)
(RELEASE.PUP PUP)
(RETURN]
(\SC.DUPLICATE (* Nothing new, drop it)
(GO DUPLICATE))
[\SC.PREVIOUS (* Retransmission of last packet is simple way to get
restart)
(COND
((NOT (fetch SEQIGNOREDUPLICATES of SEQUIN))
(replace (SEQUINPACKET SEQCONTROL) of PUP with \SEQUIN.RESTART))
((EQ (fetch (SEQUINPACKET SEQCONTROL) of PUP)
\SEQUIN.DALLYING) (* KLUDGE!!! To work around bug in Twenex Leaf server.
Remove this when server is fixed for enough people)
NIL)
(T (GO DUPLICATE]
NIL)
(COND
((ZEROP (SETQ ALLOC (fetch (SEQUINPACKET ALLOCATE) of PUP)))
(SETQ ALLOC 1)))
[COND
((NEQ (fetch (SEQUIN SEQOUTALLOC) of SEQUIN)
ALLOC)
(replace (SEQUIN SEQOUTALLOC) of SEQUIN with ALLOC)
(* Our allocation changed, maybe someone is waiting to
send)
(NOTIFY.EVENT (fetch SEQEVENT of SEQUIN]
(SELECTC (\SEQUIN.COMPARE (SETQ NEWACKSEQ (fetch (SEQUINPACKET RECEIVESEQ) of PUP))
(fetch (SEQUIN LASTACKEDSEQ) of SEQUIN))
(\SC.OUTOFRANGE (RETURN (\SEQUIN.OUT.OF.THE.BLUE SEQUIN PUP)))
((LIST \SC.DUPLICATE \SC.PREVIOUS)
(GO DUPLICATE))
(\SC.AHEAD (* Release packets acked by this pup)
(\SEQUIN.HANDLE.ACK SEQUIN NEWACKSEQ))
NIL)
(SELECTC (fetch (SEQUINPACKET SEQCONTROL) of PUP)
(\SEQUIN.DATA (UNINTERRUPTABLY
(COND
((EQ (fetch (SEQUIN SEQSTATE) of SEQUIN)
\SS.OPENING)
(replace (SEQUIN SEQSTATE) of SEQUIN with \SS.OPEN)))
(add (fetch (SEQUIN MYRECEIVESEQ) of SEQUIN)
1)
(SEQUINOP SEQUIN SEQINPUT PUP SEQUIN)
(NOTIFY.EVENT (fetch SEQEVENT of SEQUIN)))
(replace SEQTIMEOUT of SEQUIN with \ETHERTIMEOUT)
(* Set timeout back to normal now that we have a
response)
(RETURN T))
(\SEQUIN.RESTART (add (fetch #SEQRESTARTS of SEQUIN)
1)
(\SEQUIN.RETRANSMIT SEQUIN))
[\SEQUIN.DALLYING (* Only sequin Users get this)
(COND
((EQ (fetch (SEQUIN SEQSTATE) of SEQUIN)
\SS.CLOSING)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.QUIT)
(\SEQUIN.FLUSH.CONNECTION SEQUIN \SS.CLOSED]
(\SEQUIN.DESTROY (* Only sequin Servers get this or QUIT)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.DALLYING)
(replace (SEQUIN SEQSTATE) of SEQUIN with \SS.DALLYING))
[\SEQUIN.QUIT (COND
((EQ (fetch (SEQUIN SEQSTATE) of SEQUIN)
\SS.DALLYING)
(\SEQUIN.FLUSH.CONNECTION SEQUIN \SS.CLOSED]
NIL)
(RELEASE.PUP PUP)
(RETURN T)
DUPLICATE
(add (fetch #SEQDUPLICATES of SEQUIN)
1)
(RELEASE.PUP PUP)
(RETURN])
(\SEQUIN.OUT.OF.THE.BLUE
[LAMBDA (SEQUIN PUP) (* bvm: "27-JUL-83 22:29")
(* * Called when PUP arrives on SEQUIN with outlandish sequence numbers)
(* * (replace (SEQUIN SEQSTATE) of SEQUIN with \SS.ABORT) (\SEQUIN.CONTROL SEQUIN \SEQUIN.BROKEN)
(SEQUINOP SEQUIN SEQABORTED SEQUIN) (RELEASE.PUP PUP))
NIL])
(\SEQUIN.HANDLE.ACK
[LAMBDA (SEQUIN ACKSEQ) (* bvm: "29-JUN-83 12:33")
(* * Function to dispose of Pups on the output queue which have been acknowledged by a Receive sequence of ACKSEQ)
(bind (QUEUE ←(fetch (SEQUIN SEQRETRANSMITQ) of SEQUIN))
NEWACKSEQ PUP
do (* All packets up to ACKSEQ-1 are now acknowledged)
(COND
((NULL (SETQ PUP (\QUEUEHEAD QUEUE))) (* Pup hasn't come back from transmission yet;
wait)
(COND
((fetch SEQRETRANSMITTING of SEQUIN) (* Pup hasn't come back yet because we haven't sent it!
Send another)
(\SEQUIN.RETRANSMITNEXT SEQUIN)))
(BLOCK))
((UNINTERRUPTABLY
(\DEQUEUE QUEUE)
(add (fetch (SEQUIN #UNACKEDSEQS) of SEQUIN)
-1)
(replace LASTACKEDSEQ of SEQUIN with (SETQ NEWACKSEQ
(LOGAND (ADD1 (fetch (SEQUINPACKET SENDSEQ)
of PUP))
377Q)))
(SEQUINOP SEQUIN SEQACKED PUP SEQUIN)
(EQ NEWACKSEQ ACKSEQ))
(RETURN])
(\SEQUIN.RETRANSMIT
[LAMBDA (SEQUIN) (* bvm: "29-JUN-83 13:44")
(* * Routine to retransmit output sequins)
(OR (fetch SEQRETRANSMITTING of SEQUIN)
(PROG ((QUEUE (fetch (SEQUIN SEQRETRANSMITQ) of SEQUIN)))
(COND
((NULL (fetch SYSQUEUEHEAD of QUEUE))
(RETURN T)))
(while (NEQ (LOGAND (ADD1 (fetch (SEQUINPACKET SENDSEQ) of (fetch SYSQUEUETAIL
of QUEUE)))
377Q)
(fetch MYSENDSEQ of SEQUIN))
do (* Not all of our packets have been transmitted yet;
don't restart now or our retransmit queue will get out
of order)
(BLOCK))
(UNINTERRUPTABLY
(replace SEQRETRANSMITNEXT of SEQUIN with (fetch SYSQUEUEHEAD of QUEUE))
(replace SYSQUEUEHEAD of QUEUE with (replace SYSQUEUETAIL of QUEUE with NIL))
(* Detach chain of pups from retransmit queue so that
they can return there normally)
(replace SEQRETRANSMITTING of SEQUIN with T))])
(\SEQUIN.RETRANSMITNEXT
[LAMBDA (SEQUIN) (* bvm: "12-AUG-83 16:38")
(PROG ((NEXTPUP (fetch SEQRETRANSMITNEXT of SEQUIN)))
(replace EPREQUEUE of NEXTPUP with (fetch SEQRETRANSMITQ of SEQUIN))
(replace (SEQUINPACKET RECEIVESEQ) of NEXTPUP with (fetch MYRECEIVESEQ of SEQUIN))
(replace (SEQUINPACKET ALLOCATE) of NEXTPUP with (fetch SEQINALLOC of SEQUIN))
(COND
([AND CHECKFORZEROS (EQ (fetch LEAFOPCODE of (fetch PUPCONTENTS of NEXTPUP))
\LEAFOP.WRITE)
(ZEROP (fetch LEAFFIRSTDATAWORD of (fetch PUPCONTENTS of NEXTPUP]
(\LEAF.CHECKZEROS NEXTPUP)))
(SENDPUP (fetch SEQSOCKET of SEQUIN)
(PROG1 NEXTPUP (OR (replace SEQRETRANSMITNEXT of SEQUIN
with (fetch EPLINK of NEXTPUP))
(replace SEQRETRANSMITTING of SEQUIN with NIL])
)
(* LEAF device operations)
(DEFINEQ
(\LEAF.CLOSEFILE
[LAMBDA (STREAM CONNECTION LEAFHANDLE FORCE) (* bvm: "26-APR-83 15:34")
(* * Closes the file open on this LEAF connection. CONNECTION and LEAFHANDLE are obtained from STREAM if
necessary; else STREAM may be NIL)
(PROG (OPUP DATA CACHE (INTERNAL CONNECTION))
[COND
(STREAM (OR (SETQ CONNECTION (fetch LEAFCONNECTION of STREAM))
(LISPERROR "FILE NOT OPEN" STREAM))
(COND
[(AND (NOT FORCE)
(NOT (DIRTYABLE STREAM))) (* Don't really close it; keep it around in case someone
wants to look at it again soon)
(SETQ CACHE (fetch LEAFCACHEDFILE of CONNECTION))
(OR INTERNAL (replace LEAFREALLYOPEN of STREAM with NIL))
(* If this is a call from CLOSEF then mark the stream as
"really" closed, so that we know we can close it later)
(COND
((NULL CACHE) (* No cache before, so just make this the cached file)
(replace LEAFCACHEDFILE of CONNECTION with STREAM)
(RETURN))
((EQ CACHE STREAM) (* Closing the already cached file? Do nothing)
(RETURN))
((EQ (fetch FULLFILENAME of STREAM)
(fetch FULLFILENAME of CACHE))
(* Two streams open on the same file. Could happen if STREAM was opened with an incomplete filename.
Always prefer to keep the originally cached file around, so fall thru now and close STREAM)
)
(T (replace LEAFCACHEDFILE of CONNECTION with STREAM)
(COND
((NOT (fetch LEAFREALLYOPEN of CACHE))
(* Close the formerly cached stream if Lisp thinks it is
closed)
(SETQ STREAM CACHE))
(T (RETURN]
((EQ STREAM (fetch LEAFCACHEDFILE of CONNECTION))
(* We are about to close the cached stream)
(replace LEAFCACHEDFILE of CONNECTION with NIL)))
(SETQ LEAFHANDLE (fetch LEAFHANDLE of STREAM]
(SETQ OPUP (ALLOCATE.PUP))
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.CLOSE \OPCODE.SHIFT))
(replace HANDLE of DATA with LEAFHANDLE)
(replace LEAFLENGTH of DATA with \LEN.CLOSEREQUEST)
(\SENDLEAF CONNECTION OPUP STREAM NIL T)
(COND
(STREAM (* no good anymore)
(OR INTERNAL (replace LEAFREALLYOPEN of STREAM with NIL))
(replace LEAFPAGECACHE of STREAM with NIL)
(replace LEAFCONNECTION of STREAM with NIL])
(\LEAF.DELETEFILE
[LAMBDA (FILENAME) (* bvm: "14-AUG-83 14:04")
(PROG ((OPUP (ALLOCATE.PUP))
(STREAM (\LEAF.GETFILE FILENAME (QUOTE OUTPUT)
(QUOTE OLDEST)
T
(QUOTE NODATES)))
DATA IPUP)
(RETURN (COND
(STREAM (SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.DELETE \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace LEAFLENGTH of DATA with \LEN.CLOSEREQUEST)
(COND
((SETQ IPUP (\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM))
(RELEASE.PUP IPUP)
[COND
(CHECKFORZEROS (REMPROPLIST (fetch FULLFILENAME of STREAM)
(QUOTE (LASTPAGEWRITTEN PAGES]
(replace LEAFCONNECTION of STREAM with NIL)
(* The leaf file connection is now gone)
(fetch FULLFILENAME of STREAM])
(\LEAF.DEVICEP
[LAMBDA (HOST) (* bvm: "25-MAY-83 12:35")
(* * Returns the device corresponding to this HOST, or NIL if it is an illegal leaf host)
(* * Currently just makes sure it's a valid ether host)
(AND (ETHERPORT HOST)
\LEAFDEVICE])
(\LEAF.DIRECTORYNAMEP
[LAMBDA (HOST/DIR) (* bvm: "17-APR-83 22:46")
(* True if HOST/DIR is a valid host/directory specification, NIL if not. We do this by trying to open an unlikely
filename on the dir and see if the error we get is "file not found" or "invalid directory")
(\LEAF.GETFILE (CONCAT HOST/DIR "QXZRYU.WJK")
(QUOTE INPUT)
(QUOTE OLD)
T
(QUOTE DIRECTORY])
(\LEAF.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS) (* bvm: "28-JUL-83 01:23")
(OR (AND \FTPAVAILABLE (\FTP.GENERATEFILES DEVICE PATTERN DESIREDPROPS))
(\GENERATENOFILES DEVICE PATTERN DESIREDPROPS])
(\LEAF.GETFILE
[LAMBDA (FILENAME ACCESS RECOG NOERROR OPTION OLDSTREAM REALLYOPEN)
(* bvm: "15-JUL-83 10:38")
(* * Opens FILENAME for indicated ACCESS and RECOG, returning a STREAM, optionally smashing DEADSTREAM, on the
resulting file, which is now open. If NOERROR is T, returns NIL on errors; if NOERROR is FIND, returns NIL only on
file not found errors. OPTION specifies special way to not really open the file; choices are -
NAME -- used to get a full file name: in this case, the fullname is returned, and the file is closed on exit -
DIRECTORY -- FILENAME is a directory specification, not a "real" filename. Return NIL if the directory doesn't
exist, T if it does.)
(PROG (CACHEDSTREAM MODE FILELENGTH CONNECTION LEAFHANDLE HOST REMOTENAME NAME/PASS OUTCOME
CONNECTNAME/PASS OPUP IPUP DATA)
(COND
((SETQ HOST (\PARSE.REMOTE.FILENAME FILENAME NOERROR))
(SETQ REMOTENAME (CDR HOST))
(SETQ HOST (CAR HOST)))
(T (RETURN)))
TOP (OR (SETQ CONNECTION (\GETLEAFCONNECTION HOST NOERROR))
(RETURN))
[COND
((SETQ CACHEDSTREAM (fetch LEAFCACHEDFILE of CONNECTION))
(SELECTQ ACCESS
[(NONE INPUT)
(COND
((AND (NOT OLDSTREAM)
(EQ (fetch FULLFILENAME of CACHEDSTREAM)
FILENAME)) (* We already have this file open, and its open state is
correct)
(COND
(REALLYOPEN (replace LEAFREALLYOPEN of CACHEDSTREAM with T)))
(RETURN (SELECTQ OPTION
(NAME FILENAME)
(DATES (\LEAF.GETFILEDATES CACHEDSTREAM)
CACHEDSTREAM)
CACHEDSTREAM]
(COND
((NOT (fetch LEAFREALLYOPEN of CACHEDSTREAM))
(* Close the cached file in case it is the one we are
now trying to open for write)
(replace LEAFCACHEDFILE of CONNECTION with NIL)
(\LEAF.CLOSEFILE CACHEDSTREAM T NIL T]
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOST))
RETRY
(SETQ OPUP (ALLOCATE.PUP))
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(\ZEROBYTES DATA 0 (SUB1 \LEN.OPENREQUEST))
(replace OPCODE of DATA with \LEAFOP.OPEN)
(replace OPENMODE of DATA with (IPLUS (SELECTQ ACCESS
((INPUT NONE)
\LEAF.READBIT)
((OUTPUT APPEND BOTH)
(IPLUS \LEAF.WRITEBIT \LEAF.EXTENDBIT))
(LISPERROR "ILLEGAL ARG" ACCESS))
(SELECTQ RECOG
(OLD \LEAF.DEFAULT.HIGHEST)
(OLD/NEW (IPLUS \LEAF.DEFAULT.HIGHEST
\LEAF.CREATEBIT))
(NEW (IPLUS \LEAF.DEFAULT.NEXT
\LEAF.CREATEBIT))
(OLDEST \LEAF.DEFAULT.LOWEST)
(NIL (SELECTQ ACCESS
(OUTPUT (IPLUS
\LEAF.DEFAULT.NEXT
\LEAF.CREATEBIT))
((INPUT NONE)
\LEAF.DEFAULT.HIGHEST)
(IPLUS \LEAF.DEFAULT.HIGHEST
\LEAF.CREATEBIT)))
(LISPERROR "ILLEGAL ARG" RECOG))
\LEAF.EXPLICIT.ANY))
(replace LEAFLENGTH of DATA with \LEN.OPENREQUEST)
(\ADDLEAFSTRING OPUP (CAR NAME/PASS))
(\ADDLEAFSTRING OPUP (CDR NAME/PASS))
(\ADDLEAFSTRING OPUP (CAR CONNECTNAME/PASS)) (* Connect name)
(\ADDLEAFSTRING OPUP (CDR CONNECTNAME/PASS)) (* Connect password)
(\ADDLEAFSTRING OPUP REMOTENAME)
(RETURN (COND
((SETQ IPUP (\SENDLEAF CONNECTION OPUP FILENAME T))
(PROG1 [SELECTC (SETQ OUTCOME (fetch LEAFSTATUS of IPUP))
[\LEAF.GOODSTATUS
(SETQ FILELENGTH (fetch FILEADDRESS
of (fetch PUPCONTENTS of IPUP)))
(SETQ LEAFHANDLE (fetch HANDLE of (fetch PUPCONTENTS
of IPUP)))
(COND
((EQ OPTION (QUOTE DIRECTORY))
(* just wanted to know if directory is valid.
Obviously is)
(\LEAF.CLOSEFILE NIL CONNECTION LEAFHANDLE)
T)
(T (COND
((NOT (PROG1 OLDSTREAM (OR OLDSTREAM (SETQ OLDSTREAM
(create LEAFSTREAM)))
(replace LEAFCONNECTION of OLDSTREAM
with CONNECTION)
(replace LEAFHANDLE of OLDSTREAM
with LEAFHANDLE)))
(replace FULLFILENAME of OLDSTREAM
with (OR (\LEAF.READFILENAME OLDSTREAM)
FILENAME)))
(T (replace LEAFPAGECACHE of OLDSTREAM with NIL)))
[COND
((EQ ACCESS (QUOTE OUTPUT))
(* Note: OUTPUT means there is no file to start with! so
EOF=0)
(replace EPAGE of OLDSTREAM
with (replace EOFFSET of OLDSTREAM with 0)))
(T (replace EPAGE of OLDSTREAM
with (fetch (BYTEPTR PAGE) of FILELENGTH))
(replace EOFFSET of OLDSTREAM
with (fetch (BYTEPTR OFFSET) of FILELENGTH]
(COND
((EQ OPTION (QUOTE NAME))
(PROG1 (fetch FULLFILENAME of OLDSTREAM)
(\LEAF.CLOSEFILE OLDSTREAM T)))
(T (COND
((OR (EQ OPTION (QUOTE DATES))
(NEQ ACCESS (QUOTE NONE)))
(\LEAF.GETFILEDATES OLDSTREAM T)))
OLDSTREAM]
(\PASSWORD.ERRORS (* password error)
(AND (SETQ NAME/PASS (\FIXPASSWORD OUTCOME
CONNECTION))
(GO RETRY)))
(\CONNECT.PASSWORD.ERRORS
(* Connect info bad, try again)
(AND [SETQ CONNECTNAME/PASS
(\FIXPASSWORD
OUTCOME CONNECTION
(OR (CAR CONNECTNAME/PASS)
(\LEAF.DIRECTORYNAMEONLY
FILENAME]
(GO RETRY)))
[(LIST \IFSERROR.INVALID.DIRECTORY \IFSERROR.BAD.CHARACTER)
(COND
((OR (EQ OPTION (QUOTE DIRECTORY))
NOERROR)
NIL)
(T (\LEAF.ERROR IPUP FILENAME CONNECTION]
(\LEAF.BROKEN.STATUS (GO TOP))
(COND
((EQ OPTION (QUOTE DIRECTORY))
(* Open didn't barf on invalid directory, so I assume at
least that much was okay)
T)
([AND (EQ OUTCOME \IFSERROR.PROTECTION)
(SETQ CONNECTNAME/PASS (\FIXPASSWORD OUTCOME CONNECTION
(
\LEAF.DIRECTORYNAMEONLY FILENAME] (* File protected, but we got a connect password)
(GO RETRY))
((OR (EQ NOERROR T)
(EQ OUTCOME \IFSERROR.FILE.NOT.FOUND))
NIL)
(T (\LEAF.ERROR IPUP FILENAME CONNECTION]
(RELEASE.PUP IPUP])
(\PARSE.REMOTE.FILENAME
[LAMBDA (FILENAME NOERROR) (* bvm: "26-MAY-83 12:58")
(* Parses FILENAME as a dotted pair of host and
device-specific name, the latter something we can give
to the remote host)
(PROG (START HOST REMOTENAME SEMI OSTYPE)
(COND
[(AND (EQ (NTHCHARCODE FILENAME 1)
(CHARCODE {))
(SETQ START (STRPOS (QUOTE })
FILENAME 2)))
(SETQ HOST (SUBATOM FILENAME 2 (SUB1 START]
((EQ NOERROR T)
(RETURN))
(T (LISPERROR "BAD FILE NAME" FILENAME)))
(COND
((SETQ HOST (\CANONICAL.HOSTNAME HOST)))
(NOERROR (RETURN))
(T (ERROR "Host not found" HOST)))
(RETURN (CONS HOST (COND
((EQ (SETQ OSTYPE (GETOSTYPE HOST))
(QUOTE TENEX)) (* Our filenames are already Tenex style)
(SUBSTRING FILENAME (ADD1 START)))
[(SETQ SEMI (STRPOS (QUOTE ;)
FILENAME
(ADD1 START)))
(* Use ! for version delimiter)
(CONCAT [SUBSTRING FILENAME (ADD1 START)
(COND
((AND (NEQ OSTYPE (QUOTE TOPS20))
(EQ (NTHCHARCODE FILENAME (SUB1 SEMI))
(CHARCODE %.)))
(* Extensionless files have no dot on IFS)
(IDIFFERENCE SEMI 2))
(T (SUB1 SEMI]
(COND
((EQ OSTYPE (QUOTE TOPS20))
(QUOTE %.))
(T (QUOTE !)))
(SUBSTRING FILENAME (ADD1 SEMI]
(T (SUBSTRING FILENAME (ADD1 START)
(COND
((EQ (NTHCHARCODE FILENAME -1)
(CHARCODE %.))
-2)
(T -1])
(\LEAF.GETFILEDATES
[LAMBDA (STREAM FLG) (* bvm: "17-APR-83 22:37")
(PROG ((INFOBLK (fetch LEAFINFO of STREAM))
START)
(COND
[(NOT INFOBLK)
(replace LEAFINFO of STREAM with (SETQ INFOBLK (create LEAFINFOBLOCK]
((NOT FLG)
(RETURN INFOBLK)))
[COND
((SETQ START (\LEAF.READFILEPROP STREAM 0 (UNFOLD 3 BYTESPERCELL)))
(* Get 3 info dates from IFS leader)
(\BLT INFOBLK (CDR START)
(UNFOLD 3 WORDSPERCELL))
(RELEASE.PUP (CAR START)))
(T (* Can't read leader page dates)
(\ZEROBYTES INFOBLK 0 (SUB1 (UNFOLD 3 BYTESPERCELL]
(\LEAF.SETVALIDATION STREAM)
(RETURN INFOBLK])
(\LEAF.GETFILEINFO
[LAMBDA (STREAM ATTRIBUTE DEV) (* bvm: "17-APR-83 22:30")
(COND
((type? STREAM STREAM)
(\LEAF.GETFILEINFO.OPEN STREAM ATTRIBUTE))
(T (PROG [(STREAM (\LEAF.GETFILE STREAM (QUOTE NONE)
(QUOTE OLD]
(RETURN (PROG1 (\LEAF.GETFILEINFO.OPEN STREAM ATTRIBUTE)
(\LEAF.CLOSEFILE STREAM T])
(\LEAF.GETFILEINFO.OPEN
[LAMBDA (STREAM ATTRIBUTE) (* bvm: "17-APR-83 22:14")
(SELECTQ ATTRIBUTE
(LENGTH (create BYTEPTR
PAGE ←(fetch EPAGE of STREAM)
OFFSET ←(fetch EOFFSET of STREAM)))
[CREATIONDATE (GDATE (\LEAF.GETFILEINFO.OPEN STREAM (QUOTE ICREATIONDATE]
[WRITEDATE (GDATE (\LEAF.GETFILEINFO.OPEN STREAM (QUOTE IWRITEDATE]
[READDATE (GDATE (\LEAF.GETFILEINFO.OPEN STREAM (QUOTE IREADDATE]
[ICREATIONDATE (ALTO.TO.LISP.DATE (fetch LFCREATIONDATE of (\LEAF.GETFILEDATES STREAM]
[IWRITEDATE (ALTO.TO.LISP.DATE (fetch LFWRITEDATE of (\LEAF.GETFILEDATES STREAM]
[IREADDATE (ALTO.TO.LISP.DATE (fetch LFREADDATE of (\LEAF.GETFILEDATES STREAM]
[(TYPE BYTESIZE)
(PROG (FT (BYTESIZE 10Q))
[SETQ FT (COND
[(SETQ FT (\LEAF.READFILEPROP STREAM \OFFSET.FILETYPE \LEN.FILETYPE&SIZE))
(* FT = (pup . base))
(PROG1 (SELECTC (\GETBASE (CDR FT)
0)
(\FT.UNKNOWN NIL)
(\FT.TEXT (QUOTE TEXT))
(\FT.BINARY (SETQ BYTESIZE (\GETBASE (CDR FT)
1))
(QUOTE BINARY))
(QUOTE ?))
(RELEASE.PUP (CAR FT]
(T (QUOTE ?]
(RETURN (COND
((EQ ATTRIBUTE (QUOTE BYTESIZE))
BYTESIZE)
((OR (EQ BYTESIZE 10Q)
(NEQ FT (QUOTE BINARY)))
FT)
(T (* Binary file of unusual bytesize)
(LIST FT BYTESIZE]
[AUTHOR (PROG ((BASE (\LEAF.READFILEPROP STREAM \OFFSET.AUTHOR \LEN.AUTHOR)))
(RETURN (AND BASE (PROG1 (GetBcplString (CDR BASE))
(RELEASE.PUP (CAR BASE]
NIL])
(\LEAF.GETFILENAME
[LAMBDA (NAME RECOG) (* bvm: "26-DEC-81 17:43")
(* * awful hack. LEAF does not supprt directory ops, so we open file, get name, then close)
(\LEAF.GETFILE NAME (QUOTE NONE)
RECOG T (QUOTE NAME])
(\LEAF.OPENFILE
[LAMBDA (FILENAME ACCESS RECOG OTHERINFO) (* bvm: "14-AUG-83 14:04")
(PROG (STREAM TYPE OLDHANDLE CRDATE PROPS SEQUIN)
[COND
((type? STREAM FILENAME) (* Hmm? trying to reopen, perhaps?)
(COND
((fetch ACCESS of FILENAME)
(RETURN (LISPERROR "FILE WON'T OPEN" FILENAME)))
(T (SETQ FILENAME (fetch FULLFILENAME of (SETQ OLDHANDLE FILENAME]
(for X in OTHERINFO
do (* Check device-dependent parameters)
(SELECTQ [CAR (OR (LISTP X)
(SETQ X (LIST X T]
(TYPE (* Set the file TYPE (TEXT or BINARY))
(SELECTQ (CAR (SETQ TYPE (CDR X)))
((TEXT BINARY NIL)
T)
(LISPERROR "ILLEGAL ARG" OTHERINFO)))
[CREATIONDATE (SETQ CRDATE (IDATE (CADR X]
[ICREATIONDATE (SETQ CRDATE (OR (SMALLP (CADR X))
(\DTEST (CADR X)
(QUOTE FIXP]
[DON'T.CHANGE.DATE
(* Don't change create date. In order to do this, we have to look at the current date of the file, save it, then
rewrite when we open the file for real)
(COND
((AND (NEQ ACCESS (QUOTE INPUT))
(SETQ OLDHANDLE (\LEAF.GETFILE FILENAME
(QUOTE NONE)
(QUOTE OLD)
T
(QUOTE DATES)
OLDHANDLE)))
(SETQ FILENAME (fetch FULLFILENAME of OLDHANDLE))
(SETQ CRDATE (\LEAF.CREATIONDATE OLDHANDLE))
(\LEAF.CLOSEFILE OLDHANDLE NIL NIL T]
[SEQUENTIAL (* Hook for FTP)
(COND
((AND (CADR X)
\FTPAVAILABLE
(SETQ STREAM (\FTP.OPENFILE FILENAME ACCESS RECOG
OTHERINFO)))
(RETURN]
(push PROPS X)))
(RETURN (COND
(STREAM)
((SETQ STREAM (\LEAF.GETFILE FILENAME ACCESS RECOG (QUOTE FIND)
NIL OLDHANDLE T))
(* Returns NIL if file not found)
(COND
(CRDATE (\LEAF.SETCREATIONDATE STREAM CRDATE))
(T (\LEAF.GETFILEDATES STREAM)))
(COND
((AND [COND
(TYPE (* Type NIL overrides default)
(CAR TYPE))
(T (AND (SETQ TYPE DEFAULTFILETYPE)
(ZEROP (fetch EPAGE of STREAM))
(ZEROP (fetch EOFFSET of STREAM]
(NEQ ACCESS (QUOTE INPUT))) (* Set file type if explicitly requested, or if this is
a new output file and there is a global default)
(\LEAF.SETFILETYPE STREAM TYPE)))
(SETQ SEQUIN (fetch LEAFCONNECTION of STREAM))
(COND
((IGREATERP (fetch LEAFCACHEHITS of SEQUIN)
77777Q) (* Keep counters from overflowing)
(replace LEAFCACHEHITS of SEQUIN with 0)
(replace LEAFCACHEMISSES of SEQUIN with 0)))
(COND
((IGREATERP (fetch #SEQTIMEOUTS of SEQUIN)
77777Q)
(replace #SEQRESTARTS of SEQUIN with 0)
(replace #SEQTIMEOUTS of SEQUIN with 0)
(replace #SEQDUPLICATES of SEQUIN with 0)))
[COND
((AND CHECKFORZEROS (NEQ ACCESS (QUOTE INPUT)))
(REMPROPLIST (fetch FULLFILENAME of STREAM)
(QUOTE (LASTPAGEWRITTEN PAGES]
STREAM])
(\LEAF.READFILENAME
[LAMBDA (STREAM HOST) (* bvm: "17-APR-83 22:06")
(PROG ([REMOTENAME (PROG ((NAMEBASE (\LEAF.READFILEPROP STREAM \OFFSET.FILENAME \MAXLEN.FILENAME))
) (* Returns (pup . base))
(RETURN (AND NAMEBASE (PROG1 (GetBcplString (CDR NAMEBASE))
(RELEASE.PUP (CAR NAMEBASE]
(CONNECTION (fetch LEAFCONNECTION of STREAM))
(BANG 0)
(DOTCOUNT 0)
OSTYPE LASTCHAR)
(RETURN (COND
((NOT REMOTENAME) (* Some hosts may refuse us the name)
NIL)
(T (PACK* (QUOTE {)
(fetch SEQNAME of CONNECTION)
(QUOTE })
(COND
((EQ (SETQ OSTYPE (fetch OSTYPE of CONNECTION))
(QUOTE TENEX))
REMOTENAME)
(T (for CHAR instring REMOTENAME as I from 1
do (SELCHARQ CHAR
((; !)
(SETQ BANG I)
(SETQ LASTCHAR CHAR))
(%. (SETQ BANG I)
(SETQ LASTCHAR CHAR)
(add DOTCOUNT 1))
NIL))
(COND
((ZEROP BANG) (* No bang, what the hell is this?)
REMOTENAME)
((EQ LASTCHAR (CHARCODE ;))
(* Tenex?)
[COND
((NULL OSTYPE)
(replace OSTYPE of CONNECTION with (QUOTE TENEX]
REMOTENAME)
(T [COND
((AND (NULL OSTYPE)
(EQ LASTCHAR (CHARCODE %.)))
(replace OSTYPE of CONNECTION with (QUOTE TOPS20]
(U-CASE (CONCAT (SUBSTRING REMOTENAME 1 (SUB1 BANG))
(COND
((NEQ DOTCOUNT 0)
(QUOTE ;))
(T
(* IFS does not use dot for extensionless file, so
supply one)
".;"))
(SUBSTRING REMOTENAME (ADD1 BANG])
(\LEAF.READFILEPROP
[LAMBDA (STREAM OFFSET LEN) (* bvm: "17-APR-83 22:10")
(* Read a chunk of the IFS leader page starting at OFFSET for LEN bytes. Returns a dotted pair, car of which is
the reply pup and CDR is a pointer inside it to the desired data)
(PROG ((CONNECTION (fetch LEAFCONNECTION of STREAM))
(OPUP (ALLOCATE.PUP))
DATA IPUP)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.READ \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (IDIFFERENCE OFFSET \BYTES.PER.TRIDENT.PAGE))
(replace SIGNEXTEND of DATA with 0)
(replace DATALENGTH of DATA with LEN)
(replace LEAFLENGTH of DATA with \LEN.FILEREQUEST)
(SETQ IPUP (\SENDLEAF CONNECTION OPUP STREAM NOFILEPROPERROR))
(RETURN (COND
((EQ (fetch LEAFSTATUS of IPUP)
\LEAF.GOODSTATUS)
(CONS IPUP (\ADDBASE (fetch PUPCONTENTS of IPUP)
(FOLDLO \LEN.READANSWER BYTESPERWORD])
(\LEAF.READPAGES
[LAMBDA (STREAM FIRSTPAGE BUFFERLIST) (* bvm: "17-MAY-83 16:47")
(for BUF inside BUFFERLIST as PAGE# from FIRSTPAGE bind LEN
sum [COND
((.PAGE.IS.AFTER.EOF. STREAM PAGE#) (* after end of file)
(SETQ LEN 0))
(T (PROG (OPUP IPUP DATA)
RETRY
(SETQ OPUP (\LEAF.REQUESTPAGE STREAM PAGE# T))
(for NEWPAGE# from (ADD1 PAGE#) as I to (fetch LEAFCACHECNT of STREAM)
until (.PAGE.IS.AFTER.EOF. STREAM NEWPAGE#)
do (* Ask for pages immediately following this one, too)
(\LEAF.REQUESTPAGE STREAM NEWPAGE#))
(until (NEQ (SETQ IPUP (fetch EPUSERFIELD of OPUP))
STREAM)
do (AWAIT.EVENT (fetch SEQEVENT of (fetch LEAFCONNECTION of STREAM))
\ETHERTIMEOUT))
(RELEASE.PUP OPUP)
(COND
((NEQ (fetch LEAFOPCODE of (SETQ DATA (fetch PUPCONTENTS of IPUP)))
\LEAFOP.ERROR)
(SETQ LEN (IDIFFERENCE (fetch LEAFLENGTH of DATA)
\LEN.READANSWER))
(\BLT BUF (\ADDBASE DATA (FOLDLO \LEN.READANSWER BYTESPERWORD))
(FOLDHI LEN BYTESPERWORD))
(RELEASE.PUP IPUP)
(RETURN LEN))
(T (HELP "Read page failed " (fetch FULLFILENAME of STREAM))
(GO RETRY]
[COND
((ILESSP LEN BYTESPERPAGE)
(\ZEROBYTES BUF LEN (SUB1 BYTESPERPAGE]
LEN])
(\LEAF.REQUESTPAGE
[LAMBDA (STREAM PAGE# IMMEDIATE) (* bvm: "15-APR-83 22:01")
(* Requests PAGE# of STREAM, possibly finding it in the cache first. If IMMEDIATE is true, then we want the page
now, and it should be removed from the cache and returned; otherwise it is completely optional whether we ask for
the page at all or what we return)
(PROG ((CACHE (\LEAF.LOOKUPCACHE STREAM PAGE# IMMEDIATE))
OPUP DATA)
[COND
((CDR CACHE) (* Cache hit!)
[COND
(IMMEDIATE (add (fetch LEAFCACHEHITS of (fetch LEAFCONNECTION of STREAM))
1)
(COND
((ILESSP (fetch LEAFCACHECNT of STREAM)
\LEAF.MAXLOOKAHEAD) (* Reward STREAM for being sequential)
(add (fetch LEAFCACHECNT of STREAM)
1]
(RETURN (CDR CACHE]
(COND
(IMMEDIATE (* Cache miss, so we probably aren't very sequential;
be more cautious)
(replace LEAFCACHECNT of STREAM with 1)
(add (fetch LEAFCACHEMISSES of (fetch LEAFCONNECTION of STREAM))
1)))
[SETQ DATA (fetch PUPCONTENTS of (SETQ OPUP (ALLOCATE.PUP]
(replace OPWORD of DATA with (LLSH \LEAFOP.READ \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (create BYTEPTR
PAGE ← PAGE#
OFFSET ← 0))
(replace READWRITEMODE of DATA with \LEAFMODE.DONTEXTEND)
(* i.e. don't attempt to read past EOF, in case this is
the last page)
(replace DATALENGTH of DATA with BYTESPERPAGE)
(replace LEAFLENGTH of DATA with \LEN.FILEREQUEST)
(\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL (QUOTE GO))
(AND CACHE (RPLACD CACHE OPUP))
(RETURN OPUP])
(\LEAF.LOOKUPCACHE
[LAMBDA (STREAM PAGE# DELETE) (* bvm: " 5-MAY-83 17:00")
(* Looks up PAGE# in STREAM's cache. If it finds an entry, it returns it and, if DELETE is true, deletes it from
the cache; otherwise if DELETE is NIL, it inserts a new empty entry for PAGE#)
(for I from 0 bind (CACHE ←(fetch LEAFPAGECACHE of STREAM))
PREV
while CACHE
do [COND
((IEQP (CAAR CACHE)
PAGE#)
[COND
((NOT DELETE) (* Don't remove entry from cache)
)
(PREV (RPLACD PREV (CDR CACHE)))
(T (replace LEAFPAGECACHE of STREAM with (CDR CACHE]
(RETURN (CAR CACHE]
(SETQ CACHE (CDR (SETQ PREV CACHE)))
finally [COND
((NOT DELETE)
(SETQ CACHE (LIST (CONS PAGE# NIL)))
(COND
[PREV (RPLACD PREV CACHE)
(COND
((IGREATERP I \LEAF.MAXCACHE) (* Throw out old cache entries)
(replace LEAFPAGECACHE of STREAM with (CDR (fetch LEAFPAGECACHE
of STREAM]
(T (replace LEAFPAGECACHE of STREAM with CACHE]
(RETURN (CAR CACHE])
(CLEAR.LEAF.CACHE
[LAMBDA (HOST) (* bvm: "27-JUL-83 23:39")
(AND HOST (SETQ HOST (\CANONICAL.HOSTNAME HOST))
(PROG ([CONNECTION (find CONN in \LEAFCONNECTIONS suchthat (EQ HOST (fetch SEQNAME
of CONN]
CACHEDSTREAM)
(RETURN (COND
((AND CONNECTION (SETQ CACHEDSTREAM (fetch LEAFCACHEDFILE of CONNECTION))
(NOT (fetch LEAFREALLYOPEN of CACHEDSTREAM)))
(replace LEAFCACHEDFILE of CONNECTION with NIL)
(\LEAF.CLOSEFILE CACHEDSTREAM T NIL T)
(fetch SEQNAME of CONNECTION])
(\LEAF.RENAMEFILE
[LAMBDA (OLDFILE NEWFILE) (* bvm: " 4-JUN-83 23:02")
(OR (AND \FTPAVAILABLE (\FTP.RENAMEFILE OLDFILE NEWFILE))
(\GENERIC.RENAMEFILE OLDFILE NEWFILE])
(\LEAF.REOPENFILE
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM) (* bvm: "21-MAY-83 16:25")
(* * Called after, say, a LOGOUT to restore the file to its old state. We reopen the file and return a new file
handle)
(PROG (NEWSTREAM OLDINFO NEWINFO OLDDATES)
[COND
((NEQ ACCESS (QUOTE INPUT))
(* Problem: when we reopen the file for write, we change the write and creation dates, so our caller thinks the
file has been modified. So first open the file for read and look at the dates, and if they're the same as the old
filehandle's, prepare to restore them)
(COND
((SETQ NEWSTREAM (\LEAF.GETFILE NAME (QUOTE NONE)
(QUOTE OLD)
T
(QUOTE DATES)))
[COND
((AND [IEQP (fetch LFCREATIONDATE of (SETQ OLDINFO (fetch LEAFINFO of STREAM)))
(fetch LFCREATIONDATE of (SETQ NEWINFO (fetch LEAFINFO of NEWSTREAM]
(IEQP (fetch LFWRITEDATE of OLDINFO)
(fetch LFWRITEDATE of NEWINFO)))
(* Creation and write dates are indeed the same)
(SETQ OLDDATES (\LEAF.CREATIONDATE NEWSTREAM]
(\LEAF.CLOSEFILE NEWSTREAM NIL NIL T))
(T (* If we can't even find the file, there's no hope)
(RETURN NIL]
[COND
((AND (SETQ NEWSTREAM (\LEAF.GETFILE NAME ACCESS RECOG T NIL NEWSTREAM))
OLDDATES) (* Change the filedates to the old dates)
(\LEAF.SETCREATIONDATE NEWSTREAM OLDDATES)
(* And smash the validation of the old handle to be the new validation. This is sort of a cheat, but it works to
fool \REVALIDATEFILE)
(replace VALIDATION of STREAM with (fetch VALIDATION of NEWSTREAM]
(RETURN NEWSTREAM])
(\LEAF.CREATIONDATE
[LAMBDA (STREAM) (* bvm: "17-APR-83 22:34")
(ALTO.TO.LISP.DATE (fetch LFCREATIONDATE of (fetch LEAFINFO of STREAM])
(\LEAF.SETCREATIONDATE
[LAMBDA (STREAM DATE) (* bvm: "21-MAY-83 16:27")
(* DATE is integer in Lisp date format)
(PROG ((INFOBLK (\LEAF.GETFILEDATES STREAM))
(FILEDATE (LISP.TO.ALTO.DATE DATE))
(OPUP (ALLOCATE.PUP))
DATA)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.WRITE \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (IDIFFERENCE 0 \BYTES.PER.TRIDENT.PAGE))
(* negative address into leader page)
(replace SIGNEXTEND of DATA with 0)
(replace DATALENGTH of DATA with \LEN.DATE)
(replace LEAFFILEDATE of DATA with FILEDATE)
(replace LEAFLENGTH of DATA with (IPLUS \LEN.FILEREQUEST \LEN.DATE))
(\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL T)
(replace LFCREATIONDATE of INFOBLK with FILEDATE)
(\LEAF.SETVALIDATION STREAM) (* Since validation depends on file dates)
(RETURN T])
(\LEAF.SETFILEINFO
[LAMBDA (STREAM ATTRIBUTE VALUE DEV) (* bvm: "21-MAY-83 16:28")
(PROG ((WASOPEN (type? STREAM STREAM)))
(SELECTQ ATTRIBUTE
[CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
(ICREATIONDATE (OR (FIXP VALUE)
(LISPERROR "NON-NUMERIC ARG" VALUE)))
(TYPE)
(RETURN))
(RETURN (COND
([OR WASOPEN (SETQ STREAM (\LEAF.GETFILE STREAM (QUOTE NONE)
(QUOTE OLD]
(PROG1 (SELECTQ ATTRIBUTE
(TYPE (\LEAF.SETFILETYPE STREAM VALUE))
(\LEAF.SETCREATIONDATE STREAM VALUE))
(COND
((NOT WASOPEN)
(\LEAF.CLOSEFILE STREAM T])
(\LEAF.SETFILETYPE
[LAMBDA (STREAM TYPE) (* bvm: "12-APR-83 22:12")
(* Sets "type" of file to TEXT or BINARY)
(PROG ((OPUP (ALLOCATE.PUP))
BYTESIZE DATA)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.WRITE \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (IDIFFERENCE \OFFSET.FILETYPE \BYTES.PER.TRIDENT.PAGE))
(* negative address into leader page)
(replace SIGNEXTEND of DATA with 0)
(replace DATALENGTH of DATA with \LEN.FILETYPE&SIZE)
(* Patch: IFS code has bug that only lets me do a write
with length=4 here)
[COND
((LISTP TYPE) (* E.g. (BINARY 20Q). Does anyone else know about this?)
(SETQ BYTESIZE (CADR TYPE))
(SETQ TYPE (CAR TYPE]
(replace LEAFFILETYPE of DATA with (SELECTQ TYPE
(TEXT \FT.TEXT)
(BINARY \FT.BINARY)
(NIL \FT.UNKNOWN)
(LISPERROR "ILLEGAL ARG" TYPE)))
(replace LEAFBYTESIZE of DATA with (OR BYTESIZE 10Q))
(replace LEAFLENGTH of DATA with (IPLUS \LEN.FILEREQUEST \LEN.FILETYPE&SIZE))
(\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL T)
(RETURN TYPE])
(\LEAF.SETVALIDATION
[LAMBDA (STREAM) (* lmm "13-OCT-82 15:35")
(* * Set the VALIDATION field of STREAM based on the file's write and creation dates)
(replace VALIDATION of STREAM with (\MAKENUMBER (fetch LOCREATE of (fetch LEAFINFO of STREAM))
(fetch LOWRITE of (fetch LEAFINFO of STREAM])
(\LEAF.TRUNCATEFILE
[LAMBDA (STREAM LASTPAGE LASTOFF) (* bvm: "12-APR-83 22:14")
(* * Truncate file by doing a zero-length write with the EOF bit set)
(COND
(LASTPAGE (* Don't bother if defaulting, we have already set
correct length if so)
(PROG ((OPUP (ALLOCATE.PUP))
DATA)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.WRITE \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (create BYTEPTR
PAGE ← LASTPAGE
OFFSET ← LASTOFF))
(replace EOFBIT of DATA with 1)
(replace DATALENGTH of DATA with 0)
(replace LEAFLENGTH of DATA with \LEN.FILEREQUEST)
(\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL T)
(RETURN STREAM])
(\LEAF.WRITEPAGES
[LAMBDA (STREAM FIRSTPAGE BUFFERLIST) (* bvm: "14-AUG-83 14:02")
(for BUF inside BUFFERLIST as PAGE# from FIRSTPAGE
do (\LEAF.LOOKUPCACHE STREAM PAGE# T) (* Invalidate any read-ahead of this page)
(COND
(CHECKFORZEROS (COND
((NEQ PAGE# 0)
(COND
((NOT (IEQP (OR (GETP (fetch FULLFILENAME of STREAM)
(QUOTE LASTPAGEWRITTEN))
0)
(SUB1 PAGE#)))
(HELP "Page written out of order" FIRSTPAGE)))
(PUT (fetch FULLFILENAME of STREAM)
(QUOTE LASTPAGEWRITTEN)
PAGE#)))
(ADDPROP (fetch FULLFILENAME of STREAM)
(QUOTE PAGES)
PAGE# T)))
(PROG ((OPUP (ALLOCATE.PUP))
DATA LEN)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(replace OPWORD of DATA with (LLSH \LEAFOP.WRITE \OPCODE.SHIFT))
(replace HANDLE of DATA with (fetch LEAFHANDLE of STREAM))
(replace FILEADDRESS of DATA with (create BYTEPTR
PAGE ← PAGE#
OFFSET ← 0))
[replace DATALENGTH of DATA with (SETQ LEN (COND
((NEQ PAGE# (fetch EPAGE of STREAM))
BYTESPERPAGE)
(T (* On last page, only write as much as we really have)
(replace EOFBIT of DATA with 1)
(fetch EOFFSET of STREAM]
(\BLT (\ADDBASE DATA (FOLDLO \LEN.FILEREQUEST BYTESPERWORD))
BUF
(FOLDHI LEN BYTESPERWORD))
(replace LEAFLENGTH of DATA with (IPLUS \LEN.FILEREQUEST LEN))
(\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL T])
)
(DEFINEQ
(\LEAF.CHECKZEROS
[LAMBDA (PUP) (* bvm: "12-AUG-83 16:36")
(COND
([AND (IGREATERP (fetch DATALENGTH of (fetch PUPCONTENTS of PUP))
12Q)
(for I from 0 to 310Q as [BASE ←(LOCF (fetch LEAFFIRSTDATAWORD
of (fetch PUPCONTENTS of PUP]
by (\ADDBASE BASE 1) always (ZEROP (\GETBASE BASE 0]
(HELP "Zeros in packet" PUP])
)
(RPAQ? CHECKFORZEROS )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS CHECKFORZEROS)
)
(* Main routing point for LEAF pups)
(DEFINEQ
(\SENDLEAF
[LAMBDA (SEQUIN PUP FILENAME NOERROR NOREPLY) (* bvm: "17-MAY-83 16:48")
(PROG (RESULT)
(OR SEQUIN (RETURN (LISPERROR "FILE NOT OPEN" FILENAME)))
(replace EPUSERFIELD of PUP with FILENAME)
[replace LEAFFLAGS of PUP with (LOGOR (COND
(NOERROR \LF.ALLOWERRORS)
(T 0))
(COND
((EQ NOREPLY T)
0)
(T \LF.WANTANSWER]
(replace PUPLENGTH of PUP with (IPLUS (fetch LEAFLENGTH of (fetch PUPCONTENTS of PUP))
\PUPOVLEN))
(PUTSEQUIN SEQUIN PUP)
(RETURN (COND
(NOREPLY T)
(T (until (NEQ (fetch EPUSERFIELD of PUP)
FILENAME)
do (AWAIT.EVENT (fetch SEQEVENT of SEQUIN)
\ETHERTIMEOUT))
(SETQ RESULT (fetch EPUSERFIELD of PUP))
(COND
((EQ RESULT \LEAF.BROKEN.STATUS)
PUP)
(T (replace LEAFSTATUS of RESULT
with (COND
((EQ (fetch LEAFOPCODE of (fetch PUPCONTENTS of RESULT))
\LEAFOP.ERROR)
(fetch LEAFERRORCODE of (fetch PUPCONTENTS of RESULT)))
(T \LEAF.GOODSTATUS)))
(RELEASE.PUP PUP)
RESULT])
)
(* Managing LEAF connections)
(DEFINEQ
(BREAKCONNECTION
[LAMBDA (HOST FAST) (* bvm: "25-MAY-83 12:10")
(DECLARE (GLOBALVARS \OPENFILES))
(* * User entry. Breaks connection to host, if there is one. Currently this means Leaf connections.
Returns T if it broke something, NIL if there was nothing to break. If FAST is true, does not attempt to cleanly
close any files open on the host)
(PROG (CONNECTION FILES)
(RETURN (COND
((EQ HOST T)
(while \LEAFCONNECTIONS collect (BREAKCONNECTION (CAR \LEAFCONNECTIONS)
FAST)))
([SETQ CONNECTION (COND
((FMEMB HOST \LEAFCONNECTIONS)
HOST)
((SETQ HOST (\CANONICAL.HOSTNAME HOST))
(find CONN in \LEAFCONNECTIONS suchthat (EQ HOST (fetch SEQNAME
of CONN]
[COND
((SETQ FILES (for STREAM in \OPENFILES collect STREAM
when (EQ (fetch LEAFCONNECTION of STREAM)
CONNECTION)))
(COND
(FAST (SETQ \OPENFILES (LDIFFERENCE \OPENFILES FILES)))
(T (MAPC FILES (FUNCTION CLOSEF]
(\CLOSELEAFCONNECTION CONNECTION])
(\CLOSELEAFCONNECTION
[LAMBDA (CONN) (* bvm: "15-APR-83 22:53")
(COND
((CLOSESEQUIN CONN)
(fetch SEQNAME of CONN))
(T (LIST (fetch SEQNAME of CONN)
(QUOTE aborted])
(\CLOSELEAFCONNECTIONS
[LAMBDA (ONLYIFIDLE) (* bvm: "25-APR-83 18:14")
(for (TAIL ← \LEAFCONNECTIONS) bind CONN while TAIL
do (SETQ CONN (CAR TAIL)) (* Contorted structure because \CLOSELEAFCONNECTION does
a DREMOVE on the list we are mapping down)
(SETQ TAIL (CDR TAIL))
(COND
((AND ONLYIFIDLE (for STREAM in \OPENFILES thereis (EQ (fetch LEAFCONNECTION
of STREAM)
CONN)))
(* Can't close the connection, because a file is open on
it)
(SETQ $$VAL T))
(T (\CLOSELEAFCONNECTION CONN])
(\GETLEAFCONNECTION
[LAMBDA (IFS NOERROR) (* bvm: "19-MAY-83 11:49")
(OR (find CONN in \LEAFCONNECTIONS suchthat (EQ IFS (fetch SEQNAME of CONN)))
(WITH.MONITOR \LEAFCONNECTIONLOCK (OR [PROGN (* Test again, now that we have the lock.
Didn't want to go to the expense for every call to
\GETLEAFCONNECTION)
(find CONN in \LEAFCONNECTIONS
suchthat (EQ IFS (fetch SEQNAME of CONN]
(\OPENLEAFCONNECTION IFS)
(AND (NOT NOERROR)
(ERROR "Can't open LEAF connection" IFS])
(\OPENLEAFCONNECTION
[LAMBDA (HOST OLDSEQUIN) (* bvm: "14-JUL-83 15:32")
(PROG ((IFSPORT (ETHERPORT HOST))
NAME/PASS CONN RESULT DATA OPUP)
[COND
((NOT IFSPORT)
(RETURN))
((ZEROP (CDR IFSPORT))
(SETQ IFSPORT (CONS (CAR IFSPORT)
\SOCKET.LEAF]
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOST))
[SETQ CONN (OR OLDSEQUIN (create SEQUIN
SEQNAME ← HOST
SEQFRNPORT ← IFSPORT
OSTYPE ←(GETOSTYPE HOST)
SEQACKED ←(FUNCTION \LEAF.ACKED)
SEQINPUT ←(FUNCTION \LEAF.HANDLE.INPUT)
SEQBROKEN ←(FUNCTION \LEAF.FIX.BROKEN.SEQUIN)
SEQABORTED ←(FUNCTION \LEAF.FIX.BROKEN.SEQUIN)
SEQTIMEDOUT ←(FUNCTION \LEAF.TIMEDOUT)
SEQCLOSED ←(FUNCTION \LEAF.WHENCLOSED)
SEQIDLEFN ←(FUNCTION \LEAF.IDLE)
SEQIDLETIMEOUTCOMPUTER ←(FUNCTION \LEAF.IDLE?)
SEQDONEQ ←(NCREATE (QUOTE SYSQUEUE))
LEAFCACHETIMER ←(\CREATECELL \FIXP)
SEQIGNOREDUPLICATES ← T
LEAFOPENCLOSELOCK ←(CREATE.MONITORLOCK (CONCAT HOST
"#LEAFOPEN"]
(INITSEQUIN CONN (PACK* HOST "#LEAF"))
(push \LEAFCONNECTIONS CONN)
(replace LEAFCACHEHITS of CONN with 0)
(replace LEAFCACHEMISSES of CONN with 0)
RETRY
(PROGN (SETQ OPUP (ALLOCATE.PUP)) (* Build a LEAF RESET op)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(\ZEROBYTES DATA 0 (SUB1 \LEN.RESETLEAF))
(replace LEAFOPCODE of DATA with \LEAFOP.RESET)
(replace LEAFLENGTH of DATA with \LEN.RESETLEAF)
(\ADDLEAFSTRING OPUP (CAR NAME/PASS))
(\ADDLEAFSTRING OPUP (CDR NAME/PASS))
(replace PUPLENGTH of OPUP with (IPLUS (fetch LEAFLENGTH of DATA)
\PUPOVLEN)))
(replace EPUSERFIELD of OPUP with NIL)
(replace LEAFFLAGS of OPUP with (LOGOR \LF.ALLOWERRORS \LF.WANTANSWER))
(PUTSEQUIN CONN OPUP)
(until (SELECTC (fetch SEQSTATE of CONN)
(\SS.OPENING (* still waiting for an answer)
NIL)
(\SS.OPEN (* Connection has become open, or already was if this is
a retry)
(SETQ RESULT (fetch EPUSERFIELD of OPUP)))
(PROGN (* Some bad state)
(SETQ RESULT (fetch EPUSERFIELD of OPUP))
T))
do (AWAIT.EVENT (fetch SEQEVENT of CONN)
\ETHERTIMEOUT))
(SELECTC RESULT
((LIST NIL \LEAF.BROKEN.STATUS \LEAF.NEVER.OPENED)
(RETURN NIL))
NIL)
(COND
((EQ (fetch LEAFOPCODE of (fetch PUPCONTENTS of RESULT))
\LEAFOP.ERROR)
(SELECTC (SETQ RESULT (PROG1 (fetch LEAFERRORCODE of (fetch PUPCONTENTS of RESULT))
(RELEASE.PUP RESULT)))
[\PASSWORD.ERRORS (* Password error)
(COND
((SETQ NAME/PASS (\FIXPASSWORD RESULT CONN))
(GO RETRY]
NIL)
(RETURN NIL)))
(RELEASE.PUP RESULT)
(PROGN (SETQ OPUP (ALLOCATE.PUP)) (* Build a LEAF PARAMS op)
(SETQ DATA (fetch PUPCONTENTS of OPUP))
(\ZEROBYTES DATA 0 (SUB1 \LEN.LEAFPARAMS))
(replace LEAFOPCODE of DATA with \LEAFOP.PARAMS)
(replace LEAFLENGTH of DATA with \LEN.LEAFPARAMS)
(replace LEAFPCONNTIMEOUT of DATA with (ITIMES 2 (IQUOTIENT \LEAF.IDLETIMEOUT 11610Q)
))
(* Make server timeout connection in twice the time that
we would time it out ourselves)
(replace PUPLENGTH of OPUP with (IPLUS \LEN.LEAFPARAMS \PUPOVLEN)))
(replace EPUSERFIELD of OPUP with NIL)
(replace LEAFFLAGS of OPUP with \LF.ALLOWERRORS)
(PUTSEQUIN CONN OPUP)
(RETURN CONN])
(\LEAF.EVENTFN
[LAMBDA (FDEV FLG) (* bvm: " 9-AUG-83 15:55")
(DECLARE (GLOBALVARS \OPENFILES)) (* Called before LOGOUT etc to clean up any leaf
connections we have open)
(SELECTQ FLG
(BEFORELOGOUT (\CLOSELEAFCONNECTIONS))
((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(for SEQUIN in \LEAFCONNECTIONS do (replace SEQSTATE of SEQUIN with \SS.ABORT))
(SETQ \HOSTNAMES)
(SETQ \LEAFCONNECTIONS))
NIL])
)
(* Functions called when various SEQUIN events occur)
(DEFINEQ
(\LEAF.ACKED
[LAMBDA (PUP SEQUIN) (* bvm: "13-APR-83 12:46")
(* Called when a packet has been acked)
(\ENQUEUE (fetch SEQDONEQ of SEQUIN)
PUP])
(\LEAF.FIX.BROKEN.SEQUIN
[LAMBDA (SEQUIN PUP) (* bvm: "29-JUN-83 12:46")
(* Called when BROKEN received.
Try to open a new connection, and transfer everything
over)
(PROG ((STATE (fetch SEQSTATE of SEQUIN))
(RETRANSQ (fetch SEQRETRANSMITQ of SEQUIN))
(ACKEDQ (fetch SEQDONEQ of SEQUIN))
UNANSWEREDPUPS AFFECTEDFILES NEWCONNECTION STRM)
(\SEQUIN.FLUSH.RETRANSMIT SEQUIN)
[COND
(PUP (* Attempt to send PUP on a broken connection)
(COND
((NOT (FMEMB SEQUIN \LEAFCONNECTIONS))
(RETURN (\LEAF.REPAIR.BROKEN.PUP PUP)))
(T (GO FAILURE]
[COND
((SETQ UNANSWEREDPUPS (fetch SYSQUEUEHEAD of ACKEDQ))
(* There were acked but not answered packets, so process
them ahead of the unacked ones)
(replace EPLINK of (fetch SYSQUEUETAIL of ACKEDQ) with (fetch SYSQUEUEHEAD
of RETRANSQ))
(replace SYSQUEUEHEAD of ACKEDQ with (replace SYSQUEUETAIL of ACKEDQ with NIL)))
(T (SETQ UNANSWEREDPUPS (fetch SYSQUEUEHEAD of RETRANSQ]
(SELECTC STATE
[\SS.OPENING
(* Probably means we crashed on this local machine a while back using exactly the same socket number, so leaf
thinks we're confused. This virtually never happens now that we choose Pup sockets more cleverly)
(COND
((AND UNANSWEREDPUPS (NOT (fetch EPLINK of UNANSWEREDPUPS))
(EQ (fetch LEAFOPCODE of (fetch PUPCONTENTS of UNANSWEREDPUPS)
)
\LEAFOP.RESET))
[replace SEQSOCKET of SEQUIN
with (PROG1 (OPENPUPSOCKET)
(* Get a new socket and try again)
(CLOSEPUPSOCKET (fetch SEQSOCKET of SEQUIN]
(replace PUPSOURCESOCKET of UNANSWEREDPUPS with 0)
(* Let SENDPUP fill in the new socket)
(RETURN (\SEQUIN.RETRANSMIT SEQUIN)))
(T (GO FAILURE]
[(LIST \SS.OPEN \SS.CLOSING)
(COND
((NULL UNANSWEREDPUPS) (* No activity has gone unanswered here, so safe to just
abort the connection)
(\SEQUIN.FLUSH.CONNECTION SEQUIN)
(RETURN T]
(GO FAILURE))
(* * This SEQUIN is bad, probably because of a file server crash (or we were idle a long time and it timed us out)
so flush it and try to establish a new one, retransmitting anything that wasn't yet answered)
(replace SYSQUEUEHEAD of RETRANSQ with (replace SYSQUEUETAIL of RETRANSQ with NIL))
(* Detach old queues of packets from dead connection)
(printout PROMPTWINDOW "[Connection with " (fetch SEQNAME of SEQUIN)
" crashed; recovering...")
(\SEQUIN.FLUSH.CONNECTION SEQUIN)
(SETQ AFFECTEDFILES (for STREAM in \OPENFILES when (EQ (fetch LEAFCONNECTION of STREAM)
SEQUIN)
collect (* Gather up OFDS of all files on the old leaf
connection)
STREAM))
[COND
((SETQ NEWCONNECTION (\OPENLEAFCONNECTION (fetch SEQNAME of SEQUIN)))
(* Succeeded in getting a new connection, so restore
files)
(COND
((NOT (SETQ UNANSWEREDPUPS (\LEAF.USE.NEW.CONNECTION NEWCONNECTION UNANSWEREDPUPS
AFFECTEDFILES)))
(printout PROMPTWINDOW "done]" T)
(RETURN T]
(* * Either failed to make the new connection or something happened to the file)
FAILURE
(ERROR "File server connection has been broken--cannot complete file operation"
(COND
((AND PUP (SETQ STRM (fetch EPUSERFIELD of PUP)))
(.NAMEORSTREAM. STRM))
(T (fetch SEQNAME of SEQUIN])
(\LEAF.REPAIR.BROKEN.PUP
[LAMBDA (PUP) (* bvm: "22-APR-83 01:12")
(* PUP is a pup that we were trying to send on a dead sequin. If we have since established the new connection,
there is a new sequin in PUP's stream, and we can patch the pup. Returns the new connection, or NIL if it can't)
(PROG ((STREAM (fetch EPUSERFIELD of PUP))
NEWCONNECTION DATA)
(RETURN (COND
((NULL STREAM)
(replace LEAFSTATUS of PUP with \LEAF.BROKEN.STATUS)
NIL)
((AND (SETQ NEWCONNECTION (fetch LEAFCONNECTION of STREAM))
(EQ (fetch SEQSTATE of NEWCONNECTION)
\SS.OPEN)
(SELECTC (fetch LEAFOPCODE of (SETQ DATA (fetch PUPCONTENTS of PUP)))
((LIST \LEAFOP.READ \LEAFOP.WRITE \LEAFOP.TRUNCATE \LEAFOP.DELETE
\LEAFOP.CLOSE) (* These operations all have their handle in the same
place)
(replace (LEAFDATA HANDLE) of DATA with (fetch LEAFHANDLE
of STREAM))
T)
NIL))
NEWCONNECTION)
(T (LISPERROR "FILE NOT OPEN" (OR (fetch FULLFILENAME of STREAM)
STREAM))
NIL])
(\LEAF.USE.NEW.CONNECTION
[LAMBDA (SEQUIN UNSENTPUPS AFFECTEDFILES) (* bvm: "22-APR-83 00:21")
(PROG (BUSYFILES OPCODE OLDSTREAM PUP DATA GOODPUPS BADPUPS RESENDPUPS)
(while UNSENTPUPS
do [SETQ PUP (PROG1 UNSENTPUPS (SETQ UNSENTPUPS (fetch EPLINK of UNSENTPUPS]
(replace EPLINK of PUP with NIL)
(SELECTC [SETQ OPCODE (fetch LEAFOPCODE of (SETQ DATA (fetch PUPCONTENTS
of PUP]
[(LIST \LEAFOP.READ \LEAFOP.WRITE \LEAFOP.TRUNCATE \LEAFOP.DELETE)
(* These operations all have their handle in the same
place)
(COND
((SETQ OLDSTREAM (fetch EPUSERFIELD of PUP))
(pushnew AFFECTEDFILES OLDSTREAM)
(pushnew BUSYFILES OLDSTREAM)
(push GOODPUPS PUP))
(T (* Shouldn't happen)
(push BADPUPS PUP]
[\LEAFOP.CLOSE (COND
((SETQ OLDSTREAM (fetch EPUSERFIELD of PUP))
(COND
((FMEMB OLDSTREAM BUSYFILES)
(* There are other operations on this file, so include
the close)
(push GOODPUPS PUP))
((DIRTYABLE OLDSTREAM)
(push BUSYFILES OLDSTREAM))
(T (* Closing a file open only for read;
don't bother)
(SETQ AFFECTEDFILES (DREMOVE OLDSTREAM AFFECTEDFILES]
(\LEAFOP.OPEN
(* just trying to open a file, so should work fine with the new connection; however, \LEAF.GETFILE needs to know
to use the new connection, so easier to just mark it broken here)
(replace LEAFSTATUS of PUP with \LEAF.BROKEN.STATUS))
(push BADPUPS PUP)))
(for STREAM in (UNION BUSYFILES AFFECTEDFILES) when (DIRTYABLE STREAM)
do (printout T T "*****Warning: " (fetch FULLFILENAME of STREAM)
" was open for write during a file server crash; data may be lost" T T))
(COND
(AFFECTEDFILES (SETQ AFFECTEDFILES (\REVALIDATEFILELST AFFECTEDFILES))
(* Reopen those files, make sure they still exist and
haven't been modified)
))
[for PUP in GOODPUPS
do (* Do operation with new handle)
(COND
((FMEMB (SETQ OLDSTREAM (fetch EPUSERFIELD of PUP))
AFFECTEDFILES)
(replace (LEAFDATA HANDLE) of (fetch PUPCONTENTS of PUP)
with (fetch LEAFHANDLE of OLDSTREAM))
(push RESENDPUPS PUP))
(T (push BADPUPS PUP]
[COND
(RESENDPUPS (ADD.PROCESS (LIST (QUOTE \LEAF.RESENDPUPS)
(KWOTE SEQUIN)
(KWOTE RESENDPUPS]
(RETURN BADPUPS])
(\LEAF.RESENDPUPS
[LAMBDA (SEQUIN PUPS) (* bvm: "17-APR-83 18:10")
(while PUPS
do (replace PUPSOURCESOCKET of (CAR PUPS) with 0)
(PUTSEQUIN SEQUIN (pop PUPS])
(\LEAF.HANDLE.INPUT
[LAMBDA (PUP SEQUIN) (* bvm: " 9-AUG-83 18:49")
(* Called when a data sequin arrives)
(PROG ((PUPDATA (fetch PUPCONTENTS of PUP))
DONEPUP DONEPUPDATA ERROR OPCODE)
(* * Under current scheme, where every requesting packet is responded to by exactly one packet, we "know" that PUP
matches up with the head of SEQDONEQ. The error checking here is thus for protocol violation and is optional)
(SETQ DONEPUP (\DEQUEUE (fetch SEQDONEQ of SEQUIN)))
[COND
((ZEROP (fetch ANSWERBIT of PUPDATA))
(HELP "Leaf Protocol violation--will terminate connection" (fetch SEQNAME of SEQUIN))
(RETURN (RELEASE.PUP PUP)))
((NOT DONEPUP)
(RETURN (SHOULDNT "Leaf lost a packet somewhere!"]
(COND
((EQ (SETQ OPCODE (fetch LEAFOPCODE of PUPDATA))
\LEAFOP.ERROR)
(SETQ OPCODE (fetch LEAFERROROPCODE of PUPDATA))
(SETQ ERROR T)))
(COND
[(AND LEAFDEBUGFLG (NEQ (fetch LEAFOPCODE of (SETQ DONEPUPDATA (fetch PUPCONTENTS
of DONEPUP)))
OPCODE)) (* Protocol violation, but the buggy Vax server does
this)
(COND
(LEAFDEBUGFLG (HELP "Answer does not match head of done queue" PUP]
((AND ERROR (NOT (fetch LEAFALLOWERRORS of DONEPUP)))
(replace LEAFSTATUS of PUP with (fetch LEAFERRORCODE of DONEPUPDATA))
(ADD.PROCESS (LIST (QUOTE \LEAF.ERROR)
PUP
(KWOTE (PROG1 (fetch EPUSERFIELD of DONEPUP)
(replace EPUSERFIELD of DONEPUP with PUP)))
SEQUIN)))
((fetch LEAFANSWERWANTED of DONEPUP) (* Match the request with its response;
requestor will watch this slot.
Eventually change this to a NOTIFY)
(replace EPUSERFIELD of DONEPUP with PUP))
(T (RELEASE.PUP PUP)
(RELEASE.PUP DONEPUP])
(\LEAF.TIMEDOUT
[LAMBDA (SEQUIN) (* bvm: "27-JUL-83 22:05")
(* The SEQTIMEDOUT fn for LEAF)
(PROG ((STATE (fetch SEQSTATE of SEQUIN))
PUP)
(SELECTC STATE
(\SS.OPENING (* can't open connection)
(printout PROMPTWINDOW T "[" (fetch SEQNAME of SEQUIN)
" not responding to Leaf connection attempt]")
(\SEQUIN.FLUSH.CONNECTION SEQUIN))
[\SS.OPEN (printout PROMPTWINDOW T "[" (fetch SEQNAME of SEQUIN)
" not responding")
[COND
((SETQ PUP (\LEAF.STREAM.IN.QUEUE SEQUIN))
(printout PROMPTWINDOW " for " (.NAMEORSTREAM. PUP]
(printout PROMPTWINDOW "]")
(COND
(PUPTRACEFLG (printout PUPTRACEFILE T "[" (fetch SEQNAME of SEQUIN)
" not responding]" T]
(\SS.CLOSING [COND
((NULL (SETQ PUP (\LEAF.STREAM.IN.QUEUE SEQUIN T)))
(* Safe to abort connection, since no information left
to be acked)
(COND
(PUPTRACEFLG (printout PUPTRACEFILE T
"[File server connection to "
(fetch SEQNAME of SEQUIN)
" aborted]")))
(RETURN (\SEQUIN.FLUSH.CONNECTION SEQUIN]
(printout PROMPTWINDOW T "[" (fetch SEQNAME of SEQUIN)
" not responding" " for " (.NAMEORSTREAM. PUP)
"]"))
NIL])
(\LEAF.STREAM.IN.QUEUE
[LAMBDA (SEQUIN IMPORTANT) (* bvm: "27-JUL-83 22:04")
(* Examines queue of SEQUIN requests that have not yet been answered, and returns one that has a stream associated
with it. If IMPORTANT is true, only returns one with "important" operations pending: write request, or close
request for a file that is open for write)
(PROG ((PUP (fetch SYSQUEUEHEAD of (fetch SEQDONEQ of SEQUIN)))
(FIRSTTIME T)
X)
LP (COND
[(NULL PUP)
(COND
(FIRSTTIME (SETQ FIRSTTIME NIL)
(SETQ PUP (fetch SYSQUEUEHEAD of (fetch SEQRETRANSMITQ of SEQUIN)))
(GO LP))
(T (RETURN]
([AND (SETQ X (fetch EPUSERFIELD of PUP))
(OR (NOT (type? STREAM X))
(fetch FULLFILENAME of X))
(OR (NOT IMPORTANT)
(AND (type? STREAM X)
(DIRTYABLE X)
(SELECTC (fetch LEAFOPCODE of (fetch PUPCONTENTS of PUP))
((LIST \LEAFOP.WRITE \LEAFOP.CLOSE \LEAFOP.TRUNCATE)
T)
NIL]
(RETURN X)))
(SETQ PUP (fetch EPLINK of PUP))
(GO LP])
(\LEAF.IDLE
[LAMBDA (SEQUIN) (* bvm: "20-APR-83 11:16")
(* Called after a suitable timeout with no activity on
connection)
(PROG ((CACHE (fetch LEAFCACHEDFILE of SEQUIN)))
(COND
[CACHE (COND
((fetch LEAFREALLYOPEN of CACHE)
(replace LEAFCACHEDFILE of SEQUIN with NIL))
(T (\LEAF.CLOSEFILE CACHE NIL NIL T]
((for FILE in \OPENFILES thereis (EQ (fetch LEAFCONNECTION of FILE)
SEQUIN)) (* Keep activity on this connection)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.NOOP))
(T (replace LEAFCLOSING of SEQUIN with T)
(\SEQUIN.CLOSE SEQUIN])
(\LEAF.WHENCLOSED
[LAMBDA (SEQUIN FINALSTATE REASON) (* bvm: "14-JUL-83 15:30")
(PROG [PUP (CODE (COND
((EQ REASON \SS.NOSOCKET)
\LEAF.NEVER.OPENED)
(T \LEAF.BROKEN.STATUS]
(replace LEAFCACHEDFILE of SEQUIN with NIL) (* Break this potential circular link)
(while (SETQ PUP (\DEQUEUE (fetch SEQDONEQ of SEQUIN)))
do (replace LEAFSTATUS of PUP with CODE))
(while (SETQ PUP (\DEQUEUE (fetch (SEQUIN SEQRETRANSMITQ) of SEQUIN)))
do (replace LEAFSTATUS of PUP with CODE))
(SETQ \LEAFCONNECTIONS (DREMOVE SEQUIN \LEAFCONNECTIONS])
(\LEAF.IDLE?
[LAMBDA (SEQUIN) (* bvm: "15-APR-83 13:13")
(* Tells SEQUIN process how long to block when it
otherwise has nothing to do, i.e. no packets remain
unacked)
(COND
((fetch (SYSQUEUE SYSQUEUEHEAD) of (fetch SEQDONEQ of SEQUIN))
(* Still waiting for something)
NIL)
((fetch LEAFCACHEDFILE of SEQUIN)
\LEAF.CACHETIMEOUT)
(T (* For now, wait forever)
\LEAF.IDLETIMEOUT])
)
(ADDTOVAR \LEAFCONNECTIONS )
(ADDTOVAR \HOSTNAMES )
(ADDTOVAR NETWORKOSTYPES )
(* Miscellaneous and error handling)
(DEFINEQ
(\ADDLEAFSTRING
[LAMBDA (PUP STRING) (* bvm: "31-JAN-83 17:04")
(PROG ((PUPBASE (fetch PUPCONTENTS of PUP))
LEAFLEN STRLEN STRBASE STROFF NEWLENGTH)
(SETQ LEAFLEN (CEIL (fetch LEAFLENGTH of PUPBASE)
BYTESPERWORD)) (* Round Length up to next word--strings must be
word-aligned)
[COND
((NULL STRING)
(SETQ STRLEN 0))
((LITATOM STRING)
(SETQ STRBASE (fetch (LITATOM PNAMEBASE) of STRING))
(SETQ STROFF 1)
(SETQ STRLEN (fetch (LITATOM PNAMELENGTH) of STRING)))
(T (OR (STRINGP STRING)
(SETQ STRING (MKSTRING STRING)))
(SETQ STRBASE (fetch (STRINGP BASE) of STRING))
(SETQ STROFF (fetch (STRINGP OFFST) of STRING))
(SETQ STRLEN (fetch (STRINGP LENGTH) of STRING]
(COND
((IGREATERP (SETQ NEWLENGTH (IPLUS LEAFLEN STRLEN BYTESPERWORD))
\MAX.PUPLENGTH)
(ERROR "PUP OVERFLOW" PUP)))
(\PUTBASE PUPBASE (FOLDLO LEAFLEN BYTESPERWORD)
STRLEN)
(COND
((NOT (ZEROP STRLEN))
(\MOVEBYTES STRBASE STROFF PUPBASE (IPLUS LEAFLEN BYTESPERWORD)
STRLEN)))
(replace LEAFLENGTH of PUPBASE with NEWLENGTH])
(\CANONICAL.HOSTNAME
[LAMBDA (NAME) (* bvm: "24-JUL-81 17:05")
(DECLARE (GLOBALVARS FIXSPELLREL))
(* * Returns the canonical name of a given hostname, in case a server has synonyms)
(OR (CDR (FASSOC NAME \HOSTNAMES))
(PROG ((PORT (ETHERPORT NAME))
OFFICIALNAME)
(RETURN (COND
(PORT (SETQ \HOSTNAMES (CONS [CONS NAME (SETQ OFFICIALNAME
(U-CASE (OR (ETHERHOSTNAME PORT)
NAME]
\HOSTNAMES))
(* If no name in database, take what was given)
OFFICIALNAME)
((AND \HOSTNAMES (SETQ NAME (FIXSPELL NAME FIXSPELLREL \HOSTNAMES T)))
(\CANONICAL.HOSTNAME NAME])
(\FIXPASSWORD
[LAMBDA (ERRCODE CONNECTION DIRECTORY) (* bvm: "12-APR-83 21:37")
(* Called when a username or password error occurs. ERRCODE is the IFS errorcode (name or password error).
Attempts to get new name and/or password for use on CONNECTION. If DIRECTORY is specified, it is a connect error
to that directory)
(\INTERNAL/GETPASSWORD (fetch SEQNAME of CONNECTION)
(NEQ ERRCODE \IFSERROR.PROTECTION)
DIRECTORY
(SELECTC ERRCODE
(\IFSERROR.PASSWORD "Incorrect password")
((LIST \IFSERROR.USERNAME \IFSERROR.NEED.USERNAME)
"Invalid username")
(\IFSERROR.CONNECTPASSWORD "Incorrect connect password")
(\IFSERROR.CONNECTNAME "Invalid connect name")
(\IFSERROR.PROTECTION "Protection violation")
(\IFSERROR.NO.LOGIN "Can't login as files-only directory")
"Unknown error"])
(\GETLEAFSTRING
[LAMBDA (ADDR) (* bvm: "30-MAR-83 17:39")
(* Retrieves the IFS string starting at ADDR.
IFS string has length in its first word)
(PROG ((LEN (\GETBASE ADDR 0)))
(RETURN (AND (IGREATERP LEN 0)
(\GETBASESTRING ADDR 2 LEN])
(\IFSERRORSTRING
[LAMBDA (CODE FILENAME CONNECTION) (* bvm: "12-APR-83 21:37")
(* Returns the error string associated with IFS error CODE. FILENAME is the name of the file that caused the error
(used for recursion break); CONNECTION is the leaf connection on which the error occurred)
(COND
((NOT (AND FILENAME (EQ FILENAME \IFSERRORFILENAME)))
(PROG ([ERRFILE (CAR (NLSETQ (OPENFILE (SETQ \IFSERRORFILENAME
(PACK* (QUOTE {)
(fetch SEQNAME of (OR CONNECTION
(CAR \LEAFCONNECTIONS)
(ERROR
"No LEAF connections open")))
"}<SYSTEM>IFS.ERRORS"))
(QUOTE INPUT]
(EOL (FCHARACTER (CHARCODE EOL)))
START LEN RESULT)
(* * This is a text file containing entries that look like "$$<error code> <error message>". Entries can extend
over one line. Entries are sorted by error code, but I don't make use of that knowledge in the brute force
procedure below)
(RETURN (COND
(ERRFILE (SETQ \IFSERRORFILENAME ERRFILE)
(* In case an error happens while scanning file, update
this var to correct value)
(PROG1 (COND
((SETQ START (FFILEPOS (CONCAT EOL "$$" CODE " ")
ERRFILE 0 NIL NIL T))
(SETQ LEN (IDIFFERENCE (OR (FFILEPOS (CONCAT EOL "$$")
ERRFILE START)
(GETEOFPTR ERRFILE))
START))
(* Length of entry)
(SETQ RESULT (ALLOCSTRING LEN))
(SETFILEPTR ERRFILE START)
(for I from 1 to LEN bind (STREAM ←(GETOFD ERRFILE))
do (RPLCHARCODE RESULT I (\BIN STREAM)))
RESULT))
(CLOSEF ERRFILE])
(\LEAF.ERROR
[LAMBDA (PUP FILENAME CONNECTION) (* bvm: "21-MAY-83 17:00")
(PROG ((DATA (fetch PUPCONTENTS of PUP))
ERRCODE MSG)
(RETURN (SELECTC (SETQ ERRCODE (fetch LEAFERRORCODE of DATA))
(\IFSERROR.FILE.NOT.FOUND (LISPERROR "FILE NOT FOUND" FILENAME))
(\IFSERROR.MALFORMED (LISPERROR "BAD FILE NAME" FILENAME))
(\IFSERROR.ALLOCATION (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" FILENAME)
)
(PROGN (SETQ MSG (CONCAT "Leaf error: "
(OR [AND (IGREATERP (fetch PUPLENGTH
of PUP)
\SHORT.ERROR.PUPLEN)
(\GETLEAFSTRING (LOCF (fetch
LEAFERRORMSG
of DATA]
(\IFSERRORSTRING ERRCODE FILENAME CONNECTION)
ERRCODE)))
(COND
((EQ (fetch LEAFERROROPCODE of DATA)
\LEAFOP.OPEN)
(printout PROMPTWINDOW T MSG T)
(LISPERROR "FILE WON'T OPEN" FILENAME))
(T (ERROR MSG FILENAME])
(\LEAF.DIRECTORYNAMEONLY
[LAMBDA (FILENAME) (* bvm: "19-NOV-81 11:34")
(PROG ((DIR (FILENAMEFIELD FILENAME (QUOTE DIRECTORY)))
N)
(RETURN (COND
((SETQ N (STRPOS (QUOTE >)
DIR))
(SUBATOM DIR 1 (SUB1 N)))
(T DIR])
(GETOSTYPE
[LAMBDA (HOST) (* bvm: "16-OCT-81 15:42")
(CDR (FASSOC HOST NETWORKOSTYPES])
)
(DEFINEQ
(\LEAFINIT
(LAMBDA NIL (* JonL "19-JUL-83 03:23")
(SETQ \LEAFCONNECTIONLOCK (CREATE.MONITORLOCK (QUOTE LEAF)))
(\DEFINEDEVICE NIL (SETQ \LEAFDEVICE (create FDEV
DEVICENAME ←(FUNCTION LEAF)
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← T
CLOSEFILE ←(FUNCTION \LEAF.CLOSEFILE)
DELETEFILE ←(FUNCTION \LEAF.DELETEFILE)
GETFILEINFO ←(FUNCTION \LEAF.GETFILEINFO)
OPENFILE ←(FUNCTION \LEAF.OPENFILE)
READPAGES ←(FUNCTION \LEAF.READPAGES)
WRITEPAGES ←(FUNCTION \LEAF.WRITEPAGES)
SETFILEINFO ←(FUNCTION \LEAF.SETFILEINFO)
TRUNCATEFILE ←(FUNCTION \LEAF.TRUNCATEFILE)
GETFILENAME ←(FUNCTION \LEAF.GETFILENAME)
REOPENFILE ←(FUNCTION \LEAF.REOPENFILE)
GENERATEFILES ←(FUNCTION \LEAF.GENERATEFILES)
EVENTFN ←(FUNCTION \LEAF.EVENTFN)
DIRECTORYNAMEP ←(FUNCTION \LEAF.DIRECTORYNAMEP)
HOSTNAMEP ←(FUNCTION \LEAF.DEVICEP)
READP ←(FUNCTION \PAGEDREADP)
BIN ←(FUNCTION \PAGEDBIN)
BOUT ←(FUNCTION \PAGEDBOUT)
PEEKBIN ←(FUNCTION \PAGEDPEEKBIN)
BACKFILEPTR ←(FUNCTION \PAGEDBACKFILEPTR)
SETFILEPTR ←(FUNCTION \PAGEDSETFILEPTR)
GETFILEPTR ←(FUNCTION \PAGEDGETFILEPTR)
GETEOFPTR ←(FUNCTION \PAGEDGETEOFPTR)
EOFP ←(FUNCTION \PAGEDEOFP)
BLOCKIN ←(FUNCTION \PAGEDBINS)
BLOCKOUT ←(FUNCTION \PAGEDBOUTS)
RENAMEFILE ←(FUNCTION \LEAF.RENAMEFILE))))))
)
(DECLARE: DONTEVAL@LOAD
(\LEAFINIT)
)
(DEFINEQ
(PRINTLEAF
[LAMBDA (PUP) (* bvm: "13-AUG-83 17:10")
(* * Prints a LEAF pup. Called from PRINTPUP)
(PROG ((LENGTH (IDIFFERENCE (fetch PUPLENGTH of PUP)
\PUPOVLEN))
DATA OP START HI LO MACRO NBYTES)
(COND
((EQ (fetch SEQCONTROL of PUP)
\SEQUIN.DATA)
(printout NIL "SequinData"))
(T (printout NIL "SequinOp = ")
(PRINTCONSTANT (fetch SEQCONTROL of PUP)
SEQUINOPS NIL "\SEQUIN.")))
(printout NIL ", alloc = " .P2 (fetch ALLOCATE of PUP)
", recv = " .P2 (fetch RECEIVESEQ of PUP)
", send = " .P2 (fetch SENDSEQ of PUP)
T)
[COND
((IGREATERP LENGTH 0)
(SETQ DATA (fetch PUPCONTENTS of PUP))
(printout NIL "Leaf")
(COND
((SETQ OP (SELECTC (fetch LEAFOPCODE of DATA)
(\LEAFOP.OPEN "Open")
(\LEAFOP.CLOSE "Close")
(\LEAFOP.READ "Read")
(\LEAFOP.WRITE "Write")
(\LEAFOP.ERROR "Error")
NIL))
(printout NIL OP))
(T (printout NIL "Op = ")
(PRINTCONSTANT (fetch LEAFOPCODE of DATA)
LEAFOPCODES NIL "\LEAFOP.")))
(COND
((EQ (fetch ANSWERBIT of DATA)
1)
(printout NIL " (ans)")))
(COND
((AND (EQ (fetch OPCODE of DATA)
\LEAFOP.WRITE)
(EQ (fetch EOFBIT of DATA)
1))
(printout NIL " (eof)")))
(COND
((NEQ (fetch LEAFLENGTH of DATA)
LENGTH)
(printout NIL ", length = " .P2 (fetch LEAFLENGTH of DATA)
" [but Pup Length = header + " .P2 LENGTH "!]")))
(printout NIL ", Handle = " .P2 (fetch HANDLE of DATA))
(COND
([AND (IGREATERP LENGTH (SETQ START 4))
(SETQ MACRO
(SELECTC (fetch LEAFOPCODE of DATA)
[\LEAFOP.OPEN (COND
((ZEROP (fetch ANSWERBIT of DATA))
(QUOTE ("Mode: " WORDS 6 " Login: " CHARS
IFSSTRING ; BYTES IFSSTRING
" Connect: "
CHARS IFSSTRING ; BYTES IFSSTRING
" File: "
CHARS IFSSTRING)))
(T (QUOTE ("FileLength = " INTEGER 10Q ...]
(\LEAFOP.RESET (QUOTE ("Login: " CHARS IFSSTRING BYTES)))
[(LIST \LEAFOP.READ \LEAFOP.WRITE)
(SETQ HI (SIGNED (fetch (LEAFDATA JUSTHIADDR) of DATA)
13Q))
(SETQ LO (fetch (LEAFDATA LOADDR) of DATA))
(SETQ NBYTES (fetch (LEAFDATA DATALENGTH) of DATA))
[COND
[(AND (EVENP NBYTES BYTESPERPAGE)
(IGEQ HI 0))
[printout NIL ", Page " .P2 (SETQ LO (IPLUS (FOLDLO LO
BYTESPERPAGE)
(LLSH HI 7]
(COND
((IGREATERP NBYTES BYTESPERPAGE)
(printout NIL " thru " .P2 (IPLUS LO (FOLDLO NBYTES
BYTESPERPAGE)
-1]
(T (printout NIL T .P2 NBYTES " bytes from " .P2
(\MAKENUMBER (UNSIGNED HI BITSPERWORD)
LO]
(COND
((SELECTC (fetch LEAFOPCODE of DATA)
(\LEAFOP.WRITE (ZEROP (fetch ANSWERBIT of DATA)))
(IGREATERP LENGTH 12Q))
(SETQ START 12Q)
(QUOTE ("Data: " CHARS 24Q ...]
(\LEAFOP.ERROR (QUOTE ("Error op: " WORDS 6 "Error handle: " 10Q
IFSSTRING)))
(QUOTE (BYTES]
(TERPRI)
(PRINTPACKETDATA DATA START MACRO LENGTH))
(T (TERPRI]
(TERPRI))
PUP])
)
(ADDTOVAR PUPPRINTMACROS (260Q . PRINTLEAF))
(RPAQ? LEAFDEBUGFLG )
(RPAQ? \MAXLEAFTRIES 6)
(RPAQ? NOFILEPROPERROR )
(RPAQ? DEFAULTFILETYPE (QUOTE TEXT))
(RPAQ? \SEQUIN.TIMEOUTMAX 23420Q)
(RPAQ? \LEAF.IDLETIMEOUT 6673500Q)
(RPAQ? \LEAF.CACHETIMEOUT 1111740Q)
(RPAQ? \LEAF.MAXCACHE 12Q)
(RPAQ? \LEAF.MAXLOOKAHEAD 4)
(RPAQ? \FTPAVAILABLE )
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD LEAFDATA ((OPWORD WORD)
(HANDLE WORD)
(FILEADDRESS FIXP)
(DATALENGTH WORD)
(LEAFFIRSTDATAWORD WORD)) (* Format of typical file operation request.)
(BLOCKRECORD LEAFDATA ((LEAFOPCODE BITS 5)
(ANSWERBIT BITS 1)
(LEAFLENGTH BITS 12Q)
(NIL WORD)
(READWRITEMODE BITS 2)
(EOFBIT BITS 1)
(NIL BITS 2)
(JUSTHIADDR BITS 13Q)
(LOADDR WORD)) (* Details of the file address format)
(SYNONYM LEAFOPCODE (OPCODE)))
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
(SIGNEXTEND BITS 5)
(NIL BITS 33Q)) (* more details)
)
(BLOCKRECORD LEAFDATA ((NIL 2 WORD)
(OPENMODE WORD)) (* format of OPEN file request)
)
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
(LEAFFILETYPE WORD)
(LEAFBYTESIZE WORD)) (* For accessing the file's TYPE)
)
(BLOCKRECORD LEAFDATA ((NIL 5 WORD)
(LEAFFILEDATE FIXP)) (* Format of SETFILEINFO of CREATIONDATE request)
))
(BLOCKRECORD LEAFERRORDATA ((NIL WORD)
(LEAFERRORCODE WORD) (* Error subcode in ERROR leafop)
(LEAFERROROPCODE BITS 5) (* The OPCODE in the Leaf packet provoking the error)
(NIL BITS 13Q)
(LEAFERRORHANDLE WORD) (* The handle in the provoking op)
(LEAFERRORMSG WORD) (* Actually IFSSTRING starting here)
))
(BLOCKRECORD LEAFPARAMSDATA ((NIL WORD)
(LEAFPMAXDATALENGTH WORD)
(LEAFPLOCKTIMEOUT WORD) (* File Lock timeout, in units of 5 seconds)
(LEAFPCONNTIMEOUT WORD) (* Overall connection timeout, same units)
))
(ACCESSFNS LEAFPACKET [(LEAFSTATUS (fetch EPUSERFIELD of DATUM)
(replace EPUSERFIELD of DATUM with NEWVALUE))
(LEAFFLAGS (fetch EPFLAGS of DATUM)
(replace EPFLAGS of DATUM with NEWVALUE))
[LEAFANSWERWANTED (NOT (ZEROP (LOGAND (fetch EPFLAGS of DATUM)
\LF.WANTANSWER]
(LEAFALLOWERRORS (NOT (ZEROP (LOGAND (fetch EPFLAGS of DATUM)
\LF.ALLOWERRORS])
(BLOCKRECORD LEAFINFOBLOCK ((LFCREATIONDATE FIXP)
(LFWRITEDATE FIXP)
(LFREADDATE FIXP)) (* just like leader page)
(BLOCKRECORD LEAFINFOBLOCK ((HICREATE WORD)
(LOCREATE WORD)
(HIWRITE WORD)
(LOWRITE WORD)
(HIREAD WORD)
(LOREAD WORD)) (* for VALIDATION use)
)
(CREATE (\ALLOCBLOCK 3)))
(ACCESSFNS LEAFSTREAM ((LEAFCONNECTION (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(LEAFHANDLE (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(LEAFPAGECACHE (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(LEAFINFO (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(LEAFREALLYOPEN (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))
(LEAFCACHECNT (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE)))
(CREATE (create STREAM
DEVICE ← \LEAFDEVICE)))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS PUPTRACING MACRO [NIL (AND PUPTRACEFLG (NEQ PUPTRACEFLG (QUOTE %.])
(PUTPROPS .NAMEORSTREAM. MACRO (OPENLAMBDA (FILENAME)
(COND
((type? STREAM FILENAME)
(fetch FULLFILENAME of FILENAME))
(T FILENAME))))
(PUTPROPS .PAGE.IS.AFTER.EOF. MACRO [OPENLAMBDA (STREAM PAGE#)
(AND (IGEQ PAGE# (fetch EPAGE of STREAM))
(OR (NOT (IEQP (fetch EPAGE of STREAM)
PAGE#))
(EQ (fetch EOFFSET of STREAM)
0])
)
(RPAQQ LEAFOPCODES ((\LEAFOP.ERROR 0)
(\LEAFOP.OPEN 1)
(\LEAFOP.CLOSE 2)
(\LEAFOP.DELETE 3)
(\LEAFOP.LENGTH 4)
(\LEAFOP.TRUNCATE 5)
(\LEAFOP.READ 6)
(\LEAFOP.WRITE 7)
(\LEAFOP.RESET 10Q)
(\LEAFOP.NOOP 11Q)
(\LEAFOP.TELNET 12Q)
(\LEAFOP.PARAMS 13Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \LEAFOP.ERROR 0)
(RPAQQ \LEAFOP.OPEN 1)
(RPAQQ \LEAFOP.CLOSE 2)
(RPAQQ \LEAFOP.DELETE 3)
(RPAQQ \LEAFOP.LENGTH 4)
(RPAQQ \LEAFOP.TRUNCATE 5)
(RPAQQ \LEAFOP.READ 6)
(RPAQQ \LEAFOP.WRITE 7)
(RPAQQ \LEAFOP.RESET 10Q)
(RPAQQ \LEAFOP.NOOP 11Q)
(RPAQQ \LEAFOP.TELNET 12Q)
(RPAQQ \LEAFOP.PARAMS 13Q)
(CONSTANTS (\LEAFOP.ERROR 0)
(\LEAFOP.OPEN 1)
(\LEAFOP.CLOSE 2)
(\LEAFOP.DELETE 3)
(\LEAFOP.LENGTH 4)
(\LEAFOP.TRUNCATE 5)
(\LEAFOP.READ 6)
(\LEAFOP.WRITE 7)
(\LEAFOP.RESET 10Q)
(\LEAFOP.NOOP 11Q)
(\LEAFOP.TELNET 12Q)
(\LEAFOP.PARAMS 13Q))
)
(RPAQQ LEAFCONSTANTS ((\SOCKET.LEAF 43Q)
(\PT.LEAF 260Q)
(\PT.ERROR 4)
(\LEAFOP.ANSWERBIT 2000Q)
(\LEAF.READBIT 100000Q)
(\LEAF.WRITEBIT 40000Q)
(\LEAF.EXTENDBIT 20000Q)
(\LEAF.MULTIBIT 10000Q)
(\LEAF.CREATEBIT 4000Q)
(\LEAF.DEFAULT.LOWEST 200Q)
(\LEAF.DEFAULT.HIGHEST 400Q)
(\LEAF.DEFAULT.NEXT 600Q)
(\LEAF.EXPLICIT.ANY 3000Q)
(\LEAF.EXPLICIT.OLD 1000Q)
(\LEAF.EXPLICIT.NEXT.OR.OLD 2000Q)
(\LEN.RESETLEAF 4)
(\LEN.LEAFPARAMS 10Q)
(\LEN.NOOPREQUEST 2)
(\LEN.OPENREQUEST 6)
(\LEN.FILEREQUEST 12Q)
(\LEN.CLOSEREQUEST 4)
(\LEN.READANSWER 12Q)
(\OPCODE.SHIFT 13Q)
(\LEN.CLOSEREQUEST 4)
(\MAXLEN.FILENAME 144Q)
(\OFFSET.FILENAME 256*2)
(\BYTES.PER.TRIDENT.PAGE 4000Q)
(\LEN.DATE 4)
(\LEAFMODE.DONTEXTEND 2)
(\LEN.FILETYPE&SIZE 4)
(\OFFSET.FILETYPE 1250Q)
(\OFFSET.AUTHOR 1174Q)
(\LEN.AUTHOR 50Q)
(\SHORT.ERROR.PUPLEN 36Q)
(\LEAF.GOODSTATUS 177776Q)
(\LF.ALLOWERRORS 2)
(\LF.WANTANSWER 1)
(\LEAF.BROKEN.STATUS 177771Q)
(\LEAF.NEVER.OPENED 177773Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SOCKET.LEAF 43Q)
(RPAQQ \PT.LEAF 260Q)
(RPAQQ \PT.ERROR 4)
(RPAQQ \LEAFOP.ANSWERBIT 2000Q)
(RPAQQ \LEAF.READBIT 100000Q)
(RPAQQ \LEAF.WRITEBIT 40000Q)
(RPAQQ \LEAF.EXTENDBIT 20000Q)
(RPAQQ \LEAF.MULTIBIT 10000Q)
(RPAQQ \LEAF.CREATEBIT 4000Q)
(RPAQQ \LEAF.DEFAULT.LOWEST 200Q)
(RPAQQ \LEAF.DEFAULT.HIGHEST 400Q)
(RPAQQ \LEAF.DEFAULT.NEXT 600Q)
(RPAQQ \LEAF.EXPLICIT.ANY 3000Q)
(RPAQQ \LEAF.EXPLICIT.OLD 1000Q)
(RPAQQ \LEAF.EXPLICIT.NEXT.OR.OLD 2000Q)
(RPAQQ \LEN.RESETLEAF 4)
(RPAQQ \LEN.LEAFPARAMS 10Q)
(RPAQQ \LEN.NOOPREQUEST 2)
(RPAQQ \LEN.OPENREQUEST 6)
(RPAQQ \LEN.FILEREQUEST 12Q)
(RPAQQ \LEN.CLOSEREQUEST 4)
(RPAQQ \LEN.READANSWER 12Q)
(RPAQQ \OPCODE.SHIFT 13Q)
(RPAQQ \LEN.CLOSEREQUEST 4)
(RPAQQ \MAXLEN.FILENAME 144Q)
(RPAQ \OFFSET.FILENAME 256*2)
(RPAQQ \BYTES.PER.TRIDENT.PAGE 4000Q)
(RPAQQ \LEN.DATE 4)
(RPAQQ \LEAFMODE.DONTEXTEND 2)
(RPAQQ \LEN.FILETYPE&SIZE 4)
(RPAQQ \OFFSET.FILETYPE 1250Q)
(RPAQQ \OFFSET.AUTHOR 1174Q)
(RPAQQ \LEN.AUTHOR 50Q)
(RPAQQ \SHORT.ERROR.PUPLEN 36Q)
(RPAQQ \LEAF.GOODSTATUS 177776Q)
(RPAQQ \LF.ALLOWERRORS 2)
(RPAQQ \LF.WANTANSWER 1)
(RPAQQ \LEAF.BROKEN.STATUS 177771Q)
(RPAQQ \LEAF.NEVER.OPENED 177773Q)
(CONSTANTS (\SOCKET.LEAF 43Q)
(\PT.LEAF 260Q)
(\PT.ERROR 4)
(\LEAFOP.ANSWERBIT 2000Q)
(\LEAF.READBIT 100000Q)
(\LEAF.WRITEBIT 40000Q)
(\LEAF.EXTENDBIT 20000Q)
(\LEAF.MULTIBIT 10000Q)
(\LEAF.CREATEBIT 4000Q)
(\LEAF.DEFAULT.LOWEST 200Q)
(\LEAF.DEFAULT.HIGHEST 400Q)
(\LEAF.DEFAULT.NEXT 600Q)
(\LEAF.EXPLICIT.ANY 3000Q)
(\LEAF.EXPLICIT.OLD 1000Q)
(\LEAF.EXPLICIT.NEXT.OR.OLD 2000Q)
(\LEN.RESETLEAF 4)
(\LEN.LEAFPARAMS 10Q)
(\LEN.NOOPREQUEST 2)
(\LEN.OPENREQUEST 6)
(\LEN.FILEREQUEST 12Q)
(\LEN.CLOSEREQUEST 4)
(\LEN.READANSWER 12Q)
(\OPCODE.SHIFT 13Q)
(\LEN.CLOSEREQUEST 4)
(\MAXLEN.FILENAME 144Q)
(\OFFSET.FILENAME 256*2)
(\BYTES.PER.TRIDENT.PAGE 4000Q)
(\LEN.DATE 4)
(\LEAFMODE.DONTEXTEND 2)
(\LEN.FILETYPE&SIZE 4)
(\OFFSET.FILETYPE 1250Q)
(\OFFSET.AUTHOR 1174Q)
(\LEN.AUTHOR 50Q)
(\SHORT.ERROR.PUPLEN 36Q)
(\LEAF.GOODSTATUS 177776Q)
(\LF.ALLOWERRORS 2)
(\LF.WANTANSWER 1)
(\LEAF.BROKEN.STATUS 177771Q)
(\LEAF.NEVER.OPENED 177773Q))
)
(RPAQQ IFSERRORS ((\IFSERROR.PASSWORD 331Q)
(\IFSERROR.USERNAME 330Q)
(\IFSERROR.NO.LOGIN 332Q)
(\PASSWORD.ERRORS (QUOTE (330Q 331Q 332Q 337Q)))
(\IFSERROR.CONNECTPASSWORD 334Q)
(\IFSERROR.CONNECTNAME 333Q)
(\CONNECT.PASSWORD.ERRORS (QUOTE (333Q 334Q)))
(\IFSERROR.MALFORMED (QUOTE (311Q 312Q)))
(\IFSERROR.FILE.NOT.FOUND 317Q)
(\IFSERROR.INVALID.DIRECTORY 322Q)
(\IFSERROR.ALLOCATION 323Q)
(\IFSERROR.PROTECTION 320Q)
(\IFSERROR.BUSY 321Q)
(\IFSERROR.BAD.CHARACTER 312Q)
(\IFSERROR.NEED.USERNAME 337Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \IFSERROR.PASSWORD 331Q)
(RPAQQ \IFSERROR.USERNAME 330Q)
(RPAQQ \IFSERROR.NO.LOGIN 332Q)
(RPAQQ \PASSWORD.ERRORS (330Q 331Q 332Q 337Q))
(RPAQQ \IFSERROR.CONNECTPASSWORD 334Q)
(RPAQQ \IFSERROR.CONNECTNAME 333Q)
(RPAQQ \CONNECT.PASSWORD.ERRORS (333Q 334Q))
(RPAQQ \IFSERROR.MALFORMED (311Q 312Q))
(RPAQQ \IFSERROR.FILE.NOT.FOUND 317Q)
(RPAQQ \IFSERROR.INVALID.DIRECTORY 322Q)
(RPAQQ \IFSERROR.ALLOCATION 323Q)
(RPAQQ \IFSERROR.PROTECTION 320Q)
(RPAQQ \IFSERROR.BUSY 321Q)
(RPAQQ \IFSERROR.BAD.CHARACTER 312Q)
(RPAQQ \IFSERROR.NEED.USERNAME 337Q)
(CONSTANTS (\IFSERROR.PASSWORD 331Q)
(\IFSERROR.USERNAME 330Q)
(\IFSERROR.NO.LOGIN 332Q)
(\PASSWORD.ERRORS (QUOTE (330Q 331Q 332Q 337Q)))
(\IFSERROR.CONNECTPASSWORD 334Q)
(\IFSERROR.CONNECTNAME 333Q)
(\CONNECT.PASSWORD.ERRORS (QUOTE (333Q 334Q)))
(\IFSERROR.MALFORMED (QUOTE (311Q 312Q)))
(\IFSERROR.FILE.NOT.FOUND 317Q)
(\IFSERROR.INVALID.DIRECTORY 322Q)
(\IFSERROR.ALLOCATION 323Q)
(\IFSERROR.PROTECTION 320Q)
(\IFSERROR.BUSY 321Q)
(\IFSERROR.BAD.CHARACTER 312Q)
(\IFSERROR.NEED.USERNAME 337Q))
)
(RPAQQ FILETYPES ((\FT.TEXT 1)
(\FT.BINARY 2)
(\FT.UNKNOWN 0)))
(DECLARE: EVAL@COMPILE
(RPAQQ \FT.TEXT 1)
(RPAQQ \FT.BINARY 2)
(RPAQQ \FT.UNKNOWN 0)
(CONSTANTS (\FT.TEXT 1)
(\FT.BINARY 2)
(\FT.UNKNOWN 0))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \LEAFDEVICE \LEAFCONNECTIONS LEAFDEBUGFLG PUPTRACEFLG \HOSTNAMES NOFILEPROPERROR
NETWORKOSTYPES LEAFOPCODES SEQUINOPS DEFAULTFILETYPE \LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT
\LEAF.MAXLOOKAHEAD \OPENFILES \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE
\SEQUIN.TIMEOUTMAX)
)
)
(PUTPROPS LEAF COPYRIGHT (NONE))
(DECLARE: DONTCOPY
(FILEMAP (NIL (36552Q 46117Q (CLOSESEQUIN 36564Q . 37512Q) (INITSEQUIN 37514Q . 41624Q) (GETSEQUIN
41626Q . 43030Q) (PUTSEQUIN 43032Q . 46115Q)) (46120Q 111130Q (\SEQUIN.CONTROL 46132Q . 47101Q) (
\SEQUIN.PUT 47103Q . 52003Q) (\SEQUIN.PROCESS 52005Q . 64222Q) (\SEQUIN.CLOSE 64224Q . 65030Q) (
\SEQUIN.FLUSH.CONNECTION 65032Q . 66733Q) (\SEQUIN.FLUSH.RETRANSMIT 66735Q . 67601Q) (\SEQUIN.COMPARE
67603Q . 70522Q) (\SEQUIN.HANDLE.INPUT 70524Q . 101506Q) (\SEQUIN.OUT.OF.THE.BLUE 101510Q . 102326Q) (
\SEQUIN.HANDLE.ACK 102330Q . 104572Q) (\SEQUIN.RETRANSMIT 104574Q . 107137Q) (\SEQUIN.RETRANSMITNEXT
107141Q . 111126Q)) (111174Q 225170Q (\LEAF.CLOSEFILE 111206Q . 116737Q) (\LEAF.DELETEFILE 116741Q .
121021Q) (\LEAF.DEVICEP 121023Q . 121537Q) (\LEAF.DIRECTORYNAMEP 121541Q . 122466Q) (
\LEAF.GENERATEFILES 122470Q . 123052Q) (\LEAF.GETFILE 123054Q . 140762Q) (\PARSE.REMOTE.FILENAME
140764Q . 144374Q) (\LEAF.GETFILEDATES 144376Q . 146142Q) (\LEAF.GETFILEINFO 146144Q . 146765Q) (
\LEAF.GETFILEINFO.OPEN 146767Q . 152371Q) (\LEAF.GETFILENAME 152373Q . 153036Q) (\LEAF.OPENFILE
153040Q . 161601Q) (\LEAF.READFILENAME 161603Q . 165457Q) (\LEAF.READFILEPROP 165461Q . 170000Q) (
\LEAF.READPAGES 170002Q . 172735Q) (\LEAF.REQUESTPAGE 172737Q . 177144Q) (\LEAF.LOOKUPCACHE 177146Q .
201443Q) (CLEAR.LEAF.CACHE 201445Q . 202647Q) (\LEAF.RENAMEFILE 202651Q . 203200Q) (\LEAF.REOPENFILE
203202Q . 207020Q) (\LEAF.CREATIONDATE 207022Q . 207341Q) (\LEAF.SETCREATIONDATE 207343Q . 212071Q) (
\LEAF.SETFILEINFO 212073Q . 213421Q) (\LEAF.SETFILETYPE 213423Q . 216676Q) (\LEAF.SETVALIDATION
216700Q . 217541Q) (\LEAF.TRUNCATEFILE 217543Q . 221605Q) (\LEAF.WRITEPAGES 221607Q . 225166Q)) (
225171Q 226127Q (\LEAF.CHECKZEROS 225203Q . 226125Q)) (226352Q 230765Q (\SENDLEAF 226364Q . 230763Q))
(231034Q 247617Q (BREAKCONNECTION 231046Q . 233304Q) (\CLOSELEAFCONNECTION 233306Q . 233715Q) (
\CLOSELEAFCONNECTIONS 233717Q . 235305Q) (\GETLEAFCONNECTION 235307Q . 236524Q) (\OPENLEAFCONNECTION
236526Q . 246511Q) (\LEAF.EVENTFN 246513Q . 247615Q)) (247716Q 307467Q (\LEAF.ACKED 247730Q . 250353Q)
(\LEAF.FIX.BROKEN.SEQUIN 250355Q . 260714Q) (\LEAF.REPAIR.BROKEN.PUP 260716Q . 263302Q) (
\LEAF.USE.NEW.CONNECTION 263304Q . 271131Q) (\LEAF.RESENDPUPS 271133Q . 271522Q) (\LEAF.HANDLE.INPUT
271524Q . 275642Q) (\LEAF.TIMEDOUT 275644Q . 300724Q) (\LEAF.STREAM.IN.QUEUE 300726Q . 303177Q) (
\LEAF.IDLE 303201Q . 304654Q) (\LEAF.WHENCLOSED 304656Q . 306171Q) (\LEAF.IDLE? 306173Q . 307465Q)) (
307703Q 325113Q (\ADDLEAFSTRING 307715Q . 312364Q) (\CANONICAL.HOSTNAME 312366Q . 313766Q) (
\FIXPASSWORD 313770Q . 315634Q) (\GETLEAFSTRING 315636Q . 316450Q) (\IFSERRORSTRING 316452Q . 322166Q)
(\LEAF.ERROR 322170Q . 324200Q) (\LEAF.DIRECTORYNAMEONLY 324202Q . 324666Q) (GETOSTYPE 324670Q .
325111Q)) (325114Q 330057Q (\LEAFINIT 325126Q . 330055Q)) (330127Q 337055Q (PRINTLEAF 330141Q .
337053Q)))))
STOP