(FILECREATED "23-Sep-86 16:35:51" {ERIS}<LISPCORE>MSPF>LEAF.;1 551623Q
changes to: (VARS LEAFCOMS)
(FNS \LEAF.CLOSEFILE \LEAF.DEVICEP \LEAF.OPENFILE)
previous date: "31-Jul-86 18:55:49" {ERIS}<LISPCORE>SOURCES>LEAF.;31)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LEAFCOMS)
(RPAQQ LEAFCOMS
((* ;;; "Support for the Leaf random-access filing protocol")
(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))
(COMS (* ;; "Miscellaneous and error handling")
(FNS \ADDLEAFSTRING \FIXPASSWORD \GETLEAFSTRING \IFSERRORSTRING \LEAF.ERROR
\LEAF.DIRECTORYNAMEONLY GETHOSTINFO GETOSTYPE)
(VARS (DEFAULT.OSTYPE (QUOTE IFS)))
(GLOBALVARS DEFAULT.OSTYPE))
(COMS (* ;; "LookUpFile stuff")
(FNS \IFS.LOOKUPFILE)
(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))
(INITRECORDS PUPFILESERVER)
(SYSRECORDS PUPFILESERVER)))
(* ;;; "Support for the Leaf random-access filing protocol")
(* ;; "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)
(NIL POINTER)
(NIL 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)
(NIL 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))
(QUOTE ((SEQUIN 0 POINTER)
(SEQUIN 2 POINTER)
(SEQUIN 4 POINTER)
(SEQUIN 4 (BITS . 7))
(SEQUIN 2 (BITS . 7))
(SEQUIN 0 (BITS . 7))
(SEQUIN 6 (BITS . 7))
(SEQUIN 7 (BITS . 17Q))
(SEQUIN 10Q (BITS . 17Q))
(SEQUIN 11Q (BITS . 17Q))
(SEQUIN 12Q (BITS . 17Q))
(SEQUIN 13Q (BITS . 17Q))
(SEQUIN 14Q (BITS . 17Q))
(SEQUIN 15Q (BITS . 17Q))
(SEQUIN 16Q (BITS . 17Q))
(SEQUIN 17Q (BITS . 17Q))
(SEQUIN 20Q (BITS . 17Q))
(SEQUIN 21Q (BITS . 17Q))
(SEQUIN 22Q (BITS . 17Q))
(SEQUIN 23Q (BITS . 17Q))
(SEQUIN 24Q POINTER)
(SEQUIN 26Q POINTER)
(SEQUIN 30Q POINTER)
(SEQUIN 30Q (FLAGBITS . 0))
(SEQUIN 30Q (FLAGBITS . 20Q))
(SEQUIN 30Q (FLAGBITS . 40Q))
(SEQUIN 30Q (FLAGBITS . 60Q))
(SEQUIN 32Q POINTER)
(SEQUIN 34Q POINTER)
(SEQUIN 36Q POINTER)
(SEQUIN 40Q POINTER)
(SEQUIN 42Q POINTER)
(SEQUIN 44Q POINTER)
(SEQUIN 46Q POINTER)
(SEQUIN 50Q POINTER)
(SEQUIN 52Q POINTER)
(SEQUIN 54Q POINTER)
(SEQUIN 56Q POINTER)
(SEQUIN 60Q POINTER)
(SEQUIN 62Q POINTER)
(SEQUIN 64Q POINTER)
(SEQUIN 66Q POINTER)
(SEQUIN 70Q POINTER)
(SEQUIN 72Q POINTER)
(SEQUIN 74Q POINTER)
(SEQUIN 76Q (BITS . 17Q))
(SEQUIN 77Q (BITS . 17Q))
(SEQUIN 100Q (BITS . 17Q))
(SEQUIN 74Q (FLAGBITS . 0))
(SEQUIN 102Q POINTER)
(SEQUIN 104Q POINTER)
(SEQUIN 106Q POINTER)
(SEQUIN 110Q POINTER)
(SEQUIN 112Q POINTER)
(SEQUIN 114Q POINTER)
(SEQUIN 116Q POINTER)))
(QUOTE 120Q))
(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))
(QUOTE ((SEQUIN 0 POINTER)
(SEQUIN 2 POINTER)
(SEQUIN 4 POINTER)
(SEQUIN 4 (BITS . 7))
(SEQUIN 2 (BITS . 7))
(SEQUIN 0 (BITS . 7))
(SEQUIN 6 (BITS . 7))
(SEQUIN 7 (BITS . 17Q))
(SEQUIN 10Q (BITS . 17Q))
(SEQUIN 11Q (BITS . 17Q))
(SEQUIN 12Q (BITS . 17Q))
(SEQUIN 13Q (BITS . 17Q))
(SEQUIN 14Q (BITS . 17Q))
(SEQUIN 15Q (BITS . 17Q))
(SEQUIN 16Q (BITS . 17Q))
(SEQUIN 17Q (BITS . 17Q))
(SEQUIN 20Q (BITS . 17Q))
(SEQUIN 21Q (BITS . 17Q))
(SEQUIN 22Q (BITS . 17Q))
(SEQUIN 23Q (BITS . 17Q))
(SEQUIN 24Q POINTER)
(SEQUIN 26Q POINTER)
(SEQUIN 30Q POINTER)
(SEQUIN 30Q (FLAGBITS . 0))
(SEQUIN 30Q (FLAGBITS . 20Q))
(SEQUIN 30Q (FLAGBITS . 40Q))
(SEQUIN 30Q (FLAGBITS . 60Q))
(SEQUIN 32Q POINTER)
(SEQUIN 34Q POINTER)
(SEQUIN 36Q POINTER)
(SEQUIN 40Q POINTER)
(SEQUIN 42Q POINTER)
(SEQUIN 44Q POINTER)
(SEQUIN 46Q POINTER)
(SEQUIN 50Q POINTER)
(SEQUIN 52Q POINTER)
(SEQUIN 54Q POINTER)
(SEQUIN 56Q POINTER)
(SEQUIN 60Q POINTER)
(SEQUIN 62Q POINTER)
(SEQUIN 64Q POINTER)
(SEQUIN 66Q POINTER)
(SEQUIN 70Q POINTER)
(SEQUIN 72Q POINTER)
(SEQUIN 74Q POINTER)
(SEQUIN 76Q (BITS . 17Q))
(SEQUIN 77Q (BITS . 17Q))
(SEQUIN 100Q (BITS . 17Q))
(SEQUIN 74Q (FLAGBITS . 0))
(SEQUIN 102Q POINTER)
(SEQUIN 104Q POINTER)
(SEQUIN 106Q POINTER)
(SEQUIN 110Q POINTER)
(SEQUIN 112Q POINTER)
(SEQUIN 114Q POINTER)
(SEQUIN 116Q POINTER)))
(QUOTE 120Q))
[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)
(NIL POINTER)
(NIL POINTER)
(LEAFCACHEDFILE POINTER)
(LEAFCACHETIMER POINTER)
(LEAFCACHEHITS WORD)
(LEAFCACHEMISSES WORD)
(LEAFTIMEOUTCOUNT WORD)
(LEAFCLOSING FLAG)
(LEAFOPENCLOSELOCK POINTER)
(LEAFABORTBUTTONWINDOW POINTER)
(LEAFABORTSTATUS POINTER)
(NIL POINTER)
(SEQTIMEDIN POINTER)
(NIL 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) (* bvm: " 8-Nov-85 12:54")
(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 (EQ (fetch #UNACKEDSEQS
of SEQUIN)
0)
(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)
(INCLEAFSTAT (fetch #SEQTIMEOUTS of SEQUIN))
[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: " 3-Jan-85 17:32")
(WITH.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: " 6-Jan-85 00:14")
(* * Function to return sequence comparison on received pups)
(PROG ((DIF (LOGAND (IDIFFERENCE X Y)
377Q)))
(RETURN (COND
((EQ DIF 0)
\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: " 8-Nov-85 12:55")
(* * 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
[(EQ (SETQ ALLOC (fetch (SEQUINPACKET ALLOCATE) of PUP))
0)
(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 (INCLEAFSTAT (fetch #SEQRESTARTS of SEQUIN))
(\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
(INCLEAFSTAT (fetch #SEQDUPLICATES of SEQUIN))
(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) (* hdj "23-Sep-86 15:40")
(* ;;; "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")
(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")
(LET ((CACHE (fetch LEAFCACHEDFILE of CONNECTION)))
(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) (* hdj "23-Jun-86 15:13")
(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) (* hdj "23-Sep-86 15:41")
(* ;;;
"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 ←
(create PUPFILESERVER
PFSNAME ← NAME
PFSOSTYPE ←
(GETHOSTINFO NAME
(QUOTE OSTYPE))
PFSLEAFSEQUIN ← SEQUIN)
FORCEOUTPUT ←
(FUNCTION \LEAF.FORCEOUTPUT)
OPENP ← (FUNCTION \GENERIC.OPENP
)
REGISTERFILE ←
(FUNCTION \ADD-OPEN-STREAM)
UNREGISTERFILE ←
(FUNCTION
\GENERIC-UNREGISTER-STREAM)))))
DEVICE)
((AND \FTPAVAILABLE (SETQ CONN (\FTP.OPEN.CONNECTION NAME)))
(\RELEASE.FTPCONNECTION CONN)
\FTPFDEV))))))
(\LEAF.RECONNECT
[LAMBDA (DEVICE OLDONLY) (* bvm: " 3-Jan-85 16:11")
(WITH.MONITOR \LEAFCONNECTIONLOCK (PROG ((INFO (fetch DEVICEINFO of DEVICE))
SEQUIN)
(RETURN (COND
((AND (SETQ SEQUIN (fetch PFSLEAFSEQUIN
of INFO))
(EQ (fetch SEQSTATE of SEQUIN)
\SS.OPEN))
SEQUIN)
([AND (NOT OLDONLY)
(type? SEQUIN
(SETQ SEQUIN
(\OPENLEAFCONNECTION
(fetch PFSNAME of INFO]
(replace PFSLEAFSEQUIN of INFO with SEQUIN)
SEQUIN])
(\LEAF.DIRECTORYNAMEP
[LAMBDA (HOST/DIR DEV) (* bvm: " 3-Jan-85 21:04")
(* 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 ((DIRONLY (FILENAMEFIELD HOST/DIR (QUOTE DIRECTORY)))
(INFO (fetch DEVICEINFO of DEV))
TMP)
(OR DIRONLY (RETURN))
[SETQ DIRONLY (SUBATOM DIRONLY 1 (SUB1 (OR (STRPOS (QUOTE >)
DIRONLY)
0]
(COND
((FMEMB DIRONLY (fetch PFSKNOWNDIRS of INFO)) (* We already know this directory is ok)
)
((SETQ TMP (\LEAF.GETFILE DEV (PACKFILENAME.STRING (QUOTE DIRECTORY)
HOST/DIR
(QUOTE NAME)
"QXZRYU")
(QUOTE INPUT)
(QUOTE OLD)
T
(QUOTE DIRECTORY)))
(push (fetch PFSKNOWNDIRS of INFO)
DIRONLY))
(T (RETURN))) (* Returning T tells the caller to canonicalize the
host name for me)
(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-Jan-85 18:45")
(* * 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 ((DEVINFO (fetch DEVICEINFO of DEVICE))
CONNECTION 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)))
(SETQ CONNECTION (fetch PFSLEAFSEQUIN of DEVINFO))
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 DEVINFO)
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]
[(CONS \IFSERROR.INVALID.DIRECTORY \IFSERROR.MALFORMED)
(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
([AND (NULL (CDR CONNECTNAME/PASS))
(SETQ CONNECTNAME/PASS (\FIXPASSWORD OUTCOME
CONNECTION
(
\LEAF.DIRECTORYNAMEONLY FILENAME]
(* File protected, but we got a connect password. Don't do this if we already had a connect password, since then the
error is "incorrect connect password" and this protection error means there's no hope)
(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
((NEQ NOERROR T)
(SELECTC OUTCOME
(\IFSERROR.FILE.NOT.FOUND NIL)
((CONS \IFSERROR.PROTECTION \CONNECT.PASSWORD.ERRORS)
(LISPERROR "PROTECTION VIOLATION" FILENAME))
(LISPERROR "FILE WON'T OPEN" FILENAME])
(\PARSE.REMOTE.FILENAME
[LAMBDA (FILENAME NOERROR DEVICE) (* bvm: " 3-Jan-85 14:54")
(* 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 (LEAFDEVICE PFSOSTYPE) 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: " 3-Jan-85 15:53")
(COND
((type? STREAM STREAM)
(\LEAF.GETFILEINFO.OPEN STREAM ATTRIBUTE))
(T (PROG (DEVINFO 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 PFSLEAFSEQUIN of (SETQ DEVINFO (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 DEVINFO))
(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: "15-Jan-85 17: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)
(T FT]
[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) (* lmm " 6-Jan-85 18:08")
(PROG ((DEVINFO (fetch DEVICEINFO of DEV))
SEQUIN RESULT)
(RETURN (OR [COND
((AND (SETQ SEQUIN (fetch PFSLEAFSEQUIN of DEVINFO))
(SETQ RESULT (fetch LEAFCACHEDFILE of SEQUIN))
(EQ (fetch FULLFILENAME of RESULT)
NAME)) (* A name we know about)
NAME)
((AND (NEQ RECOG (QUOTE NEW))
(NEQ (SETQ RESULT (\IFS.LOOKUPFILE NAME RECOG (QUOTE NAME)
DEVINFO))
(QUOTE ?)))
RESULT)
(T (\LEAF.GETFILE DEV NAME (QUOTE NONE)
RECOG T (QUOTE NAME]
(SELECTQ RECOG
((NEW OLD/NEW)
(\GENERIC.OUTFILEP NAME DEV))
NIL])
(\LEAF.OPENFILE
(LAMBDA (FILENAME ACCESS RECOG OTHERINFO DEV) (* hdj "23-Sep-86 15:57")
(PROG ((DEVINFO (fetch DEVICEINFO of DEV))
STREAM TYPE BYTESIZE 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 FILETYPE) (* ; "Set the file TYPE (TEXT or BINARY)")
(SETQ TYPE (CDR X)))
(BYTESIZE (SETQ BYTESIZE (OR (FIXP (CADR X))
(\ILLEGAL.ARG X))))
(CREATIONDATE (SETQ CRDATE (IDATE (CADR X))))
(ICREATIONDATE (SETQ CRDATE (OR (FIXP (CADR X))
(\ILLEGAL.ARG X))))
(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 (fetch PFSOSTYPE of DEVINFO)
(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 (NEQ ACCESS (QUOTE INPUT))
(COND
(TYPE (* ; "Type NIL overrides default")
(SETQ TYPE (CAR TYPE)))
(T (AND (SETQ TYPE DEFAULTFILETYPE)
(EQ (fetch EPAGE of STREAM)
0)
(EQ (fetch EOFFSET of STREAM)
0))))) (* ;; "Set file type if explicitly requested, or if this is a new output file and there is a global default")
(\LEAF.SETFILETYPE STREAM TYPE BYTESIZE)))
(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 PFSOSTYPE of DEVINFO)
((TENEX TOPS20)
CRLF.EOLC)
(UNIX LF.EOLC)
CR.EOLC))))
(RETURN STREAM))))
(\LEAF.READFILENAME
[LAMBDA (STREAM DEVINFO) (* bvm: " 6-Jan-85 00:17")
(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 PFSOSTYPE of DEVINFO))
(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
((EQ BANG 0) (* No bang, what the hell is this?)
REMOTENAME)
((EQ LASTCHAR (CHARCODE ;))
(* Tenex?)
[COND
((NULL OSTYPE)
(replace PFSOSTYPE of DEVINFO with (QUOTE TENEX]
REMOTENAME)
(T [COND
((AND (NULL OSTYPE)
(EQ LASTCHAR (CHARCODE %.)))
(replace PFSOSTYPE of DEVINFO with (QUOTE TOPS20]
(SETQ ROOTNAME (SUBSTRING REMOTENAME 1 (SUB1 BANG)))
(U-CASE (COND
([AND (EQ OSTYPE (QUOTE UNIX))
(EQ (NTHCHARCODE REMOTENAME -1)
(CHARCODE 0))
(EQ BANG (SUB1 (NCHARS REMOTENAME]
(* Kludge: UNIX server has bug where versionless files
come back with name!0; strip off !0, since INFILEP will
never work)
ROOTNAME)
(T (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: "25-Oct-85 16:39")
(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 (OR (fetch LEAFCONNECTION of STREAM)
(LISPERROR "FILE NOT OPEN"
(fetch FULLFILENAME
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))
((NOT (READABLE STREAM))
(LISPERROR "FILE NOT OPEN" (fetch FULLFILENAME of STREAM)))
((NEQ IPUP \LEAF.BROKEN.STATUS)
(\LEAF.ERROR IPUP (fetch FULLFILENAME of STREAM)
(fetch LEAFCONNECTION of STREAM)
OPUP))
(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: " 8-Nov-85 12:55")
(* 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 (INCLEAFSTAT (fetch LEAFCACHEHITS of (fetch LEAFCONNECTION
of STREAM)))
(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)
(INCLEAFSTAT (fetch LEAFCACHEMISSES of (fetch LEAFCONNECTION
of STREAM]
[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 T (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: " 3-Jan-85 14:58")
(COND
(HOST (PROG ([DEVICE (OR (\GETDEVICEFROMNAME HOST T T)
(AND (SETQ HOST (\CANONICAL.HOSTNAME HOST))
(\GETDEVICEFROMNAME HOST T T]
CONNECTION DEVINFO)
(RETURN (COND
((AND DEVICE (type? PUPFILESERVER (SETQ DEVINFO (fetch DEVICEINFO
of DEVICE)))
(SETQ CONNECTION (ffetch PFSLEAFSEQUIN of DEVINFO))
(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) (* hdj "30-May-86 11:38")
(WITH.MONITOR (fetch LEAFOPENCLOSELOCK of SEQUIN)
(LET ((CACHE (fetch LEAFCACHEDFILE of SEQUIN)))
(COND
((fetch LEAFREALLYOPEN of CACHE)
(replace LEAFCACHEDFILE of SEQUIN with NIL)
NIL)
(T (\LEAF.CLOSEFILE CACHE SEQUIN NIL T)
(fetch SEQNAME of SEQUIN])
(\LEAF.RENAMEFILE
[LAMBDA (OLD-DEVICE OLDFILE NEW-DEVICE NEWFILE) (* hdj " 8-May-86 15:20")
(OR (AND \FTPAVAILABLE (OR (NEQ (GETHOSTINFO (fetch (FDEV DEVICENAME) of OLD-DEVICE)
(QUOTE OSTYPE))
(QUOTE UNIX))
UNIXFTPFLG)
(\FTP.RENAMEFILE OLD-DEVICE OLDFILE NEW-DEVICE NEWFILE))
(\GENERIC.RENAMEFILE OLD-DEVICE OLDFILE NEW-DEVICE 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 BYTESIZE) (* bvm: "15-Jan-85 17:21")
(* Sets "type" of file to TEXT or BINARY)
(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 (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 (FIXP (CADR TYPE)))
(SETQ TYPE (CAR TYPE]
(replace LEAFFILETYPE of DATA with (SELECTQ TYPE
(TEXT \FT.TEXT)
(NIL \FT.UNKNOWN)
\FT.BINARY))
(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) (* hdj "29-May-86 12:23")
(* * 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 DEVINFO)
(RETURN (COND
((EQ HOST T)
(for DEV in (for DEVICE in \FILEDEVICES collect DEVICE
when (AND (type? PUPFILESERVER (SETQ DEVINFO
(fetch DEVICEINFO of DEVICE)))
(fetch PFSLEAFSEQUIN of DEVINFO)))
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
((AND (type? PUPFILESERVER (SETQ DEVINFO (fetch DEVICEINFO of LEAFDEV)))
(SETQ CONNECTION (fetch PFSLEAFSEQUIN of DEVINFO)))
[COND
((SETQ FILES (FDEVOP (QUOTE OPENP)
LEAFDEV NIL NIL LEAFDEV))
(COND
(FAST (for S in FILES do (\DELETE-OPEN-STREAM S LEAFDEV)))
(T (MAPC FILES (FUNCTION CLOSEF]
(\CLOSELEAFCONNECTION CONNECTION LEAFDEV])
(\CLOSELEAFCONNECTION
[LAMBDA (CONN DEVICE) (* bvm: " 3-Jan-85 14:46")
(PROG1 [COND
((CLOSESEQUIN CONN)
(fetch SEQNAME of CONN))
(T (LIST (fetch SEQNAME of CONN)
(QUOTE aborted]
(replace (LEAFDEVICE PFSLEAFSEQUIN) of DEVICE with NIL])
(\OPENLEAFCONNECTION
[LAMBDA (HOST) (* bvm: " 6-Jan-85 00:20")
(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))
((EQ (CDR IFSPORT)
0)
(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
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 EVENT-TYPE) (* hdj " 3-Jun-86 20:37")
(* * Called before LOGOUT etc to clean up any leaf connections we have open)
(PROG ((DEVINFO (fetch DEVICEINFO of FDEV))
CONNECTION SOC)
(SELECTQ EVENT-TYPE
((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT)
(COND
((SETQ CONNECTION (fetch PFSLEAFSEQUIN of DEVINFO))
(\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 PFSLEAFSEQUIN of DEVINFO))
(\SEQUIN.FLUSH.CONNECTION CONNECTION \SS.ABORT)))
(COND
((FDEVOP (QUOTE OPENP)
FDEV NIL NIL 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)))
(COND
((SETQ SOC (fetch PFSLOOKUPFILESOCKET of DEVINFO))
(CLOSEPUPSOCKET SOC)
(replace PFSLOOKUPFILESOCKET of DEVINFO with NIL)))
(replace PFSLOOKUPFILELOCK of DEVINFO with NIL)
(* revalidate open files)
(\PAGED.REVALIDATEFILELST FDEV))
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) (* hdj "25-Jun-86 12:05")
(* 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))
(DEVICE (\GETDEVICEFROMNAME (fetch SEQNAME 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 (FDEVOP (QUOTE OPENP)
DEVICE NIL NIL DEVICE) collect STREAM
when (EQ (fetch LEAFCONNECTION of STREAM)
SEQUIN)))
RETRY.NEW.CONNECTION
[COND
([SETQ NEWCONNECTION (\LEAF.RECONNECT DEVICE (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 (\PAGED.REVALIDATEFILELST DEVICE))
(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) (* hdj "22-Jul-86 18:13")
(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 (\PAGED.REVALIDATEFILES 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: "25-Oct-85 16:43")
(* 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
((EQ (fetch ANSWERBIT of PUPDATA)
0)
(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))
(NOT (AND (EQ OPCODE \LEAFOP.CLOSE)
(EQ (fetch LEAFERRORCODE of PUPDATA)
\IFSERROR.BAD.HANDLE]
(* Last clause says that if we were closing the file and got a bad handle error, to ignore it -- this typically
happens if two files try to close the same file simultaneously)
(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 (FUNCTION \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: "25-Oct-85 12:29")
(AND (WINDOWWORLDP)
(PROG ([W (CREATEW (MAKEWITHINREGION 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) (* hdj "29-May-86 12:29")
(* 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 (LET [(DEVICE (\GETDEVICEFROMNAME (fetch SEQNAME of SEQUIN]
(FDEVOP (QUOTE OPENP)
DEVICE NIL NIL DEVICE)) 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: " 3-Jan-85 15:02")
(PROG ((CODE (COND
((EQ REASON \SS.NOSOCKET)
\LEAF.NEVER.OPENED)
(T \LEAF.BROKEN.STATUS)))
PUP DEV)
(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 DEV (\GETDEVICEFROMNAME (fetch SEQNAME of SEQUIN)
T T))
(EQ (fetch PFSLEAFSEQUIN of (SETQ DEV (fetch DEVICEINFO of DEV)))
SEQUIN)
(replace PFSLEAFSEQUIN of DEV 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: " 6-Jan-85 00:22")
(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
((EQ STRLEN 0))
[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) (* hdj "31-Jul-86 18:45")
(* 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 (STRING.EQUAL FILENAME \IFSERRORFILENAME)))
(LET* ([ERR-MSG-STREAM (CAR (NLSETQ (OPENSTREAM (SETQ \IFSERRORFILENAME
(PACK* (QUOTE {)
(COND
(CONNECTION (fetch SEQNAME
of CONNECTION))
(T \CONNECTED.HOST))
"}<SYSTEM>IFS.ERRORS"))
(QUOTE INPUT]
(ERR-FILE-NAME (FULLNAME ERR-MSG-STREAM))
(EOL (FCHARACTER (CHARCODE EOL)))
(START NIL)
(LEN NIL)
(RESULT NIL))
(* * 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)
(COND
(ERR-MSG-STREAM (SETQ \IFSERRORFILENAME ERR-FILE-NAME)
(* In case an error happens while
scanning file, update this var to
correct value)
(PROG1 (COND
((SETQ START (FFILEPOS (CONCAT EOL "$$" CODE " ")
ERR-MSG-STREAM 0 NIL NIL T))
(SETQ LEN (IDIFFERENCE (OR (FFILEPOS (CONCAT EOL "$$")
ERR-MSG-STREAM START)
(GETEOFPTR ERR-MSG-STREAM))
START)) (* Length of entry)
(SETQ RESULT (ALLOCSTRING LEN))
(SETFILEPTR ERR-MSG-STREAM START)
(for I from 1 to LEN do (RPLCHARCODE RESULT I (\BIN ERR-MSG-STREAM
)))
RESULT))
(CLOSEF ERR-MSG-STREAM])
(\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) (* lmm " 7-Jan-86 11:52")
(PROG ((NSFLG (STRPOS (QUOTE :)
HOST))
INFO VAL)
(SETQ HOST (OR (CANONICAL.HOSTNAME HOST)
(AND NSFLG 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]
[LOGINFO (COND
((SETQ VAL (ASSOC HOST NETWORKLOGINFO))
(CDR VAL))
([AND (LISTP (CDR INFO))
(SETQ VAL (LISTGET (CDR INFO)
(QUOTE LOGINFO]
VAL)
(T (CDR (ASSOC (OR (if INFO
then (if (LISTP (CDR INFO))
then
(LISTGET (CDR INFO)
(QUOTE
OSTYPE))
else (CDR INFO)))
(if NSFLG
then (QUOTE NS)
else DEFAULT.OSTYPE))
NETWORKLOGINFO]
[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])
)
(RPAQQ DEFAULT.OSTYPE IFS)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DEFAULT.OSTYPE)
)
(* ;; "LookUpFile stuff")
(DEFINEQ
(\IFS.LOOKUPFILE
[LAMBDA (NAME RECOG ATTRIBUTE DEVINFO) (* bvm: " 3-Jan-85 16:10")
(* * Attempt to use the LookupFile protocol to get full filename)
(PROG ((RESULT (QUOTE ?))
(HOSTNAME (fetch PFSNAME of DEVINFO))
REMOTENAME SEMI NAME/PASS OSTYPE START DOT ROOTNAME INFO IPUP OPUP PUPSOC DIREND LOCK)
(COND
([OR (NEQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(NOT (SETQ START (STRPOS (QUOTE })
NAME 2]
(RETURN)))
(COND
((NOT (SETQ LOCK (fetch PFSLOOKUPFILELOCK of DEVINFO)))
(* First time to do this)
(replace PFSLOOKUPFILESOCKET of DEVINFO with (SETQ PUPSOC (OPENPUPSOCKET)))
(replace PFSLOOKUPFILELOCK of DEVINFO with (SETQ LOCK (CREATE.MONITORLOCK "LookUpFile"))
)
(replace PFSLOOKUPFAILCNT of DEVINFO with 0))
((NOT (SETQ PUPSOC (fetch PFSLOOKUPFILESOCKET of DEVINFO)))
(RETURN RESULT)))
[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 (\INTERNAL/GETPASSWORD HOSTNAME)))
(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 LOCK (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 PFSLOOKUPFILESOCKET of DEVINFO
with NIL)
(CLOSEPUPSOCKET PUPSOC)
(RETURN]
NIL)
(RELEASE.PUP IPUP)
finally (SETQ IPUP)
(COND
(PUPTRACEFLG "LookupFile timed out" T))
(COND
((AND (fetch PFSLOOKUPFAILCNT of DEVINFO)
(IGREATERP (add (fetch PFSLOOKUPFAILCNT of DEVINFO)
1)
4))
(replace PFSLOOKUPFILESOCKET of DEVINFO with NIL)
(CLOSEPUPSOCKET PUPSOC]
(AND IPUP (RELEASE.PUP IPUP))
(COND
((NEQ RESULT (QUOTE ?))
(replace PFSLOOKUPFAILCNT of DEVINFO with NIL]
(RETURN RESULT])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ LOOKUPFILECOMS ((CONSTANTS \PT.LOOKUPFILE \PT.LOOKUPFILEREPLY \PT.LOOKUPFILEERROR
\SOCKET.LOOKUPFILE)
(RECORDS LOOKUPFILEDATA)
(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))))
]
(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: " 6-Jan-85 00:23")
(* * 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
((EQ (fetch ANSWERBIT of DATA)
0)
(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 (EQ (fetch ANSWERBIT of DATA)
0))
(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 LEAFDEVICE
PUPFILESERVER)
(MACROS .NAMEORSTREAM. .PAGE.IS.AFTER.EOF. INCLEAFSTAT)
(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 (TIMES 2 400Q))
(\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 (NEQ (LOGAND (fetch EPFLAGS of DATUM)
\LF.WANTANSWER)
0))
(LEAFALLOWERRORS (NEQ (LOGAND (fetch EPFLAGS of DATUM)
\LF.ALLOWERRORS)
0))))
(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))))
(ACCESSFNS LEAFDEVICE ((PUPFILESERVER (fetch DEVICEINFO of DATUM)
(replace DEVICEINFO of DATUM with NEWVALUE))))
(DATATYPE PUPFILESERVER ( (* Info common to various pup
protocols used on a file server,
independent of whether a connection is
now open)
(NIL BYTE)
(PFSNAME POINTER)
(PFSADDRESS POINTER) (* Pup address)
(PFSOSTYPE POINTER)
(PFSLEAFFLG POINTER) (* Indicates something about whether
LEAF is available)
(PFSLEAFSEQUIN POINTER) (* Pointer to SEQUIN for open leaf
connection)
(PFSLEAFTIMER POINTER) (* Timeout for handling dead servers)
(PFSLOOKUPFILESOCKET POINTER) (* The Pup socket for LookupFile
requests)
(PFSLOOKUPFILELOCK POINTER) (* Lock to secure it)
(PFSLOOKUPFAILCNT POINTER) (* Counter used until we know the
service exists)
(PFSKNOWNDIRS POINTER) (* List of directories known to exist
on this host (for DIRECTORYNAMEP))
(NIL POINTER)))
]
(/DECLAREDATATYPE (QUOTE PUPFILESERVER)
(QUOTE (BYTE POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER))
(QUOTE ((PUPFILESERVER 0 (BITS . 7))
(PUPFILESERVER 0 POINTER)
(PUPFILESERVER 2 POINTER)
(PUPFILESERVER 4 POINTER)
(PUPFILESERVER 6 POINTER)
(PUPFILESERVER 10Q POINTER)
(PUPFILESERVER 12Q POINTER)
(PUPFILESERVER 14Q POINTER)
(PUPFILESERVER 16Q POINTER)
(PUPFILESERVER 20Q POINTER)
(PUPFILESERVER 22Q POINTER)
(PUPFILESERVER 24Q POINTER)))
(QUOTE 26Q))
(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)))))
(PUTPROPS INCLEAFSTAT MACRO ((X)
(change X (IPLUS16 DATUM 1))))
)
(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 (TIMES 2 400Q))
(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 (TIMES 2 400Q))
(\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 . T)
)
(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)
)
)
(/DECLAREDATATYPE (QUOTE PUPFILESERVER)
(QUOTE (BYTE POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER))
(QUOTE ((PUPFILESERVER 0 (BITS . 7))
(PUPFILESERVER 0 POINTER)
(PUPFILESERVER 2 POINTER)
(PUPFILESERVER 4 POINTER)
(PUPFILESERVER 6 POINTER)
(PUPFILESERVER 10Q POINTER)
(PUPFILESERVER 12Q POINTER)
(PUPFILESERVER 14Q POINTER)
(PUPFILESERVER 16Q POINTER)
(PUPFILESERVER 20Q POINTER)
(PUPFILESERVER 22Q POINTER)
(PUPFILESERVER 24Q POINTER)))
(QUOTE 26Q))
[ADDTOVAR SYSTEMRECLST
(DATATYPE PUPFILESERVER ((NIL BYTE)
(PFSNAME POINTER)
(PFSADDRESS POINTER)
(PFSOSTYPE POINTER)
(PFSLEAFFLG POINTER)
(PFSLEAFSEQUIN POINTER)
(PFSLEAFTIMER POINTER)
(PFSLOOKUPFILESOCKET POINTER)
(PFSLOOKUPFILELOCK POINTER)
(PFSLOOKUPFAILCNT POINTER)
(PFSKNOWNDIRS POINTER)
(NIL POINTER)))
]
(PUTPROPS LEAF COPYRIGHT ("Xerox Corporation" 3677Q 3700Q 3701Q 3702Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (57013Q 66466Q (CLOSESEQUIN 57025Q . 57753Q) (INITSEQUIN 57755Q . 62253Q) (GETSEQUIN
62255Q . 63457Q) (PUTSEQUIN 63461Q . 66464Q)) (66467Q 133525Q (\SEQUIN.CONTROL 66501Q . 67450Q) (
\SEQUIN.PUT 67452Q . 73155Q) (\SEQUIN.PROCESS 73157Q . 104206Q) (\SEQUIN.CLOSE 104210Q . 105015Q) (
\SEQUIN.FLUSH.CONNECTION 105017Q . 106720Q) (\SEQUIN.CLEANUP 106722Q . 107752Q) (
\SEQUIN.FLUSH.RETRANSMIT 107754Q . 110620Q) (\SEQUIN.COMPARE 110622Q . 111604Q) (\SEQUIN.HANDLE.INPUT
111606Q . 124371Q) (\SEQUIN.OUT.OF.THE.BLUE 124373Q . 125211Q) (\SEQUIN.HANDLE.ACK 125213Q . 127455Q)
(\SEQUIN.RETRANSMIT 127457Q . 132022Q) (\SEQUIN.RETRANSMITNEXT 132024Q . 133523Q)) (133576Q 314402Q (
\LEAF.CLOSEFILE 133610Q . 145153Q) (\LEAF.DELETEFILE 145155Q . 147645Q) (\LEAF.DEVICEP 147647Q .
163445Q) (\LEAF.RECONNECT 163447Q . 164735Q) (\LEAF.DIRECTORYNAMEP 164737Q . 167364Q) (
\LEAF.GENERATEFILES 167366Q . 167770Q) (\LEAF.GETFILE 167772Q . 211620Q) (\PARSE.REMOTE.FILENAME
211622Q . 215632Q) (\LEAF.GETFILEDATES 215634Q . 217400Q) (\LEAF.GETFILEINFO 217402Q . 222037Q) (
\LEAF.GETFILEINFO.OPEN 222041Q . 225440Q) (\LEAF.GETFILENAME 225442Q . 227214Q) (\LEAF.OPENFILE
227216Q . 241642Q) (\LEAF.READFILENAME 241644Q . 247221Q) (\LEAF.READFILEPROP 247223Q . 251542Q) (
\LEAF.READPAGES 251544Q . 255772Q) (\LEAF.REQUESTPAGE 255774Q . 262353Q) (\LEAF.LOOKUPCACHE 262355Q .
264652Q) (CLEAR.LEAF.CACHE 264654Q . 266073Q) (LEAF.ASSURE.FINISHED 266075Q . 270723Q) (
\LEAF.FORCEOUTPUT 270725Q . 271216Q) (\LEAF.FLUSH.CACHE 271220Q . 272265Q) (\LEAF.RENAMEFILE 272267Q
. 273263Q) (\LEAF.REOPENFILE 273265Q . 277115Q) (\LEAF.CREATIONDATE 277117Q . 277436Q) (
\LEAF.SETCREATIONDATE 277440Q . 302166Q) (\LEAF.SETFILEINFO 302170Q . 303522Q) (\LEAF.SETFILETYPE
303524Q . 307031Q) (\LEAF.SETVALIDATION 307033Q . 307674Q) (\LEAF.TRUNCATEFILE 307676Q . 311740Q) (
\LEAF.WRITEPAGES 311742Q . 314400Q)) (314465Q 317575Q (\SENDLEAF 314477Q . 317573Q)) (317651Q 343504Q
(BREAKCONNECTION 317663Q . 323652Q) (\CLOSELEAFCONNECTION 323654Q . 324431Q) (\OPENLEAFCONNECTION
324433Q . 337251Q) (\LEAF.EVENTFN 337253Q . 343502Q)) (343610Q 431112Q (\LEAF.ACKED 343622Q . 344341Q)
(\LEAF.FIX.BROKEN.SEQUIN 344343Q . 362250Q) (\LEAF.REPAIR.BROKEN.PUP 362252Q . 364717Q) (
\LEAF.USE.NEW.CONNECTION 364721Q . 376016Q) (\LEAF.RESENDPUPS 376020Q . 376407Q) (\LEAF.HANDLE.INPUT
376411Q . 403734Q) (\LEAF.OPENERRORHANDLER 403736Q . 405040Q) (\LEAF.TIMEDIN 405042Q . 405606Q) (
\LEAF.TIMEDOUT 405610Q . 411336Q) (\LEAF.TIMEDOUT.EXCESSIVE 411340Q . 420024Q) (\LEAF.ABORT.FROMMENU
420026Q . 420704Q) (\LEAF.STREAM.IN.QUEUE 420706Q . 423163Q) (\LEAF.IDLE 423165Q . 425331Q) (
\LEAF.WHENCLOSED 425333Q . 427662Q) (\LEAF.IDLE? 427664Q . 431110Q)) (431235Q 453740Q (\ADDLEAFSTRING
431247Q . 434536Q) (\FIXPASSWORD 434540Q . 436404Q) (\GETLEAFSTRING 436406Q . 437220Q) (
\IFSERRORSTRING 437222Q . 445104Q) (\LEAF.ERROR 445106Q . 450100Q) (\LEAF.DIRECTORYNAMEONLY 450102Q .
450566Q) (GETHOSTINFO 450570Q . 453510Q) (GETOSTYPE 453512Q . 453736Q)) (454144Q 467360Q (
\IFS.LOOKUPFILE 454156Q . 467356Q)) (471265Q 472766Q (\LEAFINIT 471277Q . 472764Q)) (473036Q 502364Q (
PRINTLEAF 473050Q . 502362Q)))))
STOP