(FILECREATED "13-Mar-85 17:05:18" {ERIS}<LISPCORE>SOURCES>SPP.;17 79386
changes to: (FNS \SPP.HANDLE.INPUT)
previous date: "11-Mar-85 18:26:39" {ERIS}<LISPCORE>SOURCES>SPP.;15)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SPPCOMS)
(RPAQQ SPPCOMS ((COMS (* Sequenced Packet Protocol.)
(SYSRECORDS SPPCON)
(DECLARE: DONTCOPY (RECORDS SPPCON SPPHEAD SPPXIP)
(CONSTANTS * SPPTYPES)
(CONSTANTS * SPPSTATES)
(CONSTANTS (\SPPHEAD.LENGTH 12)
(\#WDS.SPPINFO (SUB1 (FOLDLO (IPLUS \XIPOVLEN
\SPPHEAD.LENGTH)
BYTESPERWORD)))
(\SPP.INITIAL.ALLOCATION 5)
(\SPP.INITIAL.ROUNDTRIP 1000)
(\SPP.RETRANSMITQ.SIZE 8))
(MACROS RETRANSMITINDEX)
(GLOBALVARS SPP.USER.TIMEOUT SPP.MIN.TIMEOUT))
(INITRECORDS SPPCON)
(INITVARS (SPP.USER.TIMEOUT 15000)
(SPP.MIN.TIMEOUT 50))
(FNS \SPPCONNECTION \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.ESTABLISH \SPPGETERROR \SPPSENDERROR))
[COMS (* Stream interface to Sequenced Packet Protocol.)
(DECLARE: DONTCOPY (RECORDS SPPSTREAM)
(MACROS GETSPPCON \FETCH.NSADDRESS \SPPINCFILEPTR GETWORD PUTWORD GETLONG
PUTLONG SPP.INPUT.ERROR)
(CONSTANTS * SPPEOFFLAGS)
(GLOBALVARS \SPPDEVICE \SPP.BULKDATA.DEVICE))
(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 SPP.DRIBBLE)
(INITVARS (PRINTSPPDATAFLG))
(GLOBALVARS PRINTSPPDATAFLG))))
(* Sequenced Packet Protocol.)
[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)
(SPPSPAREFLAG 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)
(SPPSPARE POINTER)))
]
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE SPPCON ((SPPXIPLENGTH WORD) (* First part of this record looks like the header of
an SPP XIP filled in with defaults for this connection)
(NIL BYTE) (* Transport control)
(SPPXIPTYPE BYTE) (* Constant \XIPT.SPP)
(SPPDESTNSADDRESS0 5 WORD) (* Destination address, maybe not filled in until
connection established)
(SPPDESTSKT# WORD)
(SPPSOURCENSADDRESS0 5 WORD) (* My address and socket number)
(SPPSOURCESKT# WORD)
(NIL BYTE) (* Connection Control)
(SPPDSTYPE BYTE) (* Current datastream type from our outgoing side.)
(SPPSOURCEID WORD) (* Connection identification number for this side.)
(SPPDESTID WORD) (* Connection identification number for the other
side.)
(SPPSEQNO WORD) (* Current sequence number -- next packet to go out
will take this and, if not a system packet, then
increment it.)
(SPPACKNO WORD) (* We've seen all seqno's up to but not including this
one.)
(SPPACCEPTNO WORD) (* The Allocation number we've sent -- I'll accept his
sequence numbers up to and including this.)
(* * Remainder of record contains other interesting state not a part of the packet)
(SPPESTABLISHEDP FLAG) (* True when connection is established.)
(SPPDESTINATIONKNOWN FLAG) (* True if we initiate the connection, or once a
passive connection is established)
(SPPTERMINATEDP FLAG) (* True when \TERMINATESPP wants this one to go away.)
(SPPOUTPUTABORTEDP FLAG) (* Attempt to send output instead invokes the
SPPOUTPUTABORTEDFN -- typically used to handle Bulk
Data abort)
(SPPACKPENDING FLAG) (* True if we have been requested to send an Ack)
(SPPEOMONFORCEOUT FLAG) (* True if we want each FORCEOUTPUT to cause an EOM on
the stream)
(SPPSPAREFLAG FLAG)
(SPPOUTPUTABORTEDFN POINTER)
(SPPINPUTQ POINTER) (* Packets that have arrived wait in this queue.
The packets are in order but some may be missing.)
(SPPRETRANSMITQ POINTER) (* Packets which have been to SENDXIP but have not yet
been acknowledged.)
(SPPRETRANSMITTING POINTER) (* Queue of packets that we get back from the driver
after transmission. These have to be merged into the
retransmit queue.)
(SPPLOCK POINTER) (* Monitor lock for connection.)
(SPPMYNSOCKET POINTER) (* NS socket for sending and receiving XIPs.)
(SPPACKEDSEQNO WORD) (* The most recent Acknowledge number we have received;
i.e. the SEQNO he expects to receive next.)
(SPPOUTPUTALLOCNO WORD) (* The most recent Allocation number we've received.)
(SPPRETRANSMITTIMER POINTER) (* Time at which the next Acknowledgement request or
retransmission should occur.)
(SPPACKREQUESTED POINTER) (* Will be set to a seqno when an ACK request has been
sent but not acknowledged.)
(SPPACKREQTIME POINTER) (* Whenever an ACK request is sent, this is set to the
current time. When a response arrives, the round trip
time is updated.)
(SPPACKREQTIMEOUT POINTER) (* Time at which an ACK request should be considered
hopeless.)
(SPPROUNDTRIPTIME POINTER) (* Estimate of (twice) the round trip delay on this
connection.)
(SPPACTIVITYTIMER POINTER) (* If non-NIL, the time for the next probe to see if
the other end is still there.)
(SPPATTENTIONFN POINTER) (* Fn to call when attention packet is received)
(SPPINPKT POINTER) (* Packet currently being read from, for BIN.)
(SPPOUTPKT POINTER) (* Packet currently being written to, for BOUT.)
(SPPSYSPKT POINTER) (* Cached System packet for probing and answering
Acknowledgement requests.)
(SPPINPUTSTREAM POINTER) (* Stream interface for this connection.)
(SPPSUBSTREAM POINTER) (* Bulk data substream for connection.)
(SPPPROCESS POINTER) (* Process managing this connection.)
(SPPALLOCATIONEVENT POINTER) (* Event which occurs when the allocation increases.)
(SPPINPUTEVENT POINTER) (* Event which occurs when the next data packet
arrives.)
(SPPOUTPUTSTREAM POINTER) (* Stream for output side)
(SPPWHENCLOSEDFN POINTER)
(SPPSTATE POINTER)
(SPPERRORHANDLER POINTER) (* Fn to call when stream is in abnormal input state)
(SPPSPARE POINTER))
[ACCESSFNS SPPCON ([SPPSOURCENSADDRESS (\FETCH.NSADDRESS (LOCF (fetch
SPPSOURCENSADDRESS0
of DATUM]
(SPPDESTNSADDRESS (\FETCH.NSADDRESS (LOCF (fetch SPPDESTNSADDRESS0
of DATUM]
SPPINPUTQ ←(create SYSQUEUE)
SPPRETRANSMITQ ←(ARRAY \SPP.RETRANSMITQ.SIZE (QUOTE POINTER)
NIL 0)
SPPALLOCATIONEVENT ←(CREATE.EVENT "SPP Allocation")
SPPRETRANSMITTIMER ←(SETUPTIMER 0)
SPPERRORHANDLER ←(FUNCTION \SPP.DEFAULT.ERRORHANDLER))
(BLOCKRECORD SPPHEAD ((CC BYTE)
(DSTYPE BYTE)
(SOURCECONID WORD)
(DESTCONID WORD)
(SEQNO WORD)
(ACKNO WORD)
(ALLOCNO WORD)
(FIRSTSPPDATABYTE BYTE)
(NIL BYTE))
(BLOCKRECORD SPPHEAD ((SYSTEMPACKET FLAG)
(* Interpretation of Connection Control bits)
(SENDACK FLAG)
(ATTENTION FLAG)
(ENDOFMESSAGE FLAG)
(NIL BITS 4)
(NIL BYTE)))
(BLOCKRECORD SPPHEAD ((NIL FLAG)
(NIL FLAG)
(EOMBITS BITS 2) (* End of message or Attention)
(NIL BITS 4)
(NIL BYTE)))
[ACCESSFNS SPPHEAD ((SPPCONTENTS (LOCF (fetch (SPPHEAD FIRSTSPPDATABYTE)
of DATUM)))
(EOMP (NEQ 0 (fetch (SPPHEAD EOMBITS) of DATUM])
(ACCESSFNS SPPXIP ((SPPHEAD (fetch XIPCONTENTS of DATUM))))
]
(/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
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)))
(RPAQQ SPPTYPES (\SPPHEAD.CC.SYSTEM \SPPHEAD.CC.ACKNOWLEDGE \SPPHEAD.CC.ATTENTION \SPPHEAD.CC.EOM
\SPPDSTYPE.COURIER \SPPDSTYPE.BULKDATA \SPPDSTYPE.END
\SPPDSTYPE.ENDREPLY))
(DECLARE: EVAL@COMPILE
(RPAQQ \SPPHEAD.CC.SYSTEM 128)
(RPAQQ \SPPHEAD.CC.ACKNOWLEDGE 64)
(RPAQQ \SPPHEAD.CC.ATTENTION 32)
(RPAQQ \SPPHEAD.CC.EOM 16)
(RPAQQ \SPPDSTYPE.COURIER 0)
(RPAQQ \SPPDSTYPE.BULKDATA 1)
(RPAQQ \SPPDSTYPE.END 254)
(RPAQQ \SPPDSTYPE.ENDREPLY 255)
(CONSTANTS \SPPHEAD.CC.SYSTEM \SPPHEAD.CC.ACKNOWLEDGE \SPPHEAD.CC.ATTENTION \SPPHEAD.CC.EOM
\SPPDSTYPE.COURIER \SPPDSTYPE.BULKDATA \SPPDSTYPE.END \SPPDSTYPE.ENDREPLY)
)
(RPAQQ SPPSTATES ((\SPS.INIT 0)
(\SPS.LISTENING 1)
(\SPS.OPEN 2)
(\SPS.ENDSENT 3)
(\SPS.ENDRECEIVED 4)
(\SPS.DALLYING 5)
(\SPS.CLOSED 6)
(\SPS.ABORTED 7)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SPS.INIT 0)
(RPAQQ \SPS.LISTENING 1)
(RPAQQ \SPS.OPEN 2)
(RPAQQ \SPS.ENDSENT 3)
(RPAQQ \SPS.ENDRECEIVED 4)
(RPAQQ \SPS.DALLYING 5)
(RPAQQ \SPS.CLOSED 6)
(RPAQQ \SPS.ABORTED 7)
(CONSTANTS (\SPS.INIT 0)
(\SPS.LISTENING 1)
(\SPS.OPEN 2)
(\SPS.ENDSENT 3)
(\SPS.ENDRECEIVED 4)
(\SPS.DALLYING 5)
(\SPS.CLOSED 6)
(\SPS.ABORTED 7))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \SPPHEAD.LENGTH 12)
(RPAQ \#WDS.SPPINFO (SUB1 (FOLDLO (IPLUS \XIPOVLEN \SPPHEAD.LENGTH)
BYTESPERWORD)))
(RPAQQ \SPP.INITIAL.ALLOCATION 5)
(RPAQQ \SPP.INITIAL.ROUNDTRIP 1000)
(RPAQQ \SPP.RETRANSMITQ.SIZE 8)
(CONSTANTS (\SPPHEAD.LENGTH 12)
(\#WDS.SPPINFO (SUB1 (FOLDLO (IPLUS \XIPOVLEN \SPPHEAD.LENGTH)
BYTESPERWORD)))
(\SPP.INITIAL.ALLOCATION 5)
(\SPP.INITIAL.ROUNDTRIP 1000)
(\SPP.RETRANSMITQ.SIZE 8))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS RETRANSMITINDEX MACRO ((SEQNO)
(IMOD SEQNO \SPP.RETRANSMITQ.SIZE)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS SPP.USER.TIMEOUT SPP.MIN.TIMEOUT)
)
)
(/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
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)))
(RPAQ? SPP.USER.TIMEOUT 15000)
(RPAQ? SPP.MIN.TIMEOUT 50)
(DEFINEQ
(\SPPCONNECTION
(LAMBDA (HOST SKT# NAME NOERRORFLG) (* bvm: " 2-Aug-84 16:47")
(* * 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)
(COND
((NULL HOST) (* If host is NIL, we want to listen on the specified
socket.)
(SETQ NSOC (OPENNSOCKET SKT# NOERRORFLG)))
(T (* User wants to initiate connection to host.)
(\BLT (LOCF (fetch SPPDESTNSADDRESS0 of CON))
(\COERCE.TO.NSADDRESS HOST)
\#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))))
(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)
(replace SPPROUNDTRIPTIME of CON with \SPP.INITIAL.ROUNDTRIP)
(OR NAME (SETQ NAME (COND
(HOST (PACK* "SPP#" (SPP.DESTADDRESS CON)))
(T (QUOTE SPP)))))
(replace SPPPROCESS of CON with (SETQ PROCESS (ADD.PROCESS (BQUOTE (\SPPWATCHER
(QUOTE , CON)))
(QUOTE NAME)
NAME
(QUOTE AFTEREXIT)
(QUOTE DELETE))))
(replace SPPINPUTEVENT of CON with (CREATE.EVENT (SETQ NAME (PROCESSPROP PROCESS
(QUOTE NAME)))))
(replace SPPLOCK of CON with (CREATE.MONITORLOCK NAME))
(RETURN CON))))
(\SPP.SENDPKT
(LAMBDA (CON EPKT RETRANSMITP) (* bvm: " 2-Aug-84 16:03")
(* 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 ((BASE (fetch XIPCONTENTS of EPKT))
SEQNO)
(AND RETRANSMITP (HELP "RETRANSMITP on"))
(replace (SPPHEAD ACKNO) of BASE with (fetch SPPACKNO of CON))
(replace (SPPHEAD ALLOCNO) of BASE with (fetch SPPACCEPTNO of CON))
(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))
(IGREATERP SEQNO (fetch SPPACKREQUESTED of CON)))
(replace SPPACKREQUESTED of CON with SEQNO)
(replace SPPACKREQTIMEOUT of CON with (SETUPTIMER (MAX 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: "24-Jun-84 16:52")
(* 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)))
(ILESSP (fetch (SPPXIP SEQNO) of EPKT)
(fetch SPPACKNO of CON)))
(* This is the packet we've been waiting for.
The ACKNO field has already been incremented in
\SPP.HANDLE.DATA)
(COND
((NOT PEEKFLG)
(\DEQUEUE (fetch SPPINPUTQ of CON))
(add (fetch SPPACCEPTNO of CON)
1)))
(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: " 2-Aug-84 16:05")
(* 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
((ILEQ (fetch SPPSEQNO of CON)
(COND
(IGNOREALLOC (* Can send attention packet regardless of allocation,
but make sure there is room in the retransmit pool)
(IPLUS (fetch SPPACKEDSEQNO of CON)
(SUB1 \SPP.RETRANSMITQ.SIZE)))
(T (* Make sure allocation window open)
(fetch SPPOUTPUTALLOCNO 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 (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: "11-Mar-85 12:20")
(* Called when \SPPWATCHER exits.)
(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: "11-Mar-85 18:24")
(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 until (fetch SPPTERMINATEDP of SPPCON)
do [COND
((AND (fetch SPPACKREQUESTED of SPPCON)
(TIMEREXPIRED? (fetch SPPACKREQTIMEOUT of SPPCON)))
(\SPP.NOT.RESPONDING SPPCON))
(T (SETQ ACTIVITY (\SPP.HANDLE.INPUT SPPCON))
(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)
(ILESSP (fetch SPPACKEDSEQNO of SPPCON)
(fetch SPPSEQNO of SPPCON))
(ILESSP (fetch SPPOUTPUTALLOCNO of SPPCON)
(fetch SPPSEQNO of SPPCON)))
(TIMEREXPIRED? (fetch SPPRETRANSMITTIMER of SPPCON)))
(* We asked for an ack and/or are out of allocation, so
poke again)
(\SPP.PROBE SPPCON))
(T (\SPP.CHECK.FOR.LIFE SPPCON]
(MONITOR.AWAIT.EVENT (fetch SPPLOCK of SPPCON)
SOCEVENT
(fetch SPPRETRANSMITTIMER of SPPCON)
T])
(\SPP.HANDLE.INPUT
[LAMBDA (CON) (* bvm: "13-Mar-85 17:04")
(* 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)
(ILESSP (fetch SPPACKEDSEQNO of CON)
(fetch SPPSEQNO 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))
(GO DROPIT))
(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 (ILESSP (IPLUS PKTSEQNO 3000)
(fetch SPPACKNO of CON))
(IGREATERP PKTSEQNO (IPLUS (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.)
(SETQ ACTIVE? T)
(COND
((NOT (fetch SPPESTABLISHEDP of CON)) (* We're just now establishing the connection.)
(\SPP.ESTABLISH CON XIP)))
(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
((IGREATERP (SETQ ACKED (fetch (SPPHEAD ACKNO) of SPPBASE))
(fetch SPPACKEDSEQNO of CON))
(\SPP.RELEASE.ACKED.PACKETS CON ACKED)))
[COND
([AND (IGREATERP (SETQ NEWALLOCNO (fetch (SPPHEAD ALLOCNO) of SPPBASE))
(fetch SPPOUTPUTALLOCNO of CON))
(OR [ILEQ NEWALLOCNO (SETQ MAXALLOCNO (IPLUS (fetch SPPACKEDSEQNO of CON)
(SUB1 \SPP.RETRANSMITQ.SIZE]
(IGREATERP (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) (* ejs: "29-Dec-84 15:26")
(* 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
((ILESSP XIPNO ACKNO) (* This packet is a duplicate, so drop it.)
(RELEASE.XIP XIP)
(RETURN))
((OR (NULL (SETQ CURRENT (\QUEUEHEAD INQ)))
(IGREATERP XIPNO (fetch (SPPXIP SEQNO) of (fetch SYSQUEUETAIL of INQ))))
(* Goes at tail end of queue.)
(\ENQUEUE INQ XIP))
((ILESSP XIPNO (SETQ PKTNO (fetch (SPPXIP SEQNO) of CURRENT)))
(* 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
((ILESSP XIPNO PKTNO) (* 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))
(ADD1 XIPNO)))
do (SETQ XIPNO PKTNO))
(replace SPPACKNO of CON with (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: " 2-Aug-84 16:33")
(* * 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 (ILESSP OLDACKNO ACKNO)
do (COND
((EQ OLDACKNO MAXACKNO)
(RETURN (HELP "SPP Partner acked a packet I haven't sent yet"))))
(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 (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: "16-OCT-83 21:40")
(* There hasn't been any response to our probes for a
while.)
(COND
((OR (NOT (fetch SPPESTABLISHEDP of CON))
(IGREATERP (fetch SPPROUNDTRIPTIME of CON)
(ITIMES SPP.USER.TIMEOUT 10))) (* 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 (* Warn the user that the other end may have crashed,
but hang in there.)
(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)
(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: " 2-Aug-84 16:12")
(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 (add SEQNO 1)
(fetch SPPSEQNO of CON))
(* Finished)
NIL)
(T SEQNO)))
(\SPP.SENDPKT CON XIP))))
(\SPP.ESTABLISH
(LAMBDA (CON XIP) (* bvm: " 2-Aug-84 16:45")
(* * The arrival of XIP causes this SPP connection to be established. Fix up state as appropriate)
(\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.)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(ACCESSFNS SPPSTREAM ((SPP.CONNECTION (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(BULK.DATA.CONTINUATION (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(SPPEOFBITS (fetch FW8 of DATUM)
(replace FW8 of DATUM with NEWVALUE))
(SPPFILEPTRHI (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE))
(SPPFILEPTRLO (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE)))
[ACCESSFNS SPPSTREAM ([SPPEOFP (SELECTC (fetch SPPEOFBITS of DATUM)
(0 NIL)
(\SPPFLAG.END (QUOTE END))
(\SPPFLAG.ATTENTION (QUOTE ATTENTION))
(\SPPFLAG.EOM (QUOTE EOM))
NIL)
(replace SPPEOFBITS of DATUM
with (SELECTQ NEWVALUE
(NIL 0)
(EOM \SPPFLAG.EOM)
(END \SPPFLAG.END)
(ATTENTION \SPPFLAG.ATTENTION)
(\ILLEGAL.ARG NEWVALUE]
(SPPFILEPTR (\MAKENUMBER (fetch SPPFILEPTRHI of DATUM)
(fetch SPPFILEPTRLO of DATUM])
]
(DECLARE: EVAL@COMPILE
(PUTPROPS GETSPPCON MACRO ((X)
(fetch SPP.CONNECTION of X)))
(PUTPROPS \FETCH.NSADDRESS MACRO ((BASE)
(PROG ((ADDRESS (create NSADDRESS)))
(\BLT ADDRESS BASE \#WDS.NSADDRESS)
(RETURN ADDRESS))))
(PUTPROPS \SPPINCFILEPTR MACRO [OPENLAMBDA (STREAM NBYTES)
(COND
((ILESSP (replace SPPFILEPTRLO of STREAM
with (\LOLOC (\ADDBASE (fetch SPPFILEPTRLO
of STREAM)
NBYTES)))
NBYTES)
(add (fetch SPPFILEPTRHI of STREAM)
1])
(PUTPROPS GETWORD MACRO (= . \WIN))
(PUTPROPS PUTWORD MACRO (= . \WOUT))
(PUTPROPS GETLONG MACRO (OPENLAMBDA (STREAM)
(\MAKENUMBER (\WIN STREAM)
(\WIN STREAM))))
(PUTPROPS PUTLONG MACRO [OPENLAMBDA (STREAM FIXP)
(PROGN (\WOUT STREAM (\HINUM FIXP))
(\WOUT STREAM (LOGAND FIXP 65535])
(PUTPROPS SPP.INPUT.ERROR MACRO (OPENLAMBDA (STREAM ERRCODE)
(SPREADAPPLY* (fetch SPPERRORHANDLER of (GETSPPCON STREAM)
)
STREAM ERRCODE)))
)
(RPAQQ SPPEOFFLAGS ((\SPPFLAG.EOM 1)
(\SPPFLAG.END 2)
(\SPPFLAG.ATTENTION 3)))
(DECLARE: EVAL@COMPILE
(RPAQQ \SPPFLAG.EOM 1)
(RPAQQ \SPPFLAG.END 2)
(RPAQQ \SPPFLAG.ATTENTION 3)
(CONSTANTS (\SPPFLAG.EOM 1)
(\SPPFLAG.END 2)
(\SPPFLAG.ATTENTION 3))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \SPPDEVICE \SPP.BULKDATA.DEVICE)
)
)
(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: "24-Sep-84 17:40")
(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)
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) (* bvm: "11-Mar-85 18:25")
(PROG ((CON (\SPPCONNECTION HOST SOCKET NAME)))
(RETURN (WITH.MONITOR (fetch SPPLOCK of CON)
(PROG (INSTREAM OUTSTREAM)
(RETURN (COND
((COND
((OR (fetch SPPESTABLISHEDP of CON)
(NOT PROBEP))
T)
(T (\SPP.PROBE CON)
(MONITOR.AWAIT.EVENT (fetch SPPLOCK
of CON)
(fetch SPPINPUTEVENT
of CON)
SPP.USER.TIMEOUT)
(fetch SPPESTABLISHEDP of CON)))
[replace SPPINPUTSTREAM of CON
with (SETQ INSTREAM (\SPP.CREATE.STREAM
(QUOTE INPUT]
(replace SPP.CONNECTION of INSTREAM with CON)
(replace STRMBOUTFN of INSTREAM
with (FUNCTION \SPP.OTHER.BOUT))
[replace SPPOUTPUTSTREAM of CON
with (SETQ OUTSTREAM (\SPP.CREATE.STREAM
(QUOTE OUTPUT]
(replace SPP.CONNECTION of OUTSTREAM with CON)
(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)))
NIL))
(push (fetch DEVICEINFO of \SPPDEVICE)
INSTREAM)
INSTREAM])
(\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: "10-Mar-85 13:30")
(PROG (BYTESLEFT CONDITION)
LP [COND
((SETQ CONDITION (\SPP.PREPARE.INPUT STREAM))
(COND
((NEQ (SETQ CONDITION (SPP.INPUT.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: "20-Jun-84 12:25")
(* BOUT function for the input side of an SPP
connection, in case someone doesn't want to bother with
SPPOUTPUTSTREAM)
(\BOUT (OR (SPPOUTPUTSTREAM STREAM)
(ERROR "Stream lost" STREAM))
BYTE])
(\SPP.GETNEXTBUFFER
(LAMBDA (STREAM WHATFOR NOERRORFLG) (* ejs: "27-Jan-85 13:45")
(* * 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.INPUT.ERROR STREAM ERRCODE))))
(WRITE (SETQ CON (GETSPPCON STREAM))
(COND
((\SPP.PREPARE.OUTPUT (if (EQ STREAM (fetch SPPINPUTSTREAM
of CON))
then (ffetch SPPOUTPUTSTREAM
of CON)
else 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: "24-Sep-84 17:36")
(ERROR "Connection lost" (OR (fetch FULLFILENAME of STREAM)
STREAM])
(\SPP.DEFAULT.ERRORHANDLER
[LAMBDA (STREAM CONDITION) (* bvm: " 9-Mar-85 16:10")
(SELECTQ CONDITION
(STREAM.LOST (\SPP.STREAM.LOST STREAM))
(\EOF.ACTION STREAM])
(\SPP.PREPARE.INPUT
[LAMBDA (STREAM TIMEOUT) (* bvm: " 9-Mar-85 16:20")
(* * 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)
(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 (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))
(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) (* bvm: "10-Mar-85 13:31")
(* 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))
(T (fetch (SPPXIP DSTYPE) of (OR (fetch SPPINPKT of CON)
(COND
((AND (SETQ CONDITION (\SPP.PREPARE.INPUT
STREAM))
(NEQ (SETQ CONDITION
(SPP.INPUT.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: "25-Sep-84 13:03")
(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)
(if (NOT (fetch SPPESTABLISHEDP of CON))
then (printout FILE " [not established]")
else (printout FILE "DS Type = " (SELECTC (fetch SPPDSTYPE of CON)
(\SPPDSTYPE.COURIER "courier")
(\SPPDSTYPE.BULKDATA "bulkdata")
(fetch SPPDSTYPE of CON))))
(if (fetch SPPTERMINATEDP of CON)
then (printout FILE " [terminated]"))
(if (fetch SPPACKREQUESTED of CON)
then (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: " (ADD1 (IDIFFERENCE (fetch SPPACCEPTNO of CON)
(fetch SPPACKNO of CON)))
T)
(PPSPPSTREAM (fetch SPPINPUTSTREAM of CON)
FILE)
(if (NEQ (SETQ N (IPLUS (if (fetch SPPINPKT of CON)
then 1
else 0)
(\QUEUELENGTH (fetch SPPINPUTQ of CON))))
0)
then (printout FILE " Packets in queue: " N T))
(printout FILE T "Output:" T " Seq# " (fetch SPPSEQNO of CON))
(if (EQ (fetch SPPSEQNO of CON)
(fetch SPPACKEDSEQNO of CON))
then (printout FILE ", all acked")
else (printout FILE ", acked# " (fetch SPPACKEDSEQNO of CON)))
(printout FILE T " Allocation: " (ADD1 (IDIFFERENCE (fetch SPPOUTPUTALLOCNO of CON)
(fetch SPPSEQNO of CON)))
T)
(PPSPPSTREAM (fetch SPPOUTPUTSTREAM of CON)
FILE)
(if DETAILS
then (printout FILE " Awaiting ack: " # (for I from (fetch SPPACKEDSEQNO of CON)
to (fetch SPPSEQNO of CON)
do (PRINTSPP (ELT (fetch SPPRETRANSMITQ
of CON)
(RETRANSMITINDEX I))))
T))
(if (SETQ STR (fetch SPPSUBSTREAM of CON))
then (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: "10-Jun-84 16:23")
(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
((ILESSP N2 N1)
(SHOULDNT "The input queue is out of order.")
(RETURN NIL)))
(SETQ CURRENT NEXT)
(GO L))))
(PRINTSPP
[LAMBDA (EPKT FILE) (* bvm: "24-Jun-84 16:01")
(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 "]"]
[COND
((NOT SYSTEMP) (* Datastream type significant only in data packets)
(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])
(SPP.DRIBBLE
[LAMBDA (FORM FILE) (* ecc "15-AUG-83 17:00")
(if (NULL FILE)
then (SETQ FILE (QUOTE {DSK}SPP.Transcript)))
(RESETLST (RESETSAVE XIPTRACEFILE (OPENFILE FILE (QUOTE OUTPUT)))
(RESETSAVE XIPONLYTYPES (CONSTANT (LIST \XIPT.SPP \XIPT.ERROR)))
(RESETSAVE XIPTRACEFLG T)
(RESETSAVE NIL (LIST (FUNCTION CLOSEF?)
XIPTRACEFILE))
(PRINT FORM XIPTRACEFILE)
(TERPRI XIPTRACEFILE)
(EVAL FORM])
)
(RPAQ? PRINTSPPDATAFLG )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PRINTSPPDATAFLG)
)
(PUTPROPS SPP COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (13868 28033 (\SPPCONNECTION 13878 . 16443) (\SPP.SENDPKT 16445 . 18872) (\FILLINSPP
18874 . 19547) (\SPP.SYSPKT 19549 . 20453) (\GETSPP 20455 . 21829) (\SENDSPP 21831 . 24433) (
\SPP.SEND.ENDREPLY 24435 . 24718) (\TERMINATESPP 24720 . 26390) (\SPP.CLEANUP 26392 . 28031)) (28034
47295 (\SPPWATCHER 28044 . 29998) (\SPP.HANDLE.INPUT 30000 . 36444) (\SPP.HANDLE.DATA 36446 . 40092) (
\SPP.HANDLE.ATTN 40094 . 41116) (\SPP.RELEASE.ACKED.PACKETS 41118 . 42295) (\SPP.NOT.RESPONDING 42297
. 43616) (\SPP.CHECK.FOR.LIFE 43618 . 44352) (\SPP.PROBE 44354 . 44689) (\SPP.RETRANSMIT.NEXT 44691
. 45594) (\SPP.ESTABLISH 45596 . 46538) (\SPPGETERROR 46540 . 46941) (\SPPSENDERROR 46943 . 47293)) (
50181 71425 (\INITSPP 50191 . 50835) (\SPP.EVENTFN 50837 . 51183) (\CREATE.SPP.DEVICE 51185 . 51975) (
SPP.OPEN 51977 . 53863) (\SPP.CREATE.STREAM 53865 . 54051) (SPP.DESTADDRESS 54053 . 54436) (
SPPOUTPUTSTREAM 54438 . 54678) (SPP.OPENP 54680 . 54940) (\STREAM.FROM.PACKET 54942 . 55712) (
SPP.FORCEOUTPUT 55714 . 56887) (SPP.FLUSH.TO.EOF 56889 . 57479) (SPP.SENDEOM 57481 . 58114) (
SPP.CLEAREOM 58116 . 58596) (SPP.SENDATTENTION 58598 . 59273) (SPP.CLEARATTENTION 59275 . 59872) (
SPP.CLOSE 59874 . 60814) (\SPP.CLOSE.IF.ERROR 60816 . 60986) (\SPP.RESETCLOSE 60988 . 61242) (
SPP.BACKFILEPTR 61244 . 61482) (\SPP.GETFILEPTR 61484 . 61687) (\SPP.SETFILEPTR 61689 . 62262) (
\SPP.SKIPBYTES 62264 . 63011) (\SPP.BOUTS 63013 . 63467) (\SPP.OTHER.BOUT 63469 . 63892) (
\SPP.GETNEXTBUFFER 63894 . 64986) (\SPP.STREAM.LOST 64988 . 65195) (\SPP.DEFAULT.ERRORHANDLER 65197 .
65428) (\SPP.PREPARE.INPUT 65430 . 68572) (\SPP.PREPARE.OUTPUT 68574 . 69368) (SPP.DSTYPE 69370 .
70370) (SPP.READP 70372 . 70742) (SPP.EOFP 70744 . 71423)) (71539 79206 (PPSPP 71549 . 74346) (
\SPP.INFO.HOOK 74348 . 75161) (PPSPPSTREAM 75163 . 75483) (\SPP.CHECK.INPUT.QUEUE 75485 . 76657) (
PRINTSPP 76659 . 78694) (SPP.DRIBBLE 78696 . 79204)))))
STOP