(FILECREATED " 8-Sep-85 14:38:28" {ERIS}<LISPCORE>SOURCES>SPP.;26 89202 changes to: (FNS \SPP.HANDLE.INPUT SPP.OPEN) previous date: " 5-Sep-85 17:50:40" {ERIS}<LISPCORE>SOURCES>SPP.;24) (* 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.DUPLICATE.REQUEST \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) (SPPSERVERFLAG 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) (SPPSERVERFN POINTER) (SPPOTHERXIPHANDLER 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) (SPPSERVERFLAG FLAG) (* True if connection was opened as a server) (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) (SPPSERVERFN POINTER) (* Function to use as toplevel function for connections opened as servers) (SPPOTHERXIPHANDLER POINTER) (* Function to call when non-SPP, non-ERROR XIP received on socket) (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 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)) (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))) (QUOTE 78)) (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 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)) (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))) (QUOTE 78)) (RPAQ? SPP.USER.TIMEOUT 15000) (RPAQ? SPP.MIN.TIMEOUT 50) (DEFINEQ (\SPPCONNECTION (LAMBDA (HOST SKT# NAME NOERRORFLG) (* ejs: " 5-Sep-85 17:40") (* * 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) (replace SPPROUNDTRIPTIME of CON with \SPP.INITIAL.ROUNDTRIP) (OR NAME (SETQ NAME (COND (HOST (PACK* "SPP#" (SPP.DESTADDRESS CON))) (T (QUOTE SPPSERVER))))) (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: "16-Apr-85 13: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 ((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 (IGREATERP 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)) (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: "16-Apr-85 13:10") (* 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) (UNINTERRUPTABLY (\DEQUEUE (fetch SPPINPUTQ of CON)) (add (fetch SPPACCEPTNO of CON) 1)) (COND ((AND (fetch SPPINPUTBLOCKED of CON) (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: " 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) (* ejs: " 8-Sep-85 14:37") (* 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)) (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 (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.) (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 ((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.DUPLICATE.REQUEST (LAMBDA (XIP) (* ejs: "23-Jul-85 13:21") (* * Return T if the incoming XIP is a connection request for a connection we've already established) (bind CONNECTION for INSTREAM in (fetch DEVICEINFO of \SPPDEVICE) thereis (SETQ CONNECTION (fetch (SPPSTREAM SPP.CONNECTION) of INSTREAM)) (AND (EQ (fetch (SPPXIP SOURCECONID) of XIP) (fetch (SPPCON SPPDESTID) of CONNECTION)))))) (\SPP.ESTABLISH (LAMBDA (CON XIP) (* ejs: "29-Aug-85 22:07") (* * The arrival of XIP causes this SPP connection to be established. Fix up state as appropriate) (LET (SPAWNEDSOC SPAWNEDNAME INSTREAM OUTSTREAM) (COND ((AND (fetch SPPSERVERFLAG of CON) (NOT (\SPP.DUPLICATE.REQUEST XIP))) (* * The connection was opened in server mode. Create a new spp connection, and establish it to the remote side, spawning a new process) (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) (* The other end may have switched from a well-known socket to a private one.) (SETQ SPAWNEDSOC (OPENNSOCKET)) (SETQ SPAWNEDNAME (PACK* "SPP#" (SPP.DESTADDRESS CON))) (replace SPPMYNSOCKET of CON with SPAWNEDSOC) (replace SPPSOURCESKT# of CON with (NSOCKETNUMBER SPAWNEDSOC)) (replace SPPINPUTEVENT of CON with (CREATE.EVENT SPAWNEDNAME)) (replace SPPLOCK of CON with (CREATE.MONITORLOCK SPAWNEDNAME)) (replace SPPPROCESS of CON with (ADD.PROCESS (BQUOTE (\SPPWATCHER (QUOTE , CON))) (QUOTE NAME) SPAWNEDNAME (QUOTE AFTEREXIT) (QUOTE DELETE))) (replace SPPACKREQTIME of CON with (SETUPTIMER 0)) (replace SPPACKREQTIMEOUT of CON with (SETUPTIMER SPP.USER.TIMEOUT)) (replace SPPACKREQUESTED of CON with 0) (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) (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) (push (fetch DEVICEINFO of \SPPDEVICE) INSTREAM) (ADD.PROCESS (LIST (fetch SPPSERVERFN of CON) INSTREAM OUTSTREAM) (QUOTE AFTEREXIT) (QUOTE DELETE)) (NOTIFY.EVENT (fetch SPPINPUTEVENT of CON))) (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.) (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: " 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: " 8-Sep-85 13:47") (LET ((CON (\SPPCONNECTION HOST SOCKET NAME))) (WITH.MONITOR (fetch SPPLOCK of CON) (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (SPPCON) (LET ((NSOC (fetch (SPPCON SPPMYNSOCKET) of SPPCON))) (COND ((AND RESETSTATE (TYPENAMEP NSOC (QUOTE NSOCKET) )) (CLOSENSOCKET NSOC)))))) CON)) (PROG (INSTREAM OUTSTREAM SERVERFN) (RETURN (COND ((COND ((NULL HOST) (* Server connection) (COND ((SETQ SERVERFN (LISTGET PROPS (QUOTE SERVER.FUNCTION))) (COND ((NOT (FNTYP SERVERFN)) (ERROR SERVERFN "is not a function"))) (replace SPPSERVERFLAG of CON with T) (replace SPPSERVERFN of CON with SERVERFN) T) (T (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) (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))) (OTHERXIPHANDLER (COND ((FNTYP (CADR TAIL)) (replace SPPOTHERXIPHANDLER 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 (17759 32777 (\SPPCONNECTION 17769 . 20425) (\SPP.SENDPKT 20427 . 23140) (\FILLINSPP 23142 . 23815) (\SPP.SYSPKT 23817 . 24721) (\GETSPP 24723 . 26573) (\SENDSPP 26575 . 29177) ( \SPP.SEND.ENDREPLY 29179 . 29462) (\TERMINATESPP 29464 . 31134) (\SPP.CLEANUP 31136 . 32775)) (32778 55787 (\SPPWATCHER 32788 . 34742) (\SPP.HANDLE.INPUT 34744 . 41537) (\SPP.HANDLE.DATA 41539 . 45185) ( \SPP.HANDLE.ATTN 45187 . 46209) (\SPP.RELEASE.ACKED.PACKETS 46211 . 47388) (\SPP.NOT.RESPONDING 47390 . 48709) (\SPP.CHECK.FOR.LIFE 48711 . 49445) (\SPP.PROBE 49447 . 49782) (\SPP.RETRANSMIT.NEXT 49784 . 50687) (\SPP.DUPLICATE.REQUEST 50689 . 51239) (\SPP.ESTABLISH 51241 . 55030) (\SPPGETERROR 55032 . 55433) (\SPPSENDERROR 55435 . 55785)) (58536 81241 (\INITSPP 58546 . 59190) (\SPP.EVENTFN 59192 . 59538) (\CREATE.SPP.DEVICE 59540 . 60367) (SPP.OPEN 60369 . 63679) (\SPP.CREATE.STREAM 63681 . 63867) (SPP.DESTADDRESS 63869 . 64252) (SPPOUTPUTSTREAM 64254 . 64494) (SPP.OPENP 64496 . 64756) ( \STREAM.FROM.PACKET 64758 . 65528) (SPP.FORCEOUTPUT 65530 . 66703) (SPP.FLUSH.TO.EOF 66705 . 67295) ( SPP.SENDEOM 67297 . 67930) (SPP.CLEAREOM 67932 . 68412) (SPP.SENDATTENTION 68414 . 69089) ( SPP.CLEARATTENTION 69091 . 69688) (SPP.CLOSE 69690 . 70630) (\SPP.CLOSE.IF.ERROR 70632 . 70802) ( \SPP.RESETCLOSE 70804 . 71058) (SPP.BACKFILEPTR 71060 . 71298) (\SPP.GETFILEPTR 71300 . 71503) ( \SPP.SETFILEPTR 71505 . 72078) (\SPP.SKIPBYTES 72080 . 72827) (\SPP.BOUTS 72829 . 73283) ( \SPP.OTHER.BOUT 73285 . 73708) (\SPP.GETNEXTBUFFER 73710 . 74802) (\SPP.STREAM.LOST 74804 . 75011) ( \SPP.DEFAULT.ERRORHANDLER 75013 . 75244) (\SPP.PREPARE.INPUT 75246 . 78388) (\SPP.PREPARE.OUTPUT 78390 . 79184) (SPP.DSTYPE 79186 . 80186) (SPP.READP 80188 . 80558) (SPP.EOFP 80560 . 81239)) (81355 89022 (PPSPP 81365 . 84162) (\SPP.INFO.HOOK 84164 . 84977) (PPSPPSTREAM 84979 . 85299) ( \SPP.CHECK.INPUT.QUEUE 85301 . 86473) (PRINTSPP 86475 . 88510) (SPP.DRIBBLE 88512 . 89020))))) STOP