(FILECREATED "17-AUG-83 13:08:34" {PHYLUM}<LISPCORE>SOURCES>BSP.;27 276162Q
changes to: (FNS \RTP.SOCKET.PROCESS)
previous date: "11-JUL-83 18:00:07" {PHYLUM}<LISPCORE>SOURCES>BSP.;26)
(* Copyright (c) 1982, 1983, 1900 by Xerox Corporation)
(PRETTYCOMPRINT BSPCOMS)
(RPAQQ BSPCOMS ((COMS (* User-level RTP socket manipulation)
(FNS OPENRTPSOCKET CLOSERTPSOCKET \INIT.RTPPROCESS \FLUSH.RTPPROCESS))
(COMS (* RTP process)
(FNS \RTP.SOCKET.PROCESS \RTP.CLEANUP \RTP.ACTION \RTP.ERROR \RTP.FILTER \SEND.ABORT
\SEND.ANSWERING.RFC \SEND.END \SEND.ENDREPLY \SEND.RFC \FILLRTPPUP \SETRTPPORTS)
(FNS \BSPINIT \BSPEVENTFN))
(COMS (* Creating BSP stream)
(FNS OPENBSPSTREAM BSPOUTPUTSTREAM CLOSEBSPSTREAM \BSP.SUCKINPUT \BSP.FLUSHINPUT
BSPOPENP GETBSPUSERINFO SETBSPUSERINFO)
(FNS CREATEBSPSTREAM ENDBSPSTREAM))
(COMS (* BSP stream functions)
(FNS BSPBIN BSPPEEKBIN \BSPREADBLOCK BSPREADP BSPEOFP \BSPBACKFILEPTR
\BSP.PREPARE.INPUT \BSP.CLEANUP.INPUT BSPBOUT \BSPWRITEBLOCK BSPFORCEOUTPUT
\BSP.PREPARE.OUTPUT BSPGETMARK BSPPUTMARK BSP.PUTINTERRUPT))
(COMS (* BSP pup handler)
(FNS \BSP.PUPHANDLER \BSP.HANDLE.ACK \BSP.HANDLE.DATA \BSP.HANDLE.ERROR
\BSP.HANDLE.INTERRUPT \BSP.HANDLE.INTERRUPTREPLY \SEND.ACK \SEARCH.OUTPUTQ
\SETBSPTIMEOUT \TRANSMIT.STRATEGY))
(COMS (* BSP utilities)
(FNS \BSP.DEFAULT.ERROR.HANDLER \BSP.TIMERFN \BSP.FLUSH.SOCKET.QUEUES \FILLBSPPUP
BSPHELP))
(DECLARE: EVAL@COMPILE DONTCOPY (* * This socket record has both RTP and BSP state info)
(RECORDS BSPSOC ACKPUP BSPSTREAM)
(ALISTS (PUPPRINTMACROS 10Q 11Q 20Q 21Q 22Q 24Q))
(CONSTANTS * RTPSTATES)
(CONSTANTS * RTPEVENTS)
(CONSTANTS (WORDSPERPORT 3))
(MACROS RTP.OTHERFN BSP.OTHERFN BSP.ERROR .COERCE.BSP.INPUT.STREAM))
(INITRECORDS BSPSOC)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\BSPINIT)))
(COMS (* debugging)
(FNS PPSOC PPSOC.CURRENT PRINTTIMER PRINTPUPQUEUE BSPPRINTPUP \RTP.INFO.HOOK))
(COMS (* Some of these may want to be constants)
(INITVARS (\BSPSOCKETS)
(\RFC.TIMEOUT 3720Q)
(\RTP.DALLY.TIMEOUT 11610Q)
(\RTP.DEFAULTTIMEOUT 72460Q)
(\BSP.MAXPUPS 14Q)
(\BSP.IDLETIMEOUT 35230Q)
(\BSP.OUTSTANDINGDATATIMEOUT 372Q)
(\BSP.MAXPUPALLOC 310Q)
(\BSP.ALLOCHYSTERESIS 62Q)
(\BSP.OVERLAP.DATA.WITH.ACK)
(\BSP.INITIAL.MAXPUPALLOC 5)
(\BSP.INITIAL.ADATATIMEOUT 1750Q)
(\BSP.INACTIVITY.TIMEOUT 352300Q)
(\BSP.NO.INACTIVITY.TIMEOUT T))
(GLOBALVARS \BSPSOCKETS \RFC.TIMEOUT \RTP.DALLY.TIMEOUT \RTP.DEFAULTTIMEOUT
\BSP.MAXPUPS \BSP.IDLETIMEOUT \BSP.OUTSTANDINGDATATIMEOUT \BSP.MAXPUPALLOC
\BSP.ALLOCHYSTERESIS \BSP.OVERLAP.DATA.WITH.ACK \BSP.INITIAL.MAXPUPALLOC
\BSP.INITIAL.ADATATIMEOUT \BSP.INACTIVITY.TIMEOUT
\BSP.NO.INACTIVITY.TIMEOUT))))
(* User-level RTP socket manipulation)
(DEFINEQ
(OPENRTPSOCKET
[LAMBDA (FRNPORT MODE PUPSOC CONNID TIMEOUT) (* bvm: " 5-JUN-83 14:56")
(* * Open an RTP socket in given MODE, talking to FRNPORT. If mode is or contains USER, we set up a user RTP,
sending an RFC to FRNPORT, with initial connection id CONNID (default is chosen at random). If mode is or contains
SERVER, we merely listen for an RFC from somewhere, and FRNPORT and CONNID are ignored. If MODE is or contains
RETURN, we don't wait around, but return immediately; caller is assumed to be monitoring the state of the
connection. In the case where we wait, TIMEOUT is how long we will wait (msecs) before giving up and returning
NIL. On success, we return a new BSPSOC. PUPSOC is a packet-level socket opened for the connection by the caller;
if omitted, one is created. If MODE is NIL, we open a USER connection and wait for it to succeed.)
(RESETLST (PROG (SOCKET INITSTATE SOCKET#)
[COND
(FRNPORT (SETQ FRNPORT (ETHERPORT FRNPORT T]
[COND
[(NULL PUPSOC)
(SETQ SOCKET# (PUPSOCKETNUMBER (SETQ PUPSOC (OPENPUPSOCKET]
[(FIXP PUPSOC)
(SETQ PUPSOC (OPENPUPSOCKET (SETQ SOCKET# PUPSOC]
(T (SETQ SOCKET# (PUPSOCKETNUMBER (\DTEST PUPSOC (QUOTE PUPSOCKET]
(SETQ SOCKET (create BSPSOC
STATE ← \STATE.CLOSED
CONNID ←(OR CONNID (RAND 0 32768))
OTHERPUPFN ←(QUOTE RELEASE.PUP)
PUPSOC ← PUPSOC
LCLPORT ←(\LOCALPUPADDRESS)
LCLSOCKETHI ←(\HINUM SOCKET#)
LCLSOCKETLO ←(\LONUM SOCKET#)))
(\INIT.RTPPROCESS SOCKET) (* set up a process to monitor this socket)
(push \BSPSOCKETS SOCKET)
[COND
(FRNPORT (replace FRNPORT of SOCKET with (CAR FRNPORT))
(replace FRNSOCKETHI of SOCKET with (\HINUM (CDR FRNPORT)))
(replace FRNSOCKETLO of SOCKET with (\LONUM (CDR FRNPORT]
(COND
((NOT MODE)
(SETQQ MODE USER)))
(OBTAIN.MONITORLOCK (fetch BSPLOCK of SOCKET)
NIL T)
[RESETSAVE (PROGN SOCKET)
(QUOTE (AND RESETSTATE (CLOSERTPSOCKET OLDVALUE 0]
(COND
[(EQMEMB (QUOTE USER)
MODE)
(COND
((NOT FRNPORT)
(ERROR "No foreign port specified")))
(\RTP.ACTION SOCKET \EVENT.OPEN) (* Open the connection (send RFC))
(COND
((EQMEMB (QUOTE RETURN)
MODE)
(RETURN SOCKET]
[(EQMEMB (QUOTE SERVER)
MODE)
(replace LISTENING of SOCKET with T)
(\RTP.ACTION SOCKET \EVENT.OPENLISTENING)
(COND
((EQMEMB (QUOTE RETURN)
MODE)
(RETURN SOCKET]
((EQ MODE (QUOTE RETURN)) (* Caller just wants to create this thing, putting it
immediately open)
(\RTP.ACTION SOCKET \EVENT.OPENIMMEDIATE)
(RETURN SOCKET))
(T (\ILLEGAL.ARG MODE)))
(SETQ INITSTATE (fetch STATE of SOCKET))
[COND
((NEQ TIMEOUT T)
(replace BSPINITTIMER of SOCKET with (SETUPTIMER (OR TIMEOUT
\RTP.DEFAULTTIMEOUT]
(until (NEQ (fetch STATE of SOCKET)
INITSTATE)
do (MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch RTPEVENT of SOCKET)))
(* Wait for transaction to happen)
(RETURN (COND
((OR (EQ (fetch STATE of SOCKET)
\STATE.OPEN)
(EQ (fetch STATE of SOCKET)
\STATE.ENDRECEIVED))
(* Socket has been opened ok)
SOCKET)
(T (* Give up, flush everything)
(CLOSERTPSOCKET SOCKET 0)
NIL])
(CLOSERTPSOCKET
[LAMBDA (SOCKET TIMEOUT DONTSEND) (* bvm: " 5-JUN-83 15:04")
(* * Close given RTP socket. This sends the normal end sequence if appropriate. TIMEOUT is how long we will wait
for the end to complete normally. Value returned is true if the socket was closed normally, NIL if aborted.
In either case, SOCKET goes away)
(PROG (SUCCESS)
[WITH.MONITOR (fetch BSPLOCK of SOCKET)
(COND
((NOT (ZEROP TIMEOUT)) (* Is zero to force a bad connection closed immediately)
(replace BSPINITTIMER of SOCKET with (SETUPTIMER (OR TIMEOUT
\RTP.DEFAULTTIMEOUT)))
(\RTP.ACTION SOCKET \EVENT.CLOSE)
(until (COND
((SETQ SUCCESS (EQ (fetch STATE of SOCKET)
\STATE.CLOSED))
T)
((EQ (fetch STATE of SOCKET)
\STATE.ABORTED)
(\RTP.ACTION SOCKET \EVENT.FORCECLOSE)
T))
do (* wait for end handshake)
(MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch RTPEVENT of SOCKET)
\RTP.DEFAULTTIMEOUT)))
(T (\RTP.ACTION SOCKET \EVENT.FORCECLOSE]
(DEL.PROCESS (PROG1 (fetch RTPPROCESS of SOCKET)
(replace RTPPROCESS of SOCKET with NIL)))
(* Deleting the process performs any other cleanup
needed, such as flushing the PUPSOCKET underneath)
(RETURN SUCCESS])
(\INIT.RTPPROCESS
[LAMBDA (SOCKET) (* bvm: " 5-JUN-83 14:23")
(* * Creates a process to handle RTP connection on this socket)
(PROG ((PROC (ADD.PROCESS (LIST (QUOTE \RTP.SOCKET.PROCESS)
(KWOTE SOCKET))
(QUOTE RTP)
(QUOTE NO)))
NAME)
(replace RTPPROCESS of SOCKET with PROC)
[replace RTPEVENT of SOCKET with (CREATE.EVENT (SETQ NAME (PROCESS.NAME PROC]
(replace BSPLOCK of SOCKET with (CREATE.MONITORLOCK NAME])
(\FLUSH.RTPPROCESS
[LAMBDA (SOCKET) (* bvm: "17-MAR-82 16:55")
(* * Disposes of the process we created to handle this socket)
(DEL.PROCESS (PROG1 (fetch RTPPROCESS of SOCKET)
(replace RTPPROCESS of SOCKET with NIL])
)
(* RTP process)
(DEFINEQ
(\RTP.SOCKET.PROCESS
[LAMBDA (BSPSOCKET) (* bvm: "17-AUG-83 12:59")
(DECLARE (SPECVARS BSPSOCKET)) (* For use by PPSOC in our INFO hook)
(* * This is the process that monitors the state of the RTP connection on BSPSOCKET. This better get run
periodically)
(PROG ((PUPSOC (fetch PUPSOC of BSPSOCKET))
(LOCK (fetch BSPLOCK of BSPSOCKET))
DATA TIMER EVENT PUP)
(OBTAIN.MONITORLOCK LOCK NIL T)
(RESETSAVE NIL (LIST (QUOTE \RTP.CLEANUP)
BSPSOCKET))
(PROCESSPROP (THIS.PROCESS)
(QUOTE INFOHOOK)
(FUNCTION \RTP.INFO.HOOK))
(SETQ EVENT (PUPSOCKETEVENT PUPSOC))
LP [COND
((SETQ PUP (GETPUP PUPSOC)) (* play with incoming pup)
(SELECTC (fetch PUPTYPE of PUP)
[\PT.RFC
(* RFC received. This may be either an initiating RFC (if we are listening) or an answering RFC
(if we have sent out an initiating RFC of our own))
(SETQ DATA (fetch PUPCONTENTS of PUP))
[COND
((ZEROP (fetch (PORT NET) of DATA))
(* Sender didn't know its own net number, but we know it
now)
(replace (PORT NET) of DATA with (fetch PUPSOURCENET
of PUP]
(COND
((SELECTC (fetch STATE of BSPSOCKET)
(\STATE.LISTENING
(* Accept all but broadcast pups)
(NEQ (fetch PUPDESTHOST of PUP)
0))
(\STATE.SENTRFC
(* Must match the RFC we sent out)
(\RTP.FILTER BSPSOCKET PUP T T))
[(LIST \STATE.OPEN \STATE.ENDSENT)
(* probably a duplicate. Make sure it matches the
connection we think we have open)
(AND (\RTP.FILTER BSPSOCKET PUP NIL T)
(EQ (fetch (PORT NETHOST) of DATA)
(fetch FRNPORT of BSPSOCKET))
(EQ (fetch (PORT SOCKETHI) of DATA)
(fetch FRNSOCKETHI of BSPSOCKET))
(EQ (fetch (PORT SOCKETLO) of DATA)
(fetch FRNSOCKETLO of BSPSOCKET]
NIL)
(\RTP.ACTION BSPSOCKET \EVENT.RFC PUP))
(T (* Bad RFC. Send an Abort in reply)
(SWAPPUPPORTS PUP)
(replace PUPLENGTH of PUP with (IPLUS \PUPOVLEN BYTESPERWORD))
(\PUTBASE DATA 0 0)
(PUTPUPSTRING PUP "RFC refused")
(* explanatory string)
(replace TYPEWORD of PUP with \PT.ABORT)
(replace EPREQUEUE of PUP with (QUOTE FREE))
(SENDPUP PUPSOC PUP)
(SETQ PUP NIL]
[\PT.END (COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.END PUP]
[\PT.ENDREPLY (COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.ENDREPLY PUP]
[\PT.ABORT (COND
((\RTP.FILTER BSPSOCKET PUP T T)
(\RTP.ACTION BSPSOCKET \EVENT.ABORT PUP)
(RTP.OTHERFN PUP BSPSOCKET)
(* Pass aborts on to next level
(BSP))
(SETQ PUP NIL]
(\PT.ERROR (COND
((AND (EQ (fetch ERRORPUPCODE of PUP)
2)
(\RTP.FILTER BSPSOCKET PUP T NIL))
(* Treat type 2 errors as abort)
(\RTP.ACTION BSPSOCKET \EVENT.ABORT PUP)))
(RTP.OTHERFN PUP BSPSOCKET)
(* Pass errors on to next level
(BSP))
(SETQ PUP NIL))
(PROGN (RTP.OTHERFN PUP BSPSOCKET) (* non-RTP pups go to other proc)
(SETQ PUP NIL)))
(AND PUP (RELEASE.PUP PUP))
(BLOCK))
(T (MONITOR.AWAIT.EVENT LOCK EVENT [SETQ TIMER (COND
((NEQ (fetch RTPTIMEOUT of BSPSOCKET)
0)
(fetch RTPTIMER of BSPSOCKET))
((NEQ (fetch BSPTIMEOUT of BSPSOCKET)
0)
(fetch BSPTIMER of BSPSOCKET]
(AND TIMER T))
(COND
[(NEQ (fetch RTPTIMEOUT of BSPSOCKET)
0)
(COND
((TIMEREXPIRED? (fetch RTPTIMER of BSPSOCKET))
(\RTP.ACTION BSPSOCKET \EVENT.TIMEOUT]
((NEQ (fetch BSPTIMEOUT of BSPSOCKET)
0)
(COND
((TIMEREXPIRED? (fetch BSPTIMER of BSPSOCKET))
(APPLY* (fetch BSPTIMERFN of BSPSOCKET)
BSPSOCKET]
(GO LP])
(\RTP.CLEANUP
[LAMBDA (SOCKET) (* bvm: "14-JUN-83 14:48")
(* Cleanup called when the RTP process on this socket is deleted. CLOSERTPSOCKET may or may not have been called
yet, so send an abort if socket isn't closed yet)
(SETQ \BSPSOCKETS (DREMOVE SOCKET \BSPSOCKETS))
(\RTP.ACTION SOCKET \EVENT.FORCECLOSE) (* May have been flushed already if the socket was
aborted and then timed out, so call CLOSEPUPSOCKET with
NOERRORFLG T)
(CLOSEPUPSOCKET (fetch PUPSOC of SOCKET)
T)
[PROG ((FN (fetch BSPWHENCLOSEDFN of SOCKET)))
(AND FN (APPLY* FN (OR (fetch BSPINPUTSTREAM of SOCKET)
SOCKET]
(\BSP.FLUSH.SOCKET.QUEUES SOCKET)
(replace BSPUSERSTATE of SOCKET with NIL) (* Explicitly delete to avoid problem of circular
structures not being collected)
(replace BSPINPUTSTREAM of SOCKET with NIL])
(\RTP.ACTION
[LAMBDA (SOCKET EVENT PUP) (* bvm: " 8-JUN-83 09:55")
(* * Runs the RTP "finite state machine" according to EVENT, one of several things one might want to do to an RTP
socket, either intentionally or because of an arrived pup. In the latter case, PUP is also supplied.
Performs the indicated event, changing state if appropriate and setting timeouts if appropriate)
(PROG ((STATE (fetch STATE of SOCKET))
NEWSTATE TIMEOUT STREAM)
(SELECTC EVENT
[\EVENT.OPEN (* Normal opening of a user connection.
Send RFC)
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (\SEND.RFC SOCKET)
(SETQ NEWSTATE \STATE.SENTRFC]
[\EVENT.OPENLISTENING (* Nothing to do, just prepare to listen for an RFC)
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (SETQ NEWSTATE \STATE.LISTENING]
[\EVENT.OPENIMMEDIATE (* Assume RFC done, just put in open state)
(COND
((NEQ STATE \STATE.CLOSED)
(\RTP.ERROR SOCKET EVENT))
(T (SETQ NEWSTATE \STATE.OPEN]
(\EVENT.CLOSE (* Try to close connection. Several cases)
(SETQ NEWSTATE (SELECTC STATE
(\STATE.SENTRFC
(* Tried to open the connection, now giving up)
(\SEND.ABORT SOCKET)
\STATE.ABORTED)
(\STATE.OPEN
(* Normal case, send an END)
(\SEND.END SOCKET)
\STATE.ENDSENT)
(\STATE.ENDRECEIVED
(* Other guy decided to END, too, so forget what we were
trying to do and just reply to this END)
(\SEND.ENDREPLY SOCKET)
\STATE.DALLYING)
STATE)))
(\EVENT.FORCECLOSE (* If open, abort)
(SELECTC STATE
((LIST \STATE.SENTRFC \STATE.OPEN \STATE.ENDRECEIVED
\STATE.ENDSENT)
(\SEND.ABORT SOCKET))
NIL)
(SETQ NEWSTATE \STATE.ABORTED))
(\EVENT.RFC (* Received an RFC)
(SELECTC STATE
(\STATE.SENTRFC (* This is the answering RFC.
Its body contains the port we should talk to after this)
(\BLT (LOCF (fetch FRNPORT of SOCKET))
(fetch PUPCONTENTS of PUP)
WORDSPERPORT)
(SETQ NEWSTATE \STATE.OPEN))
[(LIST \STATE.LISTENING \STATE.OPEN \STATE.ENDSENT)
(* we were listening for someone, and this is their
opening RFC, or possibly a duplicate)
(COND
((fetch LISTENING of SOCKET)
(\SEND.ANSWERING.RFC SOCKET PUP)
(COND
((EQ STATE \STATE.LISTENING)
(SETQ NEWSTATE \STATE.OPEN]
(\RTP.ERROR SOCKET EVENT PUP)))
(\EVENT.ABORT (* Received an ABORT pup)
(SELECTC STATE
((LIST \STATE.CLOSED \STATE.LISTENING)
(* Shouldn't happen)
(\RTP.ERROR SOCKET EVENT PUP))
NIL)
(SETQ NEWSTATE \STATE.ABORTED))
(\EVENT.END (* Received END)
(SELECTC STATE
[(LIST \STATE.OPEN \STATE.ENDRECEIVED)
(* Note that we have received the end, but don't do
anything until our user decides to accept the END)
(SETQ STREAM (fetch BSPINPUTSTREAM of SOCKET))
(SETQ NEWSTATE
(COND
([OR (AND (fetch BSPCURRENTPUP of STREAM)
(ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)))
(IGREATERP (fetch #UNREADPUPS of SOCKET)
(COND
((fetch BSPCURRENTPUP of STREAM)
1)
(T 0]
(* There is still input waiting to be read, so can't end
just yet)
\STATE.ENDRECEIVED)
(T (* Okay, we're ready to end)
(\SEND.ENDREPLY SOCKET)
\STATE.DALLYING]
((LIST \STATE.ENDSENT \STATE.DALLYING)
(* We've already sent an END, but other guy wants to
end. Obey.)
(\SEND.ENDREPLY SOCKET)
(SETQ NEWSTATE \STATE.DALLYING))
(\RTP.ERROR SOCKET EVENT PUP)))
(\EVENT.ENDREPLY (* Received ENDREPLY)
(SELECTC STATE
(\STATE.ENDSENT
(* This is the reply to our END.
Echo ENDREPLY so partner can stop dallying)
(\SEND.ENDREPLY SOCKET)
(SETQ NEWSTATE \STATE.CLOSED))
(\STATE.DALLYING
(* We send ENDREPLY to partner's END.
This is the echoing ENDREPLY, so everything is cool)
(SETQ NEWSTATE \STATE.CLOSED))
(\RTP.ERROR SOCKET EVENT PUP)))
[\EVENT.TIMEOUT (* RTPTIMER expired, probably want to retransmit
something)
(* Might be nice, perhaps, if we kept copies of these
pups that we might want to retransmit)
(COND
((EQ STATE \STATE.DALLYING)
(SETQ NEWSTATE \STATE.CLOSED))
((AND (fetch BSPINITTIMER of SOCKET)
(TIMEREXPIRED? (fetch BSPINITTIMER of SOCKET)))
(\SEND.ABORT SOCKET)
(SETQ NEWSTATE \STATE.CLOSED)
(replace BSPINITTIMER of SOCKET with NIL))
(T (SELECTC STATE
(\STATE.SENTRFC (\SEND.RFC SOCKET))
(\STATE.ENDSENT (\SEND.END SOCKET))
NIL]
(ERROR "Unknown RTP event" EVENT))
[COND
(NEWSTATE (replace STATE of SOCKET with (SETQ STATE NEWSTATE))
(NOTIFY.EVENT (fetch RTPEVENT of SOCKET))
(AND (fetch BSPINPUTEVENT of SOCKET)
(NOTIFY.EVENT (fetch BSPINPUTEVENT of SOCKET]
(SELECTC STATE
((LIST \STATE.SENTRFC \STATE.ENDSENT \STATE.DALLYING)
(SETUPTIMER (SETQ TIMEOUT (COND
((EQ STATE \STATE.DALLYING)
\RTP.DALLY.TIMEOUT)
(T \RFC.TIMEOUT)))
(fetch RTPTIMER of SOCKET))
(replace RTPTIMEOUT of SOCKET with TIMEOUT))
(replace RTPTIMEOUT of SOCKET with 0])
(\RTP.ERROR
[LAMBDA (SOCKET EVENT FOREIGNPUP) (* bvm: "16-JUN-83 12:48")
(COND
(PUPTRACEFLG (PRIN1 "[Unexpected RTP event " PUPTRACEFILE)
(PRINTCONSTANT EVENT RTPEVENTS PUPTRACEFILE "\EVENT.")
(PRIN1 " when in state " PUPTRACEFILE)
(PRINTCONSTANT (fetch STATE of SOCKET)
RTPSTATES PUPTRACEFILE "\STATE.")
(PRIN1 "]
" PUPTRACEFILE])
(\RTP.FILTER
[LAMBDA (SOCKET PUP CHECKFRNPORT CHECKID) (* bvm: "12-FEB-83 16:22")
(* True if PUP is a valid RTP pup for this socket,
checking frnport and/or id as indicated)
(AND (NEQ (fetch PUPDESTHOST of PUP)
0)
[OR (NOT CHECKFRNPORT)
(PROGN [COND
([ZEROP (fetch (PORT NET) of (LOCF (fetch FRNPORT of SOCKET]
(* We didn't know the local net when we opened the
socket; perhaps we do now)
(replace (PORT NET) of (LOCF (fetch FRNPORT of SOCKET))
with (fetch PUPDESTNET of PUP]
(AND (EQ (fetch PUPSOURCE of PUP)
(fetch FRNPORT of SOCKET))
(EQ (fetch PUPSOURCESOCKETHI of PUP)
(fetch FRNSOCKETHI of SOCKET))
(EQ (fetch PUPSOURCESOCKETLO of PUP)
(fetch FRNSOCKETLO of SOCKET]
(OR (NOT CHECKID)
(AND (EQ (fetch PUPIDHI of PUP)
(\HINUM (fetch CONNID of SOCKET)))
(EQ (fetch PUPIDLO of PUP)
(\LONUM (fetch CONNID of SOCKET])
(\SEND.ABORT
[LAMBDA (SOCKET) (* bvm: " 8-FEB-83 18:24")
(PROG ((PUP (ALLOCATE.PUP)))
(\FILLRTPPUP SOCKET PUP \PT.ABORT (IPLUS BYTESPERWORD \PUPOVLEN))
(* Length counts the abort code word)
(\PUTBASE (fetch PUPCONTENTS of PUP)
0 0) (* Abort code)
(PUTPUPSTRING PUP (COND
((EQ (fetch STATE of SOCKET)
\STATE.SENTRFC)
"Connection attempt aborted")
(T "Connection aborted"))) (* Explanatory string)
(SENDPUP (fetch PUPSOC of SOCKET)
PUP])
(\SEND.ANSWERING.RFC
[LAMBDA (SOCKET IPUP) (* bvm: "10-MAY-83 22:23")
(* * sends an RFC in response to the RFC in IPUP. The connection port we send is self, since we can only support
one connection in this model)
(PROG ((OPUP (ALLOCATE.PUP)))
(COND
((EQ (fetch STATE of SOCKET)
\STATE.LISTENING) (* We were waiting for this. If not, this is a duplicate
RFC and we just throw it away after retransmitting the
answering RFC)
(replace CONNID of SOCKET with (fetch PUPID of IPUP))
(\BLT (LOCF (fetch FRNPORT of SOCKET))
(fetch PUPCONTENTS of IPUP)
WORDSPERPORT) (* Set foreign connection port for this connection.
Our LCLPORT should already be correct)
))
(\FILLRTPPUP SOCKET OPUP \PT.RFC (IPLUS (UNFOLD WORDSPERPORT BYTESPERWORD)
\PUPOVLEN))
(\BLT (LOCF (fetch DEST of OPUP))
(LOCF (fetch SOURCE of IPUP))
WORDSPERPORT) (* Send this pup to the port by which IPUP arrived, not
by the RTP connection port)
(\BLT (fetch PUPCONTENTS of OPUP)
(LOCF (fetch LCLPORT of SOCKET))
WORDSPERPORT) (* Our connection port is self)
(replace EPREQUEUE of OPUP with (QUOTE FREE))
(SENDPUP (fetch PUPSOC of SOCKET)
OPUP])
(\SEND.END
[LAMBDA (SOCKET) (* bvm: " 8-FEB-83 18:22")
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLRTPPUP SOCKET NIL \PT.END \PUPOVLEN])
(\SEND.ENDREPLY
[LAMBDA (SOCKET) (* bvm: " 8-FEB-83 18:23")
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLRTPPUP SOCKET NIL \PT.ENDREPLY \PUPOVLEN])
(\SEND.RFC
[LAMBDA (SOCKET) (* bvm: " 8-FEB-83 18:23")
(* * Sends an initiating RFC on SOCKET)
(PROG ((PUP (ALLOCATE.PUP)))
(\BLT (fetch PUPCONTENTS of PUP)
(LOCF (fetch LCLPORT of SOCKET))
WORDSPERPORT) (* Connection port = self)
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLRTPPUP SOCKET PUP \PT.RFC (IPLUS (UNFOLD WORDSPERPORT BYTESPERWORD)
\PUPOVLEN])
(\FILLRTPPUP
[LAMBDA (SOCKET PUP TYPE LENGTH) (* bvm: " 8-FEB-83 18:21")
(* * Fills in an RTP pup for SOCKET. TYPE is the pup type, LENGTH its length. We fill in also the ID
(connection ID) and local and foreign ports (from socket))
(OR PUP (SETQ PUP (ALLOCATE.PUP)))
(replace PUPLENGTH of PUP with (OR LENGTH \PUPOVLEN))
(replace TYPEWORD of PUP with TYPE) (* Clears TCONTROL while setting TYPE)
(replace PUPID of PUP with (fetch CONNID of SOCKET))
(\SETRTPPORTS SOCKET PUP)
PUP])
(\SETRTPPORTS
[LAMBDA (SOCKET PUP) (* bvm: " 6-AUG-81 19:30")
(* Fill in both Frn and lcl ports in one move)
(\MOVEWORDS (LOCF (fetch FRNPORT of SOCKET))
0
(LOCF (fetch DEST of PUP))
0
(ITIMES WORDSPERPORT 2])
)
(DEFINEQ
(\BSPINIT
[LAMBDA NIL (* bvm: " 9-JUN-83 15:16")
(* Defines the BSP device, so that you can BIN and BOUT
on BSP streams)
(DECLARE (GLOBALVARS \BSPFDEV))
(SETQ \BSPFDEV (create FDEV
DEVICENAME ←(FUNCTION BSP)
RESETABLE ← NIL
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
CLOSEFILE ←(FUNCTION NILL)
DELETEFILE ←(FUNCTION NILL)
GETFILEINFO ←(FUNCTION NILL)
OPENFILE ←(FUNCTION NILL)
READPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
SETFILEINFO ←(FUNCTION NILL)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILENAME ←(FUNCTION NILL)
REOPENFILE ←(FUNCTION NILL)
EVENTFN ←(FUNCTION \BSPEVENTFN)
DIRECTORYNAMEP ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
BIN ←(FUNCTION BSPBIN)
BOUT ←(FUNCTION BSPBOUT)
READP ←(FUNCTION BSPREADP)
EOFP ←(FUNCTION BSPEOFP)
PEEKBIN ←(FUNCTION BSPPEEKBIN)
BACKFILEPTR ←(FUNCTION \BSPBACKFILEPTR)
BLOCKIN ←(FUNCTION \BSPREADBLOCK)
BLOCKOUT ←(FUNCTION \BSPWRITEBLOCK)))
(\DEFINEDEVICE NIL \BSPFDEV])
(\BSPEVENTFN
[LAMBDA (DEV EVENT) (* bvm: " 9-MAY-83 16:38")
(SELECTQ EVENT
(BEFORELOGOUT (while \BSPSOCKETS do (CLOSERTPSOCKET (pop \BSPSOCKETS)
0)))
((AFTERSYSOUT AFTERMAKESYS)
(while \BSPSOCKETS do (CLOSERTPSOCKET (pop \BSPSOCKETS)
0 T)))
NIL])
)
(* Creating BSP stream)
(DEFINEQ
(OPENBSPSTREAM
[LAMBDA (SOCKET OTHERPUPHANDLER ERRORHANDLER IOTIMEOUT IOTIMEOUTFN WHENCLOSEDFN)
(* bvm: "10-MAY-83 18:36")
(* * SOCKET is an RTP socket, which should be open. This procedure fills in the parameters to make it a BSP
stream)
(PROG (INSTREAM OUTSTREAM)
[COND
((NOT (type? BSPSOC SOCKET)) (* Interpret it as a port to which to establish a user
RTP connection)
(SETQ SOCKET (OPENRTPSOCKET SOCKET (QUOTE USER]
(COND
((NOT (AND SOCKET (SELECTC (fetch STATE of SOCKET)
((LIST \STATE.OPEN \STATE.ENDRECEIVED)
T)
NIL)))
(RETURN)))
[replace USERBYTEID of SOCKET
with (replace RCVBYTEID of SOCKET
with (replace RCVINTERRUPTID of SOCKET
with (replace XMITBYTEID of SOCKET
with (replace XMITINTERRUPTID of SOCKET
with (replace LASTACKID of SOCKET
with (fetch CONNID of SOCKET]
(* All ID's start out as the connection ID)
(replace ADATATIMEOUT of SOCKET with \BSP.INITIAL.ADATATIMEOUT)
(replace MAXPUPALLOC of SOCKET with \BSP.INITIAL.MAXPUPALLOC)
(\BSP.FLUSH.SOCKET.QUEUES SOCKET)
[replace BSPINPUTSTREAM of SOCKET
with (SETQ INSTREAM (create STREAM
DEVICE ← \BSPFDEV
BINABLE ← T
ACCESS ←(PROGN (* For backward compatibility, have to make lisp think
we can print on the input side)
(QUOTE BOTH]
[replace BSPOUTPUTSTREAM of INSTREAM with (SETQ OUTSTREAM
(create STREAM
DEVICE ← \BSPFDEV
ACCESS ←(QUOTE OUTPUT]
(replace BSPSOC of INSTREAM with (replace BSPSOC of OUTSTREAM with SOCKET))
[replace #UNREADPUPS of SOCKET
with (replace #UNACKEDPUPS of SOCKET
with (replace #UNACKEDBYTES of SOCKET
with (replace PUPALLOC of SOCKET
with (replace BYTESPERPUP of SOCKET
with (replace BYTEALLOC of SOCKET
with (replace PUPALLOCCOUNT of SOCKET
with (replace ADATACOUNT of SOCKET
with 0]
(replace BSPTIMERFN of SOCKET with (FUNCTION \BSP.TIMERFN))
(SETUPTIMER 1 (fetch BSPTIMER of SOCKET))
(replace BSPTIMEOUT of SOCKET with 1) (* \SETBSPTIMEOUT will soon fix this)
(SETUPTIMER \BSP.INACTIVITY.TIMEOUT (fetch INACTIVITYTIMER of SOCKET))
(replace OTHERPUPFN of SOCKET with (FUNCTION \BSP.PUPHANDLER))
(replace BSPOTHERPUPFN of SOCKET with (OR OTHERPUPHANDLER (FUNCTION RELEASE.PUP)))
(replace BSPERRORHANDLER of SOCKET with (OR ERRORHANDLER (FUNCTION
\BSP.DEFAULT.ERROR.HANDLER)))
(replace BSPIOTIMEOUT of SOCKET with (OR IOTIMEOUT 0))
(replace IOTIMEOUTFN of SOCKET with IOTIMEOUTFN)
(replace BSPWHENCLOSEDFN of SOCKET with WHENCLOSEDFN)
(replace BSPINPUTEVENT of SOCKET with (CREATE.EVENT (CONCAT (PROCESS.NAME (fetch RTPPROCESS
of SOCKET))
"#INPUT")))
(BLOCK) (* Let the socket process run to handle any stuff that's
arrived since the RTP connection was opened)
(RETURN INSTREAM])
(BSPOUTPUTSTREAM
[LAMBDA (BSPSTREAM) (* bvm: "10-MAY-83 18:38")
(* Returns the output side of a BSPSTREAM)
(ffetch BSPOUTPUTSTREAM of (\DTEST BSPSTREAM (QUOTE STREAM])
(CLOSEBSPSTREAM
[LAMBDA (STREAM TIMEOUT) (* bvm: "14-JUN-83 14:49")
(* Closes BSP stream. TIMEOUT is how long to wait for partner to agree. Returns true if closed amiably, NIL if
aborted. SOCKET is dead afterwards in any case)
(PROG ((SOCKET (\DTEST (fetch BSPSOC of STREAM)
(QUOTE BSPSOC)))
TIMER)
(OR TIMEOUT (SETQ TIMEOUT \RTP.DEFAULTTIMEOUT))
(WITH.MONITOR (ffetch BSPLOCK of SOCKET)
[COND
((BSPOPENP STREAM (QUOTE OUTPUT))
(BSPFORCEOUTPUT STREAM) (* Send any waiting output, and wait for all our output
to be acked)
(SETQ TIMER (SETUPTIMER TIMEOUT))
(while (OR (NEQ (fetch #UNACKEDPUPS of SOCKET)
0)
(fetch INTERRUPTOUT of SOCKET))
do (\BSP.FLUSHINPUT STREAM)
(* Discard input while waiting)
(COND
((AND (BSPOPENP STREAM)
(NOT (TIMEREXPIRED? TIMER)))
(MONITOR.AWAIT.EVENT (ffetch BSPLOCK of SOCKET)
(fetch BSPINPUTEVENT of SOCKET)
TIMER T))
(T (* Timed out or connection went bad)
(SETQ TIMEOUT 0)
(RETURN]
(* * now close the socket, continuing to flush input while we wait)
[COND
((fetch BSPINPUTSTREAM of SOCKET)
(replace BSPTIMERFN of SOCKET with (FUNCTION \BSP.SUCKINPUT]
(OR (CLOSERTPSOCKET SOCKET TIMEOUT)
(SETQ TIMEOUT 0)))
(BLOCK)
(RETURN (NEQ TIMEOUT 0])
(\BSP.SUCKINPUT
[LAMBDA (SOCKET) (* bvm: " 9-MAY-83 16:08")
(* * A BSPTIMERFN that eats input)
(\BSP.FLUSHINPUT (fetch BSPINPUTSTREAM of SOCKET))
(SETUPTIMER (fetch BSPTIMEOUT of SOCKET)
(fetch BSPTIMER of SOCKET])
(\BSP.FLUSHINPUT
[LAMBDA (STREAM) (* bvm: " 9-MAY-83 16:07")
(* Flushes any BSP input currently waiting)
(while (NULL (\BSP.PREPARE.INPUT STREAM 0))
do (* Normal data waiting, flush it)
(\BSP.CLEANUP.INPUT STREAM])
(BSPOPENP
[LAMBDA (STREAM TYPE) (* bvm: "10-MAY-83 17:25")
(* * True if STREAM is open for the indicated TYPE of i/o: NIL (either), INPUT, OUTPUT, or BOTH.
E.g. STREAM may be open for OUTPUT but not INPUT if partner has requested an end.)
(PROG [(SOCKET (fetch BSPSOC of (\DTEST STREAM (QUOTE STREAM]
(RETURN (AND SOCKET (SELECTC (fetch STATE of SOCKET)
(\STATE.OPEN T)
[\STATE.ENDRECEIVED (OR (NULL TYPE)
(EQ TYPE (QUOTE OUTPUT]
[\STATE.ENDSENT (OR (NULL TYPE)
(EQ TYPE (QUOTE INPUT]
NIL])
(GETBSPUSERINFO
[LAMBDA (STREAM) (* bvm: "10-MAY-83 17:06")
(ffetch BSPUSERSTATE of (\DTEST (ffetch BSPSOC of (\DTEST STREAM (QUOTE STREAM)))
(QUOTE BSPSOC])
(SETBSPUSERINFO
[LAMBDA (STREAM VALUE) (* bvm: " 9-MAY-83 16:12")
(freplace BSPUSERSTATE of (ffetch BSPSOC of (\DTEST STREAM (QUOTE STREAM))) with VALUE])
)
(DEFINEQ
(CREATEBSPSTREAM
[LAMBDA (SOCKET OTHERPUPHANDLER ERRORHANDLER IOTIMEOUT IOTIMEOUTFN WHENCLOSEDFN)
(* bvm: "13-JUN-83 18:21")
(OPENBSPSTREAM SOCKET OTHERPUPHANDLER ERRORHANDLER IOTIMEOUT IOTIMEOUTFN WHENCLOSEDFN])
(ENDBSPSTREAM
[LAMBDA (STREAM TIMEOUT) (* bvm: "13-JUN-83 18:22")
(CLOSEBSPSTREAM STREAM TIMEOUT])
)
(* BSP stream functions)
(DEFINEQ
(BSPBIN
[LAMBDA (STREAM) (* bvm: " 9-JUN-83 15:26")
(.COERCE.BSP.INPUT.STREAM STREAM)
(PROG (ERRCODE)
LP (RETURN (\GETBASEBYTE [OR (fetch CPPTR of STREAM)
(COND
((SETQ ERRCODE (\BSP.PREPARE.INPUT STREAM))
(RETURN (BSP.ERROR (fetch BSPSOC of STREAM)
ERRCODE)))
(T (fetch CPPTR of STREAM]
(PROG1 (fetch COFFSET of STREAM)
(COND
((IGREATERP (add (fetch COFFSET of STREAM)
1)
(fetch CBUFSIZE of STREAM))
(* Buffer was exhausted, so refill)
(\BSP.CLEANUP.INPUT STREAM)
(GO LP])
(BSPPEEKBIN
[LAMBDA (STREAM) (* bvm: "18-MAY-83 15:49")
(.COERCE.BSP.INPUT.STREAM STREAM)
(PROG (BASE ERRCODE)
LP (RETURN (\GETBASEBYTE [OR (fetch CPPTR of STREAM)
(COND
((SETQ ERRCODE (\BSP.PREPARE.INPUT STREAM))
(RETURN (BSP.ERROR (fetch BSPSOC of STREAM)
ERRCODE)))
(T (fetch CPPTR of STREAM]
(PROG1 (fetch COFFSET of STREAM)
(COND
((IGEQ (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(* Buffer was exhausted, so refill)
(\BSP.CLEANUP.INPUT STREAM)
(GO LP])
(\BSPREADBLOCK
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: " 9-JUN-83 12:20")
(* Copy NBYTES from STREAM to BASE, OFF)
(.COERCE.BSP.INPUT.STREAM STREAM)
(PROG (ERRCODE INPUTBASE INPUTLEFT (TOTAL 0))
LP [COND
((ILEQ NBYTES 0)
(RETURN TOTAL))
((SETQ INPUTBASE (fetch CPPTR of STREAM)))
((SETQ ERRCODE (\BSP.PREPARE.INPUT STREAM))
(BSP.ERROR (fetch BSPSOC of STREAM)
ERRCODE)
(RETURN TOTAL))
(T (SETQ INPUTBASE (fetch CPPTR of STREAM]
(COND
[(ILEQ (SETQ INPUTLEFT (IDIFFERENCE (fetch CBUFSIZE of STREAM)
(fetch COFFSET of STREAM)))
NBYTES) (* Copy all of the rest of this pup into destination)
[COND
((IGREATERP INPUTLEFT 0)
(\MOVEBYTES INPUTBASE (fetch COFFSET of STREAM)
BASE OFF INPUTLEFT)
(add OFF INPUTLEFT)
(add TOTAL INPUTLEFT)
(SETQ NBYTES (IDIFFERENCE NBYTES INPUTLEFT]
(COND
((ZEROP NBYTES) (* Leave last pup around for \BACKFILEPTR)
(replace COFFSET of STREAM with (fetch CBUFSIZE of STREAM)))
(T (\BSP.CLEANUP.INPUT STREAM)
(GO LP]
(T (* Move NBYTES from current pup, then we're done)
(\MOVEBYTES INPUTBASE (fetch COFFSET of STREAM)
BASE OFF NBYTES)
(add (fetch COFFSET of STREAM)
NBYTES)
(add TOTAL NBYTES)))
(RETURN TOTAL])
(BSPREADP
[LAMBDA (STREAM) (* bvm: " 5-JUN-83 15:18")
(* * true if there is input (not a mark) waiting on STREAM)
(PROG (SOCKET)
(COND
((fetch MARKPENDING of STREAM)
(RETURN NIL))
((AND (fetch BSPCURRENTPUP of STREAM)
(ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)))
(RETURN T)))
(RETURN (COND
((IGREATERP (fetch #UNREADPUPS of (SETQ SOCKET (fetch BSPSOC of STREAM)))
(COND
((fetch BSPCURRENTPUP of STREAM)
1)
(T 0)))
(SELECTC (fetch PUPTYPE of (\QUEUEHEAD (fetch INPUTQ of SOCKET)))
((LIST \PT.MARK \PT.AMARK)
NIL)
T])
(BSPEOFP
[LAMBDA (STREAM) (* bvm: "11-JUL-83 17:47")
(* * true if bsp STREAM is at end of file, i.e. is at a mark)
(COND
((fetch MARKPENDING of STREAM)
T)
((AND (fetch BSPCURRENTPUP of STREAM)
(ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)))
NIL)
((\BSP.PREPARE.INPUT STREAM)
T])
(\BSPBACKFILEPTR
[LAMBDA (STREAM) (* bvm: " 1-JUN-83 12:22")
(COND
((AND (fetch BSPOUTPUTSTREAM of STREAM)
(fetch CPPTR of STREAM)
(IGREATERP (fetch COFFSET of STREAM)
0))
(add (fetch COFFSET of STREAM)
-1))
(T (ERROR "Can't back up this BSP Stream" STREAM])
(\BSP.PREPARE.INPUT
[LAMBDA (STREAM TIMEOUT) (* bvm: " 5-JUN-83 15:32")
(* * Prepares INPUP for SOCKET, waiting at most TIMEOUT if supplied (else BSPIOTIMEOUT if in stream else forever).
Returns NIL on success, an error code on failure.)
(WITH.MONITOR (fetch BSPLOCK of (fetch BSPSOC of STREAM))
(PROG (PUP ERRCODE SOCKET)
LP (COND
[(NULL (fetch BSPCURRENTPUP of STREAM))
(SETQ SOCKET (fetch BSPSOC of STREAM))
(OR TIMEOUT [NOT (ZEROP (SETQ TIMEOUT (fetch BSPIOTIMEOUT of SOCKET]
(SETQ TIMEOUT))
(BLOCK)
(* Note: we always yield, even before checking to see if pups are available. That way a process that is sitting
reading from the bytestream at least yields once per pup)
(COND
((SETQ ERRCODE (bind (TIMER ←(AND TIMEOUT (NOT (ZEROP TIMEOUT))
(SETUPTIMER TIMEOUT)))
do [COND
((IGREATERP (fetch #UNREADPUPS of SOCKET)
0)
(RETURN))
((NOT (BSPOPENP STREAM (QUOTE INPUT)))
(RETURN (QUOTE BAD.STATE.FOR.BIN)))
((AND TIMEOUT (OR (ZEROP TIMEOUT)
(TIMEREXPIRED? TIMER)))
(RETURN (COND
((fetch IOTIMEOUTFN of SOCKET)
(APPLY* (fetch IOTIMEOUTFN
of SOCKET)
STREAM
(QUOTE INPUT)))
(T (QUOTE BIN.TIMEOUT]
(MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch BSPINPUTEVENT
of SOCKET)
TIMER TIMER)))
(RETURN ERRCODE)))
(replace BSPCURRENTPUP of STREAM
with (OR (SETQ PUP (\DEQUEUE (fetch BSPINPUTQ of SOCKET)))
(SHOULDNT)))
(replace COFFSET of STREAM with 0)
(* Set byte pointers for reading bytes from pup)
(replace MARKPENDING of STREAM
with (SELECTC (fetch PUPTYPE of PUP)
((LIST \PT.MARK \PT.AMARK)
(replace CBUFSIZE of STREAM with 0)
(* Inhibit BIN microcode from reading mark)
T)
(PROGN (replace CPPTR of STREAM
with (fetch PUPCONTENTS of PUP))
(replace CBUFSIZE of STREAM
with (IDIFFERENCE (fetch PUPLENGTH
of PUP)
\PUPOVLEN))
NIL]
((AND (IGEQ (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(NOT (fetch MARKPENDING of STREAM)))
(* Current pup is exhausted)
(\BSP.CLEANUP.INPUT STREAM)
(GO LP)))
(RETURN (AND (fetch MARKPENDING of STREAM)
(QUOTE MARK.ENCOUNTERED])
(\BSP.CLEANUP.INPUT
[LAMBDA (STREAM) (* bvm: " 9-MAY-83 17:47")
(* * Called after last byte has been read from this input pup)
(PROG [(PUP (\DTEST (fetch BSPCURRENTPUP of STREAM)
(QUOTE ETHERPACKET)))
(SOCKET (\DTEST (fetch BSPSOC of STREAM)
(QUOTE BSPSOC]
(add (fetch USERBYTEID of SOCKET)
(IDIFFERENCE (fetch PUPLENGTH of PUP)
\PUPOVLEN))
(RELEASE.PUP PUP)
(replace BSPCURRENTPUP of STREAM with NIL)
(replace CBUFSIZE of STREAM with 0)
(replace CPPTR of STREAM with NIL)
(add (fetch #UNREADPUPS of SOCKET)
-1)
(COND
((fetch SENTZEROALLOC of SOCKET) (* Our last ack said we had no allocation, so send a
gratuitous ack now to get partner going again)
(\SEND.ACK SOCKET])
(BSPBOUT
[LAMBDA (STREAM BYTE MARKP) (* bvm: " 9-JUN-83 15:26")
(SETQ STREAM (OR (ffetch BSPOUTPUTSTREAM of (\DTEST STREAM (QUOTE STREAM)))
STREAM))
(PROG (ERRCODE)
LP (\PUTBASEBYTE [OR (ffetch CPPTR of STREAM)
(COND
((SETQ ERRCODE (\BSP.PREPARE.OUTPUT STREAM))
(RETURN (BSP.ERROR (ffetch BSPSOC of STREAM)
ERRCODE)))
(T (ffetch CPPTR of STREAM]
[PROG1 (ffetch COFFSET of STREAM)
(COND
((IGREATERP (add (ffetch COFFSET of STREAM)
1)
(ffetch CBUFSIZE of STREAM))
(add (ffetch COFFSET of STREAM)
-1) (* Set COFFSET back where it for BSPFORCEOUTPUT)
(BSPFORCEOUTPUT STREAM)
(GO LP]
BYTE)
(COND
(MARKP (replace PUPTYPE of (OR (fetch BSPCURRENTPUP of STREAM)
(BSPHELP "BSPPUTMARK lost its pup"))
with \PT.MARK)
(BSPFORCEOUTPUT STREAM)))
(RETURN BYTE])
(\BSPWRITEBLOCK
[LAMBDA (STREAM BASE OFF NBYTES) (* bvm: " 9-JUN-83 15:13")
(SETQ STREAM (OR (ffetch BSPOUTPUTSTREAM of (\DTEST STREAM (QUOTE STREAM)))
STREAM))
(PROG (ERRCODE MYBASE NBYTESLEFT)
LP [COND
((ILEQ NBYTES 0)
(RETURN))
((SETQ MYBASE (ffetch CPPTR of STREAM)))
((SETQ ERRCODE (\BSP.PREPARE.OUTPUT STREAM))
(RETURN (BSP.ERROR (ffetch BSPSOC of STREAM)
ERRCODE)))
(T (SETQ MYBASE (ffetch CPPTR of STREAM]
(COND
((ILEQ (SETQ NBYTESLEFT (IDIFFERENCE (ffetch CBUFSIZE of STREAM)
(ffetch COFFSET of STREAM)))
NBYTES)
(COND
((IGREATERP NBYTESLEFT 0)
(\MOVEBYTES BASE OFF MYBASE (ffetch COFFSET of STREAM)
NBYTESLEFT)
(add OFF NBYTESLEFT)
(SETQ NBYTES (IDIFFERENCE NBYTES NBYTESLEFT))
(add (ffetch COFFSET of STREAM)
NBYTESLEFT)))
(BSPFORCEOUTPUT STREAM)
(GO LP))
(T (\MOVEBYTES BASE OFF MYBASE (ffetch COFFSET of STREAM)
NBYTES)
(add (ffetch COFFSET of STREAM)
NBYTES)
(RETURN])
(BSPFORCEOUTPUT
[LAMBDA (STREAM DEMANDINGLY) (* bvm: " 5-JUN-83 15:41")
(* * Forces any buffered output to be transmitted now. If DEMANDINGLY is true, sends it as an ADATA)
(WITH.MONITOR [fetch BSPLOCK of (fetch BSPSOC of (SETQ STREAM (OR (ffetch BSPOUTPUTSTREAM
of (\DTEST STREAM
(QUOTE STREAM)))
STREAM]
(PROG ((PUP (fetch BSPCURRENTPUP of STREAM))
SOCKET NBYTES)
(COND
(PUP (SETQ NBYTES (fetch COFFSET of STREAM))
(* number of bytes in this pup.
Always greater than zero given the way we set things up)
(replace PUPLENGTH of PUP with (IPLUS NBYTES \PUPOVLEN))
[replace PUPID of PUP with (fetch XMITBYTEID
of (SETQ SOCKET (fetch BSPSOC
of STREAM]
(* Give it the latest ID, and advance it)
(add (fetch XMITBYTEID of SOCKET)
NBYTES) (* Note: this is wrong if \OVERFLOW ~= 0)
(\SETRTPPORTS SOCKET PUP)
(add (fetch #UNACKEDPUPS of SOCKET)
1)
(add (fetch #UNACKEDBYTES of SOCKET)
NBYTES)
(add (fetch PUPALLOC of SOCKET)
-1) (* Adjust allocation information to account for
pup/bytes we are sending to partner)
(add (fetch BYTEALLOC of SOCKET)
(IMINUS NBYTES))
(replace AUXWORD of PUP with (fetch ADATACOUNT of SOCKET))
(* Lets us know where this pup falls with respect to
ADATA's we may send)
(replace BSPCURRENTPUP of STREAM with NIL)
(replace CBUFSIZE of STREAM with 0)
(replace CPPTR of STREAM with NIL)
(\TRANSMIT.STRATEGY SOCKET PUP (AND DEMANDINGLY T))
(* Maybe make it an ADATA)
(replace EPREQUEUE of PUP with (fetch BSPOUTPUTQ of SOCKET))
(* Retain pup for possible retransmission)
(SENDPUP (fetch PUPSOC of SOCKET)
PUP)
(\SETBSPTIMEOUT SOCKET])
(\BSP.PREPARE.OUTPUT
[LAMBDA (STREAM TIMEOUT) (* bvm: " 5-JUN-83 15:40")
(* * Prepares OUTPUP for SOCKET, waiting at most TIMEOUT if supplied (else BSPIOTIMEOUT if in stream else forever)
. Returns NIL on success, an error code on failure. We only need to wait if allocation is exhausted)
(WITH.MONITOR (fetch BSPLOCK of (fetch BSPSOC of STREAM))
(PROG (PUP ERRCODE SOCKET)
[COND
((NULL (fetch CPPTR of STREAM))
(SETQ SOCKET (fetch BSPSOC of STREAM))
[COND
([AND (NOT TIMEOUT)
(NOT (ZEROP (fetch BSPIOTIMEOUT of SOCKET]
(SETQ TIMEOUT (fetch BSPIOTIMEOUT of SOCKET]
(COND
((SETQ ERRCODE (bind (TIMER ←(AND TIMEOUT (NOT (ZEROP TIMEOUT))
(SETUPTIMER TIMEOUT)))
do [COND
((NOT (BSPOPENP STREAM (QUOTE OUTPUT)))
(RETURN (QUOTE BAD.STATE.FOR.BOUT)))
((AND (IGREATERP (fetch PUPALLOC of SOCKET)
0)
(IGREATERP (fetch BYTEALLOC of SOCKET)
0))
(* Partner is ready for us)
(RETURN))
((AND TIMEOUT (OR (ZEROP TIMEOUT)
(TIMEREXPIRED? TIMER)))
(RETURN (COND
((fetch IOTIMEOUTFN of SOCKET)
(APPLY* (fetch IOTIMEOUTFN
of SOCKET)
SOCKET
(QUOTE OUTPUT)))
(T (QUOTE BOUT.TIMEOUT]
(MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch BSPINPUTEVENT
of SOCKET)
TIMER TIMER)))
(RETURN ERRCODE)))
(replace BSPCURRENTPUP of STREAM with (SETQ PUP (ALLOCATE.PUP)))
(replace TYPEWORD of PUP with \PT.DATA)
(replace CPPTR of STREAM with (fetch PUPCONTENTS of PUP))
(replace COFFSET of STREAM with 0)
(* Set counters according to current socket allocation
information)
(replace CBUFSIZE of STREAM with (IMIN (fetch BYTESPERPUP of SOCKET)
(fetch BYTEALLOC of SOCKET]
(RETURN NIL])
(BSPGETMARK
[LAMBDA (STREAM) (* bvm: "10-MAY-83 23:38")
(.COERCE.BSP.INPUT.STREAM STREAM)
(COND
((EQ (\BSP.PREPARE.INPUT STREAM)
(QUOTE MARK.ENCOUNTERED))
(replace MARKPENDING of STREAM with NIL)
(PROG1 (\GETBASEBYTE (fetch PUPCONTENTS of (fetch BSPCURRENTPUP of STREAM))
0)
(\BSP.CLEANUP.INPUT STREAM)))
(T (BSP.ERROR (fetch BSPSOC of STREAM)
(QUOTE BAD.GETMARK])
(BSPPUTMARK
[LAMBDA (STREAM MARKBYTE) (* bvm: "10-MAY-83 18:07")
(BSPFORCEOUTPUT STREAM) (* Send anything waiting)
(BSPBOUT STREAM MARKBYTE T])
(BSP.PUTINTERRUPT
[LAMBDA (STREAM CODE STRING TIMEOUT) (* bvm: " 1-JUL-83 12:26")
(* * Sends an Interrupt on SOCKET with given interrupt code and text. Since there can only be one unacked
interrupt outstanding at once, it may have to wait. If TIMEOUT is given, we wait only that long.
Returns true on success.)
(PROG [(SOCKET (\DTEST (fetch BSPSOC of (\DTEST STREAM (QUOTE STREAM)))
(QUOTE BSPSOC]
(RETURN (WITH.MONITOR (fetch BSPLOCK of SOCKET)
(bind PUP (TIMER ←(AND TIMEOUT (SETUPTIMER TIMEOUT)))
do (COND
((OR (NOT (BSPOPENP STREAM (QUOTE OUTPUT)))
(AND TIMEOUT (TIMEREXPIRED? TIMER)))
(RETURN))
((NOT (fetch INTERRUPTOUT of SOCKET))
(* State fine for sending interrupt)
(SETQ PUP (ALLOCATE.PUP))
(\FILLBSPPUP SOCKET PUP \PT.INTERRUPT (IPLUS \PUPOVLEN
BYTESPERWORD)
(fetch XMITINTERRUPTID of SOCKET)
(fetch BSPOUTPUTQ of SOCKET))
(\PUTBASE (fetch PUPCONTENTS of PUP)
0 CODE)
(* Store error code in first data word)
(PUTPUPSTRING PUP STRING)
(* Append string)
(SENDPUP (fetch PUPSOC of SOCKET)
PUP) (* save pup until it is acked)
(replace INTERRUPTOUT of SOCKET with T)
(\SETBSPTIMEOUT SOCKET)
(RETURN T)))
(MONITOR.AWAIT.EVENT (fetch BSPLOCK of SOCKET)
(fetch BSPINPUTEVENT of SOCKET)
TIMER TIMER])
)
(* BSP pup handler)
(DEFINEQ
(\BSP.PUPHANDLER
[LAMBDA (PUP SOCKET) (* bvm: " 7-JUL-81 16:22")
(* * This is the pup handler for BSP. It is called whenever RTP gets an error pup or a non-RTP pup)
(SELECTC (fetch PUPTYPE of PUP)
((LIST \PT.MARK \PT.DATA) (* Ordinary data)
(\BSP.HANDLE.DATA PUP SOCKET))
((LIST \PT.AMARK \PT.ADATA) (* Data that demands an ack)
(replace ACKPENDING of SOCKET with T)
(\BSP.HANDLE.DATA PUP SOCKET))
(\PT.ACK (\BSP.HANDLE.ACK PUP SOCKET))
(\PT.INTERRUPT (\BSP.HANDLE.INTERRUPT PUP SOCKET))
(\PT.INTERRUPTREPLY (\BSP.HANDLE.INTERRUPTREPLY PUP SOCKET))
(\PT.ERROR (\BSP.HANDLE.ERROR PUP SOCKET))
(BSP.OTHERFN PUP SOCKET))
(COND
((fetch ACKPENDING of SOCKET)
(\SEND.ACK SOCKET])
(\BSP.HANDLE.ACK
[LAMBDA (PUP SOCKET) (* bvm: " 5-JUN-83 15:29")
(* * Handle an ACK pup. This is a little messy. The ACK's id tells how far partner has gotten in the stream.
Assuming this ack was in response to an ADATA of ours, we need to retransmit anything that we sent before that
ADATA which isn't acknowledged in this ack. Finally, the body of the ack gives us an update of partner's
allocation)
(PROG (THISID NEXTPUP OLDPUP ADATACOUNT ACKDATA OUTQUEUE INTERRUPTPUP)
(COND
((OR (NOT (\RTP.FILTER SOCKET PUP T))
(ILESSP (SETQ THISID (fetch PUPID of PUP))
(fetch LASTACKID of SOCKET))) (* not for us, or is a duplicate/delayed ack)
(RELEASE.PUP PUP)
(RETURN)))
[COND
((fetch ACKREQUESTED of SOCKET)
(* This is presumably in response to our last ADATA, so notice how long it took. Update our timeout = 2 * avg
round trip delay, exponentially aged over the last 8 samples)
(replace ADATATIMEOUT of SOCKET
with (LRSH [IPLUS (ITIMES 7 (fetch ADATATIMEOUT of SOCKET))
(IMAX 5 (IMIN 150 (LLSH (CLOCKDIFFERENCE (fetch LASTADATATIME
of SOCKET))
1]
3]
(replace LASTACKID of SOCKET with THISID)
(SETQ OUTQUEUE (fetch BSPOUTPUTQ of SOCKET)) (* Now figure out who is acked and who needs
retransmitting)
[COND
((fetch INTERRUPTOUT of SOCKET)
(SETQ INTERRUPTPUP (\SEARCH.OUTPUTQ SOCKET T]
(UNINTERRUPTABLY
(SETQ OLDPUP (fetch SYSQUEUEHEAD of OUTQUEUE))
(* Empty out the queue and refill it below)
(replace SYSQUEUEHEAD of OUTQUEUE with (replace SYSQUEUETAIL of OUTQUEUE with NIL)))
(COND
(INTERRUPTPUP (* Retransmit interrupts immediately)
(replace EPREQUEUE of INTERRUPTPUP with OUTQUEUE)
(SENDPUP (fetch PUPSOC of SOCKET)
INTERRUPTPUP)))
(COND
((fetch ACKREQUESTED of SOCKET)
(SETQ ADATACOUNT (fetch ADATACOUNT of SOCKET))
(* This lets us know whether a pup was sent before or
after last adata)
(replace ACKREQUESTED of SOCKET with NIL)))
(while OLDPUP
do (SETQ NEXTPUP (fetch QLINK of OLDPUP))
(replace QLINK of OLDPUP with NIL)
(COND
((EQ (fetch PUPTYPE of OLDPUP)
\PT.INTERRUPT) (* We retransmitted it above, so we should not be seeing
this!)
(\ENQUEUE OUTQUEUE OLDPUP))
((IGEQ (IDIFFERENCE THISID (fetch PUPID of OLDPUP))
(IDIFFERENCE (fetch PUPLENGTH of OLDPUP)
\PUPOVLEN)) (* has been acked, release it)
(add (fetch #UNACKEDPUPS of SOCKET)
-1)
(add (fetch #UNACKEDBYTES of SOCKET)
(IDIFFERENCE \PUPOVLEN (fetch PUPLENGTH of OLDPUP)))
(add (fetch PUPALLOCCOUNT of SOCKET)
1) (* one more pup successfully received)
(RELEASE.PUP OLDPUP))
((AND ADATACOUNT (IGREATERP ADATACOUNT (fetch AUXWORD of OLDPUP)))
(* This pup was originally sent before our last ADATA,
so retransmit it)
[\TRANSMIT.STRATEGY SOCKET OLDPUP (COND
([AND (fetch QLINK of OLDPUP)
(ILEQ ADATACOUNT (fetch AUXWORD
of (fetch QLINK of OLDPUP]
(SETQ ADATACOUNT NIL))
(T (QUOTE NO] (* Maybe make it an ADATA if this is the last thing
we're retransmitting, else make it just DATA)
(replace EPREQUEUE of OLDPUP with OUTQUEUE)
(SENDPUP (fetch PUPSOC of SOCKET)
OLDPUP))
(T (\ENQUEUE OUTQUEUE OLDPUP)))
(SETQ OLDPUP NEXTPUP))
(* * Now update allocations)
[COND
((IGREATERP (fetch PUPALLOCCOUNT of SOCKET)
\BSP.ALLOCHYSTERESIS) (* We've been doing okay for a while with no congestion,
so increase our max pup allocation)
(replace PUPALLOCCOUNT of SOCKET with 0)
(COND
((ILESSP (fetch MAXPUPALLOC of SOCKET)
\BSP.MAXPUPALLOC)
(add (fetch MAXPUPALLOC of SOCKET)
1]
(SETQ ACKDATA (fetch PUPCONTENTS of PUP))
(replace BYTESPERPUP of SOCKET with (IMIN (fetch ACKBYTESPERPUP of ACKDATA)
\MAX.PUPLENGTH))
(replace PUPALLOC of SOCKET with (IMAX (IMIN (fetch MAXPUPALLOC of SOCKET)
(IDIFFERENCE (fetch ACKPUPS of ACKDATA)
(fetch #UNACKEDPUPS of SOCKET)))
0)) (* number of pups we can still send)
(replace BYTEALLOC of SOCKET with (IMAX (IDIFFERENCE (fetch ACKBYTES of ACKDATA)
(fetch #UNACKEDBYTES of SOCKET))
0))
(RELEASE.PUP PUP)
(NOTIFY.EVENT (fetch BSPINPUTEVENT of SOCKET)) (* Actually, notifying that allocation may have changed)
(\SETBSPTIMEOUT SOCKET)
(SETUPTIMER \BSP.INACTIVITY.TIMEOUT (fetch INACTIVITYTIMER of SOCKET])
(\BSP.HANDLE.DATA
[LAMBDA (PUP SOCKET) (* bvm: " 5-JUN-83 15:27")
(* * Processes BSP data and mark pups. Principal task is to figure out where this PUP goes on our input queue.)
(PROG (THISID NEWID PREVPUP NEXTPUP DIF DATALENGTH INQUEUE)
(COND
((OR (NOT (\RTP.FILTER SOCKET PUP T))
(ZEROP (SETQ DATALENGTH (IDIFFERENCE (fetch PUPLENGTH of PUP)
\PUPOVLEN)))
(PROGN
(* if we have no space for incoming pups. If our partner is a good guy, she pays attention to our allocation
reports and never overwhelms us, so this is mainly a problem if someone screws up)
NIL)) (* Pup not for us or is zero-length, so nothing to do)
(RELEASE.PUP PUP)
(RETURN)))
(COND
((ILEQ (SETQ NEWID (IPLUS (SETQ THISID (fetch PUPID of PUP))
DATALENGTH))
(fetch RCVBYTEID of SOCKET)) (* NEWID is id of next byte after this packet.
If less than RCVBYTEID, it's a duplicate, so discard)
(RELEASE.PUP PUP)
(RETURN)))
[COND
([OR [NULL (fetch SYSQUEUEHEAD of (SETQ INQUEUE (fetch BSPINPUTQ of SOCKET]
(IGREATERP THISID (fetch PUPID of (fetch SYSQUEUETAIL of INQUEUE]
(* Checking easy case first: pup goes on end of queue)
(\ENQUEUE INQUEUE PUP))
(T (* Pup goes somewhere in middle of q)
(SETQ PREVPUP NIL)
(SETQ NEXTPUP (fetch SYSQUEUEHEAD of INQUEUE))
(while (NEQ NEXTPUP NIL)
do (COND
([ZEROP (SETQ DIF (IDIFFERENCE THISID (fetch PUPID of NEXTPUP]
(* Is duplicate of NEXTPUP)
(RELEASE.PUP PUP)
(RETURN (SETQ PUP NIL)))
((ILESSP DIF 0) (* New pup comes before NEXTPUP)
(GO $$OUT)))
(SETQ NEXTPUP (fetch QLINK of (SETQ PREVPUP NEXTPUP)))
finally (* Insert PUP between PREVPUP and NEXTPUP)
(COND
((NULL PREVPUP)
(replace SYSQUEUEHEAD of INQUEUE with PUP))
(T (replace QLINK of PREVPUP with PUP)))
(replace QLINK of PUP with NEXTPUP]
(* * now see if the new pup fills a hole in front of queue, so we can advance our ID of contiguously read pups)
(while (AND PUP (IEQP (fetch RCVBYTEID of SOCKET)
(fetch PUPID of PUP)))
do (add (fetch RCVBYTEID of SOCKET)
(IDIFFERENCE (fetch PUPLENGTH of PUP)
\PUPOVLEN)) (* Advance ID past this pup)
(add (fetch #UNREADPUPS of SOCKET)
1) (* One more pup available for BSPBIN)
(NOTIFY.EVENT (fetch BSPINPUTEVENT of SOCKET))
(SETQ PUP (fetch QLINK of PUP)))
(SETUPTIMER \BSP.INACTIVITY.TIMEOUT (fetch INACTIVITYTIMER of SOCKET))
(* There was non-trivial activity)
])
(\BSP.HANDLE.ERROR
[LAMBDA (PUP SOCKET) (* bvm: " 9-MAY-83 16:24")
(* * Handle ERROR pups. The only error codes BSP is interested in are the ones indicating network congestion.)
(SELECTC (fetch ERRORPUPCODE of PUP)
((LIST \PUPE.SOCKETFULL \PUPE.GATEWAYFULL) (* Port IQ overflow, gateway OQ overflow--congestion
error. Throttle back output by decreasing our max
outgoing allocation)
(COND
((IGREATERP (fetch MAXPUPALLOC of SOCKET)
1)
(add (fetch MAXPUPALLOC of SOCKET)
-1)))
(replace PUPALLOCCOUNT of SOCKET with 0) (* Reset hysteresis counter)
)
NIL) (* Finally pass all errors on to higher-level proc if
any)
(BSP.OTHERFN PUP SOCKET])
(\BSP.HANDLE.INTERRUPT
[LAMBDA (PUP SOCKET) (* bvm: " 8-FEB-83 17:31")
(* * Handles incoming interrupt. Notes that we have an interrupt, and sends an interrupt reply)
(COND
((\RTP.FILTER SOCKET PUP T)
(PROG [(DIF (IDIFFERENCE (fetch RCVINTERRUPTID of SOCKET)
(fetch PUPID of PUP]
[COND
((ZEROP DIF) (* New interrupt. Note receipt and pass on to
higher-level handler)
(add (fetch RCVINTERRUPTID of SOCKET)
1)
(replace INTERRUPTIN of SOCKET with T)
(BSP.OTHERFN PUP SOCKET))
(T (* Duplicate or bad ID, discard)
(RELEASE.PUP PUP)
(COND
((NEQ DIF 1) (* Garbage)
(RETURN]
[SENDPUP (fetch PUPSOC of SOCKET)
(\FILLBSPPUP SOCKET NIL \PT.INTERRUPTREPLY \PUPOVLEN
(SUB1 (fetch RCVINTERRUPTID of SOCKET]
(* reply to it)
))
(T (* Not for us)
(RELEASE.PUP PUP])
(\BSP.HANDLE.INTERRUPTREPLY
[LAMBDA (PUP SOCKET) (* bvm: " 5-JUN-83 15:49")
(* * Handles Interrupt Reply. Assuming this is in response to a (the) interrupt we sent out, we can release our
copy of the interrupt pup)
[COND
((AND (\RTP.FILTER SOCKET PUP T)
(fetch INTERRUPTOUT of SOCKET)
(IEQP (fetch PUPID of PUP)
(fetch XMITINTERRUPTID of SOCKET)))
(PROG ((INTPUP (\SEARCH.OUTPUTQ SOCKET T)))
(COND
(INTPUP (add (fetch XMITINTERRUPTID of SOCKET)
1)
(replace INTERRUPTOUT of SOCKET with NIL)
(* In case BSP.PUTINTERRUPT was waiting on us)
(NOTIFY.EVENT (fetch BSPINPUTEVENT of SOCKET))
(RELEASE.PUP INTPUP))
(T
(* Inconsistent state: we have INTERRUPTOUT, but can't find the pup on our retransmit queue.
In bcpl implementation the pup might still be on the transmit queue, but here we know we have sent it.
Change this when low-level pup gets into lisp)
(BSPHELP "Couldn't find interrupt that elicited this reply"]
(RELEASE.PUP PUP])
(\SEND.ACK
[LAMBDA (SOCKET) (* bvm: " 1-JUL-83 12:31")
(* * Send an ACK, telling partner how much of the bytestream we have received, and what our current allocation is)
(PROG ((PUP (ALLOCATE.PUP))
[#PUPS (IMAX 0 (IDIFFERENCE \BSP.MAXPUPS (fetch #UNREADPUPS of SOCKET]
DATA)
(* Our current allocation is computed by subtracting from our max allocation anything sitting in the input queue.
Don't want to say the length of the whole INPUTQ, since stuff after the hole doesn't really count.
This is all approximate, of course, but is sufficient for decent flow control)
(replace ACKPENDING of SOCKET with NIL)
(\FILLBSPPUP SOCKET PUP \PT.ACK (IPLUS \PUPOVLEN 6)
(fetch RCVBYTEID of SOCKET)
(QUOTE FREE))
(SETQ DATA (fetch PUPCONTENTS of PUP))
(replace ACKBYTESPERPUP of DATA with \MAX.PUPLENGTH)
(* We can always receive maximal size pups)
(replace ACKPUPS of DATA with #PUPS)
(replace ACKBYTES of DATA with (ITIMES #PUPS \MAX.PUPLENGTH))
(replace SENTZEROALLOC of SOCKET with (ZEROP #PUPS))
(* we said stop. This will encourage us to send an ack
as soon as our allocation improves)
(SENDPUP (fetch PUPSOC of SOCKET)
PUP)
(* * At this point the BCPL implementation flushes the pups we have received but not acked, since they will
probably be retransmitted anyway. No real need for us to do that, since we don't have a permanently constrained
pup pool)
])
(\SEARCH.OUTPUTQ
[LAMBDA (SOCKET LOOKFORINTERRUPT) (* bvm: " 5-JUN-83 15:30")
(* * Searches output queue of SOCKET for an interrupt packet, if LOOKFORINTERRUPT is true, or for the last
non-interrupt if false, and returns it or NIL)
(bind (PUP ←(fetch SYSQUEUEHEAD of (fetch BSPOUTPUTQ of SOCKET)))
LASTPUP while PUP
do (COND
[LOOKFORINTERRUPT (COND
((EQ (fetch PUPTYPE of PUP)
\PT.INTERRUPT)
(RETURN (\UNQUEUE (fetch BSPOUTPUTQ of SOCKET)
PUP]
((NEQ (fetch PUPTYPE of PUP)
\PT.INTERRUPT)
(SETQ LASTPUP PUP)))
(SETQ PUP (fetch QLINK of PUP))
finally (RETURN (AND LASTPUP (\UNQUEUE (fetch BSPOUTPUTQ of SOCKET)
LASTPUP])
(\SETBSPTIMEOUT
[LAMBDA (SOCKET) (* bvm: "10-MAY-83 23:11")
(* * Sets timer for this socket to wake us up after a while if nothing happens. If we have unacked data
outstanding, make this shorter than if we are idle)
(SETUPTIMER (replace BSPTIMEOUT of SOCKET with (COND
[(OR (fetch INTERRUPTOUT of SOCKET)
(IGREATERP (fetch #UNACKEDPUPS
of SOCKET)
0)
(ILEQ (fetch PUPALLOC of SOCKET)
0)
(ILEQ (fetch BYTEALLOC of SOCKET)
0)
(ILEQ (fetch BYTESPERPUP of SOCKET)
0))
(* We're waiting for a response)
(WAKE.PROCESS (fetch RTPPROCESS of SOCKET))
(* Because we may have shortened the timeout)
(COND
((fetch ACKREQUESTED of SOCKET)
(* Sent Adata, here's how long we expect to need)
(fetch ADATATIMEOUT of SOCKET))
(T (IMAX (fetch ADATATIMEOUT of SOCKET)
\BSP.OUTSTANDINGDATATIMEOUT]
(T \BSP.IDLETIMEOUT)))
(fetch BSPTIMER of SOCKET])
(\TRANSMIT.STRATEGY
[LAMBDA (SOCKET PUP MAKEA?) (* bvm: " 3-MAY-83 11:32")
(* * Decides whether to make PUP an ADATA (AMARK) or just DATA (MARK) when MAKEA? is nil. If T it always makes
ADATA, if NO it never does. Current strategy (from BCPL): demand ack if allocation falls below 1/3 of that given
in the last received ack, i.e. if PUPALLOC le (PUPALLOC+UNACKEDPUPS) /3, or equivalently PUPALLOC*2 le
UNACKEDPUPS. If \BSP.OVERLAP.DATA.WITH.ACK is false, however, only demands ack when allocation is exhausted)
(COND
([OR (EQ MAKEA? T)
(SETQ MAKEA? (AND (NULL MAKEA?)
(NOT (fetch ACKREQUESTED of SOCKET))
(PROG [(PUPALLOC (IMIN (fetch PUPALLOC of SOCKET)
(IQUOTIENT (fetch BYTEALLOC of SOCKET)
(fetch BYTESPERPUP of SOCKET]
(* BCPL version also mins with socket allocations)
(RETURN (COND
(\BSP.OVERLAP.DATA.WITH.ACK (ILEQ (LSH PUPALLOC 1)
(fetch #UNACKEDPUPS
of SOCKET)))
(T (ILEQ PUPALLOC 0]
(COND
((NOT (fetch ACKREQUESTED of SOCKET)) (* unless ADATA is already outstanding, note the time so
we can see how long partner takes to respond)
(SETUPTIMER 0 (fetch LASTADATATIME of SOCKET))
(replace ACKREQUESTED of SOCKET with T)))
(add (fetch ADATACOUNT of SOCKET)
1) (* This is used to distinguish pups originally sent
before this ADATA vs after)
))
(replace PUPTYPE of PUP with (SELECTC (fetch PUPTYPE of PUP)
((LIST \PT.DATA \PT.ADATA)
(COND
(MAKEA? \PT.ADATA)
(T \PT.DATA)))
((LIST \PT.MARK \PT.AMARK)
(COND
(MAKEA? \PT.AMARK)
(T \PT.MARK)))
(BSPHELP "\TRANSMIT.STRATEGY called on non-data pup"])
)
(* BSP utilities)
(DEFINEQ
(\BSP.DEFAULT.ERROR.HANDLER
[LAMBDA (SOCKET ERRCODE) (* bvm: "11-AUG-81 12:30")
(DECLARE (SPECVARS #MYHANDLE#)) (* Bind this to NIL to inhibit my toy scheduler)
(PROG (#MYHANDLE#)
(RETURN (ERROR (CONCAT "BSP error: " ERRCODE)
SOCKET])
(\BSP.TIMERFN
[LAMBDA (SOCKET) (* bvm: " 5-JUN-83 15:30")
(* * Called when BSPTIMER expires. The timer gets reset every time we send something, so this means we haven't
sent anything in a while)
(COND
((SELECTC (fetch STATE of SOCKET)
((LIST \STATE.OPEN \STATE.ENDSENT \STATE.ENDRECEIVED)
NIL)
T) (* Socket not alive, so kill it.
CLOSERTPSOCKET will free up all resources except any
waiting input, which will be held, I hope)
(CLOSERTPSOCKET SOCKET 0))
((AND (NOT \BSP.NO.INACTIVITY.TIMEOUT)
(TIMEREXPIRED? (fetch INACTIVITYTIMER of SOCKET)))
(* Connection has fallen asleep, abort it)
(\RTP.ACTION SOCKET \EVENT.FORCECLOSE))
(T (COND
((fetch ACKPENDING of SOCKET) (* I don't think this ever happens, because we can
always get pups to do an ack with)
(\SEND.ACK SOCKET)))
[PROG (PUP)
(COND
((AND (fetch INTERRUPTOUT of SOCKET)
(SETQ PUP (\SEARCH.OUTPUTQ SOCKET T)))
(* Retransmit unacked interrupt)
(replace EPREQUEUE of PUP with (fetch BSPOUTPUTQ of SOCKET))
(SENDPUP (fetch PUPSOC of SOCKET)
PUP]
(* * Generate an ADATA unconditionally every BSPTIMER cycle, both to see whether partner is alive and to
demonstrate that we are)
(COND
((NOT (fetch ACKREQUESTED of SOCKET)) (* ADATA not outstanding, so start timing)
(SETUPTIMER 0 (fetch LASTADATATIME of SOCKET))
(replace ACKREQUESTED of SOCKET with T)))
(add (fetch ADATACOUNT of SOCKET)
1)
(SENDPUP (fetch PUPSOC of SOCKET)
(\FILLBSPPUP SOCKET NIL \PT.ADATA \PUPOVLEN (fetch XMITBYTEID of SOCKET)))
(\SETBSPTIMEOUT SOCKET])
(\BSP.FLUSH.SOCKET.QUEUES
[LAMBDA (SOCKET) (* bvm: "11-JUL-83 17:59")
(\FLUSH.PACKET.QUEUE (fetch BSPINPUTQ of SOCKET))
(replace #UNREADPUPS of SOCKET with 0)
(\FLUSH.PACKET.QUEUE (fetch BSPOUTPUTQ of SOCKET))
(PROG ((STREAM (fetch BSPINPUTSTREAM of SOCKET)))
(OR STREAM (RETURN))
[COND
((fetch BSPCURRENTPUP of STREAM)
(replace CBUFSIZE of STREAM with 0)
(RELEASE.PUP (fetch BSPCURRENTPUP of STREAM))
(replace BSPCURRENTPUP of STREAM with (replace CPPTR of STREAM with NIL]
(COND
((fetch BSPCURRENTPUP of (SETQ STREAM (fetch BSPOUTPUTSTREAM of STREAM)))
(replace CBUFSIZE of STREAM with 0)
(RELEASE.PUP (fetch BSPCURRENTPUP of STREAM))
(replace BSPCURRENTPUP of STREAM with (replace CPPTR of STREAM with NIL])
(\FILLBSPPUP
[LAMBDA (SOCKET PUP TYPE LENGTH ID REQUEUE) (* bvm: " 1-JUL-83 12:23")
(* * Fills in the indicated fields of PUP, plus source and dest ports from SOCKET)
(OR PUP (SETQ PUP (ALLOCATE.PUP)))
(replace PUPLENGTH of PUP with (OR LENGTH \PUPOVLEN))
(replace TYPEWORD of PUP with TYPE)
(replace PUPID of PUP with ID)
(replace EPREQUEUE of PUP with (OR REQUEUE (QUOTE FREE)))
(\SETRTPPORTS SOCKET PUP)
PUP])
(BSPHELP
[LAMBDA (MSG) (* bvm: " 5-JUN-83 15:51")
(HELP "BSP error." MSG])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(* * This socket record has both RTP and BSP state info)
[DECLARE: EVAL@COMPILE
(DATATYPE BSPSOC ((FRNPORT WORD)
(FRNSOCKETHI WORD)
(FRNSOCKETLO WORD) (* Net,host,socket of partner)
(LCLPORT WORD)
(LCLSOCKETHI WORD)
(LCLSOCKETLO WORD) (* Net,host,socket of us)
(STATE BYTE) (* The current state of the RTP connection, see
RTPSTATES)
(RTPPROCESS POINTER) (* Process handle for RTP demon)
(RTPEVENT POINTER) (* Notified when STATE changes)
(PUPSOC POINTER) (* The packet-level socket used by us)
(CONNID POINTER) (* A large integer, the connection ID)
(RTPTIMER POINTER) (* Timer used for timing out some RTP steps)
(RTPTIMEOUT WORD) (* Timeout for current RTP op, or zero if none)
(OTHERPUPFN POINTER) (* Function applied to non-RTP pups
(plus error pups) we receive;
initially \RELEASE.PUP, but eventually a BSP handler)
(* * The rest of this structure is dedicated to handling the BSP)
(BSPINPUTSTREAM POINTER) (* Pointer back to STREAM object)
(BSPTIMER POINTER) (* Timer for BSP use)
(BSPTIMEOUT WORD)
(BSPTIMERFN POINTER) (* Called when BSPTIMER expires)
(BSPOTHERPUPFN POINTER) (* Called on error, interrupt and non-bsp pups)
(BSPERRORHANDLER POINTER) (* Called for bsp errors)
(USERBYTEID POINTER) (* ID of pup where user is currently reading)
(RCVBYTEID POINTER) (* ID of as far as we have acked)
(RCVINTERRUPTID POINTER) (* ID of next incoming interrupt)
(BSPINPUTQ POINTER) (* Queue of all pups we have received)
(#UNREADPUPS WORD) (* How many pups do we have before first hole in input)
(XMITBYTEID POINTER) (* Id of next outgoing pup)
(XMITINTERRUPTID POINTER) (* id of next outgoing interrupt)
(LASTACKID POINTER) (* Id of last ack, i.e. how far our partner has read us)
(#UNACKEDPUPS WORD)
(#UNACKEDBYTES WORD) (* how many pups/bytes have we sent that haven't been
acked)
(BSPOUTPUTQ POINTER) (* Queue of sent but not acked pups)
(BYTESPERPUP WORD) (* Maximum size we are allowed to grow pups)
(PUPALLOC WORD) (* Remaining outgoing pup allocation, i.e. partner's
allocation less #UNACKEDPUPS)
(BYTEALLOC WORD) (* Remaining outgoing byte allocation)
(MAXPUPALLOC WORD)
(PUPALLOCCOUNT WORD)
(ADATACOUNT WORD) (* incremented once per AData sent)
(LASTADATATIME POINTER) (* Time last ADATA was sent)
(ADATATIMEOUT WORD) (* Timeout currently in use for AData)
(INACTIVITYTIMER POINTER) (* Time of last incoming pup on this connection)
(LISTENING FLAG) (* if socket was opened as a server rather than user)
(INTERRUPTOUT FLAG) (* an unacked interrupt is outstanding)
(INTERRUPTIN FLAG) (* an interrupt has been received)
(ACKPENDING FLAG) (* Adata was received, we need to ack)
(ACKREQUESTED FLAG) (* We have sent an Adata, are waiting for ack)
(SENTZEROALLOC FLAG) (* Need to send gratuitous ack)
(BSPUSERSTATE POINTER) (* For applications use to do as it pleases)
(BSPIOTIMEOUT WORD) (* if non-zero will cause prepare.output and
prepare.input to timeout)
(IOTIMEOUTFN POINTER) (* function to be called when prepare.* timeout)
(BSPWHENCLOSEDFN POINTER) (* Called when connection is closed)
(BSPINPUTEVENT POINTER)
(BSPLOCK POINTER)
(BSPINITTIMER POINTER)
(NIL POINTER))
(* Note: I assume record pkg does not break up the first six words (the two ports). I hope I don't have to force
it)
RTPTIMER ←(CREATECELL \FIXP)
BSPTIMER ←(CREATECELL \FIXP)
INACTIVITYTIMER ←(CREATECELL \FIXP)
LASTADATATIME ←(CREATECELL \FIXP)
BSPINPUTQ ←(NCREATE (QUOTE SYSQUEUE))
BSPOUTPUTQ ←(NCREATE (QUOTE SYSQUEUE)))
(BLOCKRECORD ACKPUP ((ACKBYTESPERPUP WORD)
(ACKPUPS WORD)
(ACKBYTES WORD)) (* body of ACK pup, giving partner's allocation)
)
(ACCESSFNS BSPSTREAM ((BSPSOC (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(* BSPSOC object)
(BSPOUTPUTSTREAM (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(* If this stream is the input side, gives output side)
(BSPCURRENTPUP (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(* PUP whose body is the current buffer.
Could be redundant)
(MARKPENDING (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(* On input, true if next byte is a mark)
))
]
(/DECLAREDATATYPE (QUOTE BSPSOC)
(QUOTE (WORD WORD WORD WORD WORD WORD BYTE POINTER POINTER POINTER POINTER POINTER
WORD POINTER POINTER POINTER WORD POINTER POINTER POINTER POINTER
POINTER POINTER POINTER WORD POINTER POINTER POINTER WORD WORD POINTER
WORD WORD WORD WORD WORD WORD POINTER WORD POINTER FLAG FLAG FLAG FLAG
FLAG FLAG POINTER WORD POINTER POINTER POINTER POINTER POINTER POINTER)
))
(ADDTOVAR PUPPRINTMACROS (10Q BYTES 2 INTEGER)
(11Q WORD 2 CHARS)
(20Q CHARS)
(21Q CHARS)
(22Q WORDS)
(24Q WORD 2 CHARS))
(RPAQQ RTPSTATES ((\STATE.CLOSED 0)
(\STATE.SENTRFC 1)
(\STATE.LISTENING 2)
(\STATE.OPEN 3)
(\STATE.ENDRECEIVED 4)
(\STATE.ENDSENT 5)
(\STATE.DALLYING 6)
(\STATE.ABORTED 7)))
(DECLARE: EVAL@COMPILE
(RPAQQ \STATE.CLOSED 0)
(RPAQQ \STATE.SENTRFC 1)
(RPAQQ \STATE.LISTENING 2)
(RPAQQ \STATE.OPEN 3)
(RPAQQ \STATE.ENDRECEIVED 4)
(RPAQQ \STATE.ENDSENT 5)
(RPAQQ \STATE.DALLYING 6)
(RPAQQ \STATE.ABORTED 7)
(CONSTANTS (\STATE.CLOSED 0)
(\STATE.SENTRFC 1)
(\STATE.LISTENING 2)
(\STATE.OPEN 3)
(\STATE.ENDRECEIVED 4)
(\STATE.ENDSENT 5)
(\STATE.DALLYING 6)
(\STATE.ABORTED 7))
)
(RPAQQ RTPEVENTS ((\EVENT.OPEN 0)
(\EVENT.OPENLISTENING 1)
(\EVENT.OPENIMMEDIATE 2)
(\EVENT.CLOSE 3)
(\EVENT.FORCECLOSE 4)
(\EVENT.RFC 5)
(\EVENT.ABORT 6)
(\EVENT.END 7)
(\EVENT.ENDREPLY 10Q)
(\EVENT.TIMEOUT 11Q)))
(DECLARE: EVAL@COMPILE
(RPAQQ \EVENT.OPEN 0)
(RPAQQ \EVENT.OPENLISTENING 1)
(RPAQQ \EVENT.OPENIMMEDIATE 2)
(RPAQQ \EVENT.CLOSE 3)
(RPAQQ \EVENT.FORCECLOSE 4)
(RPAQQ \EVENT.RFC 5)
(RPAQQ \EVENT.ABORT 6)
(RPAQQ \EVENT.END 7)
(RPAQQ \EVENT.ENDREPLY 10Q)
(RPAQQ \EVENT.TIMEOUT 11Q)
(CONSTANTS (\EVENT.OPEN 0)
(\EVENT.OPENLISTENING 1)
(\EVENT.OPENIMMEDIATE 2)
(\EVENT.CLOSE 3)
(\EVENT.FORCECLOSE 4)
(\EVENT.RFC 5)
(\EVENT.ABORT 6)
(\EVENT.END 7)
(\EVENT.ENDREPLY 10Q)
(\EVENT.TIMEOUT 11Q))
)
(DECLARE: EVAL@COMPILE
(RPAQQ WORDSPERPORT 3)
(CONSTANTS (WORDSPERPORT 3))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS RTP.OTHERFN MACRO ((PUP SOCKET)
(SELECTQ (fetch OTHERPUPFN of SOCKET)
(RELEASE.PUP (RELEASE.PUP PUP))
(\BSP.PUPHANDLER (\BSP.PUPHANDLER PUP SOCKET))
(APPLY* (fetch OTHERPUPFN of SOCKET)
PUP SOCKET))))
(PUTPROPS BSP.OTHERFN MACRO [(PUP SOCKET)
(SELECTQ (fetch OTHERPUPFN of SOCKET)
(RELEASE.PUP (RELEASE.PUP PUP))
(APPLY* (fetch BSPOTHERPUPFN of SOCKET)
PUP
(fetch BSPINPUTSTREAM of SOCKET])
(PUTPROPS BSP.ERROR MACRO (OPENLAMBDA (SOCKET ERRCODE)
(APPLY* (fetch BSPERRORHANDLER of SOCKET)
(fetch BSPINPUTSTREAM of SOCKET)
ERRCODE)))
(PUTPROPS .COERCE.BSP.INPUT.STREAM MACRO [(STRM) (* bvm: " 9-MAY-83 15:43")
(COND
([NULL (ffetch BSPOUTPUTSTREAM
of (\DTEST STRM (QUOTE STREAM]
(* This is the output side!)
(SETQ STRM (fetch BSPINPUTSTREAM
of (\DTEST (fetch BSPSOC of STRM)
(QUOTE BSPSOC])
)
)
(/DECLAREDATATYPE (QUOTE BSPSOC)
(QUOTE (WORD WORD WORD WORD WORD WORD BYTE POINTER POINTER POINTER POINTER POINTER
WORD POINTER POINTER POINTER WORD POINTER POINTER POINTER POINTER
POINTER POINTER POINTER WORD POINTER POINTER POINTER WORD WORD POINTER
WORD WORD WORD WORD WORD WORD POINTER WORD POINTER FLAG FLAG FLAG FLAG
FLAG FLAG POINTER WORD POINTER POINTER POINTER POINTER POINTER POINTER)
))
(DECLARE: DONTEVAL@LOAD DOCOPY
(\BSPINIT)
)
(* debugging)
(DEFINEQ
(PPSOC
[LAMBDA (SOC FILE VERBOSE) (* bvm: " 5-JUN-83 15:30")
(RESETFORM (OUTPUT FILE)
(PROG (STREAM)
(printout NIL "From " (PORTSTRING (fetch LCLPORT of SOC)
(\MAKENUMBER (fetch LCLSOCKETHI of SOC)
(fetch LCLSOCKETLO of SOC)))
" to "
(PORTSTRING (fetch FRNPORT of SOC)
(\MAKENUMBER (fetch FRNSOCKETHI of SOC)
(fetch FRNSOCKETLO of SOC)))
T "State: ")
(PRINTCONSTANT (fetch STATE of SOC)
RTPSTATES)
(printout NIL T "Connection id: " (fetch CONNID of SOC)
T)
(PRINTTIMER (fetch RTPTIMER of SOC)
(fetch RTPTIMEOUT of SOC)
"RTP timer: ")
(PRINTTIMER (fetch BSPTIMER of SOC)
(fetch BSPTIMEOUT of SOC)
"BSP timer: ")
(printout NIL T "Input:" T " ID: " (fetch RCVBYTEID of SOC)
T " UserID: " (fetch USERBYTEID of SOC)
T " InterruptID: " (fetch RCVINTERRUPTID of SOC)
T)
[COND
([SETQ PUP (fetch BSPCURRENTPUP of (SETQ STREAM (fetch BSPINPUTSTREAM
of SOC]
(PPSOC.CURRENT STREAM PUP)
(COND
((fetch MARKPENDING of STREAM)
(PRIN1 "{Mark pending}")))
(COND
(VERBOSE (TAB 4)
(BSPPRINTPUP PUP T)
(TERPRI]
(PRINTPUPQUEUE (fetch BSPINPUTQ of SOC)
" Input queue: " VERBOSE)
(printout NIL " #unread: " (fetch #UNREADPUPS of SOC)
T)
(printout NIL T "Output:" T " ID: " (fetch XMITBYTEID of SOC)
T " AckID: " (fetch LASTACKID of SOC)
T " InterruptID: " (fetch XMITINTERRUPTID of SOC)
T " Unacked pups: " (fetch #UNACKEDPUPS of SOC)
", bytes: "
(fetch #UNACKEDBYTES of SOC)
T)
(COND
([SETQ PUP (fetch BSPCURRENTPUP of (SETQ STREAM (fetch BSPOUTPUTSTREAM
of STREAM]
(PPSOC.CURRENT STREAM PUP)))
(PRINTPUPQUEUE (fetch BSPOUTPUTQ of SOC)
" Retransmit queue: " VERBOSE)
(printout NIL " Alloc: " (fetch PUPALLOC of SOC)
" pups, "
(fetch BYTEALLOC of SOC)
" bytes, "
(fetch BYTESPERPUP of SOC)
"/pup" T " Max " (fetch MAXPUPALLOC of SOC)
", cntr "
(fetch PUPALLOCCOUNT of SOC)
T)
(printout NIL T "Flags: ")
(COND
((fetch LISTENING of SOC)
(PRIN1 "Listening, ")))
(COND
((fetch INTERRUPTOUT of SOC)
(PRIN1 "Interrupt out, ")))
(COND
((fetch INTERRUPTIN of SOC)
(PRIN1 "Interrupt in, ")))
(COND
((fetch ACKPENDING of SOC)
(PRIN1 "Ack pending, ")))
(COND
((fetch ACKREQUESTED of SOC)
(PRIN1 "Ack requested, ")))
(COND
((fetch SENTZEROALLOC of SOC)
(PRIN1 "Sent zero allocation.")))
(TERPRI)
(printout NIL "AData timeout: " (fetch ADATATIMEOUT of SOC])
(PPSOC.CURRENT
[LAMBDA (STREAM PUP) (* bvm: " 9-MAY-83 15:11")
(printout NIL " Current: " PUP " at " (fetch COFFSET of STREAM)
", "
(IDIFFERENCE (fetch CBUFSIZE of STREAM)
(fetch COFFSET of STREAM))
" left" T])
(PRINTTIMER
[LAMBDA (TIMER TIMEOUT LABEL) (* bvm: " 5-AUG-81 12:21")
(COND
((AND TIMEOUT (NEQ TIMEOUT 0))
(PRIN1 LABEL)
(PROG ((DIF (IDIFFERENCE (CLOCKDIFFERENCE TIMER)
TIMEOUT)))
(COND
((ILESSP DIF 0)
(printout NIL (IMINUS DIF)
" msecs left" T))
(T (printout NIL " expired " DIF " msecs ago." T])
(PRINTPUPQUEUE
[LAMBDA (QUEUE HEADER VERBOSE) (* bvm: " 7-MAR-83 13:52")
(PROG ((PUP (fetch SYSQUEUEHEAD of QUEUE))
LASTPUP GAP)
(PRIN1 HEADER)
[COND
(PUP (AND VERBOSE (TAB 4))
(do (BSPPRINTPUP (SETQ LASTPUP PUP)
VERBOSE)
repeatwhile (AND (SETQ PUP (fetch QLINK of PUP))
(PROGN (COND
[VERBOSE (TAB 4)
(COND
((NEQ (SETQ GAP
(IDIFFERENCE (IDIFFERENCE
(fetch PUPID
of PUP)
(fetch PUPID
of LASTPUP))
(IDIFFERENCE
(fetch PUPLENGTH
of LASTPUP)
\PUPOVLEN)))
0)
(printout NIL "<gap " GAP (QUOTE >)
4]
(T (PRIN1 ", ")))
T]
(COND
((NEQ (fetch SYSQUEUETAIL of QUEUE)
LASTPUP)
(printout NIL " Oops! Tail of queue = " LASTPUP)))
(TERPRI])
(BSPPRINTPUP
[LAMBDA (PUP VERBOSE) (* bvm: " 6-AUG-81 19:07")
(COND
((NOT VERBOSE)
(PRIN2 PUP))
(T (printout NIL (QUOTE {)
(fetch PUPID of PUP)
" for "
(IDIFFERENCE (fetch PUPLENGTH of PUP)
\PUPOVLEN)
(QUOTE }))
(SELECTC (fetch PUPTYPE of PUP)
((LIST \PT.AMARK \PT.MARK)
(printout NIL "[Mark " (GETBASEBYTE (fetch PUPCONTENTS of PUP)
0)
"]" T))
(PRINTPUPDATA PUP (QUOTE (CHARS])
(\RTP.INFO.HOOK
[LAMBDA (PROC BUTTON) (* bvm: "10-JUL-83 22:25")
(DECLARE (USEDFREE BSPSOCKET)) (* This is evaluated underneath \RTP.SOCKET.PROCESS)
(PROG ((WINDOW (PROCESS.WINDOW PROC)))
(COND
((NULL WINDOW)
(SETQ WINDOW (CREATEW (GETBOXREGION 240 280)
"BSP status"))
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
WINDOW)
(PROCESS.WINDOW PROC WINDOW))
(T (CLEARW WINDOW)))
(PPSOC BSPSOCKET (WINDOWPROP WINDOW (QUOTE DSP))
(EQ BUTTON (QUOTE MIDDLE])
)
(* Some of these may want to be constants)
(RPAQ? \BSPSOCKETS )
(RPAQ? \RFC.TIMEOUT 3720Q)
(RPAQ? \RTP.DALLY.TIMEOUT 11610Q)
(RPAQ? \RTP.DEFAULTTIMEOUT 72460Q)
(RPAQ? \BSP.MAXPUPS 14Q)
(RPAQ? \BSP.IDLETIMEOUT 35230Q)
(RPAQ? \BSP.OUTSTANDINGDATATIMEOUT 372Q)
(RPAQ? \BSP.MAXPUPALLOC 310Q)
(RPAQ? \BSP.ALLOCHYSTERESIS 62Q)
(RPAQ? \BSP.OVERLAP.DATA.WITH.ACK )
(RPAQ? \BSP.INITIAL.MAXPUPALLOC 5)
(RPAQ? \BSP.INITIAL.ADATATIMEOUT 1750Q)
(RPAQ? \BSP.INACTIVITY.TIMEOUT 352300Q)
(RPAQ? \BSP.NO.INACTIVITY.TIMEOUT T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \BSPSOCKETS \RFC.TIMEOUT \RTP.DALLY.TIMEOUT \RTP.DEFAULTTIMEOUT \BSP.MAXPUPS
\BSP.IDLETIMEOUT \BSP.OUTSTANDINGDATATIMEOUT \BSP.MAXPUPALLOC \BSP.ALLOCHYSTERESIS
\BSP.OVERLAP.DATA.WITH.ACK \BSP.INITIAL.MAXPUPALLOC \BSP.INITIAL.ADATATIMEOUT
\BSP.INACTIVITY.TIMEOUT \BSP.NO.INACTIVITY.TIMEOUT)
)
(PUTPROPS BSP COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3554Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5506Q 22033Q (OPENRTPSOCKET 5520Q . 15103Q) (CLOSERTPSOCKET 15105Q . 20233Q) (
\INIT.RTPPROCESS 20235Q . 21340Q) (\FLUSH.RTPPROCESS 21342Q . 22031Q)) (22064Q 67137Q (
\RTP.SOCKET.PROCESS 22076Q . 33664Q) (\RTP.CLEANUP 33666Q . 35732Q) (\RTP.ACTION 35734Q . 53503Q) (
\RTP.ERROR 53505Q . 54337Q) (\RTP.FILTER 54341Q . 56673Q) (\SEND.ABORT 56675Q . 60207Q) (
\SEND.ANSWERING.RFC 60211Q . 63304Q) (\SEND.END 63306Q . 63624Q) (\SEND.ENDREPLY 63626Q . 64156Q) (
\SEND.RFC 64160Q . 65174Q) (\FILLRTPPUP 65176Q . 66375Q) (\SETRTPPORTS 66377Q . 67135Q)) (67140Q
72360Q (\BSPINIT 67152Q . 71563Q) (\BSPEVENTFN 71565Q . 72356Q)) (72421Q 111414Q (OPENBSPSTREAM 72433Q
. 101773Q) (BSPOUTPUTSTREAM 101775Q . 102442Q) (CLOSEBSPSTREAM 102444Q . 105677Q) (\BSP.SUCKINPUT
105701Q . 106402Q) (\BSP.FLUSHINPUT 106404Q . 107244Q) (BSPOPENP 107246Q . 110471Q) (GETBSPUSERINFO
110473Q . 111050Q) (SETBSPUSERINFO 111052Q . 111412Q)) (111415Q 112324Q (CREATEBSPSTREAM 111427Q .
112072Q) (ENDBSPSTREAM 112074Q . 112322Q)) (112366Q 156445Q (BSPBIN 112400Q . 113774Q) (BSPPEEKBIN
113776Q . 115344Q) (\BSPREADBLOCK 115346Q . 120532Q) (BSPREADP 120534Q . 122166Q) (BSPEOFP 122170Q .
123052Q) (\BSPBACKFILEPTR 123054Q . 123660Q) (\BSP.PREPARE.INPUT 123662Q . 131523Q) (
\BSP.CLEANUP.INPUT 131525Q . 133467Q) (BSPBOUT 133471Q . 135570Q) (\BSPWRITEBLOCK 135572Q . 140046Q) (
BSPFORCEOUTPUT 140050Q . 145043Q) (\BSP.PREPARE.OUTPUT 145045Q . 151477Q) (BSPGETMARK 151501Q .
152475Q) (BSPPUTMARK 152477Q . 153056Q) (BSP.PUTINTERRUPT 153060Q . 156443Q)) (156502Q 224452Q (
\BSP.PUPHANDLER 156514Q . 160351Q) (\BSP.HANDLE.ACK 160353Q . 173407Q) (\BSP.HANDLE.DATA 173411Q .
201771Q) (\BSP.HANDLE.ERROR 201773Q . 203622Q) (\BSP.HANDLE.INTERRUPT 203624Q . 206151Q) (
\BSP.HANDLE.INTERRUPTREPLY 206153Q . 210472Q) (\SEND.ACK 210474Q . 214164Q) (\SEARCH.OUTPUTQ 214166Q
. 215671Q) (\SETBSPTIMEOUT 215673Q . 220414Q) (\TRANSMIT.STRATEGY 220416Q . 224450Q)) (224505Q
234551Q (\BSP.DEFAULT.ERROR.HANDLER 224517Q . 225234Q) (\BSP.TIMERFN 225236Q . 231326Q) (
\BSP.FLUSH.SOCKET.QUEUES 231330Q . 233310Q) (\FILLBSPPUP 233312Q . 234340Q) (BSPHELP 234342Q . 234547Q
)) (260076Q 274150Q (PPSOC 260110Q . 266450Q) (PPSOC.CURRENT 266452Q . 267150Q) (PRINTTIMER 267152Q .
267751Q) (PRINTPUPQUEUE 267753Q . 271744Q) (BSPPRINTPUP 271746Q . 273000Q) (\RTP.INFO.HOOK 273002Q .
274146Q)))))
STOP