(FILECREATED " 5-May-86 11:15:27" {ERIS}<LISPCORE>SOURCES>SPP.;41 80308
changes to: (FNS SPP.DSTYPE PRINTSPP \SPP.PREPARE.INPUT)
previous date: " 9-Apr-86 17:19:27" {ERIS}<LISPCORE>SOURCES>SPP.;39)
(* Copyright (c) 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SPPCOMS)
(RPAQQ SPPCOMS
((COMS (* Sequenced Packet Protocol.)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SOURCE)
SPPDECLS)
(MACROS RETRANSMITINDEX SEQ.ADD1 SEQ.GREATERP SEQ.GEQ)
(GLOBALVARS SPP.USER.TIMEOUT SPP.MIN.TIMEOUT SPP.MAX.FAILED.PROBES XIPTRACEFLG
XIPTRACEFILE))
(SYSRECORDS SPPCON)
(INITRECORDS SPPCON)
(INITVARS (SPP.USER.TIMEOUT 15000)
(SPP.MIN.TIMEOUT 50)
(SPP.MAX.FAILED.PROBES 6))
(FNS \SPPCONNECTION \SPP.CREATE.STREAMS \SPP.CREATE.WATCHER \SPP.SENDPKT \FILLINSPP
\SPP.SYSPKT \GETSPP \SENDSPP \SPP.SEND.ENDREPLY \TERMINATESPP \SPP.CLEANUP)
(FNS \SPPWATCHER \SPP.HANDLE.INPUT \SPP.HANDLE.DATA \SPP.HANDLE.ATTN
\SPP.RELEASE.ACKED.PACKETS \SPP.NOT.RESPONDING \SPP.CHECK.FOR.LIFE \SPP.PROBE
\SPP.RETRANSMIT.NEXT \SPP.DUPLICATE.REQUEST \SPP.ESTABLISH \SPPGETERROR
\SPPSENDERROR))
(COMS (* Stream interface to Sequenced Packet Protocol.)
(FNS \INITSPP \SPP.EVENTFN \CREATE.SPP.DEVICE SPP.OPEN \SPP.CREATE.STREAM
SPP.DESTADDRESS SPPOUTPUTSTREAM SPP.OPENP \STREAM.FROM.PACKET SPP.FORCEOUTPUT
SPP.FLUSH.TO.EOF SPP.SENDEOM SPP.CLEAREOM SPP.SENDATTENTION SPP.CLEARATTENTION
SPP.CLOSE \SPP.CLOSE.IF.ERROR \SPP.RESETCLOSE SPP.BACKFILEPTR \SPP.GETFILEPTR
\SPP.SETFILEPTR \SPP.SKIPBYTES \SPP.BOUTS \SPP.OTHER.BOUT \SPP.GETNEXTBUFFER
\SPP.STREAM.LOST \SPP.DEFAULT.ERRORHANDLER \SPP.PREPARE.INPUT \SPP.PREPARE.OUTPUT
SPP.DSTYPE SPP.READP SPP.EOFP)
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\INITSPP))))
(COMS (* Debugging)
(ALISTS (XIPPRINTMACROS 5))
(FNS PPSPP \SPP.INFO.HOOK PPSPPSTREAM \SPP.CHECK.INPUT.QUEUE PRINTSPP)
(INITVARS (PRINTSPPDATAFLG))
(GLOBALVARS PRINTSPPDATAFLG))))
(* Sequenced Packet Protocol.)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SOURCE)
SPPDECLS)
(DECLARE: EVAL@COMPILE
(PUTPROPS RETRANSMITINDEX MACRO ((SEQNO)
(IMOD SEQNO \SPP.RETRANSMITQ.SIZE)))
(PUTPROPS SEQ.ADD1 MACRO ((FORM INC)
(\LOLOC (\ADDBASE FORM (OR INC 1)))))
(PUTPROPS SEQ.GREATERP MACRO ((X Y)
(ILESSP (\LOLOC (IDIFFERENCE (IDIFFERENCE X Y)
1))
32768)))
(PUTPROPS SEQ.GEQ MACRO ((X Y)
(ILESSP (\LOLOC (IDIFFERENCE X Y))
32768)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SPP.USER.TIMEOUT SPP.MIN.TIMEOUT SPP.MAX.FAILED.PROBES XIPTRACEFLG XIPTRACEFILE)
)
)
[ADDTOVAR SYSTEMRECLST
(DATATYPE SPPCON ((SPPXIPLENGTH WORD)
(NIL BYTE)
(SPPXIPTYPE BYTE)
(SPPDESTNSADDRESS0 5 WORD)
(SPPDESTSKT# WORD)
(SPPSOURCENSADDRESS0 5 WORD)
(SPPSOURCESKT# WORD)
(NIL BYTE)
(SPPDSTYPE BYTE)
(SPPSOURCEID WORD)
(SPPDESTID WORD)
(SPPSEQNO WORD)
(SPPACKNO WORD)
(SPPACCEPTNO WORD)
(SPPESTABLISHEDP FLAG)
(SPPDESTINATIONKNOWN FLAG)
(SPPTERMINATEDP FLAG)
(SPPOUTPUTABORTEDP FLAG)
(SPPACKPENDING FLAG)
(SPPEOMONFORCEOUT FLAG)
(SPPSERVERFLAG FLAG)
(SPPINPUTBLOCKED FLAG)
(SPPOUTPUTABORTEDFN POINTER)
(SPPINPUTQ POINTER)
(SPPRETRANSMITQ POINTER)
(SPPRETRANSMITTING POINTER)
(SPPLOCK POINTER)
(SPPMYNSOCKET POINTER)
(SPPACKEDSEQNO WORD)
(SPPOUTPUTALLOCNO WORD)
(SPPRETRANSMITTIMER POINTER)
(SPPACKREQUESTED POINTER)
(SPPACKREQTIME POINTER)
(SPPACKREQTIMEOUT POINTER)
(SPPROUNDTRIPTIME POINTER)
(SPPACTIVITYTIMER POINTER)
(SPPATTENTIONFN POINTER)
(SPPINPKT POINTER)
(SPPOUTPKT POINTER)
(SPPSYSPKT POINTER)
(SPPINPUTSTREAM POINTER)
(SPPSUBSTREAM POINTER)
(SPPPROCESS POINTER)
(SPPALLOCATIONEVENT POINTER)
(SPPINPUTEVENT POINTER)
(SPPOUTPUTSTREAM POINTER)
(SPPWHENCLOSEDFN POINTER)
(SPPSTATE POINTER)
(SPPERRORHANDLER POINTER)
(SPPSERVERFN POINTER)
(SPPOTHERXIPHANDLER POINTER)
(SPPINACTIVECOUNT POINTER)
(SPPINPUTDSTYPE BYTE)
(SPPDSTYPECHANGEFN POINTER)))
]
(/DECLAREDATATYPE (QUOTE SPPCON)
(QUOTE (WORD BYTE BYTE WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD WORD BYTE BYTE
WORD WORD WORD WORD WORD FLAG FLAG FLAG FLAG FLAG FLAG FLAG FLAG POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER BYTE POINTER))
(QUOTE ((SPPCON 0 (BITS . 15))
(SPPCON 1 (BITS . 7))
(SPPCON 1 (BITS . 135))
(SPPCON 2 (BITS . 15))
(SPPCON 3 (BITS . 15))
(SPPCON 4 (BITS . 15))
(SPPCON 5 (BITS . 15))
(SPPCON 6 (BITS . 15))
(SPPCON 7 (BITS . 15))
(SPPCON 8 (BITS . 15))
(SPPCON 9 (BITS . 15))
(SPPCON 10 (BITS . 15))
(SPPCON 11 (BITS . 15))
(SPPCON 12 (BITS . 15))
(SPPCON 13 (BITS . 15))
(SPPCON 14 (BITS . 7))
(SPPCON 14 (BITS . 135))
(SPPCON 15 (BITS . 15))
(SPPCON 16 (BITS . 15))
(SPPCON 17 (BITS . 15))
(SPPCON 18 (BITS . 15))
(SPPCON 19 (BITS . 15))
(SPPCON 20 (FLAGBITS . 0))
(SPPCON 20 (FLAGBITS . 16))
(SPPCON 20 (FLAGBITS . 32))
(SPPCON 20 (FLAGBITS . 48))
(SPPCON 20 (FLAGBITS . 64))
(SPPCON 20 (FLAGBITS . 80))
(SPPCON 20 (FLAGBITS . 96))
(SPPCON 20 (FLAGBITS . 112))
(SPPCON 20 POINTER)
(SPPCON 22 POINTER)
(SPPCON 24 POINTER)
(SPPCON 26 POINTER)
(SPPCON 28 POINTER)
(SPPCON 30 POINTER)
(SPPCON 32 (BITS . 15))
(SPPCON 33 (BITS . 15))
(SPPCON 34 POINTER)
(SPPCON 36 POINTER)
(SPPCON 38 POINTER)
(SPPCON 40 POINTER)
(SPPCON 42 POINTER)
(SPPCON 44 POINTER)
(SPPCON 46 POINTER)
(SPPCON 48 POINTER)
(SPPCON 50 POINTER)
(SPPCON 52 POINTER)
(SPPCON 54 POINTER)
(SPPCON 56 POINTER)
(SPPCON 58 POINTER)
(SPPCON 60 POINTER)
(SPPCON 62 POINTER)
(SPPCON 64 POINTER)
(SPPCON 66 POINTER)
(SPPCON 68 POINTER)
(SPPCON 70 POINTER)
(SPPCON 72 POINTER)
(SPPCON 74 POINTER)
(SPPCON 76 POINTER)
(SPPCON 76 (BITS . 7))
(SPPCON 78 POINTER)))
(QUOTE 80))
(RPAQ? SPP.USER.TIMEOUT 15000)
(RPAQ? SPP.MIN.TIMEOUT 50)
(RPAQ? SPP.MAX.FAILED.PROBES 6)
(DEFINEQ
(\SPPCONNECTION
[LAMBDA (HOST SKT# NAME NOERRORFLG) (* bvm: "20-Dec-85 15:24")
(* * Create an active connection if HOST is specified. NAME is optional name of connection watcher process.
If HOST is NIL, sets up a listener on socket SKT# -- NOERRORFLG = T means do not cause error if SKT# is in use)
(PROG ((CON (create SPPCON))
NSOC PROCESS HOSTADDRESS)
(COND
((NULL HOST) (* If host is NIL, we want to listen on the specified
socket.)
(SETQ NSOC (OPENNSOCKET SKT# NOERRORFLG)))
((SETQ HOSTADDRESS (\COERCE.TO.NSADDRESS HOST))
(* User wants to initiate connection to host.)
(\BLT (LOCF (fetch SPPDESTNSADDRESS0 of CON))
HOSTADDRESS \#WDS.NSADDRESS)
(COND
((AND SKT# (EQ (fetch SPPDESTSKT# of CON)
0))
(replace SPPDESTSKT# of CON with SKT#)))
(replace SPPDESTINATIONKNOWN of CON with T)
(SETQ NSOC (OPENNSOCKET)))
(T (\ILLEGAL.ARG HOST)))
(PROGN (* Fill in canonical XIP info)
(replace SPPXIPLENGTH of CON with (IPLUS \XIPOVLEN \SPPHEAD.LENGTH))
(replace SPPXIPTYPE of CON with \XIPT.SPP)
(replace SPPSOURCEID of CON with (LOGOR 32768 (LOGAND (DAYTIME)
32767)))
(\BLT (LOCF (fetch SPPSOURCENSADDRESS0 of CON))
\MY.NSADDRESS
(SUB1 \#WDS.NSADDRESS))
(replace SPPSOURCESKT# of CON with (NSOCKETNUMBER NSOC))
(replace SPPACCEPTNO of CON with \SPP.INITIAL.ALLOCATION))
(replace SPPMYNSOCKET of CON with NSOC)
[\SPP.CREATE.WATCHER CON (COND
(NAME)
(HOST (PACK* "SPP#" (SPP.DESTADDRESS CON)))
(T (QUOTE SPPSERVER]
(RETURN CON])
(\SPP.CREATE.STREAMS
[LAMBDA (CON) (* bvm: "20-Dec-85 15:03")
(* * Creates input and output streams for SPP connection CON and installs them appropriately.
Returns the input stream)
(LET [(INSTREAM (\SPP.CREATE.STREAM (QUOTE INPUT)))
(OUTSTREAM (\SPP.CREATE.STREAM (QUOTE OUTPUT]
(replace SPPINPUTSTREAM of CON with INSTREAM)
(replace SPP.CONNECTION of INSTREAM with CON)
(replace STRMBOUTFN of INSTREAM with (FUNCTION \SPP.OTHER.BOUT))
(replace SPPOUTPUTSTREAM of CON with OUTSTREAM)
(replace SPP.CONNECTION of OUTSTREAM with CON)
(push (fetch DEVICEINFO of \SPPDEVICE)
INSTREAM)
INSTREAM])
(\SPP.CREATE.WATCHER
[LAMBDA (CON NAME) (* bvm: "20-Dec-85 15:24")
(replace SPPINPUTEVENT of CON with (CREATE.EVENT NAME))
(replace SPPLOCK of CON with (CREATE.MONITORLOCK NAME))
(replace SPPROUNDTRIPTIME of CON with \SPP.INITIAL.ROUNDTRIP)
(replace SPPPROCESS of CON with (ADD.PROCESS (LIST (FUNCTION \SPPWATCHER)
(KWOTE CON))
(QUOTE NAME)
NAME
(QUOTE RESTARTABLE)
(QUOTE HARDRESET)
(QUOTE AFTEREXIT)
(QUOTE DELETE])
(\SPP.SENDPKT
[LAMBDA (CON EPKT RETRANSMITP) (* bvm: "20-Dec-85 14:50")
(* This function makes sure the variable connection information in the packet is current, and actually sends the
packet. If the packet is to be retransmitted, the connection must be locked when this function is called.
Note that the sequence number is NOT updated; it was allocated once and for all by \SENDSPP)
(PROG ((ACK# (fetch SPPACKNO of CON))
(ALLOC# (fetch SPPACCEPTNO of CON))
(BASE (fetch XIPCONTENTS of EPKT))
SEQNO)
(AND RETRANSMITP (HELP "RETRANSMITP on"))
(replace (SPPHEAD ACKNO) of BASE with ACK#)
(replace (SPPHEAD ALLOCNO) of BASE with ALLOC#)
(replace SPPINPUTBLOCKED of CON with (SEQ.GREATERP ACK# ALLOC#))
(* If ACK# > ALLOC# then partner cannot send more data
until we eat some of what we have)
[COND
((fetch (SPPHEAD SENDACK) of BASE)
(* We start a timer when we send an Ack request, and turn it off when the next packet arrives
(in \SPPINPUTWORK.) If the timer expires, we assume that the connection is wedged. Otherwise, the elapsed time will
be used to update our estimate of the round trip delay. The timer will go off after the user-level timeout, or
twice the round trip delay, whichever is longer.)
(SETQ SEQNO (fetch (SPPHEAD SEQNO) of BASE))
(COND
((OR (NOT (fetch SPPACKREQUESTED of CON))
(SEQ.GREATERP SEQNO (fetch SPPACKREQUESTED of CON)))
(replace SPPACKREQUESTED of CON with SEQNO)
(replace SPPACKREQTIMEOUT of CON
with (SETUPTIMER (IMAX SPP.USER.TIMEOUT (UNFOLD (fetch
SPPROUNDTRIPTIME
of CON)
4))
(fetch SPPACKREQTIMEOUT of CON)))
(replace SPPACKREQTIME of CON with (SETUPTIMER 0 (fetch SPPACKREQTIME
of CON]
(replace SPPACKPENDING of CON with NIL) (* If partner asked for an ack, this will satisfy it)
(SENDXIP (fetch SPPMYNSOCKET of CON)
EPKT)
(replace SPPRETRANSMITTIMER of CON
with (SETUPTIMER (COND
((fetch SPPRETRANSMITTING of CON)
SPP.MIN.TIMEOUT)
(T (UNFOLD (fetch SPPROUNDTRIPTIME of CON)
2)))
(fetch SPPRETRANSMITTIMER of CON])
(\FILLINSPP
[LAMBDA (CON CCONTROL DSTYPE) (* bvm: "10-Jun-84 15:55")
(PROG ((EPKT (\ALLOCATE.ETHERPACKET))
BASE)
(replace EPTYPE of EPKT with \EPT.XIP)
(\BLT (LOCF (fetch XIPLENGTH of EPKT))
(LOCF (fetch SPPXIPLENGTH of CON))
\#WDS.SPPINFO) (* Fill in canonical SPP packet for this connection)
(SETQ BASE (fetch XIPCONTENTS of EPKT))
(AND CCONTROL (replace (SPPHEAD CC) of BASE with CCONTROL))
(AND DSTYPE (replace (SPPHEAD DSTYPE) of BASE with DSTYPE))
(RETURN EPKT])
(\SPP.SYSPKT
(LAMBDA (CON CCBITS) (* bvm: "10-Jun-84 15:58")
(* Return a System packet for the connection with the
specified control bits set. Uses the cached packet if
there is one.)
(PROG ((XIP (fetch SPPSYSPKT of CON))
BASE)
(COND
((NULL XIP)
(SETQ XIP (\FILLINSPP CON))
(replace SPPSYSPKT of CON with XIP))
(T (while (fetch EPTRANSMITTING of XIP) do (BLOCK))))
(SETQ BASE (fetch XIPCONTENTS of XIP))
(replace (SPPHEAD CC) of BASE with (LOGOR \SPPHEAD.CC.SYSTEM (OR CCBITS 0)))
(replace (SPPHEAD SEQNO) of BASE with (fetch SPPSEQNO of CON))
(RETURN XIP))))
(\GETSPP
[LAMBDA (CON TIMEOUT PEEKFLG) (* bvm: "17-Dec-85 12:32")
(* Obtains the next packet on this SPP connection. If TIMEOUT is specified and expires before a packet arrives,
returns NIL. Also returns NIL if the connection is terminated. If PEEKFLG is true, returns the next packet without
removing it from queue.)
(WITH.MONITOR (fetch SPPLOCK of CON)
(bind (EPKT ← NIL)
(TIMER ←(AND TIMEOUT (SETUPTIMER TIMEOUT)))
do (COND
((AND (SETQ EPKT (\QUEUEHEAD (fetch SPPINPUTQ of CON)))
(SEQ.GREATERP (fetch SPPACKNO of CON)
(fetch (SPPXIP SEQNO) of EPKT)))
(* This is the packet we've been waiting for.
The ACKNO field has already been incremented in
\SPP.HANDLE.DATA)
[COND
((NOT PEEKFLG)
(UNINTERRUPTABLY
(\DEQUEUE (fetch SPPINPUTQ of CON))
(change (fetch SPPACCEPTNO of CON)
(SEQ.ADD1 DATUM)))
(COND
((AND (fetch SPPINPUTBLOCKED of CON)
(SEQ.GREATERP (fetch SPPACCEPTNO of CON)
(fetch SPPACKNO of CON)))
(* Partner was waiting to be able to transmit again, so allow it now. Don't send this gratuitous ack the moment we
open up; wait for the window to at least get a couple of packets wide)
(\SPP.SENDPKT CON (\SPP.SYSPKT CON]
(RETURN EPKT))
((OR (AND TIMEOUT (TIMEREXPIRED? TIMER))
(fetch SPPTERMINATEDP of CON))
(RETURN NIL))
(T (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON)
(fetch SPPINPUTEVENT of CON)
TIMER T])
(\SENDSPP
[LAMBDA (CON EPKT IGNOREALLOC) (* bvm: "17-Dec-85 12:15")
(* Send the next SPP packet over the connection. Blocks if necessary until the allocation window opens up.
Returns T if successful, NIL if connection dropped.)
(CHECK (type? ETHERPACKET EPKT)
(NOT (fetch (SPPXIP SYSTEMPACKET) of EPKT)))
(WITH.MONITOR (fetch SPPLOCK of CON)
(bind SEQNO while (NOT (fetch SPPTERMINATEDP of CON))
do (COND
((SEQ.GEQ (COND
(IGNOREALLOC (* Can send attention packet regardless of allocation,
but make sure there is room in the retransmit pool)
(SEQ.ADD1 (fetch SPPACKEDSEQNO of CON)
(SUB1 \SPP.RETRANSMITQ.SIZE)))
(T (* Make sure allocation window open)
(fetch SPPOUTPUTALLOCNO of CON)))
(fetch SPPSEQNO of CON))
(\BLT (LOCF (fetch (SPPXIP SOURCECONID) of EPKT))
(LOCF (fetch (SPPCON SPPSOURCEID) of CON))
5) (* Fill in connection id's and sequence numbers)
(UNINTERRUPTABLY
[replace SPPSEQNO of CON with (SEQ.ADD1 (SETQ SEQNO
(fetch SPPSEQNO
of CON]
(* Bump the sequence number and stuff the packet into the retransmit bin. This is the only place, I think, where it
would hurt us to be interrupted. After this, it is okay if we are interrupted even before the packet actually gets
sent, since the retransmit logic will take over)
(SETA (fetch SPPRETRANSMITQ of CON)
(IMOD SEQNO \SPP.RETRANSMITQ.SIZE)
EPKT)) (* advance the packet sequence number.)
(COND
((AND (EQ SEQNO (fetch SPPOUTPUTALLOCNO of CON))
(NEQ (fetch (SPPXIP DSTYPE) of EPKT)
\SPPDSTYPE.ENDREPLY))
(* Sending this packet exhausts our allocation, so
request an ack in hopes of getting more)
(replace (SPPXIP SENDACK) of EPKT with T)))
(\SPP.SENDPKT CON EPKT)
(RETURN T))
(T (* Otherwise, we have to wait until the other end
opens up the allocation window.)
(MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON)
(fetch SPPALLOCATIONEVENT of CON])
(\SPP.SEND.ENDREPLY
[LAMBDA (CON NOACK) (* bvm: "22-Jun-84 14:57")
(\SENDSPP CON (\FILLINSPP CON (LOGOR \SPPHEAD.CC.EOM (COND
(NOACK 0)
(T \SPPHEAD.CC.ACKNOWLEDGE)))
\SPPDSTYPE.ENDREPLY)
T])
(\TERMINATESPP
(LAMBDA (CON TIMEOUT) (* bvm: "24-Jun-84 15:48")
(* Reliable connection termination, as in section 7.5
of the spec.)
(WITH.MONITOR (fetch SPPLOCK of CON)
(PROG NIL
(SELECTC (fetch SPPSTATE of CON)
((LIST \SPS.CLOSED \SPS.ABORTED)
(RETURN NIL))
((LIST \SPS.INIT \SPS.LISTENING)
(replace SPPTERMINATEDP of CON with T)
(replace SPPSTATE of CON with \SPS.ABORTED)
(RETURN NIL))
(\SPS.OPEN (* We initiate the termination by sending an END
packet.)
(\SENDSPP CON (\FILLINSPP CON (LOGOR
\SPPHEAD.CC.ACKNOWLEDGE
\SPPHEAD.CC.EOM)
\SPPDSTYPE.END)
T)
(replace SPPSTATE of CON with \SPS.ENDSENT))
NIL)
(COND
((NEQ TIMEOUT 0)
(bind (TIMER ←(SETUPTIMER (OR TIMEOUT 5000)))
do (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON)
(fetch SPPINPUTEVENT of CON)
TIMER T)
(SELECTC (fetch SPPSTATE of CON)
(\SPS.CLOSED (RETURN T))
(\SPS.ABORTED (RETURN))
NIL)
repeatuntil (TIMEREXPIRED? TIMER))))
(replace SPPSTATE of CON with \SPS.ABORTED)
(DEL.PROCESS (PROG1 (fetch SPPPROCESS of CON)
(replace SPPPROCESS of CON with NIL)))
(RETURN NIL)))))
(\SPP.CLEANUP
[LAMBDA (CON) (* bvm: "20-Dec-85 17:50")
(* Called when \SPPWATCHER exits.)
(SELECTQ RESETSTATE
(HARDRESET (* Don't do this if process is being restarted after
HARDRESET)
NIL)
(WITH.MONITOR (fetch SPPLOCK of CON)
(PROG ((INSTREAM (fetch SPPINPUTSTREAM of CON))
FN)
(replace SPPTERMINATEDP of CON with T)
(NOTIFY.EVENT (fetch SPPINPUTEVENT of CON))
(NOTIFY.EVENT (fetch SPPALLOCATIONEVENT of CON))
(* We just notified anyone who might be blocked
waiting for something to happen on this connection.)
(replace DEVICEINFO of \SPPDEVICE
with (DREMOVE INSTREAM (fetch DEVICEINFO of
\SPPDEVICE)))
[COND
((SETQ FN (fetch SPPWHENCLOSEDFN of CON))
(for F in (COND
((AND (LISTP FN)
(NEQ (CAR FN)
(QUOTE LAMBDA)))
FN)
(T (LIST FN)))
do (APPLY* F INSTREAM CON]
(replace SPPOUTPUTSTREAM of CON
with (replace SPPINPUTSTREAM of CON
with (replace SPPSUBSTREAM of CON
with NIL)))
(* Snap circular links before we lose control)
(CLOSENSOCKET (PROG1 (fetch SPPMYNSOCKET of CON)
(replace SPPMYNSOCKET of CON
with NIL))
T)
(replace SPPPROCESS of CON with NIL])
)
(DEFINEQ
(\SPPWATCHER
[LAMBDA (SPPCON) (* bvm: "20-Dec-85 14:43")
(DECLARE (SPECVARS SPPCON))
(RESETSAVE NIL (LIST (FUNCTION \SPP.CLEANUP)
SPPCON))
(PROCESSPROP (THIS.PROCESS)
(QUOTE INFOHOOK)
(FUNCTION \SPP.INFO.HOOK))
(WITH.MONITOR (fetch SPPLOCK of SPPCON)
(bind (SOCEVENT ←(NSOCKETEVENT (fetch SPPMYNSOCKET of SPPCON)))
ACTIVITY TIMER until (fetch SPPTERMINATEDP of SPPCON)
do [COND
((AND (fetch SPPACKREQUESTED of SPPCON)
(TIMEREXPIRED? (fetch SPPACKREQTIMEOUT of SPPCON)))
(\SPP.NOT.RESPONDING SPPCON))
(T (COND
((SETQ ACTIVITY (\SPP.HANDLE.INPUT SPPCON))
(replace SPPINACTIVECOUNT of SPPCON with NIL)))
(COND
((fetch SPPRETRANSMITTING of SPPCON)
(\SPP.RETRANSMIT.NEXT SPPCON))
((fetch SPPACKPENDING of SPPCON)
(\SPP.SENDPKT SPPCON (\SPP.SYSPKT SPPCON))
(replace SPPACKPENDING of SPPCON with NIL))
((AND (NULL ACTIVITY)
(OR (fetch SPPESTABLISHEDP of SPPCON)
(fetch SPPDESTINATIONKNOWN of SPPCON)))
(COND
([AND (OR (fetch SPPACKREQUESTED of SPPCON)
(SEQ.GREATERP (fetch SPPSEQNO of SPPCON)
(fetch SPPACKEDSEQNO of SPPCON))
(SEQ.GREATERP (fetch SPPSEQNO of SPPCON)
(fetch SPPOUTPUTALLOCNO
of SPPCON)))
(TIMEREXPIRED? (SETQ TIMER (fetch
SPPRETRANSMITTIMER
of SPPCON]
(* We asked for an ack, not all outstanding packets
are acked, or we are out of allocation, so poke again)
(\SPP.PROBE SPPCON))
(T (\SPP.CHECK.FOR.LIFE SPPCON]
(MONITOR.AWAIT.EVENT (fetch SPPLOCK of SPPCON)
SOCEVENT TIMER T])
(\SPP.HANDLE.INPUT
[LAMBDA (CON) (* bvm: "17-Dec-85 12:38")
(* Handle all queued input packets.
Returns T if there was activity on the connection.)
(PROG (XIP SPPBASE PKTSEQNO ACTIVE? ATTN ACKED ACKRECEIVED ALLOCINCREASED ADDRESSEDID
NEWALLOCNO MAXALLOCNO)
LOOP(COND
((fetch SPPTERMINATEDP of CON)
(RETURN T)))
(SETQ XIP (GETXIP (fetch SPPMYNSOCKET of CON)))
(COND
((NULL XIP)
[COND
((AND ACKRECEIVED (NOT ALLOCINCREASED)
(SEQ.GREATERP (fetch SPPSEQNO of CON)
(fetch SPPACKEDSEQNO of CON))
(NULL (fetch SPPRETRANSMITTING of CON)))
(* We received an apparently genuine ack, but there are still unacked packets, so assume that they have not been
seen--start retransmitting them. The test for ALLOCINCREASED is in the hopes that this ack was so old that future
acks will say the data arrived okay)
(replace SPPRETRANSMITTING of CON with (fetch SPPACKEDSEQNO of CON]
(RETURN ACTIVE?)))
(SELECTC (fetch XIPTYPE of XIP)
(\XIPT.SPP)
(\XIPT.ERROR (COND
((EQ (fetch ERRORXIPCODE of XIP)
\XIPE.NOSOCKET)
(* Partner not there, or disappeared)
(replace SPPTERMINATEDP of CON with T)
(\RELEASE.ETHERPACKET XIP)
(RETURN T)))
(GO DROPIT))
(PROGN (APPLY* (OR (fetch SPPOTHERXIPHANDLER of CON)
(FUNCTION RELEASE.XIP))
XIP
(fetch SPPMYNSOCKET of CON))
(GO LOOP)))
(SETQ SPPBASE (fetch XIPCONTENTS of XIP))
(COND
((OR (AND (fetch SPPESTABLISHEDP of CON)
(NEQ (fetch (SPPHEAD SOURCECONID) of SPPBASE)
(fetch SPPDESTID of CON)))
(AND (NEQ (SETQ ADDRESSEDID (fetch (SPPHEAD DESTCONID) of SPPBASE))
(fetch SPPSOURCEID of CON))
(NEQ ADDRESSEDID 0)))
(* If the connection has already been established, then both connection IDs must match. Otherwise, the destination
ID in the packet must be ours if it is nonzero.)
(\SPPSENDERROR CON XIP "Wrong connection ID.")
(GO DROPIT)))
(SETQ PKTSEQNO (fetch (SPPHEAD SEQNO) of SPPBASE))
(COND
((OR (SEQ.GREATERP (fetch SPPACKNO of CON)
(SEQ.ADD1 PKTSEQNO 3000))
(SEQ.GREATERP PKTSEQNO (SEQ.ADD1 (fetch SPPACCEPTNO of CON)
2)))
(* Sequence numbers more than 1 or 2 past the allocation or delayed by more than a few thousand are grounds for
generating an error response. See section 7.2 of the spec.)
(\SPPSENDERROR CON XIP "Packet out of allocation sequence.")
(GO DROPIT))) (* We have a legal packet for this connection.)
(COND
[(NOT (fetch SPPESTABLISHEDP of CON)) (* We're just now establishing the connection.)
(\SPP.ESTABLISH CON XIP)
(COND
((fetch SPPSERVERFLAG of CON)
(* * This process is a server. Remain a server in the listening state)
(GO LOOP]
(T (SETQ ACTIVE? T)))
(COND
((fetch (SPPHEAD ATTENTION) of SPPBASE)
(COND
((fetch (SPPHEAD SYSTEMPACKET) of SPPBASE)
(\SPPSENDERROR CON XIP "Both System and Attention control bits?")
(GO DROPIT)))
(COND
((IGREATERP (IDIFFERENCE (fetch XIPLENGTH of XIP)
(IPLUS \XIPOVLEN \SPPHEAD.LENGTH))
1)
(\SPPSENDERROR CON XIP "More than 1 byte of data in Attention packet?")
(GO DROPIT)))
(SETQ ATTN T)))
(COND
((SEQ.GREATERP (SETQ ACKED (fetch (SPPHEAD ACKNO) of SPPBASE))
(fetch SPPACKEDSEQNO of CON))
(\SPP.RELEASE.ACKED.PACKETS CON ACKED)))
[COND
([AND (SEQ.GREATERP (SETQ NEWALLOCNO (fetch (SPPHEAD ALLOCNO) of SPPBASE))
(fetch SPPOUTPUTALLOCNO of CON))
(OR (SEQ.GEQ (SETQ MAXALLOCNO (IPLUS (fetch SPPACKEDSEQNO of CON)
(SUB1 \SPP.RETRANSMITQ.SIZE)))
NEWALLOCNO)
(SEQ.GREATERP (SETQ NEWALLOCNO MAXALLOCNO)
(fetch SPPOUTPUTALLOCNO of CON]
(* Limit our actual allocation to the maximum we are
willing to buffer up)
(replace SPPOUTPUTALLOCNO of CON with NEWALLOCNO)
(SETQ ALLOCINCREASED T)
(NOTIFY.EVENT (fetch SPPALLOCATIONEVENT of CON]
(COND
((fetch (SPPHEAD SENDACK) of SPPBASE) (* The other end wants an acknowledgment.
Wait until we have processed all input)
(replace SPPACKPENDING of CON with T)))
(COND
((fetch (SPPHEAD SYSTEMPACKET) of SPPBASE)
(* Don't keep system packets)
(RELEASE.XIP XIP))
(T (\SPP.HANDLE.DATA CON XIP) (* Note that this call may increment the connection's
ACKNO field.)
))
(COND
([AND (fetch SPPACKREQUESTED of CON)
(OR (NEQ ACKED (fetch SPPACKREQUESTED of CON))
(EQ ACKED (fetch SPPSEQNO of CON]
(* This is the first packet that has arrived since we turned on the Ack request timer in \SPP.SENDPKT.
Turn off the timer and update our estimate of round trip delay. This packet might be delayed, and not really in
response to our Ack request. The NEQ test filters out packets that cannot possibly be in response to our ACK: if
partner received our request at seqno N, and has seen up thru N-1, ACKED should be N+1, unless the ack request was
on a system packet.)
(replace SPPROUNDTRIPTIME of CON
with (LRSH (IPLUS (ITIMES 3 (fetch SPPROUNDTRIPTIME of CON))
(IMAX SPP.MIN.TIMEOUT
(IMIN (CLOCKDIFFERENCE (fetch SPPACKREQTIME
of CON))
SPP.USER.TIMEOUT)))
2))
(replace SPPACKREQUESTED of CON with NIL)
(SETQ ACKRECEIVED T)))
(COND
(ATTN (\SPP.HANDLE.ATTN CON XIP)))
(GO LOOP)
DROPIT
(RELEASE.XIP XIP)
(GO LOOP])
(\SPP.HANDLE.DATA
[LAMBDA (CON XIP) (* bvm: "17-Dec-85 12:43")
(* This function is called when a non-System packet has arrived for a connection. It inserts the packet in the
proper place in the queue, ordered by sequence number. If the packet is a duplicate, it is dropped.)
(* * Potential problem here if sequence numbers overflow)
(PROG ((ACKNO (fetch SPPACKNO of CON))
(INQ (fetch SPPINPUTQ of CON))
(XIPNO (fetch (SPPXIP SEQNO) of XIP))
CURRENT NEXT PKTNO)
(CHECK (\SPP.CHECK.INPUT.QUEUE CON))
[COND
((SEQ.GREATERP ACKNO XIPNO) (* This packet is a duplicate, so drop it.)
(RELEASE.XIP XIP)
(RETURN))
([OR (NULL (SETQ CURRENT (\QUEUEHEAD INQ)))
(SEQ.GREATERP XIPNO (fetch (SPPXIP SEQNO) of (fetch SYSQUEUETAIL
of INQ]
(* Goes at tail end of queue.)
(\ENQUEUE INQ XIP))
((SEQ.GREATERP (SETQ PKTNO (fetch (SPPXIP SEQNO) of CURRENT))
XIPNO) (* Goes right at head of queue.)
(replace QLINK of XIP with CURRENT)
(replace SYSQUEUEHEAD of INQ with XIP))
(T (do (* Loop until the correct place is found for this
packet.)
(COND
((EQ XIPNO PKTNO) (* This packet is a duplicate, so drop it.)
(RELEASE.XIP XIP)
(RETURN)))
(SETQ NEXT (fetch QLINK of CURRENT))
(SETQ PKTNO (fetch (SPPXIP SEQNO) of NEXT))
(COND
((SEQ.GREATERP PKTNO XIPNO) (* Here's where it goes.)
(replace QLINK of XIP with NEXT)
(replace QLINK of CURRENT with XIP)
(RETURN)))
(SETQ CURRENT NEXT]
(SELECTC (fetch (SPPXIP DSTYPE) of XIP)
(\SPPDSTYPE.END (replace SPPSTATE of CON with \SPS.ENDRECEIVED)
(replace ACCESS of (fetch SPPOUTPUTSTREAM of CON)
with NIL) (* Can't send any more)
(\SPP.SEND.ENDREPLY CON)
(replace SPPSTATE of CON with \SPS.DALLYING))
(\SPPDSTYPE.ENDREPLY (SELECTC (fetch SPPSTATE of CON)
(\SPS.DALLYING
(* This is the closing end reply, so can quit now)
)
(\SPS.ENDSENT
(* This is the reply to our END)
(\SPP.SEND.ENDREPLY CON T))
(\SPPSENDERROR CON XIP "unexpected ENDREPLY")
)
(replace SPPSTATE of CON with \SPS.CLOSED)
(replace SPPTERMINATEDP of CON with T))
NIL)
(COND
((EQ XIPNO ACKNO)
(* Looks like this packet opens the way for some acknowledgements. Find the end of the run of consecutive packets
starting with the one we've just inserted.)
(while (AND (SETQ XIP (fetch QLINK of XIP))
(EQ (SETQ PKTNO (fetch (SPPXIP SEQNO) of XIP))
(SEQ.ADD1 XIPNO)))
do (SETQ XIPNO PKTNO))
(replace SPPACKNO of CON with (SEQ.ADD1 XIPNO))
(NOTIFY.EVENT (fetch SPPINPUTEVENT of CON])
(\SPP.HANDLE.ATTN
(LAMBDA (CON XIP) (* bvm: "12-Oct-84 16:03")
(* * Called when a packet is received with Attention bit set)
(PROG ((ATTENTIONFN (fetch (SPPCON SPPATTENTIONFN) of CON))
(BYTE (fetch (SPPXIP FIRSTSPPDATABYTE) of XIP))
(DSTYPE (fetch (SPPXIP DSTYPE) of XIP))
STREAM)
(COND
((AND ATTENTIONFN (for FN in (COND
((OR (NLISTP ATTENTIONFN)
(MEMB (CAR ATTENTIONFN)
LAMBDASPLST))
(LIST ATTENTIONFN))
(T ATTENTIONFN))
thereis (APPLY* FN (fetch SPPINPUTSTREAM of CON)
BYTE DSTYPE)))
(* Somebody knew how to handle it)
)
(NSWIZARDFLG (* Some other kind of attention we don't know about)
(printout PROMPTWINDOW .TAB0 0 "[Attention packet (" BYTE ")]"))))))
(\SPP.RELEASE.ACKED.PACKETS
[LAMBDA (CON ACKNO) (* bvm: "17-Dec-85 12:21")
(* * Releases packets that are acked by incoming ACKNO, i.e., any packets with sequence number less than ACKNO.
Packets are held in SPPRETRANSMITQ array)
(bind (POOL ←(fetch SPPRETRANSMITQ of CON))
(OLDACKNO ←(fetch SPPACKEDSEQNO of CON))
(MAXACKNO ←(fetch SPPSEQNO of CON))
XIP while (SEQ.GREATERP ACKNO OLDACKNO)
do [COND
((EQ OLDACKNO MAXACKNO)
(RETURN (AND XIPTRACEFLG (HELP "SPP Partner acked a packet I haven't sent yet"
ACKNO]
(SETQ XIP (ELT POOL (RETRANSMITINDEX OLDACKNO)))
[CHECK (AND XIP (EQ OLDACKNO (fetch (SPPXIP SEQNO) of XIP]
(UNINTERRUPTABLY
(SETA POOL (RETRANSMITINDEX OLDACKNO)
NIL)
(RELEASE.XIP XIP)
(replace SPPACKEDSEQNO of CON with (SETQ OLDACKNO (SEQ.ADD1 OLDACKNO))))
(replace SPPRETRANSMITTING of CON with NIL)
(* If we get ANY interesting ack, stop retransmission
until we figure out what's going on)])
(\SPP.NOT.RESPONDING
[LAMBDA (CON) (* bvm: "20-Dec-85 14:52")
(* There hasn't been any response to our probes for a
while.)
(COND
((OR (NOT (fetch SPPESTABLISHEDP of CON))
(IGEQ (replace SPPINACTIVECOUNT of CON with (ADD1 (OR (fetch
SPPINACTIVECOUNT
of CON)
0)))
SPP.MAX.FAILED.PROBES)) (* If the connection hasn't been established yet, or
if the roundtrip time is intolerably long, we drop the
connection.)
(replace SPPTERMINATEDP of CON with T))
(T (replace SPPROUNDTRIPTIME of CON with (IMIN SPP.USER.TIMEOUT
(ITIMES (fetch SPPROUNDTRIPTIME
of CON)
2)))
(* Increase our estimate of the time it takes the
other end to respond.)
(replace SPPACKREQUESTED of CON with NIL)
(COND
((EQ (fetch SPPINACTIVECOUNT of CON)
2) (* Warn the user after a while that the other end may
have crashed, but hang in there.)
(printout PROMPTWINDOW .TAB0 0 (PROCESSPROP (THIS.PROCESS)
(QUOTE NAME))
" not responding. "])
(\SPP.CHECK.FOR.LIFE
(LAMBDA (CON) (* bvm: "10-Jun-84 16:27")
(* This function gets called when there is no activity
on a connection, and occasionally probes the other
end.)
(PROG ((TIMER (fetch SPPACTIVITYTIMER of CON)))
(COND
((OR (NULL TIMER)
(TIMEREXPIRED? TIMER))
(COND
(TIMER (\SPP.PROBE CON)))
(replace SPPACTIVITYTIMER of CON with (SETUPTIMER (MAX SPP.USER.TIMEOUT
(ITIMES (fetch SPPROUNDTRIPTIME
of CON)
2))
TIMER)))))))
(\SPP.PROBE
[LAMBDA (CON) (* bvm: " 2-Aug-84 16:32")
(* Send out a system packet requesting acknowledgement
from other side.)
(\SPP.SENDPKT CON (\SPP.SYSPKT CON \SPPHEAD.CC.ACKNOWLEDGE])
(\SPP.RETRANSMIT.NEXT
[LAMBDA (CON) (* bvm: "17-Dec-85 12:22")
(PROG ((SEQNO (fetch SPPRETRANSMITTING of CON))
XIP)
(SETQ XIP (ELT (fetch SPPRETRANSMITQ of CON)
(IMOD SEQNO \SPP.RETRANSMITQ.SIZE)))
(CHECK (EQ SEQNO (fetch (SPPXIP SEQNO) of XIP)))
(replace (SPPXIP SENDACK) of XIP with (EQ SEQNO (fetch SPPOUTPUTALLOCNO
of CON)))
(* Turn off any undesired acknowledge bit)
(replace SPPRETRANSMITTING of CON with (COND
((EQ (SETQ SEQNO (SEQ.ADD1 SEQNO))
(fetch SPPSEQNO of CON))
(* Finished)
NIL)
(T SEQNO)))
(\SPP.SENDPKT CON XIP])
(\SPP.DUPLICATE.REQUEST
[LAMBDA (XIP) (* bvm: "17-Dec-85 18:41")
(* * Return T if the incoming XIP is a connection request for a connection we've already established)
(bind CONNECTION (SOURCEID ←(fetch (SPPXIP SOURCECONID) of XIP)) for INSTREAM
in (fetch DEVICEINFO of \SPPDEVICE) thereis (AND (SETQ CONNECTION
(fetch (SPPSTREAM
SPP.CONNECTION)
of INSTREAM))
(EQ SOURCEID (fetch
(SPPCON SPPDESTID)
of CONNECTION])
(\SPP.ESTABLISH
[LAMBDA (CON XIP) (* bvm: "20-Dec-85 15:28")
(* * The arrival of XIP causes this SPP connection to be established. Fix up state as appropriate)
(PROG (SPAWNEDSOC INSTREAM)
(COND
((fetch SPPSERVERFLAG of CON)
(* * The connection was opened in server mode. Create a new spp connection, and establish it to the remote side,
spawning a new process)
(COND
((\SPP.DUPLICATE.REQUEST XIP)
(RETURN)))
(SETQ CON (create SPPCON using CON SPPSERVERFLAG ← NIL SPPRETRANSMITQ ←(ARRAY
\SPP.RETRANSMITQ.SIZE
(QUOTE POINTER)
NIL 0)
SPPINPUTQ ←(create SYSQUEUE)))
(\BLT (LOCF (fetch SPPDESTNSADDRESS0 of CON))
(LOCF (fetch XIPSOURCENET of XIP))
\#WDS.NSADDRESS) (* Fill in address of port that contacted us)
(replace SPPACKREQTIME of CON with (SETUPTIMER 0))
(replace SPPACKREQTIMEOUT of CON with (SETUPTIMER SPP.USER.TIMEOUT))
(replace SPPACKREQUESTED of CON with 0)
(SETQ INSTREAM (\SPP.CREATE.STREAMS CON))
(replace SPPMYNSOCKET of CON with (SETQ SPAWNEDSOC (OPENNSOCKET)))
[\SPP.CREATE.WATCHER CON (PACK* (PROCESSPROP (fetch SPPPROCESS of CON)
(QUOTE NAME))
(QUOTE +)
(OCTALSTRING (replace SPPSOURCESKT#
of CON with (NSOCKETNUMBER
SPAWNEDSOC]
(ADD.PROCESS (LIST (fetch SPPSERVERFN of CON)
INSTREAM
(SPPOUTPUTSTREAM INSTREAM))
(QUOTE AFTEREXIT)
(QUOTE DELETE)))
(T (\BLT (LOCF (fetch SPPDESTNSADDRESS0 of CON))
(LOCF (fetch XIPSOURCENET of XIP))
\#WDS.NSADDRESS) (* The other end may have switched from a well-known
socket to a private one.)
))
(replace SPPDESTID of CON with (fetch (SPPXIP SOURCECONID) of XIP))
(replace SPPSYSPKT of CON with NIL) (* Flush any cached sys packet, now out of date)
(replace SPPESTABLISHEDP of CON with T)
(replace SPPSTATE of CON with \SPS.OPEN)
(replace SPPDESTINATIONKNOWN of CON with T)
(NOTIFY.EVENT (fetch SPPINPUTEVENT of CON])
(\SPPGETERROR
[LAMBDA (CON TRIALPKT MOREMSG) (* ecc " 3-OCT-83 17:09")
(if XIPTRACEFLG
then (printout XIPTRACEFILE "Error packet received on Sequenced Packet Protocol connection."
T)
(PRINTPACKET TRIALPKT NIL XIPTRACEFILE)
(if MOREMSG
then (printout XIPTRACEFILE .TAB0 0 MOREMSG))
(TERPRI XIPTRACEFILE])
(\SPPSENDERROR
[LAMBDA (CON EPKT MSG) (* bvm: " 8-Mar-85 16:17")
(* Stub for now)
(COND
((OR XIPTRACEFLG NSWIZARDFLG)
(printout XIPTRACEFILE MSG T)
(PRINTPACKET EPKT NIL XIPTRACEFILE)
(TERPRI XIPTRACEFILE])
)
(* Stream interface to Sequenced Packet Protocol.)
(DEFINEQ
(\INITSPP
[LAMBDA NIL (* bvm: "11-Mar-85 12:26")
(* Set up devices so that SPP streams can be used generically. The Bulk Data device enables a naive stream user to
read or write a Bulk Data object.)
[\DEFINEDEVICE NIL (SETQ \SPPDEVICE (\CREATE.SPP.DEVICE (QUOTE SPP)
(FUNCTION SPP.CLOSE]
(replace EVENTFN of \SPPDEVICE with (FUNCTION \SPP.EVENTFN))
(\DEFINEDEVICE NIL (SETQ \SPP.BULKDATA.DEVICE (\CREATE.SPP.DEVICE (QUOTE COURIER.BULK.DATA)
(FUNCTION \BULK.DATA.CLOSE])
(\SPP.EVENTFN
[LAMBDA (DEVICE EVENT) (* bvm: "11-Mar-85 12:26")
(SELECTQ EVENT
(BEFORELOGOUT (* Abort any open streams before we logout)
(for STREAM in (fetch DEVICEINFO of DEVICE) do (SPP.CLOSE STREAM T)))
NIL])
(\CREATE.SPP.DEVICE
[LAMBDA (NAME CLOSEFN) (* bvm: " 9-Jun-85 16:39")
(create FDEV
DEVICENAME ← NAME
FDBINABLE ← T
BUFFERED ← T
EVENTFN ←(FUNCTION NILL)
TRUNCATEFILE ←(FUNCTION NILL)
CLOSEFILE ← CLOSEFN
BIN ←(FUNCTION \BUFFERED.BIN)
BOUT ←(FUNCTION \BUFFERED.BOUT)
EOFP ←(FUNCTION SPP.EOFP)
READP ←(FUNCTION SPP.READP)
PEEKBIN ←(FUNCTION \BUFFERED.PEEKBIN)
BACKFILEPTR ←(FUNCTION SPP.BACKFILEPTR)
FORCEOUTPUT ←(FUNCTION SPP.FORCEOUTPUT)
BLOCKIN ←(FUNCTION \BUFFERED.BINS)
BLOCKOUT ←(FUNCTION \SPP.BOUTS)
GETNEXTBUFFER ←(FUNCTION \SPP.GETNEXTBUFFER)
GETFILEPTR ←(FUNCTION \SPP.GETFILEPTR)
SETFILEPTR ←(FUNCTION \SPP.SETFILEPTR])
(SPP.OPEN
(LAMBDA (HOST SOCKET PROBEP NAME PROPS) (* ejs: "31-Dec-85 16:52")
(RESETLST (LET ((CON (\SPPCONNECTION HOST SOCKET NAME)))
(OBTAIN.MONITORLOCK (fetch SPPLOCK of CON)
NIL T)
(RESETSAVE (fetch (SPPCON SPPMYNSOCKET) of CON)
(QUOTE (AND RESETSTATE (CLOSENSOCKET OLDVALUE))))
(* Close socket if we abort out of SPP.OPEN)
(COND
((COND
((NULL HOST) (* Server connection)
(LET ((SERVERFN (LISTGET PROPS (QUOTE SERVER.FUNCTION))))
(COND
(SERVERFN (* Handler for each of multiple possible connections
to this server socket)
(replace SPPSERVERFLAG of CON with T)
(replace SPPSERVERFN of CON with SERVERFN)
T)
(T (* Wait for single user to connect, then return it)
(until (fetch SPPESTABLISHEDP of CON)
do (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON)
(fetch SPPINPUTEVENT
of CON)))
T))))
((OR (fetch SPPESTABLISHEDP of CON)
(NOT PROBEP)) (* User connection)
T)
(T (\SPP.PROBE CON)
(bind (TIMER ←(SETUPTIMER SPP.USER.TIMEOUT))
do (COND
((fetch SPPESTABLISHEDP of CON)
(RETURN T))
((TIMEREXPIRED? TIMER)
(replace SPPTERMINATEDP of CON with T)
(RETURN NIL))
(T (MONITOR.AWAIT.EVENT (fetch SPPLOCK of CON)
(fetch SPPINPUTEVENT
of CON)
TIMER T))))))
(* * CON is okay to use -- either established, or willing to be)
(for TAIL on PROPS by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(CLOSEFN (replace SPPWHENCLOSEDFN of CON
with (CADR TAIL)))
(ATTENTIONFN (replace SPPATTENTIONFN of CON
with (CADR TAIL)))
(ERRORHANDLER (replace SPPERRORHANDLER of CON
with (CADR TAIL)))
(EOM.ON.FORCEOUT (replace SPPEOMONFORCEOUT
of CON with (CADR TAIL)))
(OTHERXIPHANDLER (COND
((FNTYP (CADR TAIL))
(replace SPPOTHERXIPHANDLER
of CON with (CADR TAIL)))))
NIL))
(\SPP.CREATE.STREAMS CON)))))))
(\SPP.CREATE.STREAM
[LAMBDA (ACCESS) (* bvm: "12-Oct-84 22:43")
(create STREAM
DEVICE ← \SPPDEVICE
ACCESS ← ACCESS])
(SPP.DESTADDRESS
(LAMBDA (STREAM) (* bvm: " 2-Aug-84 16:42")
(PROG ((CON (COND
((type? SPPCON STREAM)
STREAM)
(T (GETSPPCON STREAM))))
(ADDRESS (create NSADDRESS)))
(\BLT ADDRESS (LOCF (fetch SPPDESTNSADDRESS0 of CON))
\#WDS.NSADDRESS)
(RETURN ADDRESS))))
(SPPOUTPUTSTREAM
(LAMBDA (SPPINPUTSTREAM) (* bvm: "18-Jun-84 16:26")
(PROG ((CON (GETSPPCON SPPINPUTSTREAM)))
(RETURN (AND CON (fetch SPPOUTPUTSTREAM of CON))))))
(SPP.OPENP
(LAMBDA (STREAM) (* bvm: "22-Jun-84 15:44")
(PROG (CON)
(RETURN (AND STREAM (SETQ CON (GETSPPCON STREAM))
(NOT (fetch SPPTERMINATEDP of CON)))))))
(\STREAM.FROM.PACKET
[LAMBDA (EPKT) (* bvm: "21-Jun-84 14:34")
(* Return a stream which will read out of the contents
of a single Packet Exchange packet.)
(CHECK (EQP (fetch XIPTYPE of EPKT)
\XIPT.EXCHANGE))
(* (\STRINGOFD (create STRINGP READONLY ← T BASE ← (LOCF (fetch PACKETEXCHANGEBODY of (fetch XIPCONTENTS of EPKT))
) OFFST ← 0 LENGTH ← (IDIFFERENCE (fetch XIPLENGTH of EPKT) (CONSTANT (IPLUS \XIPOVLEN 6))))))
(\MAKEBASEBYTESTREAM (fetch PACKETEXCHANGEBODY of EPKT)
0
(IDIFFERENCE (fetch XIPLENGTH of EPKT)
(CONSTANT (IPLUS \XIPOVLEN 6)))
(QUOTE INPUT])
(SPP.FORCEOUTPUT
(LAMBDA (STREAM) (* ejs: "18-Dec-84 19:56")
(PROG ((CON (GETSPPCON STREAM))
EPKT)
(COND
((SETQ EPKT (fetch SPPOUTPKT of CON))
(COND
((EQ STREAM (fetch SPPINPUTSTREAM of CON))
(SETQ STREAM (fetch SPPOUTPUTSTREAM of CON))))
(UNINTERRUPTABLY
(add (fetch XIPLENGTH of EPKT)
(fetch COFFSET of STREAM))
(\SPPINCFILEPTR STREAM (fetch COFFSET of STREAM))
(replace SPPOUTPKT of CON with NIL)
(replace CBUFMAXSIZE of STREAM with 0)
(replace COFFSET of STREAM with 0)
(replace CBUFPTR of STREAM with NIL))
(COND
((fetch SPPEOMONFORCEOUT of CON)
(replace (SPPXIP ENDOFMESSAGE) of EPKT with T)))
(COND
((fetch SPPOUTPUTABORTEDP of CON)
(replace SPPOUTPUTABORTEDP of CON with NIL)
(APPLY* (fetch SPPOUTPUTABORTEDFN of CON)
STREAM))
((NOT (\SENDSPP CON EPKT))
(\SPP.STREAM.LOST STREAM))))))))
(SPP.FLUSH.TO.EOF
(LAMBDA (INSTREAM) (* ejs: "18-Dec-84 17:32")
(while (NOT (\SPP.PREPARE.INPUT INSTREAM)) do (replace COFFSET of INSTREAM
with (fetch CBUFSIZE of INSTREAM))
finally (RETURN (SELECTC (fetch SPPEOFBITS of INSTREAM)
(\SPPFLAG.EOM (replace SPPEOFP of INSTREAM with NIL)
(QUOTE EOM))
(\SPPFLAG.ATTENTION (SPP.CLEARATTENTION INSTREAM)
(BIN INSTREAM))
(\SPPFLAG.END (QUOTE EOF))
NIL)))))
(SPP.SENDEOM
[LAMBDA (STREAM) (* bvm: "14-Feb-85 00:04")
(* Send the End of Message indication.)
(PROG ((CON (GETSPPCON STREAM))
EPKT)
(OR (WRITEABLE STREAM)
(SETQ STREAM (fetch SPPOUTPUTSTREAM of CON))
(\SPP.STREAM.LOST STREAM))
(replace (SPPXIP ENDOFMESSAGE) of (OR (fetch SPPOUTPKT of CON)
(\SPP.PREPARE.OUTPUT STREAM CON)
(\SPP.STREAM.LOST STREAM))
with T)
(SPP.FORCEOUTPUT STREAM])
(SPP.CLEAREOM
(LAMBDA (STREAM NOERRORFLG) (* ejs: "18-Dec-84 17:32")
(PROG ((CON (GETSPPCON STREAM))
FLG)
(RETURN (COND
((AND (\SPP.PREPARE.INPUT STREAM)
(EQ (fetch SPPEOFBITS of STREAM)
\SPPFLAG.EOM))
(replace SPPEOFP of STREAM with NIL)
T)
((NOT NOERRORFLG)
(ERROR "SPP.CLEAREOM - not at end of message" STREAM)))))))
(SPP.SENDATTENTION
[LAMBDA (STREAM ATTENTIONBYTE CC) (* bvm: "22-Jun-84 14:52")
(* Send an Attention packet with the specified data byte
and control bits. Can't use normal stream mechanism
because stream may be read only.)
(PROG ((CON (GETSPPCON STREAM))
EPKT)
[SETQ EPKT (\FILLINSPP CON (LOGOR \SPPHEAD.CC.ATTENTION (OR CC 0]
(replace (SPPXIP FIRSTSPPDATABYTE) of EPKT with ATTENTIONBYTE)
(add (fetch XIPLENGTH of EPKT)
1)
(RETURN (\SENDSPP CON EPKT T])
(SPP.CLEARATTENTION
(LAMBDA (STREAM NOERRORFLG) (* ejs: "18-Dec-84 17:33")
(PROG ((CON (GETSPPCON STREAM))
FLG)
(RETURN (COND
((AND (\SPP.PREPARE.INPUT STREAM)
(EQ (fetch SPPEOFBITS of STREAM)
\SPPFLAG.ATTENTION))
(UNINTERRUPTABLY
(replace SPPEOFP of STREAM with NIL)
(replace CBUFSIZE of STREAM with 1))
T)
((NOT NOERRORFLG)
(ERROR "SPP.CLEARATTENTION - not at attention packet" STREAM)))))))
(SPP.CLOSE
(LAMBDA (STREAM ABORT?) (* bvm: "12-Oct-84 22:46")
(* Close an SPP stream. Don't close it if there's still
an open Bulk Data stream, unless the user is aborting
the connection.)
(PROG (CON SUBSTREAM)
(RETURN (COND
((OR (NULL STREAM)
(NULL (SETQ CON (GETSPPCON STREAM)))
(fetch SPPTERMINATEDP of CON))
NIL)
(T (COND
((AND (SETQ SUBSTREAM (fetch SPPSUBSTREAM of CON))
(OPENED SUBSTREAM)) (* This connection still has an active bulk data
stream. Must want to abort it)
(\BULK.DATA.CLOSE SUBSTREAM (SETQ ABORT? T))))
(COND
((NOT ABORT?)
(SPP.FORCEOUTPUT STREAM)))
(\TERMINATESPP CON)))))))
(\SPP.CLOSE.IF.ERROR
[LAMBDA (STREAM) (* bvm: "16-NOV-83 14:57")
(COND
(RESETSTATE (SPP.CLOSE STREAM T])
(\SPP.RESETCLOSE
[LAMBDA (STREAM) (* bvm: "16-NOV-83 14:59")
(* * For use in RESETSAVE -- sets the abort arg to SPP.CLOSE according to RESETSTATE)
(SPP.CLOSE STREAM RESETSTATE])
(SPP.BACKFILEPTR
[LAMBDA (STREAM) (* bvm: "13-Feb-85 23:36")
(if (NEQ (fetch COFFSET of STREAM)
0)
then (add (fetch COFFSET of STREAM)
-1])
(\SPP.GETFILEPTR
[LAMBDA (STREAM) (* bvm: "24-Sep-84 17:24")
(IPLUS (fetch SPPFILEPTR of STREAM)
(fetch COFFSET of STREAM])
(\SPP.SETFILEPTR
[LAMBDA (STREAM INDX) (* bvm: "24-Sep-84 17:44")
(PROG ((CON (GETSPPCON STREAM))
SKIPBYTES)
(RETURN (COND
((AND (EQ (fetch ACCESSBITS of STREAM)
ReadBit)
(IGEQ (SETQ SKIPBYTES (IDIFFERENCE INDX (\SPP.GETFILEPTR STREAM)))
0)) (* Can only move file pointer on input, and then only
forward)
(\SPP.SKIPBYTES STREAM SKIPBYTES))
(T (\IS.NOT.RANDACCESSP STREAM])
(\SPP.SKIPBYTES
[LAMBDA (STREAM NBYTES) (* bvm:
"31-Jan-86 16:47")
(PROG (BYTESLEFT CONDITION)
LP [COND
((SETQ CONDITION (\SPP.PREPARE.INPUT STREAM))
(COND
((NEQ (SETQ CONDITION (SPP.STREAM.ERROR STREAM CONDITION))
T)
(RETURN CONDITION]
(COND
([IGREATERP NBYTES (SETQ BYTESLEFT (IDIFFERENCE (fetch CBUFSIZE of STREAM)
(fetch COFFSET of STREAM]
(SETQ NBYTES (IDIFFERENCE NBYTES BYTESLEFT))
(replace COFFSET of STREAM with (fetch CBUFSIZE of STREAM))
(GO LP))
(T (add (fetch COFFSET of STREAM)
NBYTES])
(\SPP.BOUTS
(LAMBDA (STREAM BASE OFF NBYTES) (* bvm: "12-Oct-84 22:53")
(PROG ((CON (GETSPPCON STREAM)))
(RETURN (\BUFFERED.BOUTS (OR (COND
((NULL CON)
NIL)
((EQ STREAM (fetch SPPINPUTSTREAM of CON))
(fetch SPPOUTPUTSTREAM of CON))
(T STREAM))
(RETURN (\SPP.STREAM.LOST STREAM)))
BASE OFF NBYTES)))))
(\SPP.OTHER.BOUT
[LAMBDA (STREAM BYTE) (* bvm:
"31-Jan-86 16:49")
(* BOUT function for the
input side of an SPP
connection, in case
someone doesn't want to
bother with
SPPOUTPUTSTREAM)
(\BOUT (OR (SPPOUTPUTSTREAM STREAM)
(\SPP.STREAM.LOST STREAM))
BYTE])
(\SPP.GETNEXTBUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* bvm:
"31-Jan-86 16:47")
(* * Generic buffer refiller for SPP streams)
(PROG (CON ERRCODE)
(RETURN (SELECTQ WHATFOR
(READ (COND
((NULL (SETQ ERRCODE (\SPP.PREPARE.INPUT STREAM)))
T)
((OR (NEQ ERRCODE (QUOTE EOM))
(NULL NOERRORFLG))
(SPP.STREAM.ERROR STREAM ERRCODE))))
(WRITE (SETQ CON (GETSPPCON STREAM))
(COND
((\SPP.PREPARE.OUTPUT (COND
((EQ STREAM (fetch SPPINPUTSTREAM
of CON))
(ffetch SPPOUTPUTSTREAM of CON))
(T STREAM))
CON)
T)
(T (* If that returned,
then client must want no
error)
(RETFROM (OR (STKPOS (QUOTE \BUFFERED.BOUT))
(STKPOS (QUOTE \BUFFERED.BOUTS))
(RETURN (\SPP.STREAM.LOST STREAM)))
NIL T))))
(SHOULDNT])
(\SPP.STREAM.LOST
[LAMBDA (STREAM) (* bvm:
"31-Jan-86 16:47")
(SPP.STREAM.ERROR STREAM (QUOTE STREAM.LOST])
(\SPP.DEFAULT.ERRORHANDLER
[LAMBDA (STREAM CONDITION) (* bvm:
"31-Jan-86 16:47")
(SELECTQ CONDITION
(STREAM.LOST (ERROR "Connection lost" (OR (fetch FULLFILENAME of STREAM)
STREAM)))
(\EOF.ACTION STREAM])
(\SPP.PREPARE.INPUT
(LAMBDA (STREAM TIMEOUT) (* ejs: " 3-May-86 20:16")
(* * Gets the next input packet for the stream interface.
If OK, returns NIL, otherwise returns the error condition as one of the
canonical error codes, or one of the SPP-specific error codes)
(PROG ((CON (GETSPPCON STREAM))
EPKT CONDITION OLD.DSTYPE NEW.DSTYPE SPPDSTYPECHANGEFN)
(COND
((SETQ EPKT (fetch SPPINPKT of CON)) (* Look at previous packet to make
sure we're not trying to read past the
end of the stream.)
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)) (* Not finished with this packet yet)
(RETURN NIL)))
(COND
((EQ (fetch SPPEOFBITS of STREAM)
\SPPFLAG.ATTENTION) (* Waiting to read attention packet.
Has to be cleared first, so indicate
eof now)
(RETURN (QUOTE ATTENTION)))) (* Throw away the previous packet in
preparation for the next one.)
(UNINTERRUPTABLY
(\SPPINCFILEPTR STREAM (fetch CBUFSIZE of STREAM))
(replace COFFSET of STREAM with (replace CBUFSIZE of STREAM with 0))
(replace SPPINPKT of CON with NIL)
(replace CBUFPTR of STREAM with NIL)
(COND
((fetch (SPPXIP EOMP) of EPKT)
(replace SPPEOFP of STREAM with (QUOTE EOM)))))
(RELEASE.XIP EPKT)))
(COND
((SETQ CONDITION (fetch SPPEOFP of STREAM))
(RETURN CONDITION)))
AGAIN
(SETQ EPKT (\GETSPP CON TIMEOUT))
(COND
((NULL EPKT)
(RETURN (COND
(TIMEOUT (QUOTE BIN.TIMEOUT))
(T (QUOTE STREAM.LOST))))))
(SELECTC (SETQ NEW.DSTYPE (fetch (SPPXIP DSTYPE) of EPKT))
((LIST \SPPDSTYPE.END \SPPDSTYPE.ENDREPLY)
(replace SPPEOFP of STREAM with (QUOTE END))
(RETURN (QUOTE END)))
(\SPPDSTYPE.BULKDATA
(COND
((NULL (fetch BULK.DATA.CONTINUATION of STREAM))
(* We got a Bulk Data packet but not on a Bulk Data stream.
It's probably a straggler after we aborted a transfer, so ignore it.)
(GO AGAIN))))
NIL)
(UNINTERRUPTABLY
(replace CBUFPTR of STREAM with (fetch (SPPXIP SPPCONTENTS) of EPKT))
(replace COFFSET of STREAM with 0)
(replace CBUFSIZE of STREAM with (COND
((fetch (SPPXIP ATTENTION) of EPKT)
(* Not readable yet)
(replace SPPEOFP of STREAM with (QUOTE ATTENTION))
0)
(T (IDIFFERENCE (fetch XIPLENGTH of EPKT)
(CONSTANT (IPLUS \XIPOVLEN
\SPPHEAD.LENGTH))))))
(replace SPPINPKT of CON with EPKT))
(SETQ OLD.DSTYPE (fetch (SPPCON SPPINPUTDSTYPE) of CON))
(replace (SPPCON SPPINPUTDSTYPE) of CON with NEW.DSTYPE)
(COND
((AND (NEQ OLD.DSTYPE NEW.DSTYPE)
(SETQ SPPDSTYPECHANGEFN (fetch (SPPCON SPPDSTYPECHANGEFN) of CON)))
(APPLY* SPPDSTYPECHANGEFN STREAM OLD.DSTYPE NEW.DSTYPE)))
(RETURN (fetch SPPEOFP of STREAM)))))
(\SPP.PREPARE.OUTPUT
(LAMBDA (STREAM CON) (* bvm: "24-Sep-84 16:17")
(* Fill in a new packet for the output side of the
stream interface.)
(SPP.FORCEOUTPUT STREAM)
(if (NOT (fetch SPPTERMINATEDP of CON))
then (PROG ((EPKT (\FILLINSPP CON)))
(replace SPPOUTPKT of CON with EPKT)
(replace CBUFPTR of STREAM with (fetch (SPPXIP SPPCONTENTS) of EPKT))
(replace COFFSET of STREAM with 0)
(replace CBUFMAXSIZE of STREAM with (IDIFFERENCE \MAX.XIPDATALENGTH
\SPPHEAD.LENGTH))
(RETURN EPKT)))))
(SPP.DSTYPE
(LAMBDA (STREAM DSTYPE NOBLOCK) (* ejs: " 5-May-86 10:21")
(* Get or set datastream type of
current packet.)
(PROG ((CON (GETSPPCON STREAM))
EPKT CONDITION)
(RETURN (COND
(DSTYPE (COND
((SETQ EPKT (fetch SPPOUTPKT of CON))
(replace (SPPXIP DSTYPE) of EPKT with DSTYPE)))
(replace SPPDSTYPE of CON with DSTYPE))
(T (COND
((NOT (READABLE STREAM))
(fetch SPPDSTYPE of CON))
(NOBLOCK (fetch (SPPCON SPPINPUTDSTYPE) of CON))
(T (fetch (SPPXIP DSTYPE)
of (OR (fetch SPPINPKT of CON)
(COND
((AND (SETQ CONDITION (\SPP.PREPARE.INPUT STREAM))
(NEQ (SETQ CONDITION (SPP.STREAM.ERROR STREAM
CONDITION))
T))
(RETURN CONDITION))
(T (fetch SPPINPKT of CON)))))))))))))
(SPP.READP
(LAMBDA (STREAM) (* ejs: "18-Dec-84 17:35")
(COND
((NOT (READABLE STREAM))
(LISPERROR "FILE NOT OPEN" (FULLNAME STREAM)))
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
T)
(T (NULL (\SPP.PREPARE.INPUT STREAM 0))))))
(SPP.EOFP
[LAMBDA (STREAM) (* bvm: " 9-Mar-85 16:21")
(COND
((NOT (READABLE STREAM))
T)
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
NIL)
(T (LET ((CONDITION (\SPP.PREPARE.INPUT STREAM)))
(SELECTQ CONDITION
(NIL (* There is more)
NIL)
(END T)
(STREAM.LOST (* Harumph, can't say EOFP because there would have
been more)
NIL)
(PROGN (* Special kinds of EOF)
CONDITION])
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\INITSPP)
)
(* Debugging)
(ADDTOVAR XIPPRINTMACROS (5 . PRINTSPP))
(DEFINEQ
(PPSPP
[LAMBDA (CON FILE DETAILS) (* bvm: "17-Dec-85 12:49")
(PROG (STR N)
(SETQ FILE (\GETSTREAM FILE (QUOTE OUTPUT)))
(printout FILE "Local: " (fetch SPPSOURCENSADDRESS of CON)
", id = "
(fetch SPPSOURCEID of CON)
T "Remote: " (fetch SPPDESTNSADDRESS of CON)
", id = "
(fetch SPPDESTID of CON)
T)
[COND
((NOT (fetch SPPESTABLISHEDP of CON))
(printout FILE " [not established]"))
(T (printout FILE "DS Type = " (SELECTC (fetch SPPDSTYPE of CON)
(\SPPDSTYPE.COURIER "courier")
(\SPPDSTYPE.BULKDATA "bulkdata")
(fetch SPPDSTYPE of CON]
(COND
((fetch SPPTERMINATEDP of CON)
(printout FILE " [terminated]")))
(COND
((fetch SPPACKREQUESTED of CON)
(printout FILE " [ack requested]")))
(printout FILE T "Round trip: " (fetch SPPROUNDTRIPTIME of CON)
T)
(printout FILE T "Input:" T " Seq# " (fetch SPPACKNO of CON)
T " Allocation: " [\LOLOC (IDIFFERENCE (fetch SPPACCEPTNO of CON)
(SUB1 (fetch SPPACKNO
of CON]
T)
(PPSPPSTREAM (fetch SPPINPUTSTREAM of CON)
FILE)
(COND
((NEQ [SETQ N (IPLUS (COND
((fetch SPPINPKT of CON)
1)
(T 0))
(\QUEUELENGTH (fetch SPPINPUTQ of CON]
0)
(printout FILE " Packets in queue: " N T)))
(printout FILE T "Output:" T " Seq# " (fetch SPPSEQNO of CON))
[COND
((EQ (fetch SPPSEQNO of CON)
(fetch SPPACKEDSEQNO of CON))
(printout FILE ", all acked"))
(T (printout FILE ", acked# " (fetch SPPACKEDSEQNO of CON]
(printout FILE T " Allocation: " [\LOLOC (IDIFFERENCE (fetch SPPOUTPUTALLOCNO
of CON)
(SUB1 (fetch SPPSEQNO
of CON]
T)
(PPSPPSTREAM (fetch SPPOUTPUTSTREAM of CON)
FILE)
(COND
(DETAILS (printout FILE " Awaiting ack: " #
[for (I ←(fetch SPPACKEDSEQNO of CON)) by (SEQ.ADD1 I)
bind (NEXT ←(fetch SPPSEQNO of CON))
while (SEQ.GREATERP NEXT I)
do (PRINTSPP (ELT (fetch SPPRETRANSMITQ of CON)
(RETRANSMITINDEX I]
T)))
(COND
((SETQ STR (fetch SPPSUBSTREAM of CON))
(printout FILE T "Bulk data stream (" (fetch ACCESS of STR)
"):" T)
(PPSPPSTREAM STR FILE])
(\SPP.INFO.HOOK
[LAMBDA (PROC BUTTON) (* bvm: "25-Sep-84 13:07")
(DECLARE (USEDFREE SPPCON)) (* This is evaluated underneath \SPPWATCHER)
(if (EQ BUTTON (QUOTE MIDDLE))
then (* all the details)
(INSPECT SPPCON)
else (PROG [(WINDOW (PROCESSPROP PROC (QUOTE WINDOW]
(COND
((NULL WINDOW)
(SETQ WINDOW (CREATEW (GETBOXREGION 256 240)
"SPP Connection Status"))
(DSPFONT (FONTCREATE (QUOTE GACHA)
8)
WINDOW)
(PROCESSPROP PROC (QUOTE WINDOW)
WINDOW))
(T (CLEARW WINDOW)))
(PPSPP SPPCON WINDOW])
(PPSPPSTREAM
[LAMBDA (STREAM FILE) (* bvm: "25-Sep-84 12:27")
(if STREAM
then (printout FILE " File pointer: " (\SPP.GETFILEPTR STREAM))
(if (fetch SPPEOFP of STREAM)
then (printout FILE " [eof]"))
(TERPRI FILE])
(\SPP.CHECK.INPUT.QUEUE
[LAMBDA (CON) (* bvm: "17-Dec-85 12:50")
(PROG ((ACKNO (fetch SPPACKNO of CON))
(INQ (fetch SPPINPUTQ of CON))
N1 N2 CURRENT NEXT) (* Check consistency of input queue.)
(SETQ CURRENT (fetch SYSQUEUEHEAD of INQ))
L (COND
((NULL CURRENT)
(RETURN T)))
(SETQ N1 (fetch (SPPXIP SEQNO) of CURRENT))
(COND
((EQ N1 ACKNO)
(SHOULDNT
"The input queue contains a packet that should have been acknowledged already.")
(RETURN NIL)))
(COND
((NULL (SETQ NEXT (fetch QLINK of CURRENT)))
(RETURN T)))
(SETQ N2 (fetch (SPPXIP SEQNO) of NEXT))
(COND
((EQ N1 N2)
(SHOULDNT "The input queue has duplicates.")
(RETURN NIL)))
(COND
((SEQ.GREATERP N1 N2)
(SHOULDNT "The input queue is out of order.")
(RETURN NIL)))
(SETQ CURRENT NEXT)
(GO L])
(PRINTSPP
(LAMBDA (EPKT FILE) (* ejs: " 3-May-86 20:34")
(PROG ((BASE (fetch XIPCONTENTS of EPKT))
SYSTEMP DS LENGTH)
(printout FILE (fetch (SPPHEAD SOURCECONID) of BASE)
"/"
(fetch (SPPHEAD DESTCONID) of BASE))
(COND
((NEQ (fetch (SPPHEAD CC) of BASE)
0)
(PROG ((SEPR " [")
(COMMA ", "))
(COND
((fetch (SPPHEAD SYSTEMPACKET) of BASE)
(printout FILE SEPR "sys")
(SETQ SEPR COMMA)
(SETQ SYSTEMP T)))
(COND
((fetch (SPPHEAD SENDACK) of BASE)
(printout FILE SEPR "ack")
(SETQ SEPR COMMA)))
(COND
((fetch (SPPHEAD ATTENTION) of BASE)
(printout FILE SEPR "attn")
(SETQ SEPR COMMA)))
(COND
((fetch (SPPHEAD ENDOFMESSAGE) of BASE)
(printout FILE SEPR "eom")
(SETQ SEPR COMMA)))
(COND
((NEQ SEPR COMMA)
(printout FILE SEPR "??")))
(printout FILE "]"))))
(printout FILE , (SELECTC (SETQ DS (fetch (SPPHEAD DSTYPE) of BASE))
(\SPPDSTYPE.COURIER
"courier")
(\SPPDSTYPE.BULKDATA
"bulkdata")
(\SPPDSTYPE.END
"end")
(\SPPDSTYPE.ENDREPLY
"end-reply")
DS))
(printout FILE " seq " (fetch (SPPHEAD SEQNO) of BASE)
"; ack/alloc = "
(fetch (SPPHEAD ACKNO) of BASE)
"/"
(fetch (SPPHEAD ALLOCNO) of BASE))
(COND
((NEQ 0 (SETQ LENGTH (IDIFFERENCE (fetch XIPLENGTH of EPKT)
(CONSTANT (IPLUS \XIPOVLEN \SPPHEAD.LENGTH)))))
(printout FILE "; " LENGTH " bytes")
(COND
(PRINTSPPDATAFLG (printout FILE T "Data: ")
(PRINTPACKETDATA (fetch (SPPHEAD SPPCONTENTS) of BASE)
0
(QUOTE (CHARS))
LENGTH FILE)))))
(printout FILE T T))))
)
(RPAQ? PRINTSPPDATAFLG )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PRINTSPPDATAFLG)
)
(PUTPROPS SPP COPYRIGHT ("Xerox Corporation" 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (8496 24599 (\SPPCONNECTION 8506 . 10568) (\SPP.CREATE.STREAMS 10570 . 11401) (
\SPP.CREATE.WATCHER 11403 . 12035) (\SPP.SENDPKT 12037 . 14667) (\FILLINSPP 14669 . 15342) (
\SPP.SYSPKT 15344 . 16248) (\GETSPP 16250 . 18158) (\SENDSPP 18160 . 20774) (\SPP.SEND.ENDREPLY 20776
. 21059) (\TERMINATESPP 21061 . 22731) (\SPP.CLEANUP 22733 . 24597)) (24600 46725 (\SPPWATCHER 24610
. 26718) (\SPP.HANDLE.INPUT 26720 . 33450) (\SPP.HANDLE.DATA 33452 . 37029) (\SPP.HANDLE.ATTN 37031
. 38053) (\SPP.RELEASE.ACKED.PACKETS 38055 . 39321) (\SPP.NOT.RESPONDING 39323 . 40833) (
\SPP.CHECK.FOR.LIFE 40835 . 41569) (\SPP.PROBE 41571 . 41906) (\SPP.RETRANSMIT.NEXT 41908 . 42829) (
\SPP.DUPLICATE.REQUEST 42831 . 43463) (\SPP.ESTABLISH 43465 . 45968) (\SPPGETERROR 45970 . 46371) (
\SPPSENDERROR 46373 . 46723)) (46785 72240 (\INITSPP 46795 . 47439) (\SPP.EVENTFN 47441 . 47787) (
\CREATE.SPP.DEVICE 47789 . 48616) (SPP.OPEN 48618 . 51256) (\SPP.CREATE.STREAM 51258 . 51444) (
SPP.DESTADDRESS 51446 . 51829) (SPPOUTPUTSTREAM 51831 . 52071) (SPP.OPENP 52073 . 52333) (
\STREAM.FROM.PACKET 52335 . 53105) (SPP.FORCEOUTPUT 53107 . 54280) (SPP.FLUSH.TO.EOF 54282 . 54872) (
SPP.SENDEOM 54874 . 55507) (SPP.CLEAREOM 55509 . 55989) (SPP.SENDATTENTION 55991 . 56666) (
SPP.CLEARATTENTION 56668 . 57265) (SPP.CLOSE 57267 . 58207) (\SPP.CLOSE.IF.ERROR 58209 . 58379) (
\SPP.RESETCLOSE 58381 . 58635) (SPP.BACKFILEPTR 58637 . 58875) (\SPP.GETFILEPTR 58877 . 59080) (
\SPP.SETFILEPTR 59082 . 59655) (\SPP.SKIPBYTES 59657 . 60532) (\SPP.BOUTS 60534 . 60988) (
\SPP.OTHER.BOUT 60990 . 61850) (\SPP.GETNEXTBUFFER 61852 . 63690) (\SPP.STREAM.LOST 63692 . 63935) (
\SPP.DEFAULT.ERRORHANDLER 63937 . 64333) (\SPP.PREPARE.INPUT 64335 . 68820) (\SPP.PREPARE.OUTPUT 68822
. 69616) (SPP.DSTYPE 69618 . 71185) (SPP.READP 71187 . 71557) (SPP.EOFP 71559 . 72238)) (72354 80123
(PPSPP 72364 . 75086) (\SPP.INFO.HOOK 75088 . 75901) (PPSPPSTREAM 75903 . 76223) (
\SPP.CHECK.INPUT.QUEUE 76225 . 77319) (PRINTSPP 77321 . 80121)))))
STOP