(FILECREATED " 9-Dec-84 18:39:27" {ERIS}<LISPCORE>SOURCES>LEAF.;11 437767Q
changes to: (FNS \LEAF.HANDLE.INPUT)
previous date: "30-Sep-84 18:21:24" {ERIS}<LISPCORE>SOURCES>LEAF.;10)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LEAFCOMS)
(RPAQQ LEAFCOMS ((E (RESETSAVE (RADIX 8)))
(COMS (* SEQUIN protocol)
(DECLARE: EVAL@COMPILE DONTCOPY (COMS * SEQUINCOMS))
(INITRECORDS SEQUIN)
(SYSRECORDS SEQUIN)
(FNS CLOSESEQUIN INITSEQUIN GETSEQUIN PUTSEQUIN)
(FNS \SEQUIN.CONTROL \SEQUIN.PUT \SEQUIN.PROCESS \SEQUIN.CLOSE \SEQUIN.FLUSH.CONNECTION
\SEQUIN.CLEANUP \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.RECONNECT
\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.ASSURE.FINISHED
\LEAF.FORCEOUTPUT \LEAF.FLUSH.CACHE \LEAF.RENAMEFILE \LEAF.REOPENFILE
\LEAF.CREATIONDATE \LEAF.SETCREATIONDATE \LEAF.SETFILEINFO \LEAF.SETFILETYPE
\LEAF.SETVALIDATION \LEAF.TRUNCATEFILE \LEAF.WRITEPAGES))
(COMS (* Main routing point for LEAF pups)
(FNS \SENDLEAF))
(COMS (* Managing LEAF connections)
(FNS BREAKCONNECTION \CLOSELEAFCONNECTION \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.OPENERRORHANDLER \LEAF.TIMEDIN \LEAF.TIMEDOUT \LEAF.TIMEDOUT.EXCESSIVE
\LEAF.ABORT.FROMMENU \LEAF.STREAM.IN.QUEUE \LEAF.IDLE \LEAF.WHENCLOSED \LEAF.IDLE?)
)
(ADDVARS (NETWORKOSTYPES))
(* Miscellaneous and error handling)
(FNS \ADDLEAFSTRING \FIXPASSWORD \GETLEAFSTRING \IFSERRORSTRING \LEAF.ERROR
\LEAF.DIRECTORYNAMEONLY GETHOSTINFO GETOSTYPE)
(COMS (* LookUpFile stuff)
(FNS \IFS.LOOKUPFILE)
(INITVARS (\LOOKUPFILE.HOSTINFO))
(DECLARE: EVAL@COMPILE DONTCOPY (COMS * LOOKUPFILECOMS)))
[COMS (FNS \LEAFINIT)
(DECLARE: DONTEVAL@LOAD (P (\LEAFINIT]
(COMS (FNS PRINTLEAF)
(ALISTS (PUPPRINTMACROS 176)))
(INITVARS (LEAFDEBUGFLG)
(LEAFABORTREGION (QUOTE (417 616 399 192)))
(\MAXLEAFTRIES 4)
(NOFILEPROPERROR)
(DEFAULTFILETYPE (QUOTE TEXT))
(\SOCKET.LEAF 35)
(\SEQUIN.TIMEOUTMAX 10000)
(\LEAF.IDLETIMEOUT 1800000)
(\LEAF.CACHETIMEOUT 90000)
(\LEAF.MAXCACHE 10)
(\LEAF.RECOVERY.TIMEOUT 600000)
(\LEAF.MAXLOOKAHEAD 4)
(\FTPAVAILABLE)
(UNIXFTPFLG)
(NONLEAFHOSTS))
(DECLARE: EVAL@COMPILE DONTCOPY (COMS * LEAFCOMPILETIMECOMS))))
(* SEQUIN protocol)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ SEQUINCOMS ((RECORDS SEQUINPACKET SEQUIN)
(CONSTANTS * SEQUINOPS)
(CONSTANTS * SEQUINSTATES)
(CONSTANTS (\SC.EQUAL 0)
(\SC.PREVIOUS 1)
(\SC.DUPLICATE 2)
(\SC.AHEAD 3)
(\SC.OUTOFRANGE 4)
(\PT.SEQUIN 260Q)
(\SS.NOSOCKET 10Q)
(\SEQUIN.DEFAULT.ALLOCATION 12Q)
(\SEQUIN.DEFAULT.RETRANSMITMAX 5))
(MACROS SEQUINOP)))
[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)
(SEQMAXALLOC WORD) (* The largest I will let output allocation get)
(#UNACKEDSEQS WORD) (* Number of data packets we have sent for which no
acks have been received)
(SEQINPUTQLENGTH WORD) (* Number of packets in input
(done) queue)
(SEQTIMEOUT WORD) (* Timeout before retransmission)
(SEQBASETIMEOUT WORD) (* Timeout for this connection in general)
(SEQRETRANSMITMAX WORD) (* How many times to retransmit before complaining)
(#SEQRESTARTS WORD) (* Some statistical info...)
(#SEQRETRANSMITS WORD)
(#SEQDUPLICATES WORD)
(#SEQTIMEOUTS WORD)
(#SEQTURNOVERS WORD)
(SEQRETRANSMITQ POINTER) (* Sequin output queue)
(SEQTIMER POINTER)
(SEQPROCESS POINTER)
(SEQIGNOREDUPLICATES FLAG)
(SEQRETRANSMITTING FLAG)
(SEQCLOSEME FLAG)
(SEQCLOSEDFORLOGOUT FLAG)
(SEQLASTRESTARTTIMER POINTER) (* Allows for some aging of the connection timeout)
(SEQLASTRESTART POINTER)
(SEQRETRANSMITNEXT POINTER)
(SEQEVENT POINTER) (* Signaled when there is input, state changed, or
allocation changed)
(SEQLOCK POINTER) (* Monitor lock for this structure)
(* * 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)
(LEAFTIMEOUTCOUNT WORD)
(LEAFCLOSING FLAG)
(LEAFOPENCLOSELOCK POINTER) (* Monitor lock to keep GETFILE and CLOSEFILE from
stepping on each other)
(LEAFABORTBUTTONWINDOW POINTER)
(LEAFABORTSTATUS POINTER)
(NIL POINTER)
(SEQTIMEDIN POINTER)
(LEAFKNOWNDIRS POINTER)
(SEQOPENERRORHANDLER POINTER) (* (SEQUIN PUP) called on errors trying to open
connection)
)
SEQSTATE ← \SS.UNOPENED SEQOUTALLOC ← 1 SEQINALLOC ← \SEQUIN.DEFAULT.ALLOCATION
SEQRETRANSMITMAX ← \SEQUIN.DEFAULT.RETRANSMITMAX SEQRETRANSMITQ ←(NCREATE
(QUOTE SYSQUEUE))
SEQTIMEOUT ← \ETHERTIMEOUT SEQBASETIMEOUT ← \ETHERTIMEOUT SEQTIMER ←(\CREATECELL
\FIXP)
SEQLASTRESTARTTIMER ←(\CREATECELL \FIXP)
SEQMAXALLOC ← 12Q SEQACKED ←(FUNCTION NILL)
SEQBROKEN ←(FUNCTION NILL)
SEQABORTED ←(FUNCTION NILL)
SEQABORTED ←(FUNCTION NILL)
SEQTIMEDOUT ←(FUNCTION NILL)
SEQCLOSED ←(FUNCTION NILL)
SEQIDLETIMEOUTCOMPUTER ←(FUNCTION NILL)
SEQIDLEFN ←(FUNCTION NILL)
SEQTIMEDIN ←(FUNCTION NILL)
SEQOPENERRORHANDLER ←(FUNCTION NILL)
(SYNONYM SEQDONEQ (INPUTQ)))
]
(/DECLAREDATATYPE (QUOTE SEQUIN)
(QUOTE (POINTER POINTER POINTER BYTE BYTE BYTE BYTE WORD WORD WORD WORD WORD WORD
WORD WORD WORD WORD WORD WORD WORD POINTER POINTER POINTER FLAG
FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD WORD FLAG POINTER POINTER
POINTER 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 SEQUINSTATES ((\SS.UNOPENED 0)
(\SS.OPEN 1)
(\SS.DALLYING 2)
(\SS.ABORT 3)
(\SS.DESTROYED 4)
(\SS.TIMEDOUT 5)
(\SS.CLOSING 6)
(\SS.OPENING 7)
(\SS.CLOSED 10Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SS.UNOPENED 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 \SS.CLOSED 10Q)
(CONSTANTS (\SS.UNOPENED 0)
(\SS.OPEN 1)
(\SS.DALLYING 2)
(\SS.ABORT 3)
(\SS.DESTROYED 4)
(\SS.TIMEDOUT 5)
(\SS.CLOSING 6)
(\SS.OPENING 7)
(\SS.CLOSED 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 \PT.SEQUIN 260Q)
(RPAQQ \SS.NOSOCKET 10Q)
(RPAQQ \SEQUIN.DEFAULT.ALLOCATION 12Q)
(RPAQQ \SEQUIN.DEFAULT.RETRANSMITMAX 5)
(CONSTANTS (\SC.EQUAL 0)
(\SC.PREVIOUS 1)
(\SC.DUPLICATE 2)
(\SC.AHEAD 3)
(\SC.OUTOFRANGE 4)
(\PT.SEQUIN 260Q)
(\SS.NOSOCKET 10Q)
(\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 WORD WORD WORD WORD WORD POINTER POINTER POINTER FLAG
FLAG FLAG FLAG POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD WORD FLAG POINTER POINTER
POINTER POINTER POINTER POINTER POINTER)))
[ADDTOVAR SYSTEMRECLST
(DATATYPE SEQUIN ((SEQNAME POINTER)
(SEQFRNPORT POINTER)
(SEQSOCKET POINTER)
(SEQSTATE BYTE)
(MYSENDSEQ BYTE)
(MYRECEIVESEQ BYTE)
(LASTACKEDSEQ BYTE)
(SEQOUTALLOC WORD)
(SEQINALLOC WORD)
(SEQMAXALLOC WORD)
(#UNACKEDSEQS WORD)
(SEQINPUTQLENGTH WORD)
(SEQTIMEOUT WORD)
(SEQBASETIMEOUT WORD)
(SEQRETRANSMITMAX WORD)
(#SEQRESTARTS WORD)
(#SEQRETRANSMITS WORD)
(#SEQDUPLICATES WORD)
(#SEQTIMEOUTS WORD)
(#SEQTURNOVERS WORD)
(SEQRETRANSMITQ POINTER)
(SEQTIMER POINTER)
(SEQPROCESS POINTER)
(SEQIGNOREDUPLICATES FLAG)
(SEQRETRANSMITTING FLAG)
(SEQCLOSEME FLAG)
(SEQCLOSEDFORLOGOUT FLAG)
(SEQLASTRESTARTTIMER POINTER)
(SEQLASTRESTART POINTER)
(SEQRETRANSMITNEXT POINTER)
(SEQEVENT POINTER)
(SEQLOCK POINTER)
(SEQACKED POINTER)
(SEQINPUT POINTER)
(SEQBROKEN POINTER)
(SEQABORTED POINTER)
(SEQTIMEDOUT POINTER)
(SEQCLOSED POINTER)
(SEQIDLETIMEOUTCOMPUTER POINTER)
(SEQIDLEFN POINTER)
(SEQDONEQ POINTER)
(LOOKUPFILESOCKET POINTER)
(OSTYPE POINTER)
(LEAFCACHEDFILE POINTER)
(LEAFCACHETIMER POINTER)
(LEAFCACHEHITS WORD)
(LEAFCACHEMISSES WORD)
(LEAFTIMEOUTCOUNT WORD)
(LEAFCLOSING FLAG)
(LEAFOPENCLOSELOCK POINTER)
(LEAFABORTBUTTONWINDOW POINTER)
(LEAFABORTSTATUS POINTER)
(NIL POINTER)
(SEQTIMEDIN POINTER)
(LEAFKNOWNDIRS POINTER)
(SEQOPENERRORHANDLER POINTER)))
]
(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: "14-SEP-83 11:23")
(replace SEQSOCKET of SEQUIN with (OPENPUPSOCKET))
(replace SEQSTATE of SEQUIN with \SS.UNOPENED)
(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 #SEQRETRANSMITS of SEQUIN with 0)
(replace #SEQTURNOVERS 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 DONTWAIT) (* bvm: " 1-NOV-83 19:56")
(PROG1 (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.UNOPENED (replace (SEQUIN SEQSTATE) of SEQUIN
with \SS.OPENING)
(replace SEQCONTROL of OPUP with
\SEQUIN.OPEN)
T)
(\SS.OPENING NIL)
(RETURN (PUTSEQUIN (OR (SEQUINOP SEQUIN SEQBROKEN
SEQUIN OPUP)
(RETURN OPUP))
OPUP)))
(ILESSP (fetch #UNACKEDSEQS of SEQUIN)
(fetch SEQOUTALLOC of SEQUIN))
(ILEQ (fetch SEQINPUTQLENGTH of SEQUIN)
(fetch SEQINALLOC 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 (COND
(DONTWAIT (RETURN)))
(MONITOR.AWAIT.EVENT (fetch SEQLOCK of SEQUIN)
(fetch SEQEVENT of SEQUIN)
\ETHERTIMEOUT)
finally (\SEQUIN.PUT SEQUIN OPUP T)
(RETURN SEQUIN)))
(BLOCK])
)
(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: "14-SEP-83 11:14")
(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
(PROG ((SENDSEQ (fetch (SEQUIN MYSENDSEQ) of SEQUIN)))
(replace (SEQUINPACKET RECEIVESEQ) of PUP with (fetch (SEQUIN MYRECEIVESEQ)
of SEQUIN))
(replace (SEQUINPACKET SENDSEQ) of PUP with SENDSEQ)
[COND
(ISDATA [replace (SEQUIN MYSENDSEQ) of SEQUIN with (COND
((EQ SENDSEQ 377Q)
(add (fetch (SEQUIN
#SEQTURNOVERS)
of SEQUIN)
1)
0)
(T (ADD1 SENDSEQ]
(* 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. It might be in its long idle phase, and if no packets arrive on its socket,
it won't wake up to notice that remote host is not responding)
(WAKE.PROCESS (fetch SEQPROCESS of SEQUIN))))])
(\SEQUIN.PROCESS
(LAMBDA (SEQUIN) (* JonL "17-Dec-83 01:42")
(DECLARE (SPECVARS SEQUIN))
(WITH.MONITOR (fetch SEQLOCK of SEQUIN)
(RESETSAVE NIL (LIST (FUNCTION \SEQUIN.CLEANUP)
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 REASON)
(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 (COND
((EQ PUPTRACEFLG (QUOTE PEEK))
(PRINTPUP PUP (QUOTE GET))))
(COND
((NEQ (fetch SEQSTATE of SEQUIN)
\SS.OPENING)
(SELECTC (fetch ERRORPUPCODE of PUP)
(\PUPE.NOSOCKET
(* Connection was open and went away?)
(SEQUINOP SEQUIN
SEQBROKEN
SEQUIN))
NIL))
((SETQ REASON (SEQUINOP SEQUIN SEQOPENERRORHANDLER
SEQUIN PUP))
(RELEASE.PUP PUP)
(RETURN (\SEQUIN.FLUSH.CONNECTION SEQUIN
\SS.ABORT
REASON))))
(RELEASE.PUP PUP))
(RELEASE.PUP PUP)))
((fetch SEQRETRANSMITTING of SEQUIN)
(\SEQUIN.RETRANSMITNEXT SEQUIN))
((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
((\CLOCKGREATERP (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)))
(T (SEQUINOP SEQUIN SEQTIMEDOUT SEQUIN (add CNT 1))
(COND
((fetch SEQCLOSEME of SEQUIN)
(* In case SEQTIMEDOUT closed the connection)
(RETURN)))))
(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)))))))))
(BLOCK)
(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.CLEANUP
[LAMBDA (SEQUIN) (* bvm: "14-SEP-83 11:51")
(* Called via RESETSAVE by Sequin process to perform cleanup if the sequin watcher is killed unexpectedly.
Important thing is that we not do this on HARDRESET)
(SELECTQ RESETSTATE
((ERROR RESET)
(COND
((EQ (fetch SEQSTATE of SEQUIN)
\SS.OPEN)
(\SEQUIN.CONTROL SEQUIN \SEQUIN.BROKEN)))
(\SEQUIN.FLUSH.CONNECTION SEQUIN \SS.ABORT))
NIL])
(\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: "21-SEP-83 18:05")
(* * 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)))
(COND
((ILESSP (fetch SEQINPUTQLENGTH of SEQUIN)
1)
(* Allocation = 0 normally defaults to 1; however, in rare cases, my partner has actually decremented its
allocation below 1, meaning I can't send ANY packets.)
(SETQ ALLOC 1]
((IGREATERP ALLOC (fetch SEQMAXALLOC of SEQUIN))
(SETQ ALLOC (fetch SEQMAXALLOC of SEQUIN]
[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)))
(COND
((NEQ (fetch SEQTIMEOUT of SEQUIN)
(fetch SEQBASETIMEOUT of SEQUIN))
(replace SEQTIMEOUT of SEQUIN with (fetch SEQBASETIMEOUT
of SEQUIN))
(SEQUINOP SEQUIN SEQTIMEDIN SEQUIN)))
(* 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: "14-SEP-83 11:15")
(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))
[SENDPUP (fetch SEQSOCKET of SEQUIN)
(PROG1 NEXTPUP (OR (replace SEQRETRANSMITNEXT of SEQUIN
with (fetch EPLINK of NEXTPUP))
(replace SEQRETRANSMITTING of SEQUIN with NIL]
(add (fetch (SEQUIN #SEQRETRANSMITS) of SEQUIN)
1])
)
(* LEAF device operations)
(DEFINEQ
(\LEAF.CLOSEFILE
[LAMBDA (STREAM CONNECTION LEAFHANDLE FORCE) (* bvm: "11-Jul-84 11:25")
(* * 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 (INTERNAL CONNECTION))
[COND
(STREAM (\CLEARMAP STREAM)
(OR (SETQ CONNECTION (fetch LEAFCONNECTION of STREAM))
(LISPERROR "FILE NOT OPEN" STREAM))
(COND
([WITH.MONITOR (fetch LEAFOPENCLOSELOCK of CONNECTION)
(COND
((EQ (fetch SEQSTATE of CONNECTION)
\SS.OPEN)
(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)
(PROG ((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)
(RETURN (COND
((NULL CACHE)
(* No cache before, so just make this the cached file)
(replace LEAFCACHEDFILE of CONNECTION
with STREAM)
T)
((EQ CACHE STREAM)
(* Closing the already cached file? Do nothing)
T)
((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)
NIL)
(T (replace LEAFCACHEDFILE of CONNECTION
with STREAM)
(COND
((fetch LEAFREALLYOPEN
of CACHE)
T)
(T
(* Close the formerly cached stream if Lisp thinks it is
closed)
(SETQ STREAM CACHE)
NIL]
((EQ STREAM (fetch LEAFCACHEDFILE of CONNECTION))
(* We are about to close the cached stream)
(replace LEAFCACHEDFILE of CONNECTION with NIL]
(RETURN)))
(SETQ LEAFHANDLE (fetch LEAFHANDLE of STREAM]
(COND
((EQ (fetch SEQSTATE of CONNECTION)
\SS.OPEN) (* Don't bother sending anything if the connection is
already gone)
(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 DEV) (* bvm: "12-SEP-83 14:08")
(PROG ((OPUP (ALLOCATE.PUP))
(STREAM (\LEAF.GETFILE DEV 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)
(replace LEAFCONNECTION of STREAM with NIL)
(* The leaf file connection is now gone)
(fetch FULLFILENAME of STREAM])
(\LEAF.DEVICEP
[LAMBDA (HOST LEAFDEV) (* bvm: "30-Sep-84 18:21")
(* * Returns the device corresponding to this HOST, or NIL if it is an illegal leaf host)
(PROG (NAME DEVICE SEQUIN CONN)
(RETURN (COND
([AND (STRPOS "DSK" HOST 1 NIL T NIL UPPERCASEARRAY)
(for I from 4 to (NCHARS HOST) always (SMALLP (NTHCHAR HOST I]
(* Kludge: Name of form DSKn: don't bother)
NIL)
((STRPOS (QUOTE :)
HOST) (* NS host, skip it. Would be nice to have more orderly
name tests)
NIL)
((NULL (SETQ NAME (\CANONICAL.HOSTNAME HOST)))
NIL)
((NULL LEAFDEV) (* Called as predicate, don't try to open one)
NAME)
((AND (NEQ NAME HOST)
(SETQ DEVICE (\GETDEVICEFROMNAME NAME T T)))
DEVICE)
((NULL (SETQ SEQUIN (\OPENLEAFCONNECTION NAME)))
NIL)
((type? SEQUIN SEQUIN)
[\DEFINEDEVICE NAME (SETQ DEVICE (\MAKE.PMAP.DEVICE
(create FDEV
DEVICENAME ← NAME
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 NILL)
RENAMEFILE ←(FUNCTION \LEAF.RENAMEFILE)
DEVICEINFO ← SEQUIN
FORCEOUTPUT ←(FUNCTION \LEAF.FORCEOUTPUT]
DEVICE)
((AND \FTPAVAILABLE (SETQ CONN (\FTP.OPEN.CONNECTION NAME)))
(\RELEASE.FTPCONNECTION CONN)
\FTPFDEV])
(\LEAF.RECONNECT
[LAMBDA (DEVICE OLDONLY) (* bvm: "22-SEP-83 12:59")
(WITH.MONITOR \LEAFCONNECTIONLOCK (PROG ((SEQUIN (fetch DEVICEINFO of DEVICE)))
(RETURN (COND
((AND SEQUIN (EQ (fetch SEQSTATE of SEQUIN)
\SS.OPEN))
SEQUIN)
([AND (NOT OLDONLY)
(type? SEQUIN
(SETQ SEQUIN
(\OPENLEAFCONNECTION
(fetch DEVICENAME
of DEVICE]
(replace DEVICEINFO of DEVICE with SEQUIN)
SEQUIN])
(\LEAF.DIRECTORYNAMEP
[LAMBDA (HOST/DIR DEV) (* lmm " 7-Sep-84 14:14")
(* 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")
(PROG ((BRKT (STRPOS (QUOTE })
HOST/DIR))
DIRONLY TMP CONN)
[SETQ DIRONLY (SUBATOM HOST/DIR (IPLUS BRKT 2)
(AND (SETQ TMP (STRPOS (QUOTE >)
HOST/DIR
(ADD1 BRKT)))
(SUB1 TMP]
(COND
((AND (SETQ CONN (fetch DEVICEINFO of DEV))
(FMEMB DIRONLY (fetch LEAFKNOWNDIRS of CONN)))
(* We already know this directory is ok)
)
((SETQ TMP (\LEAF.GETFILE DEV (CONCAT HOST/DIR "QXZRYU.WJK")
(QUOTE INPUT)
(QUOTE OLD)
T
(QUOTE DIRECTORY)))
(push (fetch LEAFKNOWNDIRS of (OR CONN (fetch DEVICEINFO of DEV)))
DIRONLY))
(T (RETURN))) (* Now return the name, possibly revised by using the
canonical host name)
(RETURN T])
(\LEAF.GENERATEFILES
[LAMBDA (DEVICE PATTERN DESIREDPROPS OPTIONS) (* bvm: "28-Apr-84 00:02")
(OR (AND \FTPAVAILABLE (\FTP.GENERATEFILES DEVICE PATTERN DESIREDPROPS OPTIONS))
(\GENERATENOFILES DEVICE PATTERN DESIREDPROPS OPTIONS])
(\LEAF.GETFILE
[LAMBDA (DEVICE FILENAME ACCESS RECOG NOERROR OPTION OLDSTREAM REALLYOPEN)
(* bvm: " 3-NOV-83 22:31")
(* * 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 ((CONNECTION (fetch DEVICEINFO of DEVICE))
MODE FILELENGTH CACHEDSTREAM LEAFHANDLE HOST REMOTENAME NAME/PASS OUTCOME CONNECTNAME/PASS
OPUP IPUP DATA)
(COND
((SETQ HOST (\PARSE.REMOTE.FILENAME FILENAME NOERROR DEVICE))
(SETQ REMOTENAME (CDR HOST))
(SETQ HOST (CAR HOST)))
(T (RETURN)))
TOP (OR CONNECTION (SETQ CONNECTION (\LEAF.RECONNECT DEVICE))
(RETURN))
(COND
([AND (fetch LEAFCACHEDFILE of CONNECTION)
(SETQ OUTCOME
(WITH.MONITOR (fetch LEAFOPENCLOSELOCK of CONNECTION)
(AND (SETQ CACHEDSTREAM (fetch LEAFCACHEDFILE of CONNECTION))
(SELECTQ ACCESS
[(NONE INPUT)
(COND
((AND (NOT OLDSTREAM)
(EQ (fetch FULLFILENAME of CACHEDSTREAM)
FILENAME)
(COND
((NOT REALLYOPEN)
T)
((fetch LEAFREALLYOPEN of CACHEDSTREAM)
(* Asking for a new REAL opening of the file, so don't
use cache)
NIL)
(T (replace LEAFREALLYOPEN of
CACHEDSTREAM
with T)
T)))
(* We already have this file open, and its open state is
correct)
(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)
NIL]
(RETURN OUTCOME)))
(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)
T)
(\ADDLEAFSTRING OPUP (CAR CONNECTNAME/PASS)) (* Connect name)
(\ADDLEAFSTRING OPUP (CDR CONNECTNAME/PASS)
T) (* 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 STREAM
DEVICE ← DEVICE)))
(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)
(COND
((SETQ NAME/PASS (\FIXPASSWORD OUTCOME
CONNECTION))
(GO RETRY))
(T (GO CAUSE.ERROR]
[\CONNECT.PASSWORD.ERRORS
(* Connect info bad, try again)
(COND
([SETQ CONNECTNAME/PASS
(\FIXPASSWORD
OUTCOME CONNECTION
(OR (CAR CONNECTNAME/PASS)
(\LEAF.DIRECTORYNAMEONLY
FILENAME]
(GO RETRY))
(T (GO CAUSE.ERROR]
[(LIST \IFSERROR.INVALID.DIRECTORY \IFSERROR.BAD.CHARACTER)
(COND
((OR (EQ OPTION (QUOTE DIRECTORY))
NOERROR)
NIL)
(T (\LEAF.ERROR IPUP FILENAME CONNECTION]
(\LEAF.BROKEN.STATUS (SETQ CONNECTION)
(GO TOP))
(COND
((EQ OPTION (QUOTE DIRECTORY))
(* Open didn't barf on invalid directory, so I assume at
least that much was okay)
T)
[(EQ OUTCOME \IFSERROR.PROTECTION)
(COND
((SETQ CONNECTNAME/PASS (\FIXPASSWORD OUTCOME CONNECTION
(
\LEAF.DIRECTORYNAMEONLY FILENAME))) (* File protected, but we got a connect password)
(GO RETRY))
(T (GO CAUSE.ERROR]
((OR (EQ NOERROR T)
(EQ OUTCOME \IFSERROR.FILE.NOT.FOUND))
NIL)
(T (\LEAF.ERROR IPUP FILENAME CONNECTION]
(RELEASE.PUP IPUP]
CAUSE.ERROR
(RELEASE.PUP IPUP)
(RETURN (COND
((OR (EQ NOERROR T)
(EQ OUTCOME \IFSERROR.FILE.NOT.FOUND))
NIL)
(T (LISPERROR "FILE WON'T OPEN" FILENAME])
(\PARSE.REMOTE.FILENAME
[LAMBDA (FILENAME NOERROR DEVICE) (* bvm: "12-SEP-83 14:26")
(* 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 (fetch OSTYPE of DEVICE))
(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: "26-SEP-83 16:43")
(COND
((type? STREAM STREAM)
(\LEAF.GETFILEINFO.OPEN STREAM ATTRIBUTE))
(T (PROG (SEQUIN RESULT)
[COND
((FMEMB ATTRIBUTE (QUOTE (CREATIONDATE ICREATIONDATE)))
(* Would like to have LENGTH here, too, but might disagree with Leaf due to race conditions;
e.g. LENGTH of a file that I just had closed could get an old length)
(COND
((AND (SETQ SEQUIN (fetch DEVICEINFO of DEV))
(SETQ RESULT (fetch LEAFCACHEDFILE of SEQUIN))
(EQ (fetch FULLFILENAME of RESULT)
STREAM)) (* A name we know about)
(RETURN (\LEAF.GETFILEINFO.OPEN RESULT ATTRIBUTE)))
((NEQ (SETQ RESULT (\IFS.LOOKUPFILE STREAM (QUOTE OLD)
ATTRIBUTE
(fetch DEVICENAME of DEV)))
(QUOTE ?))
(RETURN RESULT]
(RETURN (PROG1 (\LEAF.GETFILEINFO.OPEN (SETQ STREAM (\LEAF.GETFILE DEV STREAM
(QUOTE NONE)
(QUOTE OLD)))
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 DEV) (* bvm: "23-SEP-83 14:44")
(PROG ((SEQUIN (fetch DEVICEINFO of DEV))
RESULT)
(RETURN (COND
((AND SEQUIN (SETQ RESULT (fetch LEAFCACHEDFILE of SEQUIN))
(EQ (fetch FULLFILENAME of RESULT)
NAME)) (* A name we know about)
NAME)
((NEQ (SETQ RESULT (\IFS.LOOKUPFILE NAME RECOG (QUOTE NAME)
(fetch DEVICENAME of DEV)))
(QUOTE ?))
RESULT)
(T (\LEAF.GETFILE DEV NAME (QUOTE NONE)
RECOG T (QUOTE NAME])
(\LEAF.OPENFILE
[LAMBDA (FILENAME ACCESS RECOG OTHERINFO DEV) (* bvm: " 4-NOV-83 19:29")
(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 DEV 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
(OR (NEQ (GETHOSTINFO (fetch DEVICENAME of DEV)
(QUOTE OSTYPE))
(QUOTE UNIX))
UNIXFTPFLG)
(SETQ STREAM (\FTP.OPENFILE FILENAME ACCESS RECOG
OTHERINFO)))
(RETURN]
(push PROPS X)))
[COND
(STREAM)
((SETQ STREAM (\LEAF.GETFILE DEV 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)))
(replace CBUFSIZE of STREAM with 0) (* For the benefit of uCode and PageMapped fns)
(replace CPPTR of STREAM with NIL)
(replace EOLCONVENTION of STREAM with (SELECTQ (fetch OSTYPE of SEQUIN)
((VMS TENEX TOPS20)
CRLF.EOLC)
(UNIX LF.EOLC)
CR.EOLC]
(RETURN STREAM])
(\LEAF.READFILENAME
[LAMBDA (STREAM HOST) (* bvm: "30-Sep-84 18:14")
(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 ROOTNAME)
(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))
(> (* Still in the directory, so forget what we heard
about a dot)
(SETQ BANG (SETQ DOTCOUNT 0)))
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]
(SETQ ROOTNAME (SUBSTRING REMOTENAME 1 (SUB1 BANG)))
(U-CASE (if [AND (EQ OSTYPE (QUOTE UNIX))
(EQ (NTHCHARCODE REMOTENAME -1)
(CHARCODE 0))
(EQ BANG (SUB1 (NCHARS REMOTENAME]
then (* Kludge: UNIX server has bug where versionless files
come back with name!0; strip off !0, since INFILEP will
never work)
ROOTNAME
else (CONCAT ROOTNAME (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: "22-SEP-83 11:53")
(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
((AND (NEQ IPUP \LEAF.BROKEN.STATUS)
(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 "Failed to read page of file" (fetch FULLFILENAME of STREAM))
(GO RETRY]
[COND
((ILESSP LEN BYTESPERPAGE)
(\ZEROBYTES BUF LEN (SUB1 BYTESPERPAGE]
LEN])
(\LEAF.REQUESTPAGE
[LAMBDA (STREAM PAGE# IMMEDIATE) (* bvm: "22-SEP-83 13:57")
(* 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)
(RETURN (COND
((\SENDLEAF (fetch LEAFCONNECTION of STREAM)
OPUP STREAM NIL (QUOTE GO)
(NOT IMMEDIATE))
(AND CACHE (RPLACD CACHE OPUP))
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: "19-SEP-83 17:09")
(COND
(HOST (PROG ([DEVICE (OR (\GETDEVICEFROMNAME HOST T T)
(AND (SETQ HOST (\CANONICAL.HOSTNAME HOST))
(\GETDEVICEFROMNAME HOST T T]
CONNECTION)
(RETURN (COND
((AND DEVICE (SETQ CONNECTION (fetch DEVICEINFO of DEVICE))
(fetch LEAFCACHEDFILE of CONNECTION))
(\LEAF.FLUSH.CACHE CONNECTION])
(LEAF.ASSURE.FINISHED
[LAMBDA (STREAM) (* bvm: "10-NOV-83 17:15")
(PROG [(SEQUIN (fetch LEAFCONNECTION of (SETQ STREAM (\DTEST STREAM (QUOTE STREAM]
TOP [COND
((type? SEQUIN SEQUIN)
(WITH.MONITOR (fetch SEQLOCK of SEQUIN)
(bind PUP
until [AND [OR [NOT (SETQ PUP (fetch SYSQUEUEHEAD
of (fetch SEQDONEQ of SEQUIN]
(while PUP never (PROG1 (EQ (fetch EPUSERFIELD
of PUP)
STREAM)
(SETQ PUP
(fetch EPLINK of PUP]
(OR [NOT (SETQ PUP (fetch SYSQUEUEHEAD
of (fetch SEQRETRANSMITQ
of SEQUIN]
(while PUP never (PROG1 (EQ (fetch EPUSERFIELD
of PUP)
STREAM)
(SETQ PUP
(fetch EPLINK of PUP]
do (* Not quite right, because it doesn't catch stuff in
the retransmit queue)
(MONITOR.AWAIT.EVENT (fetch SEQLOCK of SEQUIN)
(fetch SEQEVENT of SEQUIN)
\ETHERTIMEOUT)))
(COND
((NEQ (fetch LEAFERRORCNT of STREAM)
0)
(ERROR "Waiting for operation on broken file to finish" (fetch FULLFILENAME
of STREAM))
(GO TOP]
(RETURN T])
(\LEAF.FORCEOUTPUT
[LAMBDA (STREAM) (* bvm: "11-Jul-84 11:31")
(\PAGED.FORCEOUTPUT STREAM)
(LEAF.ASSURE.FINISHED STREAM])
(\LEAF.FLUSH.CACHE
[LAMBDA (SEQUIN) (* bvm: "19-SEP-83 17:14")
(WITH.MONITOR (fetch LEAFOPENCLOSELOCK of SEQUIN)
(PROG ((CACHE (fetch LEAFCACHEDFILE of SEQUIN)))
(RETURN (COND
((fetch LEAFREALLYOPEN of CACHE)
(replace LEAFCACHEDFILE of SEQUIN with NIL)
NIL)
(T (\LEAF.CLOSEFILE CACHE NIL NIL T)
(fetch SEQNAME of SEQUIN])
(\LEAF.RENAMEFILE
[LAMBDA (OLDFILE NEWFILE DEV) (* bvm: "31-OCT-83 17:51")
(OR (AND \FTPAVAILABLE (OR (NEQ (GETHOSTINFO (fetch DEVICENAME of DEV)
(QUOTE OSTYPE))
(QUOTE UNIX))
UNIXFTPFLG)
(\FTP.RENAMEFILE OLDFILE NEWFILE))
(\GENERIC.RENAMEFILE OLDFILE NEWFILE])
(\LEAF.REOPENFILE
[LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM) (* bvm: "12-SEP-83 14:16")
(* * 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 FDEV 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 FDEV 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: "12-SEP-83 14:16")
(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 DEV 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: "12-SEP-83 16:14")
(for BUF inside BUFFERLIST as PAGE# from FIRSTPAGE
do (\LEAF.LOOKUPCACHE STREAM PAGE# T) (* Invalidate any read-ahead of this page)
(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])
)
(* Main routing point for LEAF pups)
(DEFINEQ
(\SENDLEAF
[LAMBDA (SEQUIN PUP FILENAME NOERROR NOREPLY DONTWAIT) (* bvm: "10-NOV-83 15:37")
(PROG (RESULT)
TOP (OR SEQUIN (RETURN (LISPERROR "FILE NOT OPEN" FILENAME)))
(COND
((AND (type? STREAM FILENAME)
(NEQ (fetch LEAFERRORCNT of FILENAME)
0))
(ERROR
"Attempt to operate on broken file. Do not proceed until the problem has been resolved."
(fetch FULLFILENAME of FILENAME))
(GO TOP)))
(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))
(RETURN (COND
((NULL (PUTSEQUIN SEQUIN PUP DONTWAIT))
NIL)
(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: "14-SEP-83 11:06")
(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 (LEAFDEV CONNECTION FILES)
(RETURN (COND
((EQ HOST T)
(for DEV in (for DEVICE in \FILEDEVICES collect DEVICE
when (EQ (fetch OPENFILE of DEVICE)
(QUOTE \LEAF.OPENFILE)))
collect (BREAKCONNECTION DEV FAST)))
([SETQ LEAFDEV (COND
((type? FDEV HOST)
HOST)
((\GETDEVICEFROMNAME HOST T T))
((SETQ HOST (\CANONICAL.HOSTNAME HOST))
(\GETDEVICEFROMNAME HOST T T]
[COND
((SETQ FILES (for STREAM in \OPENFILES collect STREAM
when (EQ (fetch DEVICE of STREAM)
LEAFDEV)))
(COND
(FAST (SETQ \OPENFILES (LDIFFERENCE \OPENFILES FILES)))
(T (MAPC FILES (FUNCTION CLOSEF]
(AND (SETQ CONNECTION (fetch DEVICEINFO of LEAFDEV))
(\CLOSELEAFCONNECTION CONNECTION LEAFDEV])
(\CLOSELEAFCONNECTION
[LAMBDA (CONN DEVICE) (* bvm: "12-SEP-83 14:47")
(PROG1 [COND
((CLOSESEQUIN CONN)
(fetch SEQNAME of CONN))
(T (LIST (fetch SEQNAME of CONN)
(QUOTE aborted]
(replace DEVICEINFO of DEVICE with NIL])
(\OPENLEAFCONNECTION
[LAMBDA (HOST) (* bvm: "17-Jan-84 14:36")
(PROG (PROTOCOLS IFSPORT NAME/PASS)
[COND
([OR (MEMB HOST NONLEAFHOSTS)
(AND [LISTP (SETQ PROTOCOLS (GETHOSTINFO HOST (QUOTE PROTOCOLS]
(NOT (MEMB (QUOTE LEAF)
PROTOCOLS]
(RETURN \LEAF.NEVER.OPENED))
((NOT (SETQ IFSPORT (BESTPUPADDRESS HOST PROMPTWINDOW)))
(RETURN))
((ZEROP (CDR IFSPORT))
(SETQ IFSPORT (CONS (CAR IFSPORT)
\SOCKET.LEAF]
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOST))
(RETURN (WITH.MONITOR \LEAFCONNECTIONLOCK (* NOTE: Implicit RESETLST)
(PROG (CONN RESULT DATA OPUP)
[SETQ CONN (create SEQUIN
SEQNAME ← HOST
SEQFRNPORT ← IFSPORT
OSTYPE ←(GETHOSTINFO HOST (QUOTE OSTYPE))
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)
SEQTIMEDIN ←(FUNCTION \LEAF.TIMEDIN)
SEQCLOSED ←(FUNCTION \LEAF.WHENCLOSED)
SEQIDLEFN ←(FUNCTION \LEAF.IDLE)
SEQIDLETIMEOUTCOMPUTER ←(FUNCTION
\LEAF.IDLE?)
SEQOPENERRORHANDLER ←(FUNCTION
\LEAF.OPENERRORHANDLER)
SEQDONEQ ←(NCREATE (QUOTE SYSQUEUE))
LEAFCACHETIMER ←(\CREATECELL \FIXP)
SEQIGNOREDUPLICATES ← T
LEAFOPENCLOSELOCK ←(CREATE.MONITORLOCK
(CONCAT HOST "#LEAFOPEN"]
(INITSEQUIN CONN (PACK* HOST "#LEAF"))
(replace LEAFCACHEHITS of CONN with 0)
(replace LEAFCACHEMISSES of CONN with 0)
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (SEQUIN)
(AND RESETSTATE (\SEQUIN.CLOSE SEQUIN]
CONN))
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)
T)
(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)
(RETURN NIL))
(\LEAF.NEVER.OPENED (RETURN \LEAF.NEVER.OPENED))
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)
(\SEQUIN.CLOSE CONN)
(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: "26-Jul-84 16:44")
(DECLARE (GLOBALVARS \OPENFILES)) (* Called before LOGOUT etc to clean up any leaf
connections we have open)
(PROG (CONNECTION)
(SELECTQ FLG
[(BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT)
(COND
((SETQ CONNECTION (fetch DEVICEINFO of FDEV))
(\FLUSH.OPEN.STREAMS FDEV)
(* Would like to have a monitor on this to prevent other processes from writing files now, but it can't be the
main sequin lock)
(\CLOSELEAFCONNECTION CONNECTION FDEV]
[(AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(COND
((SETQ CONNECTION (fetch DEVICEINFO of FDEV))
(\SEQUIN.FLUSH.CONNECTION CONNECTION \SS.ABORT)))
(COND
((for STREAM in \OPENFILES never (EQ (fetch DEVICE of STREAM)
FDEV))
(* Association between hostname and host goes away over logout, so flush it. If there is a file open on it,
however, assume it's okay)
(\REMOVEDEVICE FDEV)))
(while \LOOKUPFILE.HOSTINFO bind ENTRY
do (* Flush LookUpFile info)
(COND
((fetch LOOKUPSOCKET of (SETQ ENTRY (pop \LOOKUPFILE.HOSTINFO)))
(CLOSEPUPSOCKET (fetch LOOKUPSOCKET of ENTRY]
NIL])
)
(* Functions called when various SEQUIN events occur)
(DEFINEQ
(\LEAF.ACKED
[LAMBDA (PUP SEQUIN) (* bvm: "12-SEP-83 16:48")
(* Called when a packet has been acked)
(\ENQUEUE (fetch SEQDONEQ of SEQUIN)
PUP)
(add (fetch SEQINPUTQLENGTH of SEQUIN)
1])
(\LEAF.FIX.BROKEN.SEQUIN
[LAMBDA (SEQUIN PUP) (* bvm: " 1-NOV-83 20:40")
(* 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)
(GO GET.NEW.CONNECTION)))
[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; " "trying to establish new connection...")
GET.NEW.CONNECTION
(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))
RETRY.NEW.CONNECTION
[COND
([SETQ NEWCONNECTION (\LEAF.RECONNECT (\GETDEVICEFROMNAME (fetch SEQNAME of SEQUIN))
(AND (EQ (fetch LEAFABORTSTATUS of SEQUIN)
(QUOTE ABORT))
(NOT (\CLOCKGREATERP (fetch SEQTIMER
of SEQUIN)
\LEAF.RECOVERY.TIMEOUT]
(* Succeeded in getting a new connection, so restore
files)
(\SEQUIN.FLUSH.CONNECTION SEQUIN)
(COND
(PUP (* Attempt to send PUP on a broken connection)
(AND AFFECTEDFILES (\REVALIDATEFILELST AFFECTEDFILES))
(RETURN (\LEAF.REPAIR.BROKEN.PUP SEQUIN PUP)))
((NOT (SETQ UNANSWEREDPUPS (\LEAF.USE.NEW.CONNECTION NEWCONNECTION UNANSWEREDPUPS
AFFECTEDFILES)))
(printout PROMPTWINDOW "done]" T)
(RETURN T]
(COND
((NULL (fetch LEAFABORTBUTTONWINDOW of SEQUIN))
(\SEQUIN.FLUSH.CONNECTION SEQUIN))
((forDuration 165140Q
do (COND
((EQ (fetch LEAFABORTSTATUS of SEQUIN)
(QUOTE ABORT))
(\SEQUIN.FLUSH.CONNECTION SEQUIN)
(RETURN T)))
(AWAIT.EVENT (fetch SEQEVENT of SEQUIN)
11610Q))
(RETURN))
(T (GO RETRY.NEW.CONNECTION)))
(* * 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(s). (RETURN) to try again to get a new connection."
(COND
((AND PUP (SETQ STRM (fetch EPUSERFIELD of PUP)))
(.NAMEORSTREAM. STRM))
(T (fetch SEQNAME of SEQUIN]
(GO RETRY.NEW.CONNECTION])
(\LEAF.REPAIR.BROKEN.PUP
[LAMBDA (OLDSEQUIN PUP) (* bvm: "18-OCT-83 17:55")
(* 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)
[COND
((OR (NULL STREAM)
(NOT (type? STREAM STREAM))) (* Not much to go on)
)
((AND (SETQ NEWCONNECTION (fetch LEAFCONNECTION of STREAM))
(NEQ NEWCONNECTION OLDSEQUIN)
(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))
(RETURN NEWCONNECTION))
(T (ERROR "File server connection broken" (OR (fetch FULLFILENAME of STREAM)
STREAM]
(replace LEAFSTATUS of PUP with \LEAF.BROKEN.STATUS)
(RETURN 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-Dec-84 18:31")
(* Called when a data sequin arrives)
(PROG ((PUPDATA (fetch PUPCONTENTS of PUP))
DONEPUP DONEPUPDATA ERROR OPCODE STREAM)
(* * 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
((NOT DONEPUP)
(RETURN (SHOULDNT "Leaf lost a packet somewhere!"]
(add (fetch SEQINPUTQLENGTH of SEQUIN)
-1)
[COND
((ZEROP (fetch ANSWERBIT of PUPDATA))
(HELP "Leaf Protocol violation--will terminate connection" (fetch SEQNAME of SEQUIN))
(RETURN (RELEASE.PUP PUP]
(COND
((EQ (SETQ OPCODE (fetch LEAFOPCODE of PUPDATA))
\LEAFOP.ERROR)
(SETQ OPCODE (fetch LEAFERROROPCODE of PUPDATA))
(SETQ ERROR T)))
(COND
((AND (NEQ (fetch LEAFOPCODE of (SETQ DONEPUPDATA (fetch PUPCONTENTS of DONEPUP)))
OPCODE)
LEAFDEBUGFLG) (* Protocol violation, but the buggy Vax server does
this)
(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))
(SETQ STREAM (fetch EPUSERFIELD of DONEPUP))
(COND
((type? STREAM STREAM)
(add (fetch LEAFERRORCNT of STREAM)
1)))
(replace EPUSERFIELD of DONEPUP with PUP)
(ADD.PROCESS (LIST (QUOTE \LEAF.ERROR)
PUP
(KWOTE STREAM)
SEQUIN DONEPUP)))
((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.OPENERRORHANDLER
[LAMBDA (SEQUIN PUP) (* bvm: "31-OCT-83 16:18")
(SELECTC (fetch ERRORPUPCODE of PUP)
(\PUPE.NOSOCKET (printout PROMPTWINDOW T "[No Leaf Server on " (fetch SEQNAME
of SEQUIN))
(COND
(\FTPAVAILABLE (printout PROMPTWINDOW "; trying FTP...")))
(printout PROMPTWINDOW "]")
\SS.NOSOCKET)
(\PUPE.NOROUTE (printout PROMPTWINDOW T "[No route to " (fetch SEQNAME of SEQUIN)
"]")
T)
NIL])
(\LEAF.TIMEDIN
[LAMBDA (SEQUIN) (* bvm: "21-SEP-83 18:05")
(COND
((fetch LEAFABORTBUTTONWINDOW of SEQUIN)
(CLOSEW (fetch LEAFABORTBUTTONWINDOW of SEQUIN))
(replace LEAFABORTBUTTONWINDOW of SEQUIN with NIL)
(replace LEAFABORTSTATUS of SEQUIN with NIL])
(\LEAF.TIMEDOUT
[LAMBDA (SEQUIN CNT) (* bvm: "21-SEP-83 18:00")
(* The SEQTIMEDOUT fn for LEAF)
(COND
((EQ (fetch LEAFABORTSTATUS of SEQUIN)
(QUOTE ABORT))
(\SEQUIN.CONTROL SEQUIN \SEQUIN.BROKEN)
(\SEQUIN.FLUSH.CONNECTION SEQUIN))
((EQ CNT \MAXLEAFTRIES)
(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)))
((EQ CNT (LLSH \MAXLEAFTRIES 1))
(\LEAF.TIMEDOUT.EXCESSIVE SEQUIN CNT])
(\LEAF.TIMEDOUT.EXCESSIVE
[LAMBDA (SEQUIN CNT) (* bvm: " 1-NOV-83 20:15")
(AND (WINDOWWORLDP)
(PROG ([W (CREATEW LEAFABORTREGION (CONCAT "Leaf Abort window for " (fetch SEQNAME
of SEQUIN]
(PUP (fetch SYSQUEUEHEAD of (fetch SEQDONEQ of SEQUIN)))
(FIRSTTIME T)
READFILES WRITEFILES X DATA PAGE FULLNAME)
(replace LEAFABORTBUTTONWINDOW of SEQUIN with W)
(printout W (fetch SEQNAME of SEQUIN)
" is not responding." T)
(PROG NIL
LP [COND
[(NULL PUP)
(COND
(FIRSTTIME (SETQ FIRSTTIME NIL)
(SETQ PUP (fetch SYSQUEUEHEAD of (fetch SEQRETRANSMITQ
of SEQUIN)))
(GO LP))
(T (for ENTRY in WRITEFILES
do (printout W T "Writing page")
(COND
((CDDR ENTRY)
(PRIN1 "s" W)))
(MAPRINT (CDR ENTRY)
W " " NIL ", ")
(printout W " of " (CAR ENTRY)))
(RETURN]
([AND (SETQ X (fetch EPUSERFIELD of PUP))
(OR (NOT (type? STREAM X))
(SETQ FULLNAME (fetch FULLFILENAME of X]
(COND
((AND (type? STREAM X)
(SELECTC (fetch LEAFOPCODE of (fetch PUPCONTENTS of PUP))
(\LEAFOP.WRITE (SETQ PAGE
(IPLUS (FOLDLO (fetch (LEAFDATA LOADDR)
of (SETQ DATA
(fetch PUPCONTENTS
of PUP)))
BYTESPERPAGE)
(LLSH (SIGNED (fetch (LEAFDATA
JUSTHIADDR)
of DATA)
BITSPERWORD)
7)))
T)
[(LIST \LEAFOP.CLOSE \LEAFOP.TRUNCATE)
(AND (DIRTYABLE X)
(SETQ PAGE (QUOTE EOF]
NIL))
(for ENTRY in WRITEFILES do [COND
((EQ (CAR ENTRY)
FULLNAME)
(RETURN (RPLACD ENTRY
(CONS PAGE (CDR ENTRY]
finally (push WRITEFILES (LIST FULLNAME PAGE)))
(pushnew READFILES FULLNAME))
((AND FULLNAME (NOT (FMEMB FULLNAME READFILES)))
(printout W T "Reading " FULLNAME)
(push READFILES FULLNAME]
(SETQ PUP (fetch EPLINK of PUP))
(GO LP))
(printout W T T "... will keep trying." T
"If you do not wish to wait for the server to resume operation, you can abort the connection by clicking ABORT below"
T)
(ADDMENU (create MENU
ITEMS ←(QUOTE (ABORT))
WHENSELECTEDFN ←(FUNCTION \LEAF.ABORT.FROMMENU))
W
(create POSITION
XCOORD ←(IQUOTIENT (IDIFFERENCE (WINDOWPROP W (QUOTE WIDTH))
(STRINGWIDTH (QUOTE ABORT)
MENUFONT))
2)
YCOORD ← 12Q))
(WINDOWPROP W (QUOTE SEQUIN)
SEQUIN)
(WINDOWPROP W (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(WINDOWPROP WINDOW (QUOTE SEQUIN)
NIL])
(\LEAF.ABORT.FROMMENU
[LAMBDA (ITEM MENU BUTTON) (* bvm: " 1-NOV-83 20:30")
(PROG ((WINDOW (WFROMMENU MENU))
SEQUIN)
(COND
([AND WINDOW (SETQ SEQUIN (WINDOWPROP WINDOW (QUOTE SEQUIN]
(SHADEITEM (QUOTE ABORT)
MENU GRAYSHADE)
(replace LEAFABORTSTATUS of SEQUIN with (QUOTE ABORT))
(NOTIFY.EVENT (fetch SEQEVENT of SEQUIN])
(\LEAF.STREAM.IN.QUEUE
[LAMBDA (SEQUIN IMPORTANT) (* bvm: "30-SEP-83 12:33")
(* 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)
(SELECTC (fetch LEAFOPCODE of (fetch PUPCONTENTS of PUP))
((LIST \LEAFOP.WRITE \LEAFOP.TRUNCATE)
T)
(\LEAFOP.CLOSE (DIRTYABLE X))
NIL]
(RETURN X)))
(SETQ PUP (fetch EPLINK of PUP))
(GO LP])
(\LEAF.IDLE
[LAMBDA (SEQUIN) (* bvm: "19-SEP-83 17:14")
(* Called after a suitable timeout with no activity on
connection)
(COND
[(fetch LEAFCACHEDFILE of SEQUIN)
(ADD.PROCESS (LIST (FUNCTION \LEAF.FLUSH.CACHE)
(KWOTE SEQUIN]
((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: "22-SEP-83 12:07")
(PROG ((CODE (COND
((EQ REASON \SS.NOSOCKET)
\LEAF.NEVER.OPENED)
(T \LEAF.BROKEN.STATUS)))
PUP DEVICE)
(replace LEAFCACHEDFILE of SEQUIN with NIL) (* Break this potential circular link)
(COND
((fetch LEAFABORTBUTTONWINDOW of SEQUIN)
(CLOSEW (fetch LEAFABORTBUTTONWINDOW of SEQUIN))
(replace LEAFABORTBUTTONWINDOW of SEQUIN with NIL)))
(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))
(replace SEQINPUTQLENGTH of SEQUIN with 0)
(AND (SETQ DEVICE (\GETDEVICEFROMNAME (fetch SEQNAME of SEQUIN)
T T))
(EQ (fetch DEVICEINFO of DEVICE)
SEQUIN)
(replace DEVICEINFO of DEVICE with NIL])
(\LEAF.IDLE?
[LAMBDA (SEQUIN) (* bvm: "12-SEP-83 16:52")
(* Tells SEQUIN process how long to block when it
otherwise has nothing to do, i.e. no packets remain
unacked)
(COND
((NEQ (fetch SEQINPUTQLENGTH of SEQUIN)
0) (* Still waiting for something)
NIL)
((fetch LEAFCACHEDFILE of SEQUIN)
\LEAF.CACHETIMEOUT)
(T (* For now, wait forever)
\LEAF.IDLETIMEOUT])
)
(ADDTOVAR NETWORKOSTYPES )
(* Miscellaneous and error handling)
(DEFINEQ
(\ADDLEAFSTRING
[LAMBDA (PUP STRING DECODE) (* bvm: " 3-NOV-83 22:30")
(PROG ((PUPBASE (fetch PUPCONTENTS of PUP))
LEAFLEN STRLEN STRBASE STROFF PUPSTRBASE 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 (SETQ PUPSTRBASE (\ADDBASE PUPBASE (FOLDLO LEAFLEN BYTESPERWORD)))
0 STRLEN)
(SETQ PUPSTRBASE (\ADDBASE PUPSTRBASE 1))
(COND
((ZEROP STRLEN))
[DECODE (for I from 0 to (SUB1 STRLEN) do (\PUTBASEBYTE PUPSTRBASE I
(\DECRYPT.PWD.CHAR
(\GETBASEBYTE STRBASE
(IPLUS I STROFF]
(T (\MOVEBYTES STRBASE STROFF PUPSTRBASE 0 STRLEN)))
(replace LEAFLENGTH of PUPBASE with NEWLENGTH])
(\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-SEP-83 15:06")
(* 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 {)
(COND
(CONNECTION (fetch SEQNAME of CONNECTION))
(T \CONNECTED.HOST))
"}<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 SENTPUP) (* bvm: "26-Jul-84 16:53")
(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)
)
(\IFSERROR.BAD.HANDLE (ERROR
"Leaf Error: Bad Handle.
This shouldn't happen: Lisp and the server have different ideas about which file they are talking about. All operations to this file are now suspended. See a wizard if possible."
(fetch FULLFILENAME of FILENAME)))
(PROGN [SETQ MSG
(SELECTC ERRCODE
(\IFSERROR.BUSY "File busy")
(\IFS.ERROR.BROKEN.LEAF
"Leaf Broken--a file you had open was accessed by another user while it was idle.")
(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])
(GETHOSTINFO
[LAMBDA (HOST ATTRIBUTE) (* bvm: " 3-NOV-83 23:44")
(PROG ((NSFLG (STRPOS (QUOTE :)
HOST))
INFO)
(OR NSFLG (SETQ HOST (\CANONICAL.HOSTNAME HOST))
(RETURN))
(SETQ INFO (ASSOC HOST NETWORKOSTYPES))
(RETURN (SELECTQ ATTRIBUTE
[(OS OSTYPE)
(COND
((NULL INFO)
(AND NSFLG (QUOTE NS)))
((LITATOM (CDR INFO))
(CDR INFO))
(T (LISTGET (CDR INFO)
(QUOTE OSTYPE]
[PROTOCOLS (COND
((LITATOM (CDR INFO))
(SELECTQ (CDR INFO)
(IFS (QUOTE (LEAF PUPFTP CHAT LOOKUPFILE)))
NIL))
(T (LISTGET (CDR INFO)
(QUOTE PROTOCOLS]
NIL])
(GETOSTYPE
[LAMBDA (HOST) (* bvm: "31-OCT-83 17:08")
(GETHOSTINFO HOST (QUOTE OSTYPE])
)
(* LookUpFile stuff)
(DEFINEQ
(\IFS.LOOKUPFILE
[LAMBDA (NAME RECOG ATTRIBUTE HOSTNAME) (* bvm: "12-Jul-84 14:22")
(* * Attempt to use the LookupFile protocol to get full filename)
(PROG ((RESULT (QUOTE ?))
REMOTENAME SEMI NAME/PASS OSTYPE NAME/PASS START DOT ROOTNAME INFO IPUP OPUP PUPSOC DIREND)
(COND
[(AND (EQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(SETQ START (STRPOS (QUOTE })
NAME 2))
(OR HOSTNAME (SETQ HOSTNAME (\CANONICAL.HOSTNAME (SUBATOM NAME 2 (SUB1 START]
(T (RETURN)))
[SETQ INFO (OR (ASSOC HOSTNAME \LOOKUPFILE.HOSTINFO)
(CAR (push \LOOKUPFILE.HOSTINFO (create LOOKUPFILEHOSTINFO
LOOKUPHOST ← HOSTNAME
LOOKUPSOCKET ←(OPENPUPSOCKET)
LOOKUPLOCK ←(CREATE.MONITORLOCK
"LookUpFile")
LOOKUPFAILCNT ← 0]
(OR (fetch LOOKUPSOCKET of INFO)
(RETURN RESULT))
(SETQ NAME/PASS (\INTERNAL/GETPASSWORD HOSTNAME))
[SETQ ROOTNAME (U-CASE (SUBSTRING NAME (ADD1 START)
(COND
([SETQ SEMI (OR (STRPOS (QUOTE ;)
NAME
(ADD1 START))
(STRPOS (QUOTE !)
NAME
(ADD1 START]
(PROG1 (SUB1 SEMI)
(COND
((EQ SEMI (NCHARS NAME))
(* Not really a version there)
(SETQ SEMI NIL]
(while (SETQ DOT (STRPOS (QUOTE >)
ROOTNAME DIREND))
do (SETQ DIREND (ADD1 DOT)))
[COND
((NOT DIREND)
(SETQ DIREND (IMINUS (NCHARS ROOTNAME)))
(SETQ ROOTNAME (CONCAT (QUOTE <)
(U-CASE (CAR NAME/PASS))
(QUOTE >)
ROOTNAME]
(COND
[(STRPOS (QUOTE %.)
ROOTNAME DIREND)
(SETQ DOT (EQ (NTHCHARCODE ROOTNAME -1)
(CHARCODE %.]
(T (SETQ ROOTNAME (CONCAT ROOTNAME (QUOTE %.)))
(SETQ DOT T))) (* DOT now T if filename is extensionless.
ROOTNAME is everything but the version)
[SETQ REMOTENAME (COND
[(EQ (SETQ OSTYPE (GETHOSTINFO HOSTNAME (QUOTE OSTYPE)))
(QUOTE TENEX)) (* Our filenames are already Tenex style)
(COND
((OR SEMI (NEQ RECOG (QUOTE OLDEST)))
ROOTNAME)
(T (CONCAT ROOTNAME ";-2"]
[SEMI (* Use ! for version delimiter)
(CONCAT (COND
(DOT (SUBSTRING ROOTNAME 1 -2))
(T ROOTNAME))
(COND
((EQ OSTYPE (QUOTE TOPS20))
(QUOTE %.))
(T (QUOTE !)))
(SUBSTRING NAME (ADD1 SEMI]
((EQ OSTYPE (QUOTE TOPS20))
(COND
((EQ RECOG (QUOTE OLDEST))
(CONCAT ROOTNAME ".-2"))
(T ROOTNAME)))
(T (SETQ REMOTENAME (COND
(DOT (SUBSTRING ROOTNAME 1 -2))
(T ROOTNAME)))
(COND
((EQ RECOG (QUOTE OLDEST))
(CONCAT REMOTENAME "!L"))
(T REMOTENAME]
[WITH.MONITOR (fetch LOOKUPLOCK of INFO)
(COND
((SETQ PUPSOC (fetch LOOKUPSOCKET of INFO))
(SETUPPUP (SETQ OPUP (ALLOCATE.PUP))
HOSTNAME \SOCKET.LOOKUPFILE \PT.LOOKUPFILE NIL PUPSOC)
(\PUTPUPSTRING OPUP REMOTENAME)
[to \MAXETHERTRIES when (SETQ IPUP (EXCHANGEPUPS PUPSOC OPUP NIL T))
do (SELECTC (fetch PUPTYPE of IPUP)
[\PT.LOOKUPFILEREPLY
(RETURN (SETQ RESULT
(SELECTQ ATTRIBUTE
((NAME NIL)
(PACK* (QUOTE {)
HOSTNAME
(QUOTE })
ROOTNAME
(QUOTE ;)
(fetch LOOKUPVERSION
of IPUP)))
[CREATIONDATE
(GDATE (ALTO.TO.LISP.DATE
(fetch LOOKUPCREATIONDATE
of IPUP]
(ICREATIONDATE (ALTO.TO.LISP.DATE
(fetch
LOOKUPCREATIONDATE
of IPUP)))
(LENGTH (fetch LOOKUPLENGTH
of IPUP))
(\ILLEGAL.ARG ATTRIBUTE]
(\PT.LOOKUPFILEERROR
(* No such file)
(RETURN (SETQ RESULT NIL)))
[\PT.ERROR (COND
((EQ (fetch ERRORPUPCODE of IPUP)
\PUPE.NOSOCKET)
(* No such socket)
(AND PUPTRACEFLG (PRINTERRORPUP IPUP
PUPTRACEFILE))
(replace LOOKUPSOCKET of INFO with NIL)
(CLOSEPUPSOCKET PUPSOC)
(RETURN]
NIL)
(RELEASE.PUP IPUP)
finally (SETQ IPUP)
(COND
(PUPTRACEFLG "LookupFile timed out" T))
(COND
((AND (fetch LOOKUPFAILCNT of INFO)
(IGREATERP (add (fetch LOOKUPFAILCNT of INFO)
1)
4))
(replace LOOKUPSOCKET of INFO with NIL)
(CLOSEPUPSOCKET PUPSOC]
(AND IPUP (RELEASE.PUP IPUP))
(COND
((NEQ RESULT (QUOTE ?))
(replace LOOKUPFAILCNT of INFO with NIL]
(RETURN RESULT])
)
(RPAQ? \LOOKUPFILE.HOSTINFO )
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ LOOKUPFILECOMS ((CONSTANTS \PT.LOOKUPFILE \PT.LOOKUPFILEREPLY \PT.LOOKUPFILEERROR
\SOCKET.LOOKUPFILE)
(RECORDS LOOKUPFILEDATA LOOKUPFILEHOSTINFO)
(GLOBALVARS \LOOKUPFILE.HOSTINFO)))
(DECLARE: EVAL@COMPILE
(RPAQQ \PT.LOOKUPFILE 200Q)
(RPAQQ \PT.LOOKUPFILEREPLY 201Q)
(RPAQQ \PT.LOOKUPFILEERROR 202Q)
(RPAQQ \SOCKET.LOOKUPFILE 61Q)
(CONSTANTS \PT.LOOKUPFILE \PT.LOOKUPFILEREPLY \PT.LOOKUPFILEERROR \SOCKET.LOOKUPFILE)
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS LOOKUPFILEDATA ((LOOKUPFILEBASE (fetch PUPCONTENTS of DATUM)))
(BLOCKRECORD LOOKUPFILEBASE ((LOOKUPVERSION WORD)
(LOOKUPCREATIONDATE FIXP)
(LOOKUPLENGTH FIXP))))
(RECORD LOOKUPFILEHOSTINFO (LOOKUPHOST LOOKUPSOCKET LOOKUPLOCK . LOOKUPFAILCNT))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LOOKUPFILE.HOSTINFO)
)
)
(DEFINEQ
(\LEAFINIT
[LAMBDA NIL (* bvm: "12-SEP-83 15:39")
(SETQ \LEAFCONNECTIONLOCK (CREATE.MONITORLOCK (QUOTE LEAF)))
(\DEFINEDEVICE NIL (create FDEV
DEVICENAME ←(QUOTE LEAF)
RESETABLE ← T
RANDOMACCESSP ← T
PAGEMAPPED ← T
HOSTNAMEP ←(FUNCTION \LEAF.DEVICEP)
EVENTFN ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILEINFO ←(FUNCTION \ILLEGAL.DEVICEOP)
OPENFILE ←(FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ←(FUNCTION \ILLEGAL.DEVICEOP)
GENERATEFILES ←(FUNCTION \ILLEGAL.DEVICEOP)
DIRECTORYNAMEP ←(FUNCTION \ILLEGAL.DEVICEOP)
RENAMEFILE ←(FUNCTION \ILLEGAL.DEVICEOP])
)
(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? LEAFABORTREGION (QUOTE (641Q 1150Q 617Q 300Q)))
(RPAQ? \MAXLEAFTRIES 4)
(RPAQ? NOFILEPROPERROR )
(RPAQ? DEFAULTFILETYPE (QUOTE TEXT))
(RPAQ? \SOCKET.LEAF 43Q)
(RPAQ? \SEQUIN.TIMEOUTMAX 23420Q)
(RPAQ? \LEAF.IDLETIMEOUT 6673500Q)
(RPAQ? \LEAF.CACHETIMEOUT 257620Q)
(RPAQ? \LEAF.MAXCACHE 12Q)
(RPAQ? \LEAF.RECOVERY.TIMEOUT 2223700Q)
(RPAQ? \LEAF.MAXLOOKAHEAD 4)
(RPAQ? \FTPAVAILABLE )
(RPAQ? UNIXFTPFLG )
(RPAQ? NONLEAFHOSTS )
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ LEAFCOMPILETIMECOMS ((RECORDS LEAFDATA LEAFERRORDATA LEAFPARAMSDATA LEAFPACKET LEAFINFOBLOCK
LEAFSTREAM)
(MACROS .NAMEORSTREAM. .PAGE.IS.AFTER.EOF.)
(CONSTANTS * LEAFOPCODES)
(CONSTANTS * IFSERRORS)
(CONSTANTS (\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))
(CONSTANTS (\FT.TEXT 1)
(\FT.BINARY 2)
(\FT.UNKNOWN 0))
(LOCALVARS . T)
(GLOBALVARS \LEAFDEVICE \SOCKET.LEAF LEAFDEBUGFLG PUPTRACEFLG NOFILEPROPERROR NETWORKOSTYPES
LEAFOPCODES SEQUINOPS DEFAULTFILETYPE \LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT
\LEAF.MAXLOOKAHEAD \OPENFILES \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE
UNIXFTPFLG \SEQUIN.TIMEOUTMAX LEAFABORTREGION \MAXLEAFTRIES
\LEAF.RECOVERY.TIMEOUT NONLEAFHOSTS \FTPFDEV)))
[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))
(LEAFERRORCNT (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE))))
]
(DECLARE: EVAL@COMPILE
(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 IFSERRORS ((\IFSERROR.BAD.CHARACTER 312Q)
(\IFSERROR.MALFORMED (QUOTE (311Q 312Q)))
(\IFSERROR.FILE.NOT.FOUND 317Q)
(\IFSERROR.PROTECTION 320Q)
(\IFSERROR.BUSY 321Q)
(\IFSERROR.INVALID.DIRECTORY 322Q)
(\IFSERROR.ALLOCATION 323Q)
(\IFSERROR.USERNAME 330Q)
(\IFSERROR.PASSWORD 331Q)
(\IFSERROR.NO.LOGIN 332Q)
(\PASSWORD.ERRORS (QUOTE (330Q 331Q 332Q 337Q)))
(\IFSERROR.CONNECTNAME 333Q)
(\IFSERROR.CONNECTPASSWORD 334Q)
(\CONNECT.PASSWORD.ERRORS (QUOTE (333Q 334Q)))
(\IFSERROR.NEED.USERNAME 337Q)
(\IFS.ERROR.BROKEN.LEAF 1751Q)
(\IFSERROR.BAD.HANDLE 1763Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \IFSERROR.BAD.CHARACTER 312Q)
(RPAQQ \IFSERROR.MALFORMED (311Q 312Q))
(RPAQQ \IFSERROR.FILE.NOT.FOUND 317Q)
(RPAQQ \IFSERROR.PROTECTION 320Q)
(RPAQQ \IFSERROR.BUSY 321Q)
(RPAQQ \IFSERROR.INVALID.DIRECTORY 322Q)
(RPAQQ \IFSERROR.ALLOCATION 323Q)
(RPAQQ \IFSERROR.USERNAME 330Q)
(RPAQQ \IFSERROR.PASSWORD 331Q)
(RPAQQ \IFSERROR.NO.LOGIN 332Q)
(RPAQQ \PASSWORD.ERRORS (330Q 331Q 332Q 337Q))
(RPAQQ \IFSERROR.CONNECTNAME 333Q)
(RPAQQ \IFSERROR.CONNECTPASSWORD 334Q)
(RPAQQ \CONNECT.PASSWORD.ERRORS (333Q 334Q))
(RPAQQ \IFSERROR.NEED.USERNAME 337Q)
(RPAQQ \IFS.ERROR.BROKEN.LEAF 1751Q)
(RPAQQ \IFSERROR.BAD.HANDLE 1763Q)
(CONSTANTS (\IFSERROR.BAD.CHARACTER 312Q)
(\IFSERROR.MALFORMED (QUOTE (311Q 312Q)))
(\IFSERROR.FILE.NOT.FOUND 317Q)
(\IFSERROR.PROTECTION 320Q)
(\IFSERROR.BUSY 321Q)
(\IFSERROR.INVALID.DIRECTORY 322Q)
(\IFSERROR.ALLOCATION 323Q)
(\IFSERROR.USERNAME 330Q)
(\IFSERROR.PASSWORD 331Q)
(\IFSERROR.NO.LOGIN 332Q)
(\PASSWORD.ERRORS (QUOTE (330Q 331Q 332Q 337Q)))
(\IFSERROR.CONNECTNAME 333Q)
(\IFSERROR.CONNECTPASSWORD 334Q)
(\CONNECT.PASSWORD.ERRORS (QUOTE (333Q 334Q)))
(\IFSERROR.NEED.USERNAME 337Q)
(\IFS.ERROR.BROKEN.LEAF 1751Q)
(\IFSERROR.BAD.HANDLE 1763Q))
)
(DECLARE: EVAL@COMPILE
(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 (\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 \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)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \LEAFDEVICE \SOCKET.LEAF LEAFDEBUGFLG PUPTRACEFLG NOFILEPROPERROR NETWORKOSTYPES
LEAFOPCODES SEQUINOPS DEFAULTFILETYPE \LEAF.IDLETIMEOUT \LEAF.CACHETIMEOUT
\LEAF.MAXLOOKAHEAD \OPENFILES \LEAF.MAXCACHE \LEAFCONNECTIONLOCK \FTPAVAILABLE UNIXFTPFLG
\SEQUIN.TIMEOUTMAX LEAFABORTREGION \MAXLEAFTRIES \LEAF.RECOVERY.TIMEOUT NONLEAFHOSTS
\FTPFDEV)
)
)
(PUTPROPS LEAF COPYRIGHT ("Xerox Corporation" 3677Q 3700Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (33456Q 43131Q (CLOSESEQUIN 33470Q . 34416Q) (INITSEQUIN 34420Q . 36716Q) (GETSEQUIN
36720Q . 40122Q) (PUTSEQUIN 40124Q . 43127Q)) (43132Q 107046Q (\SEQUIN.CONTROL 43144Q . 44113Q) (
\SEQUIN.PUT 44115Q . 47620Q) (\SEQUIN.PROCESS 47622Q . 60300Q) (\SEQUIN.CLOSE 60302Q . 61106Q) (
\SEQUIN.FLUSH.CONNECTION 61110Q . 63011Q) (\SEQUIN.CLEANUP 63013Q . 64043Q) (\SEQUIN.FLUSH.RETRANSMIT
64045Q . 64711Q) (\SEQUIN.COMPARE 64713Q . 65632Q) (\SEQUIN.HANDLE.INPUT 65634Q . 77712Q) (
\SEQUIN.OUT.OF.THE.BLUE 77714Q . 100532Q) (\SEQUIN.HANDLE.ACK 100534Q . 102776Q) (\SEQUIN.RETRANSMIT
103000Q . 105343Q) (\SEQUIN.RETRANSMITNEXT 105345Q . 107044Q)) (107112Q 244477Q (\LEAF.CLOSEFILE
107124Q . 116144Q) (\LEAF.DELETEFILE 116146Q . 120033Q) (\LEAF.DEVICEP 120035Q . 124410Q) (
\LEAF.RECONNECT 124412Q . 125536Q) (\LEAF.DIRECTORYNAMEP 125540Q . 130113Q) (\LEAF.GENERATEFILES
130115Q . 130517Q) (\LEAF.GETFILE 130521Q . 150523Q) (\PARSE.REMOTE.FILENAME 150525Q . 154151Q) (
\LEAF.GETFILEDATES 154153Q . 155717Q) (\LEAF.GETFILEINFO 155721Q . 160170Q) (\LEAF.GETFILEINFO.OPEN
160172Q . 163574Q) (\LEAF.GETFILENAME 163576Q . 164772Q) (\LEAF.OPENFILE 164774Q . 174213Q) (
\LEAF.READFILENAME 174215Q . 201513Q) (\LEAF.READFILEPROP 201515Q . 204034Q) (\LEAF.READPAGES 204036Q
. 207057Q) (\LEAF.REQUESTPAGE 207061Q . 213320Q) (\LEAF.LOOKUPCACHE 213322Q . 215617Q) (
CLEAR.LEAF.CACHE 215621Q . 216573Q) (LEAF.ASSURE.FINISHED 216575Q . 221423Q) (\LEAF.FORCEOUTPUT
221425Q . 221716Q) (\LEAF.FLUSH.CACHE 221720Q . 222654Q) (\LEAF.RENAMEFILE 222656Q . 223412Q) (
\LEAF.REOPENFILE 223414Q . 227244Q) (\LEAF.CREATIONDATE 227246Q . 227565Q) (\LEAF.SETCREATIONDATE
227567Q . 232315Q) (\LEAF.SETFILEINFO 232317Q . 233651Q) (\LEAF.SETFILETYPE 233653Q . 237126Q) (
\LEAF.SETVALIDATION 237130Q . 237771Q) (\LEAF.TRUNCATEFILE 237773Q . 242035Q) (\LEAF.WRITEPAGES
242037Q . 244475Q)) (244555Q 247665Q (\SENDLEAF 244567Q . 247663Q)) (247734Q 270211Q (BREAKCONNECTION
247746Q . 252413Q) (\CLOSELEAFCONNECTION 252415Q . 253132Q) (\OPENLEAFCONNECTION 253134Q . 265304Q) (
\LEAF.EVENTFN 265306Q . 270207Q)) (270310Q 344207Q (\LEAF.ACKED 270322Q . 271041Q) (
\LEAF.FIX.BROKEN.SEQUIN 271043Q . 303255Q) (\LEAF.REPAIR.BROKEN.PUP 303257Q . 305724Q) (
\LEAF.USE.NEW.CONNECTION 305726Q . 313553Q) (\LEAF.RESENDPUPS 313555Q . 314144Q) (\LEAF.HANDLE.INPUT
314146Q . 321004Q) (\LEAF.OPENERRORHANDLER 321006Q . 322110Q) (\LEAF.TIMEDIN 322112Q . 322656Q) (
\LEAF.TIMEDOUT 322660Q . 326406Q) (\LEAF.TIMEDOUT.EXCESSIVE 326410Q . 334155Q) (\LEAF.ABORT.FROMMENU
334157Q . 335035Q) (\LEAF.STREAM.IN.QUEUE 335037Q . 337314Q) (\LEAF.IDLE 337316Q . 340565Q) (
\LEAF.WHENCLOSED 340567Q . 342757Q) (\LEAF.IDLE? 342761Q . 344205Q)) (344325Q 362770Q (\ADDLEAFSTRING
344337Q . 347377Q) (\FIXPASSWORD 347401Q . 351245Q) (\GETLEAFSTRING 351247Q . 352061Q) (
\IFSERRORSTRING 352063Q . 355514Q) (\LEAF.ERROR 355516Q . 360510Q) (\LEAF.DIRECTORYNAMEONLY 360512Q .
361176Q) (GETHOSTINFO 361200Q . 362540Q) (GETOSTYPE 362542Q . 362766Q)) (363026Q 375041Q (
\IFS.LOOKUPFILE 363040Q . 375037Q)) (376711Q 400412Q (\LEAFINIT 376723Q . 400410Q)) (400462Q 407410Q (
PRINTLEAF 400474Q . 407406Q)))))
STOP