(FILECREATED " 9-Mar-85 18:23:42" {SAFE}</C/SCHOEN/TCP>TCP.;3 104218
changes to: (FNS \TCP.GET.SEGMENT)
previous date: " 9-Mar-85 16:14:54" {SAFE}</C/SCHOEN/TCP>TCP.;2)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT TCPCOMS)
(RPAQQ TCPCOMS ((COMS (* Transmission Control Protocol. RFC 793, September 1981))
(COMS (DECLARE: EVAL@LOAD (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
LLIP))
(GLOBALVARS \TCP.LOCK \TCP.CONTROL.BLOCKS \TCP.CHECKSUMS.ON \TCP.PSEUDOHEADER \TCP.MSL
\TCP.DEFAULT.USER.TIMEOUT \TCP.DEFAULT.RECEIVE.WINDOW \TCP.DEVICE
\TCP.MASTER.SOCKET))
(COMS (* DoD Internet addresses)
(FNS SET.IP.ADDRESS STRING.TO.IP.ADDRESS IP.ADDRESS.TO.STRING \LOCAL.IP.ADDRESS))
(COMS (* TCP segments)
(DECLARE: EVAL@COMPILE DONTCOPY (* control bits for TCP.CTRL field of TCP header)
(CONSTANTS \TCP.CTRL.ACK \TCP.CTRL.FIN \TCP.CTRL.PSH \TCP.CTRL.RST
\TCP.CTRL.SYN \TCP.CTRL.URG)
(* option definitions)
(CONSTANTS \TCPOPT.END \TCPOPT.NOP \TCPOPT.MAXSEG)
(* TCP protocol number for IP level dispatch)
(CONSTANTS \TCP.PROTOCOL)
(* TCP header length in bytes (= 4 * min data offset))
(CONSTANTS \TCP.HEADER.LENGTH)
(* minimum offset of data from segment in 32-bit words
(= header length / 4))
(CONSTANTS \TCP.MIN.DATA.OFFSET)
(* default maximum segment size)
(CONSTANTS \TCP.DEFAULT.MAXSEG)
(* TCP segment)
(RECORDS TCPSEGMENT)))
(COMS (* TCP sequence numbers)
(DECLARE: EVAL@COMPILE DONTCOPY (* macros for comparing TCP sequence numbers)
(MACROS \32BIT.EQ \32BIT.LT \32BIT.LEQ \32BIT.GT \32BIT.GEQ)
(* fast multiply by 3 -- evaluates its argument twice)
(MACROS \3TIMES))
(FNS \TCP.SELECT.ISS))
(COMS (* TCP control blocks)
(DECLARE: EVAL@COMPILE DONTCOPY (* TCP control block)
(RECORDS TCP.CONTROL.BLOCK)
(* TCP stream)
(RECORDS TCPSTREAM))
(INITRECORDS TCP.CONTROL.BLOCK TCPSTREAM)
(* global lock for TCP-related mutual exclusion)
(INITVARS (\TCP.LOCK (CREATE.MONITORLOCK)))
(* list of TCP control blocks for connection lookup)
(INITVARS (\TCP.CONTROL.BLOCKS NIL))
(FNS \TCP.CREATE.TCB \TCP.SELECT.PORT \TCP.LOOKUP.TCB \TCP.DELETE.TCB \TCP.PORTCOMPARE))
(COMS (* TCP checksums)
(DECLARE: EVAL@COMPILE DONTCOPY (* pseudo-header for checksum calculation)
(RECORDS TCP.PSEUDOHEADER)
(CONSTANTS \TCP.PSEUDOHEADER.LENGTH)
(MACROS \16BIT.COMPLEMENT \16BIT.1C.PLUS))
(INITRECORDS TCP.PSEUDOHEADER)
(INITVARS (\TCP.PSEUDOHEADER NIL))
(* this variable controls whether checksums are performed on incoming segments)
(INITVARS (\TCP.CHECKSUMS.ON NIL))
(* checksum routines)
(FNS \COMPUTE.CHECKSUM \TCP.CHECKSUM.INCOMING \TCP.CHECKSUM.OUTGOING))
(COMS (DECLARE: EVAL@COMPILE DONTCOPY (* constants for retransmission timeout calculation)
(* initial retransmission timeout)
(CONSTANTS \TCP.INITIAL.RTO)
(* upper and lower bounds on retransmission timeout)
(CONSTANTS \TCP.UBOUND \TCP.LBOUND))
(* maximum segment lifetime)
(INITVARS (\TCP.MSL 5000))
(INITVARS (\TCP.DEFAULT.USER.TIMEOUT 60000)
(\TCP.DEFAULT.RECEIVE.WINDOW 2000)
(\TCP.DEVICE NIL))
(* TCP protocol routines)
(FNS \TCP.PACKET.FILTER \TCP.SETUP.SEGMENT \TCP.RELEASE.SEGMENT \TCP.CONNECTION
\TCP.FIX.INCOMING.SEGMENT \TCP.DATA.LENGTH \TCP.SYN.OR.FIN \TCP.INPUT
\TCP.INPUT.INITIAL \TCP.INPUT.UNSYNC \TCP.INPUT.LISTEN \TCP.INPUT.SYN.SENT
\TCP.CHECK.WINDOW \TCP.CHECK.RESET \TCP.CHECK.SECURITY \TCP.CHECK.NO.SYN
\TCP.CHECK.ACK \TCP.HANDLE.ACK \TCP.HANDLE.URG \TCP.QUEUE.INPUT \TCP.HANDLE.FIN
\TCP.OUR.FIN.IS.ACKED \TCP.SIGNAL.URGENT.DATA \TCP.PROCESS \TCP.TEMPLATE
\TCP.SEND.CONTROL \TCP.SEND.ACK \TCP.SEND.RESET \TCP.FIX.OUTGOING.SEGMENT
\TCP.SEND.DATA \TCP.SEND.SEGMENT \TCP.NEW.TEMPLATE \TCP.START.PROBE.TIMER
\TCP.RETRANSMIT \TCP.START.TIME.WAIT \TCP.CONNECTION.DROPPED))
(COMS (* support for ICMP messages that affect TCP connections)
(DECLARE: EVAL@COMPILE DONTCOPY (* ICMP protocol number for IP level dispatch)
(CONSTANTS \ICMP.PROTOCOL)
(* number of 32 bit words in ICMP message before start of original datagram)
(CONSTANTS \ICMP.32BIT.WORDS)
(* relevant ICMP message types)
(CONSTANTS \ICMP.DESTINATION.UNREACHABLE \ICMP.SOURCE.QUENCH))
(FNS \TCP.HANDLE.ICMP))
(COMS (* TCP stream routines)
(FNS TCP.OPEN TCP.OTHER.STREAM \TCP.BIN \TCP.BACKFILEPTR \TCP.GETNEXTBUFFER
\TCP.GET.SEGMENT \TCP.PEEKBIN \TCP.GETFILEPTR \TCP.READP \TCP.EOFP TCP.URGENTP
TCP.URGENT.EVENT \TCP.BOUT \TCP.FLUSH \TCP.FORCEOUTPUT TCP.URGENT.MARK
\TCP.FILL.IN.SEGMENT \TCP.CLOSE TCP.CLOSE.SENDER TCP.STOP))
(COMS (* well-known ports for network standard functions)
(CONSTANTS * \TCP.ASSIGNED.PORTS))
(COMS (* Stub for debugging)
(INITVARS (\TCP.DEBUGGABLE))
(GLOBALVARS \TCP.DEBUGGABLE)
(FNS PPTCB \TCP.TRACE.SEGMENT \TCP.TRACE.TRANSITION))
(COMS (* TCP initialization)
(FNS \TCP.INIT)
(P (\TCP.INIT)))
(ADVISE GETOSTYPE)))
(* Transmission Control Protocol. RFC 793, September 1981)
(DECLARE: EVAL@LOAD
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
LLIP)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TCP.LOCK \TCP.CONTROL.BLOCKS \TCP.CHECKSUMS.ON \TCP.PSEUDOHEADER \TCP.MSL
\TCP.DEFAULT.USER.TIMEOUT \TCP.DEFAULT.RECEIVE.WINDOW \TCP.DEVICE \TCP.MASTER.SOCKET)
)
(* DoD Internet addresses)
(DEFINEQ
(SET.IP.ADDRESS
(LAMBDA NIL (* ejs: "28-Dec-84 18:45")
(* set local IP address manually)
(PROG ((ADDR (\IP.READ.STRING.ADDRESS (PROMPTFORWORD "Enter IP address:"
(\IP.ADDRESS.TO.STRING (OR (CAR
\IP.LOCAL.ADDRESSES)
0))))))
(SETQ \IP.LOCAL.ADDRESSES (LIST ADDR)))))
(STRING.TO.IP.ADDRESS
(LAMBDA (STR) (* ecc "14-May-84 15:01")
(APPLY (FUNCTION IP\Make\Address)
(to 4 bind (I ← 0)
OFFSET
collect (SETQ OFFSET (ADD1 I))
(MKATOM (SUBSTRING STR OFFSET (AND (SETQ I (STRPOS "." STR OFFSET))
(SUB1 I))))))))
(IP.ADDRESS.TO.STRING
(LAMBDA (IPADDR) (* ecc "14-May-84 14:32")
(PROG ((A (LOADBYTE IPADDR 24 8))
(B (LOADBYTE IPADDR 16 8))
(C (LOADBYTE IPADDR 8 8))
(D (LOADBYTE IPADDR 0 8)))
(RETURN (CONCAT A "." B "." C "." D)))))
(\LOCAL.IP.ADDRESS
(LAMBDA NIL (* ejs: "28-Dec-84 18:45")
(* return our IP address (or the first if we're
multi-homed))
(if (NULL \IP.LOCAL.ADDRESSES)
then (ERROR "You must set \IP.LOCAL.ADDRESSES to a list of our local IP addresses"))
(CAR \IP.LOCAL.ADDRESSES)))
)
(* TCP segments)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.CTRL.ACK 16)
(RPAQQ \TCP.CTRL.FIN 1)
(RPAQQ \TCP.CTRL.PSH 8)
(RPAQQ \TCP.CTRL.RST 4)
(RPAQQ \TCP.CTRL.SYN 2)
(RPAQQ \TCP.CTRL.URG 32)
(CONSTANTS \TCP.CTRL.ACK \TCP.CTRL.FIN \TCP.CTRL.PSH \TCP.CTRL.RST \TCP.CTRL.SYN \TCP.CTRL.URG)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCPOPT.END 0)
(RPAQQ \TCPOPT.NOP 1)
(RPAQQ \TCPOPT.MAXSEG 2)
(CONSTANTS \TCPOPT.END \TCPOPT.NOP \TCPOPT.MAXSEG)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.PROTOCOL 6)
(CONSTANTS \TCP.PROTOCOL)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.HEADER.LENGTH 20)
(CONSTANTS \TCP.HEADER.LENGTH)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.MIN.DATA.OFFSET 5)
(CONSTANTS \TCP.MIN.DATA.OFFSET)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.DEFAULT.MAXSEG 536)
(CONSTANTS \TCP.DEFAULT.MAXSEG)
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS TCPSEGMENT ((TCPHEADER (\IPDATABASE DATUM)))
(BLOCKRECORD TCPHEADER ((TCP.SRC.PORT WORD)
(TCP.DST.PORT WORD)
(TCP.SEQ FIXP)
(TCP.ACK FIXP)
(TCP.DATA.OFFSET BITS 4)
(NIL BITS 6)
(TCP.CTRL BITS 6)
(TCP.WINDOW WORD)
(TCP.CHECKSUM WORD)
(TCP.URG.PTR WORD)))
(ACCESSFNS TCPSEGMENT ((TCP.DATA.LENGTH (fetch (IP IPHEADERCHECKSUM)
of DATUM)
(replace (IP IPHEADERCHECKSUM)
of DATUM with NEWVALUE))
(TCP.SRC.ADDR (fetch (IP IPSOURCEADDRESS) of DATUM)
(replace (IP IPSOURCEADDRESS) of DATUM with NEWVALUE))
(TCP.DST.ADDR (fetch (IP IPDESTINATIONADDRESS) of DATUM)
(replace (IP IPDESTINATIONADDRESS) of DATUM
with NEWVALUE))
(TCP.HEADER.LENGTH (LLSH (fetch TCP.DATA.OFFSET of DATUM)
2))
(TCP.CONTENTS (\ADDBASE (fetch TCPHEADER of DATUM)
(UNFOLD (fetch TCP.DATA.OFFSET
of DATUM)
BYTESPERWORD))))))
]
)
(* TCP sequence numbers)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \32BIT.EQ MACRO ((A B)
(IEQP A B)))
(PUTPROPS \32BIT.LT MACRO ((A B)
(ILESSP (IDIFFERENCE A B)
0)))
(PUTPROPS \32BIT.LEQ MACRO ((A B)
(ILEQ (IDIFFERENCE A B)
0)))
(PUTPROPS \32BIT.GT MACRO ((A B)
(IGREATERP (IDIFFERENCE A B)
0)))
(PUTPROPS \32BIT.GEQ MACRO ((A B)
(IGEQ (IDIFFERENCE A B)
0)))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \3TIMES MACRO ((N)
(IPLUS (LLSH N 1)
N)))
)
)
(DEFINEQ
(\TCP.SELECT.ISS
(LAMBDA NIL (* ecc "16-May-84 11:40")
(* select an initial send sequence number -- use the
time of day to make sure we won't repeat after a crash)
(LOGAND (DAYTIME)
65535)))
)
(* TCP control blocks)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE TCP.CONTROL.BLOCK ((TCB.LOCK POINTER) (* monitor lock for synchronizing access)
(TCB.STATE POINTER) (* one of CLOSED LISTEN SYN.SENT SYN.RECEIVED
ESTABLISHED FIN.WAIT.1 FIN.WAIT.2 CLOSE.WAIT CLOSING
LAST.ACK TIME.WAIT)
(TCB.SND.STREAM POINTER) (* user's send stream)
(TCB.SND.SEGMENT POINTER) (* current output packet being filled)
(TCB.RCV.STREAM POINTER) (* user's receive stream)
(TCB.RCV.SEGMENT POINTER) (* current input packet being read)
(TCB.2MSL.TIMER POINTER) (* 2*MSL quiet time)
(TCB.MAXSEG POINTER) (* maximum segment size)
(TCB.CLOSEDFLG POINTER) (* T if user has initiated close
(no more data to send))
(TCB.FINSEQ POINTER) (* one past the sequence number of the FIN we sent)
(TCB.ACKFLG POINTER) (* when to ACK peer: NOW or LATER)
(TCB.TEMPLATE POINTER) (* TCP header template)
(TCB.PH POINTER) (* TCP pseudo-header for checksumming)
(TCB.SRC.PORT WORD) (* local port)
(TCB.DST.PORT WORD) (* remote port)
(TCB.DST.HOST FIXP) (* remote host address)
(TCB.INPUT.QUEUE POINTER) (* queue of received segments to be read)
(TCB.REXMT.QUEUE POINTER) (* queue of unacked segments to be retransmitted)
(TCB.SND.UNA FIXP) (* first unacknowledged sequence number)
(TCB.SND.NXT FIXP) (* next sequence number to be sent)
(TCB.SND.UP FIXP) (* send urgent pointer)
(TCB.SND.WL1 FIXP) (* segment sequence number used for last window update)
(TCB.SND.WL2 FIXP) (* segment acknowledgment number used for last window
update)
(TCB.ISS FIXP) (* initial send sequence number)
(TCB.SND.WND WORD) (* send window)
(TCB.RCV.WND WORD) (* receive window)
(TCB.RCV.NXT FIXP) (* next sequence number expected)
(TCB.RCV.UP FIXP) (* receive urgent pointer)
(TCB.IRS FIXP) (* initial receive sequence number)
(TCB.USER.TIMEOUT POINTER) (* in milliseconds)
(TCB.ESTABLISHED POINTER) (* processes waiting for this event are notified when
the connection becomes established)
(TCB.SND.EVENT POINTER) (* processes waiting for this event are notified when
the send window opens up)
(TCB.RCV.EVENT POINTER) (* processes waiting for this event are notified when
data is received)
(TCB.URGENT.EVENT POINTER) (* processes waiting for this event are notified when
urgent data is received)
(TCB.FINACKED.EVENT POINTER) (* processes waiting for this event are notified when
our FIN has been acked)
(TCB.MODE POINTER) (* ACTIVE or PASSIVE)
(TCB.RTFLG POINTER) (* T if round trip time being measured)
(TCB.RTSEQ POINTER) (* sequence number being timed)
(TCB.RTTIMER POINTER) (* round trip timer)
(TCB.SRTT POINTER) (* smoothed round trip time)
(TCB.RTO POINTER) (* retransmission timeout based on smoothed round trip
time)
(TCB.PROBE.TIMER POINTER) (* timer for delayed ACKs and window probes)
(TCB.IPSOCKET POINTER) (* Pointer to open IP socket for this connection)
)
TCB.LOCK ←(CREATE.MONITORLOCK)
TCB.STATE ←(QUOTE CLOSED)
TCB.RCV.WND ← \TCP.DEFAULT.RECEIVE.WINDOW TCB.USER.TIMEOUT ←
\TCP.DEFAULT.USER.TIMEOUT TCB.ESTABLISHED ←(CREATE.EVENT)
TCB.SND.EVENT ←(CREATE.EVENT)
TCB.RCV.EVENT ←(CREATE.EVENT)
TCB.URGENT.EVENT ←(CREATE.EVENT)
TCB.FINACKED.EVENT ←(CREATE.EVENT)
TCB.MAXSEG ← \TCP.DEFAULT.MAXSEG TCB.SRTT ← \TCP.INITIAL.RTO TCB.RTO ←
\TCP.INITIAL.RTO)
]
(/DECLAREDATATYPE (QUOTE TCP.CONTROL.BLOCK)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD FIXP POINTER POINTER FIXP
FIXP FIXP FIXP FIXP FIXP WORD WORD FIXP FIXP FIXP POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
[DECLARE: EVAL@COMPILE
(ACCESSFNS TCPSTREAM ((TCB (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(ACCESS (fetch (STREAM ACCESS) of DATUM)
(replace (STREAM ACCESS) of DATUM with NEWVALUE))
(PACKET.WINDOW (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE)))
(CREATE (create STREAM
DEVICE ← \TCP.DEVICE)))
]
)
(/DECLAREDATATYPE (QUOTE TCP.CONTROL.BLOCK)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER WORD WORD FIXP POINTER POINTER FIXP
FIXP FIXP FIXP FIXP FIXP WORD WORD FIXP FIXP FIXP POINTER POINTER
POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER POINTER)))
(* global lock for TCP-related mutual exclusion)
(RPAQ? \TCP.LOCK (CREATE.MONITORLOCK))
(* list of TCP control blocks for connection lookup)
(RPAQ? \TCP.CONTROL.BLOCKS NIL)
(DEFINEQ
(\TCP.CREATE.TCB
(LAMBDA (DST.HOST DST.PORT SRC.PORT MODE) (* ejs: " 3-Feb-85 19:35")
(* create a new TCB and the input and output streams
that go with it)
(WITH.FAST.MONITOR \TCP.LOCK (PROG ((TCB (create TCP.CONTROL.BLOCK
TCB.DST.HOST ← DST.HOST
TCB.DST.PORT ← DST.PORT
TCB.SRC.PORT ←(if (ZEROP SRC.PORT)
then (\TCP.SELECT.PORT)
else SRC.PORT)
TCB.INPUT.QUEUE ←(create SYSQUEUE)
TCB.REXMT.QUEUE ←(create SYSQUEUE)
TCB.MODE ← MODE)))
(replace TCB.RCV.STREAM of TCB with (create TCPSTREAM
ACCESS ←(QUOTE
INPUT)
TCB ← TCB
PACKET.WINDOW ← 0))
(replace TCB.SND.STREAM of TCB with (create TCPSTREAM
ACCESS ←(QUOTE
APPEND)
TCB ← TCB
PACKET.WINDOW ← 0))
(\TCP.START.PROBE.TIMER TCB)
(push \TCP.CONTROL.BLOCKS TCB)
(* put it on the global list of TCBs so it can be found
by \TCP.LOOKUP.TCB)
(replace TCB.IPSOCKET of TCB with (\IP.OPEN.SOCKET
\TCP.PROTOCOL TCB)
) (* Tell IP about it)
(RETURN TCB)))))
(\TCP.SELECT.PORT
(LAMBDA NIL (* ecc " 7-May-84 17:23")
(* find a port unique among all TCP connections on this
host)
(PROG ((PORT (LOGAND (DAYTIME)
65535)))
(until (for TCB in \TCP.CONTROL.BLOCKS always (NEQ PORT (fetch TCB.SRC.PORT of TCB)))
do (add PORT 1))
(RETURN PORT))))
(\TCP.LOOKUP.TCB
(LAMBDA (DST.HOST DST.PORT SRC.PORT NOWILDCARDFLG) (* ecc " 3-May-84 11:03")
(* Find a TCB that matches the specified addresses. If NOWILDCARDFLG is non-NIL we match against a partially
specified TCB if no fully specified one was found.)
(WITH.MONITOR \TCP.LOCK (bind WILDCARD for TCB in \TCP.CONTROL.BLOCKS
do (if (EQ SRC.PORT (fetch TCB.SRC.PORT of TCB))
then (* only check further if the local ports match)
(if (AND (IEQP DST.HOST (fetch TCB.DST.HOST of TCB))
(EQ DST.PORT (fetch TCB.DST.PORT of TCB)))
then (* a full match)
(RETURN TCB)
elseif (AND (NOT NOWILDCARDFLG)
(NULL WILDCARD)
(OR (ZEROP (fetch TCB.DST.HOST of TCB))
(IEQP DST.HOST (fetch TCB.DST.HOST
of TCB)))
(OR (ZEROP (fetch TCB.DST.PORT of TCB))
(EQ DST.PORT (fetch TCB.DST.PORT
of TCB))))
then (* a wildcard match)
(SETQ WILDCARD TCB)))
finally (RETURN (if NOWILDCARDFLG
then NIL
else WILDCARD))))))
(\TCP.DELETE.TCB
(LAMBDA (TCB) (* ejs: " 3-Feb-85 19:45")
(WITH.MONITOR \TCP.LOCK (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED))
(replace TCB.STATE of TCB with (QUOTE CLOSED))
(\FLUSH.PACKET.QUEUE (fetch TCB.INPUT.QUEUE of TCB))
(\FLUSH.PACKET.QUEUE (fetch TCB.REXMT.QUEUE of TCB))
(SETQ \TCP.CONTROL.BLOCKS (DREMOVE TCB \TCP.CONTROL.BLOCKS))
(\IP.CLOSE.SOCKET TCB \TCP.PROTOCOL) (* break circular links)
(replace TCB.SND.STREAM of TCB with NIL)
(replace TCB.RCV.STREAM of TCB with NIL) (* wake up anyone waiting for events to occur)
(NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB))
(NOTIFY.EVENT (fetch TCB.SND.EVENT of TCB))
(NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB))
(NOTIFY.EVENT (fetch TCB.URGENT.EVENT of TCB))
(NOTIFY.EVENT (fetch TCB.FINACKED.EVENT of TCB)))))
(\TCP.PORTCOMPARE
(LAMBDA (SEGMENT IPSOCKET NOWILDCARDFLG) (* ejs: " 3-Feb-85 22:30")
(* Find a TCB that matches the specified addresses. If NOWILDCARDFLG is non-NIL we match against a partially
specified TCB if no fully specified one was found.)
(WITH.FAST.MONITOR \TCP.LOCK (PROG ((DST.HOST (fetch (TCPSEGMENT TCP.SRC.ADDR) of SEGMENT))
(DST.PORT (fetch (TCPSEGMENT TCP.SRC.PORT) of SEGMENT))
(SRC.PORT (fetch (TCPSEGMENT TCP.DST.PORT) of SEGMENT))
(TCB (fetch (IPSOCKET IPSOCKET) of IPSOCKET)))
(COND
((AND TCB (EQ SRC.PORT (fetch TCB.SRC.PORT of TCB)))
(* only check further if the local ports match)
(COND
((AND (IEQP DST.HOST (fetch TCB.DST.HOST of TCB))
(EQ DST.PORT (fetch TCB.DST.PORT of TCB)))
(* a full match)
(RETURN IPSOCKET))
((AND (NOT NOWILDCARDFLG)
(OR (ZEROP (fetch TCB.DST.HOST of TCB))
(IEQP DST.HOST (fetch TCB.DST.HOST
of TCB)))
(OR (ZEROP (fetch TCB.DST.PORT of TCB))
(EQ DST.PORT (fetch TCB.DST.PORT of TCB))))
(* a wildcard match)
(RETURN IPSOCKET)))))))))
)
(* TCP checksums)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(DATATYPE TCP.PSEUDOHEADER ((PH.SRC.ADDR FIXP)
(PH.DST.ADDR FIXP)
(NIL BYTE)
(PH.PROTOCOL BYTE)
(PH.LENGTH WORD))
PH.PROTOCOL ← \TCP.PROTOCOL)
]
(/DECLAREDATATYPE (QUOTE TCP.PSEUDOHEADER)
(QUOTE (FIXP FIXP BYTE BYTE WORD)))
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.PSEUDOHEADER.LENGTH 12)
(CONSTANTS \TCP.PSEUDOHEADER.LENGTH)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS \16BIT.COMPLEMENT MACRO ((X)
(LOGXOR X (MASK.1'S 0 16))))
(PUTPROPS \16BIT.1C.PLUS MACRO ((X Y) (* compute the one's complement sum of X and Y without
creating FIXP boxes -- the sum modulo 2↑16 plus an
end-around carry)
(PROG ((DELTA (IDIFFERENCE MAX.SMALLP Y)))
(RETURN (if (ILEQ X DELTA)
then (IPLUS X Y)
else (IDIFFERENCE X DELTA))))))
)
)
(/DECLAREDATATYPE (QUOTE TCP.PSEUDOHEADER)
(QUOTE (FIXP FIXP BYTE BYTE WORD)))
(RPAQ? \TCP.PSEUDOHEADER NIL)
(* this variable controls whether checksums are performed on incoming segments)
(RPAQ? \TCP.CHECKSUMS.ON NIL)
(* checksum routines)
(DEFINEQ
(\COMPUTE.CHECKSUM
(LAMBDA (BASE LENGTH DONTCOMPLEMENTFLG) (* ecc "25-May-84 18:47")
(* TCP/IP protocol checksum is the 16-bit 1's
complement of the 1's complement sum of the 16-bit
words)
(PROG ((CHECKSUM 0)
(N (SUB1 (LRSH LENGTH 1))))
(for I from 0 to N do (SETQ CHECKSUM (\16BIT.1C.PLUS CHECKSUM (\GETBASE BASE I))))
(if (ODDP LENGTH)
then (* if LENGTH is odd, the last byte must be padded on
the right by a zero byte)
(SETQ CHECKSUM (\16BIT.1C.PLUS CHECKSUM (LLSH (\GETBASEBYTE BASE (SUB1 LENGTH))
8))))
(RETURN (if DONTCOMPLEMENTFLG
then (* if DONTCOMPLEMENTFLG is non-NIL just return the 1's
complement sum)
CHECKSUM
else (\16BIT.COMPLEMENT CHECKSUM))))))
(\TCP.CHECKSUM.INCOMING
(LAMBDA (SEGMENT) (* ecc "16-May-84 11:53")
(* computes the TCP checksum and returns T or NIL
depending on whether it matches the checksum in the
header)
(PROG ((LENGTH (IPLUS (fetch TCP.HEADER.LENGTH of SEGMENT)
(\TCP.DATA.LENGTH SEGMENT)))
(SEGMENT.CHECKSUM (fetch TCP.CHECKSUM of SEGMENT))
CHECKSUM OK)
(WITH.FAST.MONITOR \TCP.LOCK (* need to lock this because we're using
\TCP.PSEUDOHEADER)
(replace PH.SRC.ADDR of \TCP.PSEUDOHEADER with (fetch TCP.SRC.ADDR
of SEGMENT))
(replace PH.DST.ADDR of \TCP.PSEUDOHEADER with (fetch TCP.DST.ADDR
of SEGMENT))
(replace PH.LENGTH of \TCP.PSEUDOHEADER with LENGTH)
(replace TCP.CHECKSUM of SEGMENT with 0)
(* checksum field must be 0 while we are computing
checksum)
(SETQ CHECKSUM (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM
\TCP.PSEUDOHEADER
\TCP.PSEUDOHEADER.LENGTH T)
(\COMPUTE.CHECKSUM
(fetch TCPHEADER
of SEGMENT)
LENGTH T)))))
(SETQ OK (EQ CHECKSUM SEGMENT.CHECKSUM))
(if (AND (NOT OK)
(MEMB (QUOTE CHECKSUM)
TCPTRACEFLG))
then (printout TCPTRACEFILE .TAB0 0 "[bad checksum " CHECKSUM "]" T))
(RETURN OK))))
(\TCP.CHECKSUM.OUTGOING
(LAMBDA (TCB SEGMENT) (* ecc "16-May-84 11:53")
(* compute checksum and place in header)
(PROG ((LENGTH (IPLUS (fetch TCP.HEADER.LENGTH of SEGMENT)
(\TCP.DATA.LENGTH SEGMENT)))
(PH (if TCB
then (fetch TCB.PH of TCB)
else \TCP.PSEUDOHEADER)))
(WITH.FAST.MONITOR \TCP.LOCK (* need to lock this in case we're using
\TCP.PSEUDOHEADER)
(replace PH.SRC.ADDR of PH with (fetch TCP.SRC.ADDR of SEGMENT))
(replace PH.DST.ADDR of PH with (fetch TCP.DST.ADDR of SEGMENT))
(replace PH.LENGTH of PH with LENGTH)
(replace TCP.CHECKSUM of SEGMENT with 0)
(* checksum field must be 0 while we are computing
checksum)
(replace TCP.CHECKSUM of SEGMENT
with (\16BIT.COMPLEMENT (\16BIT.1C.PLUS (\COMPUTE.CHECKSUM PH
\TCP.PSEUDOHEADER.LENGTH T)
(\COMPUTE.CHECKSUM
(fetch TCPHEADER
of SEGMENT)
LENGTH T))))))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.INITIAL.RTO 1000)
(CONSTANTS \TCP.INITIAL.RTO)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.UBOUND 60000)
(RPAQQ \TCP.LBOUND 1000)
(CONSTANTS \TCP.UBOUND \TCP.LBOUND)
)
)
(* maximum segment lifetime)
(RPAQ? \TCP.MSL 5000)
(RPAQ? \TCP.DEFAULT.USER.TIMEOUT 60000)
(RPAQ? \TCP.DEFAULT.RECEIVE.WINDOW 2000)
(RPAQ? \TCP.DEVICE NIL)
(* TCP protocol routines)
(DEFINEQ
(\TCP.PACKET.FILTER
(LAMBDA (SEGMENT PROTOCOL) (* ecc " 7-May-84 17:27")
(* packet filter used by IP code to dispatch packets by
protocol)
(SELECTC PROTOCOL
(\TCP.PROTOCOL (ERSETQ (\TCP.INPUT SEGMENT))
T)
(\ICMP.PROTOCOL (ERSETQ (\TCP.HANDLE.ICMP SEGMENT))
T)
NIL)))
(\TCP.SETUP.SEGMENT
(LAMBDA (SRC.HOST SRC.PORT DST.HOST DST.PORT) (* ejs: " 5-Jan-85 16:44")
(* allocate a new TCP segment and set up its header)
(PROG ((SEGMENT (\IP.SETUPIP (\ALLOCATE.ETHERPACKET)
DST.HOST 0 \TCP.MASTER.SOCKET)))
(add (fetch (IP IPTOTALLENGTH) of SEGMENT)
\TCP.HEADER.LENGTH)
(replace TCP.SRC.PORT of SEGMENT with SRC.PORT)
(replace TCP.DST.PORT of SEGMENT with DST.PORT)
(replace TCP.DATA.OFFSET of SEGMENT with \TCP.MIN.DATA.OFFSET)
(RETURN SEGMENT))))
(\TCP.RELEASE.SEGMENT
(LAMBDA (SEGMENT) (* ecc " 7-May-84 17:28")
(* release a TCP segment -- it had better not be on
anyone's queue)
(CHECK (OR (NULL (fetch QLINK of SEGMENT))
(SHOULDNT "releasing queued segment")))
(\RELEASE.ETHERPACKET SEGMENT)))
(\TCP.CONNECTION
(LAMBDA (DST.HOST DST.PORT SRC.PORT MODE) (* ejs: " 3-Feb-85 16:34")
(* open a TCP connection and return the TCB or NIL if
the connection fails)
(PROG (SPECIFIED TCB ISS TCP.PROCESS)
(SELECTQ MODE
(ACTIVE)
(PASSIVE)
(ERROR "TCP open mode must be ACTIVE or PASSIVE"))
(if (NULL DST.HOST)
then (SETQ DST.HOST 0))
(if (NULL DST.PORT)
then (SETQ DST.PORT 0))
(if (NULL SRC.PORT)
then (SETQ SRC.PORT 0))
(SETQ SPECIFIED (NOT (OR (ZEROP DST.HOST)
(ZEROP DST.PORT))))
(if (AND (EQ MODE (QUOTE ACTIVE))
(NOT SPECIFIED))
then (ERROR "foreign socket unspecified"))
(* Check for conflict with existing connections. ACTIVE open only conflicts with other fully specified connections.
PASSIVE open conflicts with fully specified connections if the open is fully specifed, and with partially specified
connections if the open is partially specified)
(if (SETQ TCB (OR (AND (OR (EQ MODE (QUOTE ACTIVE))
SPECIFIED)
(\TCP.LOOKUP.TCB DST.HOST DST.PORT SRC.PORT T))
(AND (EQ MODE (QUOTE PASSIVE))
(NOT SPECIFIED)
(SETQ TCB (\TCP.LOOKUP.TCB DST.HOST DST.PORT SRC.PORT NIL))
(OR (ZEROP (fetch TCB.DST.HOST of TCB))
(ZEROP (fetch TCB.DST.PORT of TCB))))))
then (COND
((type? TCP.CONTROL.BLOCK TCB)
(COND
((FMEMB (fetch TCB.STATE of TCB)
(QUOTE (CLOSED CLOSE.WAIT TIME.WAIT FIN.WAIT.1 FIN.WAIT.2)))
(\TCP.DELETE.TCB TCB))))
(T (ERROR "TCP connection already exists"))))
(SETQ TCB (\TCP.CREATE.TCB DST.HOST DST.PORT SRC.PORT MODE))
(SELECTQ MODE
(ACTIVE (WITH.MONITOR \TCP.LOCK (SETQ ISS (\TCP.SELECT.ISS))
(replace TCB.ISS of TCB with ISS))
(\TCP.TEMPLATE TCB)
(replace TCB.SND.UNA of TCB with ISS)
(replace TCB.SND.NXT of TCB with ISS)
(replace TCB.SND.UP of TCB with ISS)
(\TCP.TRACE.TRANSITION TCB (QUOTE SYN.SENT))
(replace TCB.STATE of TCB with (QUOTE SYN.SENT))
(SETQ TCP.PROCESS (ADD.PROCESS (BQUOTE (\TCP.PROCESS , TCB))
(QUOTE NAME)
(QUOTE TCP)))
(* initiate the three-way handshake to establish the
connection)
(\TCP.FLUSH (fetch TCB.SND.STREAM of TCB)
\TCP.CTRL.SYN) (* wait until established)
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(RESETLST (RESETSAVE NIL (BQUOTE (AND RESETSTATE
(DEL.PROCESS ,
TCP.PROCESS))))
(until (NEQ (fetch TCB.STATE of TCB)
(QUOTE SYN.SENT))
do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK
of TCB)
(fetch TCB.ESTABLISHED
of TCB))))))
(PASSIVE (\TCP.TRACE.TRANSITION TCB (QUOTE LISTEN))
(replace TCB.STATE of TCB with (QUOTE LISTEN))
(SETQ TCP.PROCESS (ADD.PROCESS (BQUOTE (\TCP.PROCESS , TCB))
(QUOTE NAME)
(QUOTE TCP)))
(* wait until established)
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(RESETLST (RESETSAVE NIL (BQUOTE (AND RESETSTATE
(DEL.PROCESS ,
TCP.PROCESS))))
(until (NEQ (fetch TCB.STATE of TCB)
(QUOTE LISTEN))
do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK
of TCB)
(fetch TCB.ESTABLISHED
of TCB))))))
(SHOULDNT))
(RETURN (if (NEQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
then TCB
else NIL)))))
(\TCP.FIX.INCOMING.SEGMENT
(LAMBDA (SEGMENT FLAGS) (* ecc "16-May-84 11:56")
(PROG NIL
(if (AND (BITTEST FLAGS \TCP.CTRL.SYN)
(BITTEST FLAGS \TCP.CTRL.FIN))
then (RETURN NIL))
(* calculate the length of the segment data and place it in a fixed position in the header for fast access -- note
that the TCP.DATA.LENGTH field isn't a true part of the TCP header; it overlays the IP level checksum which is no
longer needed)
(replace TCP.DATA.LENGTH of SEGMENT with (\TCP.DATA.LENGTH SEGMENT))
(* return T or NIL depending on whether checksum is
correct)
(RETURN (OR (NOT \TCP.CHECKSUMS.ON)
(\TCP.CHECKSUM.INCOMING SEGMENT))))))
(\TCP.DATA.LENGTH
(LAMBDA (SEGMENT) (* ejs: " 5-Jan-85 16:46")
(* data length = total segment length -
(IP header length + TCP header length))
(IDIFFERENCE (fetch (IP IPTOTALLENGTH) of SEGMENT)
(IPLUS (UNFOLD (fetch (IP IPHEADERLENGTH) of SEGMENT)
4)
(UNFOLD (fetch TCP.DATA.OFFSET of SEGMENT)
4)))))
(\TCP.SYN.OR.FIN
(LAMBDA (FLAGS NOERRORFLG) (* ecc " 1-May-84 17:10")
(* SYN and FIN occupy sequence number space so we have
to include them in the "length" of the segment)
(SELECTC (LOGAND FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.FIN))
(0 0)
(\TCP.CTRL.SYN 1)
(\TCP.CTRL.FIN 1)
(if NOERRORFLG
then 0
else (SHOULDNT "both SYN and FIN")))))
(\TCP.INPUT
(LAMBDA (SEGMENT TCB) (* ejs: "28-Dec-84 18:22")
(* handle an incoming TCP segment -- pages 65-76 of RFC
793)
(PROG ((SEQ (fetch TCP.SEQ of SEGMENT))
(ACK (fetch TCP.ACK of SEGMENT))
(FLAGS (fetch TCP.CTRL of SEGMENT))
UNA QUEUEDFLG)
(if (NOT (\TCP.INPUT.INITIAL TCB SEGMENT SEQ ACK FLAGS))
then (\TCP.RELEASE.SEGMENT SEGMENT)
(RETURN))
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(PROG NIL (* handle unsynchronized states)
(if (NOT (\TCP.INPUT.UNSYNC TCB SEGMENT SEQ ACK FLAGS))
then (GO DROPIT)) (* first check sequence number)
(if (NOT (\TCP.CHECK.WINDOW TCB SEGMENT FLAGS))
then (GO DROPIT)) (* second check the RST bit)
(if (NOT (\TCP.CHECK.RESET TCB SEGMENT SEQ ACK FLAGS))
then (GO DROPIT)) (* third check security and precedence)
(if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS))
then (GO DROPIT)) (* fourth check the SYN bit)
(if (NOT (\TCP.CHECK.NO.SYN TCB SEGMENT FLAGS))
then (GO DROPIT)) (* fifth check the ACK field)
(if (NOT (\TCP.CHECK.ACK TCB SEGMENT FLAGS))
then (GO DROPIT))
(if (EQ (fetch TCB.STATE of TCB)
(QUOTE SYN.RECEIVED))
then (if (AND (\32BIT.LEQ (fetch TCB.SND.UNA of TCB)
ACK)
(\32BIT.LEQ ACK (fetch TCB.SND.NXT of TCB)))
then (* our SYN has been acked)
(\TCP.TRACE.TRANSITION TCB (QUOTE ESTABLISHED))
(replace TCB.STATE of TCB with (QUOTE ESTABLISHED))
(NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB))
(* continue processing in ESTABLISHED state)
else (\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST)
(GO DROPIT)))
(if (NOT (\TCP.HANDLE.ACK TCB SEGMENT SEQ ACK FLAGS))
then (GO DROPIT))
(SELECTQ (fetch TCB.STATE of TCB)
(FIN.WAIT.1 (if (\TCP.OUR.FIN.IS.ACKED TCB)
then (\TCP.TRACE.TRANSITION TCB (QUOTE
FIN.WAIT.2))
(replace TCB.STATE of TCB
with (QUOTE FIN.WAIT.2))
(NOTIFY.EVENT (fetch TCB.FINACKED.EVENT
of TCB))))
((ESTABLISHED FIN.WAIT.2 CLOSE.WAIT)
NIL)
(CLOSING (if (\TCP.OUR.FIN.IS.ACKED TCB)
then (\TCP.START.TIME.WAIT TCB)
(NOTIFY.EVENT (fetch TCB.FINACKED.EVENT
of TCB))
else (GO DROPIT)))
(LAST.ACK (if (\TCP.OUR.FIN.IS.ACKED TCB)
then (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED))
(replace TCB.STATE of TCB
with (QUOTE CLOSED))
(NOTIFY.EVENT (fetch TCB.FINACKED.EVENT
of TCB))
(RETURN)
else (GO DROPIT)))
(TIME.WAIT (\TCP.SEND.ACK TCB)
(GO DROPIT))
(SHOULDNT)) (* sixth check the URG bit)
(\TCP.HANDLE.URG TCB SEGMENT SEQ ACK FLAGS)
(* seventh process the segment text)
(SELECTQ (fetch TCB.STATE of TCB)
((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2)
(SETQ QUEUEDFLG (\TCP.QUEUE.INPUT TCB SEGMENT SEQ)))
((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT))
(SHOULDNT)) (* eighth check the FIN bit)
(\TCP.HANDLE.FIN TCB SEGMENT SEQ ACK FLAGS)
(if QUEUEDFLG
then (RETURN))
DROPIT
(\TCP.RELEASE.SEGMENT SEGMENT))))))
(\TCP.INPUT.INITIAL
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 17:27")
(* handle segment for non-existent TCB -- page 65 of
RFC 793)
(PROG NIL
(\TCP.TRACE.SEGMENT (QUOTE RECV)
SEGMENT)
(if (NOT (\TCP.FIX.INCOMING.SEGMENT SEGMENT FLAGS))
then (* bad checksum)
(RETURN NIL))
(if (OR (NULL TCB)
(EQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED)))
then (* an incoming segment not containing a RST causes a
RST to be sent in response)
(if TCPTRACEFLG
then (printout TCPTRACEFILE .TAB0 0 "[no such TCP connection]"))
(if (NOT (BITTEST FLAGS \TCP.CTRL.RST))
then (* send a RST)
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (\TCP.SEND.RESET SEGMENT ACK)
else (\TCP.SEND.RESET SEGMENT 0 (IPLUS SEQ (fetch TCP.DATA.LENGTH
of SEGMENT)
(\TCP.SYN.OR.FIN FLAGS)))))
(RETURN NIL))
(RETURN T))))
(\TCP.INPUT.UNSYNC
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:03")
(* handle segment for TCB in LISTEN or SYN.SENT state
-- pages 65-68 of RFC 793)
(SELECTQ (fetch TCB.STATE of TCB)
(LISTEN (\TCP.INPUT.LISTEN TCB SEGMENT SEQ ACK FLAGS)
NIL)
(SYN.SENT (\TCP.INPUT.SYN.SENT TCB SEGMENT SEQ ACK FLAGS)
NIL)
T)))
(\TCP.INPUT.LISTEN
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:13")
(* handle segment for TCB in LISTEN state -- pages
65-66 of RFC 793)
(PROG (ISS) (* first check for a RST)
(if (BITTEST FLAGS \TCP.CTRL.RST)
then (RETURN NIL)) (* second check for an ACK)
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (* any acknowledgment is bad if it arrives on a
connection still in the LISTEN state)
(\TCP.SEND.RESET SEGMENT ACK)
(RETURN NIL)) (* third check for a SYN)
(if (BITTEST FLAGS \TCP.CTRL.SYN)
then (if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS))
then (RETURN NIL))
(replace TCB.RCV.NXT of TCB with (ADD1 SEQ))
(replace TCB.IRS of TCB with SEQ)
(SETQ ISS (\TCP.SELECT.ISS))
(replace TCB.ISS of TCB with ISS)
(replace TCB.SND.NXT of TCB with ISS)
(replace TCB.SND.UNA of TCB with ISS)
(replace TCB.SND.UP of TCB with ISS)
(\TCP.TRACE.TRANSITION TCB (QUOTE SYN.RECEIVED))
(replace TCB.STATE of TCB with (QUOTE SYN.RECEIVED))
(* fill in foreign socket in case it was only partially
specified)
(replace TCB.DST.HOST of TCB with (fetch TCP.SRC.ADDR of SEGMENT))
(replace TCB.DST.PORT of TCB with (fetch TCP.SRC.PORT of SEGMENT))
(\TCP.TEMPLATE TCB) (* send a SYN, ACK segment using \TCP.FLUSH because SYN
occupies sequence number space)
(\TCP.FLUSH (fetch TCB.SND.STREAM of TCB)
\TCP.CTRL.SYN) (* NOTE: we never queue data that arrives in a SYN
segment, we just ACK the SYN and require the data to be
retransmitted)
)
(RETURN NIL))))
(\TCP.INPUT.SYN.SENT
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:13")
(* handle segment for TCB in SYN.SENT state -- pages
66-68 of RFC 793)
(PROG NIL (* first check the ACK bit)
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (if (OR (\32BIT.LEQ ACK (fetch TCB.ISS of TCB))
(\32BIT.GT ACK (fetch TCB.SND.NXT of TCB)))
then (* ACK is unacceptable)
(if (NOT (BITTEST FLAGS \TCP.CTRL.RST))
then (\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST))
(RETURN NIL))) (* second check the RST bit)
(if (BITTEST FLAGS \TCP.CTRL.RST)
then (if (BITTEST FLAGS \TCP.CTRL.ACK)
then (* if the ACK was acceptable then signal the user)
(\TCP.CONNECTION.DROPPED TCB "reset"))
(RETURN NIL)) (* third check the security and precedence)
(if (NOT (\TCP.CHECK.SECURITY TCB SEGMENT FLAGS))
then (RETURN NIL)) (* fourth check the SYN bit)
(if (BITTEST FLAGS \TCP.CTRL.SYN)
then (replace TCB.RCV.NXT of TCB with (ADD1 SEQ))
(replace TCB.IRS of TCB with SEQ)
(if (AND (BITTEST FLAGS \TCP.CTRL.ACK)
(\32BIT.GEQ ACK (fetch TCB.SND.UNA of TCB)))
then (* new ACK information)
(replace TCB.SND.UNA of TCB with ACK))
(replace TCP.CTRL of SEGMENT with (SETQ FLAGS (BITCLEAR FLAGS \TCP.CTRL.SYN)))
(if (\32BIT.GT (fetch TCB.SND.UNA of TCB)
(fetch TCB.ISS of TCB))
then (* our SYN has been acked)
(\TCP.TRACE.TRANSITION TCB (QUOTE ESTABLISHED))
(replace TCB.STATE of TCB with (QUOTE ESTABLISHED))
(* send an ACK segment)
(\TCP.SEND.ACK TCB (QUOTE NOW))
(NOTIFY.EVENT (fetch TCB.ESTABLISHED of TCB))
else (* we can just let our original SYN segment be
retransmitted)
(\TCP.TRACE.TRANSITION TCB (QUOTE SYN.RECEIVED))
(replace TCB.STATE of TCB with (QUOTE SYN.RECEIVED))
(* send an ACK segment)
(\TCP.SEND.ACK TCB (QUOTE NOW))) (* NOTE: we never queue data that arrives in a SYN
segment, we just ACK the SYN and require the data to be
retransmitted)
) (* drop the segment and return)
(RETURN NIL))))
(\TCP.CHECK.WINDOW
(LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 16:29")
(* check segment length against receive window -- page
69 of RFC 793)
(PROG ((LEN (fetch TCP.DATA.LENGTH of SEGMENT))
(SEQ (fetch TCP.SEQ of SEGMENT))
(RCV.NXT (fetch TCB.RCV.NXT of TCB))
(WND (fetch TCB.RCV.WND of TCB))
TOP)
(SETQ TOP (IPLUS SEQ LEN (\TCP.SYN.OR.FIN FLAGS)))
(if (ZEROP LEN)
then (if (ZEROP WND)
then (if (\32BIT.EQ SEQ RCV.NXT)
then (RETURN T))
else (if (AND (\32BIT.LEQ RCV.NXT SEQ)
(\32BIT.LT SEQ (IPLUS RCV.NXT WND)))
then (RETURN T)))
else (if (NOT (ZEROP WND))
then (if (OR (AND (\32BIT.LEQ RCV.NXT SEQ)
(\32BIT.LT SEQ (IPLUS RCV.NXT WND)))
(AND (\32BIT.LT RCV.NXT TOP)
(\32BIT.LEQ TOP (IPLUS RCV.NXT WND))))
then (RETURN T))))
(if (NOT (BITTEST FLAGS \TCP.CTRL.RST))
then (* send an ACK in reply)
(\TCP.SEND.ACK TCB (QUOTE NOW)))
(RETURN NIL))))
(\TCP.CHECK.RESET
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:07")
(* check the RST bit -- page 70 of RFC 793)
(PROG NIL
(if (BITTEST FLAGS \TCP.CTRL.RST)
then (SELECTQ (fetch TCB.STATE of TCB)
(SYN.RECEIVED (if (EQ (fetch TCB.MODE of TCB)
(QUOTE PASSIVE))
then (\TCP.TRACE.TRANSITION TCB (QUOTE LISTEN))
(replace TCB.STATE of TCB with (QUOTE LISTEN))
else (\TCP.CONNECTION.DROPPED TCB "refused"))
(\FLUSH.PACKET.QUEUE (fetch TCB.REXMT.QUEUE of TCB))
(\TCP.SEND.CONTROL TCB ACK NIL \TCP.CTRL.RST))
((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2 CLOSE.WAIT)
(\TCP.CONNECTION.DROPPED TCB "reset"))
((CLOSING LAST.ACK TIME.WAIT)
(\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED))
(replace TCB.STATE of TCB with (QUOTE CLOSED)))
(SHOULDNT))
(RETURN NIL)
else (RETURN T)))))
(\TCP.CHECK.SECURITY
(LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:06")
(* returns T or NIL depending on whether security and
precedence are OK; sends RST if necessary)
(* not implemented)
T))
(\TCP.CHECK.NO.SYN
(LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:07")
(* check the SYN bit -- page 71 of RFC 793)
(PROG NIL
(CHECK (OR (NOT (BITTEST FLAGS \TCP.CTRL.RST))
(SHOULDNT "RST bit set")))
(if (NOT (BITTEST FLAGS \TCP.CTRL.SYN))
then (RETURN T))
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (\TCP.SEND.CONTROL TCB (fetch TCP.ACK of SEGMENT)
NIL \TCP.CTRL.RST)
else (\TCP.SEND.CONTROL TCB 0 (IPLUS (fetch TCP.ACK of SEGMENT)
(fetch TCP.DATA.LENGTH of SEGMENT)
1)
(LOGOR \TCP.CTRL.ACK \TCP.CTRL.RST)))
(\TCP.CONNECTION.DROPPED TCB "reset")
(RETURN NIL))))
(\TCP.CHECK.ACK
(LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:08")
(* check the ACK field -- page 72 of RFC 793)
(PROG NIL
(CHECK (OR (NOT (BITTEST FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.RST)))
(SHOULDNT "SYN or RST bit set")))
(RETURN (BITTEST FLAGS \TCP.CTRL.ACK)))))
(\TCP.HANDLE.ACK
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "25-May-84 13:53")
(* ACK processing -- pages 72-73 of RFC 793)
(PROG (EVENT)
(if (\32BIT.GT ACK (fetch TCB.SND.NXT of TCB))
then (* this segment acks something we haven't sent yet)
(\TCP.SEND.ACK TCB (QUOTE NOW))
(RETURN NIL))
(if (AND (fetch TCB.RTFLG of TCB)
(\32BIT.GT ACK (fetch TCB.RTSEQ of TCB)))
then (* calculate smoothed round trip time)
(replace TCB.RTFLG of TCB with NIL)
(replace TCB.SRTT of TCB with (LRSH (IPLUS (\3TIMES (fetch TCB.SRTT of TCB))
(CLOCKDIFFERENCE (fetch TCB.RTTIMER
of TCB)))
1))
(replace TCB.RTO of TCB with (IMIN \TCP.UBOUND
(IMAX \TCP.LBOUND
(LRSH (\3TIMES (fetch TCB.SRTT
of TCB))
1)))))
(if (\32BIT.GT ACK (fetch TCB.SND.UNA of TCB))
then (* new ACK information)
(replace TCB.SND.UNA of TCB with ACK)
(SETQ EVENT T))
(if (OR (\32BIT.GT SEQ (fetch TCB.SND.WL1 of TCB))
(AND (\32BIT.EQ SEQ (fetch TCB.SND.WL1 of TCB))
(\32BIT.GEQ ACK (fetch TCB.SND.WL2 of TCB))))
then (* update send window)
(replace TCB.SND.WND of TCB with (fetch TCP.WINDOW of SEGMENT))
(replace TCB.SND.WL1 of TCB with SEQ)
(replace TCB.SND.WL2 of TCB with ACK)
(SETQ EVENT T))
(if EVENT
then (NOTIFY.EVENT (fetch TCB.SND.EVENT of TCB)))
(RETURN T))))
(\TCP.HANDLE.URG
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "16-May-84 12:10")
(* check the URG bit -- pages 73-74 of RFC 793)
(PROG (UP)
(if (BITTEST FLAGS \TCP.CTRL.URG)
then (SELECTQ (fetch TCB.STATE of TCB)
((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2)
(SETQ UP (IPLUS SEQ (fetch TCP.URG.PTR of SEGMENT)))
(if (\32BIT.GT UP (fetch TCB.RCV.UP of TCB))
then (replace TCB.RCV.UP of TCB with UP)
(if (\32BIT.GT UP (fetch TCB.RCV.NXT of TCB))
then (* urgent pointer is in advance of the data consumed)
(\TCP.SIGNAL.URGENT.DATA TCB))))
((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT)
NIL)
(SHOULDNT))))))
(\TCP.QUEUE.INPUT
(LAMBDA (TCB SEGMENT SEQ) (* ejs: "29-Jan-85 14:33")
(* Put the segment in its proper position in the input queue according to its sequence number range.
Returns T if the segment was queued, NIL if it was a duplicate. Segments are queued by increasing left endpoint of
their sequence number range. If the entire sequence number range has been seen or is covered by segments already in
the queue, the segment is a duplicate. Otherwise, it covers some gap in the queue, so it is placed in its proper
position. Note that a later segment that covers gaps on both sides will also be queued, resulting in duplicates in
the queue. Therefore \TCP.GET.SEGMENT must be prepared to skip over duplicates.)
(CHECK (OR (NULL (fetch QLINK of SEGMENT))
(SHOULDNT "input segment already queued")))
(CHECK (\TCP.CHECK.INPUT.QUEUE TCB))
(UNINTERRUPTABLY
(PROG ((QUEUE (fetch TCB.INPUT.QUEUE of TCB))
(RCV.NXT (fetch TCB.RCV.NXT of TCB))
(LEN (fetch TCP.DATA.LENGTH of SEGMENT))
TOP CURRENT CURSEQ NEXT)
(if (ZEROP LEN)
then (* this segment has no data)
(GO DROPIT))
(SETQ TOP (IPLUS SEQ LEN))
(if (\32BIT.LEQ TOP RCV.NXT)
then (* this segment is a duplicate)
(GO DROPIT))
(SETQ CURRENT (fetch SYSQUEUEHEAD of QUEUE))
(SETQ NEXT (fetch SYSQUEUETAIL of QUEUE))
(if (OR (NULL CURRENT)
(\32BIT.GT TOP (IPLUS (fetch TCP.SEQ of NEXT)
(fetch TCP.DATA.LENGTH of NEXT))))
then (* the segment goes at the tail of the queue -- we
check this first since this is the expected case)
(\ENQUEUE QUEUE SEGMENT)
elseif (\32BIT.LT SEQ (SETQ CURSEQ (fetch TCP.SEQ of CURRENT)))
then (* the segment goes at the head of the queue)
(replace QLINK of SEGMENT with CURRENT)
(replace SYSQUEUEHEAD of QUEUE with SEGMENT)
else (* search through the queue for the proper position)
(do (if (\32BIT.LEQ TOP (IPLUS CURSEQ (fetch TCP.DATA.LENGTH of CURRENT)))
then (* this segment is a duplicate)
(GO DROPIT))
(SETQ NEXT (fetch QLINK of CURRENT))
(SETQ CURSEQ (fetch TCP.SEQ of NEXT))
(if (\32BIT.LT SEQ CURSEQ)
then (* here is where it goes)
(replace QLINK of SEGMENT with NEXT)
(replace QLINK of CURRENT with SEGMENT)
(RETURN))
(SETQ CURRENT NEXT)))
(while (AND (\32BIT.LEQ SEQ RCV.NXT)
(\32BIT.LT RCV.NXT TOP))
do (* advance RCV.NXT)
(replace TCB.RCV.NXT of TCB with (SETQ RCV.NXT TOP))
(if (SETQ SEGMENT (fetch QLINK of SEGMENT))
then (SETQ TOP (IPLUS (SETQ SEQ (fetch TCP.SEQ of SEGMENT))
(fetch TCP.DATA.LENGTH of SEGMENT)))))
(\TCP.SEND.ACK TCB)
(NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB))
(RETURN T)
DROPIT
(\TCP.SEND.ACK TCB (QUOTE NOW)) (* Duplicate? Better let the other end know we've
received the packet)
(RETURN NIL)))))
(\TCP.HANDLE.FIN
(LAMBDA (TCB SEGMENT SEQ ACK FLAGS) (* ecc "30-May-84 10:29")
(* check the FIN bit -- pages 75-76 of RFC 793)
(PROG (TOP)
(if (BITTEST FLAGS \TCP.CTRL.FIN)
then (SETQ TOP (IPLUS SEQ (fetch TCP.DATA.LENGTH of SEGMENT)))
(* check whether we've received all the data before the
FIN)
(if (\32BIT.GEQ (fetch TCB.RCV.NXT of TCB)
TOP)
then (if (\32BIT.EQ (fetch TCB.RCV.NXT of TCB)
TOP)
then (* advance RCV.NXT over the FIN)
(add (fetch TCB.RCV.NXT of TCB)
1))
(SELECTQ (fetch TCB.STATE of TCB)
((SYN.RECEIVED ESTABLISHED)
(\TCP.TRACE.TRANSITION TCB (QUOTE CLOSE.WAIT))
(replace TCB.STATE of TCB with (QUOTE CLOSE.WAIT)))
(FIN.WAIT.1 (if (\TCP.OUR.FIN.IS.ACKED TCB)
then (\TCP.START.TIME.WAIT TCB)
(NOTIFY.EVENT (fetch TCB.FINACKED.EVENT
of TCB))
else (\TCP.TRACE.TRANSITION TCB (QUOTE CLOSING))
(replace TCB.STATE of TCB
with (QUOTE CLOSING))))
(FIN.WAIT.2 (\TCP.START.TIME.WAIT TCB))
((CLOSE.WAIT CLOSING LAST.ACK)
NIL)
(TIME.WAIT (\TCP.START.TIME.WAIT TCB))
(SHOULDNT))
(NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB)))
(* acknowledge the FIN)
(\TCP.SEND.ACK TCB (QUOTE NOW))))))
(\TCP.OUR.FIN.IS.ACKED
(LAMBDA (TCB) (* ecc "16-May-84 12:15")
(* check whether our FIN's sequence number
(recorded in the TCB.FINSEQ field) has been
acknowledged)
(\32BIT.GEQ (fetch TCB.SND.UNA of TCB)
(OR (fetch TCB.FINSEQ of TCB)
(SHOULDNT "FIN not sent")))))
(\TCP.SIGNAL.URGENT.DATA
(LAMBDA (TCB) (* ecc " 7-May-84 12:19")
(NOTIFY.EVENT (fetch TCB.URGENT.EVENT of TCB))
(if TCPTRACEFLG
then (printout TCPTRACEFILE .TAB0 0 "[Urgent TCP data has arrived]" T))))
(\TCP.PROCESS
(LAMBDA (TCB) (* ejs: " 3-Feb-85 22:51")
(* process to handle retransmission and timeouts for
TCP connection)
(RESETSAVE NIL (LIST (FUNCTION \TCP.DELETE.TCB)
TCB))
(PROCESSPROP (THIS.PROCESS)
(QUOTE INFOHOOK)
(FUNCTION (LAMBDA NIL
(PPTCB TCB))))
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(bind SEGMENT PACKETQUEUE EVENT (IPSOCKET ←(fetch TCB.IPSOCKET of TCB))
first (SETQ PACKETQUEUE (fetch (IPSOCKET IPSQUEUE) of IPSOCKET))
(SETQ EVENT (fetch (IPSOCKET IPSEVENT) of IPSOCKET))
while (NEQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
do (COND
((AND (fetch TCB.RTFLG of TCB)
(IGREATERP (CLOCKDIFFERENCE (fetch TCB.RTTIMER of TCB))
(fetch TCB.USER.TIMEOUT of TCB)))
(* timeout has expired without other end responding)
(\TCP.CONNECTION.DROPPED TCB "not responding"))
((AND (EQ (fetch TCB.STATE of TCB)
(QUOTE TIME.WAIT))
(TIMEREXPIRED? (fetch TCB.2MSL.TIMER of TCB)))
(* 2MSL has expired)
(\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED))
(replace TCB.STATE of TCB with (QUOTE CLOSED)))
((\TCP.RETRANSMIT TCB)
NIL)
((OR (EQ (fetch TCB.ACKFLG of TCB)
(QUOTE NOW))
(AND (fetch TCB.ACKFLG of TCB)
(TIMEREXPIRED? (fetch TCB.PROBE.TIMER of TCB)))
(AND (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))
(\32BIT.GT (fetch TCP.SEQ of (\QUEUEHEAD (fetch TCB.INPUT.QUEUE
of TCB)))
(fetch TCB.RCV.NXT of TCB))))
(* an ACK needs to be sent either because the protocol routines requested it or because we need to fill a gap in the
input queue)
(\TCP.SEND.CONTROL TCB (fetch TCB.SND.NXT of TCB)
(fetch TCB.RCV.NXT of TCB)
\TCP.CTRL.ACK))
((AND (\32BIT.GT (fetch TCB.SND.NXT of TCB)
(IPLUS (fetch TCB.SND.WL1 of TCB)
(fetch TCB.SND.WND of TCB)))
(TIMEREXPIRED? (fetch TCB.PROBE.TIMER of TCB)))
(* a probe needs to be sent to open the window)
(\TCP.SEND.CONTROL TCB (IPLUS (fetch TCB.SND.NXT of TCB)
(fetch TCB.SND.WND of TCB))
(fetch TCB.RCV.NXT of TCB)
\TCP.CTRL.ACK)))
(COND
((\QUEUEHEAD PACKETQUEUE)
(SETQ SEGMENT (\DEQUEUE PACKETQUEUE))
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1)
(\TCP.INPUT SEGMENT TCB))
(T (COND
((EQ (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB)
EVENT
(fetch TCB.RTO of TCB))
EVENT)
(COND
((SETQ SEGMENT (\DEQUEUE PACKETQUEUE))
(add (fetch (IPSOCKET IPSQUEUELENGTH) of IPSOCKET)
-1)
(\TCP.INPUT SEGMENT TCB)))))))))))
(\TCP.TEMPLATE
(LAMBDA (TCB) (* ecc "16-May-84 12:19")
(* set up segment for sending control information and
pseudo-header for checksumming)
(PROG ((SEGMENT (fetch TCB.TEMPLATE of TCB)))
(if SEGMENT
then (replace TCP.DST.ADDR of SEGMENT with (fetch TCB.DST.HOST of TCB))
(replace TCP.DST.PORT of SEGMENT with (fetch TCB.DST.PORT of TCB))
else (SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS)
(fetch TCB.SRC.PORT of TCB)
(fetch TCB.DST.HOST of TCB)
(fetch TCB.DST.PORT of TCB))))
(replace TCB.TEMPLATE of TCB with SEGMENT)
(if (NULL (fetch TCB.PH of TCB))
then (replace TCB.PH of TCB with (create TCP.PSEUDOHEADER))))))
(\TCP.SEND.CONTROL
(LAMBDA (TCB SEQ ACK FLAGS) (* ejs: "29-Dec-84 13:02")
(* send a control segment with the specified sequence
number and ACK information)
(PROG ((SEGMENT (fetch TCB.TEMPLATE of TCB)))
(if (NULL FLAGS)
then (SETQ FLAGS 0))
(CHECK (OR (NOT (BITTEST FLAGS (LOGOR \TCP.CTRL.SYN \TCP.CTRL.FIN)))
(SHOULDNT "SYN or FIN")))
(while (fetch EPTRANSMITTING of SEGMENT) do (BLOCK))
(replace TCP.SEQ of SEGMENT with SEQ)
(if ACK
then (replace TCP.ACK of SEGMENT with ACK)
(SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK))
else (replace TCP.ACK of SEGMENT with 0))
(replace TCP.CTRL of SEGMENT with FLAGS)
(replace TCP.WINDOW of SEGMENT with (fetch TCB.RCV.WND of TCB))
(\TCP.SEND.SEGMENT TCB SEGMENT FLAGS)
(\TCP.NEW.TEMPLATE TCB))))
(\TCP.SEND.ACK
(LAMBDA (TCB WHEN) (* ejs: " 3-Feb-85 22:26")
(* set TCB.ACKFLG to tell the \TCP.PROCESS that an ACK needs to be sent -- NOW means send the ack immediately, LATER
means delay in the hope that it can be piggybacked on an outgoing data segment)
(replace TCB.ACKFLG of TCB with (OR WHEN (QUOTE LATER)))
(COND
((EQ WHEN (QUOTE NOW))
(\TCP.SEND.CONTROL TCB (fetch TCB.SND.NXT of TCB)
(fetch TCB.RCV.NXT of TCB)
\TCP.CTRL.ACK)))))
(\TCP.SEND.RESET
(LAMBDA (ORIG SEQ ACK) (* ecc " 3-May-84 13:54")
(* like \TCP.SEND.CONTROL but always sends RST and can
be used without a TCB)
(PROG (SEGMENT FLAGS)
(SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS)
(fetch TCP.DST.PORT of ORIG)
(fetch TCP.SRC.ADDR of ORIG)
(fetch TCP.SRC.PORT of ORIG)))
(replace TCP.SEQ of SEGMENT with SEQ)
(if ACK
then (replace TCP.ACK of SEGMENT with ACK)
(SETQ FLAGS (LOGOR \TCP.CTRL.RST \TCP.CTRL.ACK))
else (replace TCP.ACK of SEGMENT with 0)
(SETQ FLAGS \TCP.CTRL.RST))
(replace TCP.CTRL of SEGMENT with FLAGS)
(replace TCP.WINDOW of SEGMENT with 0)
(replace EPREQUEUE of SEGMENT with (QUOTE FREE))
(\TCP.SEND.SEGMENT NIL SEGMENT FLAGS))))
(\TCP.FIX.OUTGOING.SEGMENT
(LAMBDA (TCB SEGMENT FLAGS) (* ecc "16-May-84 12:24")
(* fill in control bits, ACK and window information,
and start round trip timer)
(if (BITTEST FLAGS \TCP.CTRL.ACK)
then (replace TCP.ACK of SEGMENT with (fetch TCB.RCV.NXT of TCB))
else (replace TCP.ACK of SEGMENT with 0))
(replace TCP.CTRL of SEGMENT with FLAGS) (* set control bits)
(replace TCP.WINDOW of SEGMENT with (fetch TCB.RCV.WND of TCB))
(if (NULL (fetch TCB.RTFLG of TCB))
then (* time round trip response to this segment)
(replace TCB.RTFLG of TCB with T)
(replace TCB.RTSEQ of TCB with (fetch TCP.SEQ of SEGMENT))
(replace TCB.RTTIMER of TCB with (SETUPTIMER 0 (fetch TCB.RTTIMER of TCB))))))
(\TCP.SEND.DATA
(LAMBDA (TCB SEGMENT LENGTH FLAGS) (* ejs: " 3-Feb-85 22:01")
(* This function is used to send a TCP data segment for
the first time. Subsequent retransmissions are done
directly through \TCP.SEND.SEGMENT)
(PROG (SEQ TOP)
(CHECK (OR (EQ LENGTH (\TCP.DATA.LENGTH SEGMENT))
(SHOULDNT "bad segment length")))
(CHECK (OR (ILEQ LENGTH (fetch TCB.MAXSEG of TCB))
(SHOULDNT "segment > max segment size")))
(if (NEQ (fetch TCB.STATE of TCB)
(QUOTE SYN.SENT))
then (* ACK in all synchronized states)
(SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK)))
(SETQ SEQ (fetch TCB.SND.NXT of TCB)) (* assign sequence number)
(if (fetch TCB.ACKFLG of TCB)
then (SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.ACK)))
(SETQ TOP (IPLUS SEQ LENGTH (\TCP.SYN.OR.FIN FLAGS)))
(CHECK (OR (\32BIT.GEQ TOP (fetch TCB.SND.NXT of TCB))
(SHOULDNT "bad sequence numbers")))
(replace TCP.SEQ of SEGMENT with SEQ)
(if (BITTEST FLAGS \TCP.CTRL.URG)
then (replace TCB.SND.UP of TCB with TOP))
(if (\32BIT.GT (fetch TCB.SND.UP of TCB)
SEQ)
then (* there's urgent data to send)
(SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.URG))
(replace TCP.URG.PTR of SEGMENT with (IDIFFERENCE (fetch TCB.SND.UP of TCB)
SEQ))
else (* no urgent data)
(* drag the urgent pointer along at the left edge of
the window)
(replace TCB.SND.UP of TCB with (fetch TCB.SND.UNA of TCB)))
(if (BITTEST FLAGS \TCP.CTRL.FIN)
then (* remember the sequence number of the FIN so we can
tell when it's been acked)
(CHECK (OR (EQ (fetch TCB.STATE of TCB)
(QUOTE FIN.WAIT.1))
(EQ (fetch TCB.STATE of TCB)
(QUOTE LAST.ACK))
(SHOULDNT "bad state for FIN")))
(replace TCB.FINSEQ of TCB with TOP))
(do (* try to send segment)
(SELECTQ (fetch TCB.STATE of TCB)
(LISTEN (ERROR "TCP connection not established"))
((SYN.SENT SYN.RECEIVED ESTABLISHED FIN.WAIT.1 CLOSE.WAIT LAST.ACK)
(if (OR (ZEROP LENGTH)
(ZEROP (fetch TCB.SND.WL1 of TCB))
(\32BIT.LEQ SEQ (IPLUS (fetch TCB.SND.UNA of TCB)
(fetch TCB.SND.WND of TCB)))
(\32BIT.GT (fetch TCB.SND.UP of TCB)
(fetch TCB.SND.UNA of TCB)))
then (* go ahead and send it)
(replace TCB.SND.NXT of TCB with TOP)
(* advance SND.NXT)
(\TCP.FIX.OUTGOING.SEGMENT TCB SEGMENT FLAGS)
(replace EPREQUEUE of SEGMENT with (fetch TCB.REXMT.QUEUE
of TCB))
(\TCP.SEND.SEGMENT TCB SEGMENT FLAGS)
(RETURN)
else (* block until we can send it)
(MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB)
(fetch TCB.SND.EVENT of TCB))))
((FIN.WAIT.2 CLOSING TIME.WAIT)
(ERROR "TCP connection closing"))
(CLOSED (ERROR "TCP connection closed"))
(SHOULDNT))))))
(\TCP.SEND.SEGMENT
(LAMBDA (TCB SEGMENT FLAGS) (* ejs: "28-Dec-84 18:06")
(* common routine to transmit a TCP segment)
(\TCP.CHECKSUM.OUTGOING TCB SEGMENT)
(\TCP.TRACE.SEGMENT (QUOTE SEND)
SEGMENT)
(if TCB
then (if (BITTEST FLAGS \TCP.CTRL.ACK)
then (replace TCB.ACKFLG of TCB with NIL))
(\TCP.START.PROBE.TIMER TCB))
(\IP.TRANSMIT SEGMENT)))
(\TCP.NEW.TEMPLATE
(LAMBDA (TCB) (* ejs: "29-Dec-84 13:05")
(replace TCB.TEMPLATE of TCB with NIL)
(\TCP.TEMPLATE TCB)))
(\TCP.START.PROBE.TIMER
(LAMBDA (TCB) (* ecc "19-Apr-84 18:12")
(replace TCB.PROBE.TIMER of TCB with (SETUPTIMER (ITIMES 2 (fetch TCB.RTO of TCB))
(fetch TCB.PROBE.TIMER of TCB)))))
(\TCP.RETRANSMIT
(LAMBDA (TCB) (* ecc "16-May-84 11:53")
(* find the first unacknowledged segment and retransmit
it)
(PROG ((QUEUE (fetch TCB.REXMT.QUEUE of TCB))
(UNA (fetch TCB.SND.UNA of TCB))
CURRENT CURSEQ NEXT PREV REST FIRSTSEG MINSEQ FLAGS)
(UNINTERRUPTABLY (* detach the list of segments to be retransmitted so
we don't interfere with the driver)
(SETQ NEXT (fetch SYSQUEUEHEAD of QUEUE))
(replace SYSQUEUEHEAD of QUEUE with NIL)
(replace SYSQUEUETAIL of QUEUE with NIL))
(while (SETQ CURRENT NEXT)
do (SETQ NEXT (fetch QLINK of CURRENT))
(replace QLINK of CURRENT with NIL)
(if (\32BIT.LEQ (IPLUS (SETQ CURSEQ (fetch TCP.SEQ of CURRENT))
(\TCP.DATA.LENGTH CURRENT)
(\TCP.SYN.OR.FIN (fetch TCP.CTRL of CURRENT)))
UNA)
then (* this segment has already been acked)
(\TCP.RELEASE.SEGMENT CURRENT)
elseif (NULL FIRSTSEG)
then (* this is the first unacked segment we've encountered)
(SETQ FIRSTSEG CURRENT)
(SETQ MINSEQ CURSEQ)
elseif (\32BIT.LT CURSEQ MINSEQ)
then (* this is the lowest sequence number seen so so far;
put the previous contender back on the REST queue)
(replace QLINK of FIRSTSEG with REST)
(SETQ REST FIRSTSEG)
(SETQ FIRSTSEG CURRENT)
(SETQ MINSEQ CURSEQ)
else (* this is an unacked segment but later than one we've
already seen; just add it to the REST queue)
(replace QLINK of CURRENT with REST)
(SETQ REST CURRENT)))
(UNINTERRUPTABLY (* set the retransmit queue to be the REST queue we've
accumulated)
(if (SETQ CURRENT REST)
then (* find tail of REST queue)
(while (SETQ NEXT (fetch QLINK of CURRENT)) do (SETQ CURRENT NEXT)))
(replace SYSQUEUEHEAD of QUEUE with REST)
(replace SYSQUEUETAIL of QUEUE with CURRENT))
(if FIRSTSEG
then (SETQ FLAGS (fetch TCP.CTRL of FIRSTSEG))
(\TCP.FIX.OUTGOING.SEGMENT TCB FIRSTSEG FLAGS)
(replace EPREQUEUE of FIRSTSEG with (fetch TCB.REXMT.QUEUE of TCB))
(\TCP.SEND.SEGMENT TCB FIRSTSEG FLAGS)
(RETURN T)
else (RETURN NIL)))))
(\TCP.START.TIME.WAIT
(LAMBDA (TCB) (* ecc "16-Apr-84 17:58")
(* start 2MSL timer)
(replace TCB.2MSL.TIMER of TCB with (SETUPTIMER (ITIMES 2 \TCP.MSL)
(fetch TCB.2MSL.TIMER of TCB)))
(\TCP.TRACE.TRANSITION TCB (QUOTE TIME.WAIT))
(replace TCB.STATE of TCB with (QUOTE TIME.WAIT))))
(\TCP.CONNECTION.DROPPED
(LAMBDA (TCB MSG) (* ejs: "29-Jan-85 16:06")
(if TCPTRACEFLG
then (printout TCPTRACEFILE .TAB0 0 "[TCP connection " (OR MSG "dropped")
"]" T))
(\TCP.TRACE.TRANSITION TCB (QUOTE CLOSED))
(replace TCB.STATE of TCB with (QUOTE CLOSED))
(AND (OPENP (fetch TCB.RCV.STREAM of TCB)
(QUOTE INPUT))
(CLOSEF (fetch TCB.RCV.STREAM of TCB)))
(AND (OPENP (fetch TCB.SND.STREAM of TCB)
(QUOTE OUTPUT))
(CLOSEF (fetch TCB.SND.STREAM of TCB)))
(NOTIFY.EVENT (fetch TCB.RCV.EVENT of TCB))))
)
(* support for ICMP messages that affect TCP connections)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \ICMP.PROTOCOL 1)
(CONSTANTS \ICMP.PROTOCOL)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \ICMP.32BIT.WORDS 2)
(CONSTANTS \ICMP.32BIT.WORDS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \ICMP.DESTINATION.UNREACHABLE 3)
(RPAQQ \ICMP.SOURCE.QUENCH 4)
(CONSTANTS \ICMP.DESTINATION.UNREACHABLE \ICMP.SOURCE.QUENCH)
)
)
(DEFINEQ
(\TCP.HANDLE.ICMP
(LAMBDA (SEGMENT) (* ejs: " 5-Jan-85 16:52")
(* handle ICMP messages)
(PROG (MSG TCB)
(if (NEQ (fetch (ICMP ICMPTYPE) of SEGMENT)
\ICMP.DESTINATION.UNREACHABLE)
then (RETURN))
(SETQ MSG (SELECTQ (fetch (ICMP ICMPCODE) of SEGMENT)
(0 "net unreachable")
(1 "host unreachable")
(2 "protocol unreachable")
(3 "port unreachable")
(4 "fragmentation needed and DF set")
(5 "source route failed")
"destination unreachable (unknown code)"))
(add (fetch (IP IPHEADERLENGTH) of SEGMENT)
\ICMP.32BIT.WORDS) (* adjust header so that segment will look like
original TCP segment)
(SETQ TCB (\TCP.LOOKUP.TCB (fetch TCP.DST.ADDR of SEGMENT)
(fetch TCP.DST.PORT of SEGMENT)
(fetch TCP.SRC.PORT of SEGMENT)))
(if (OR (NULL TCB)
(EQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED)))
then (RETURN))
(\TCP.CONNECTION.DROPPED TCB MSG))))
)
(* TCP stream routines)
(DEFINEQ
(TCP.OPEN
(LAMBDA (DST.HOST DST.PORT SRC.PORT MODE ACCESS NOERRORFLG)
(* ecc " 7-May-84 17:06")
(PROG (TCB)
(SELECTQ ACCESS
(INPUT)
(APPEND)
(OUTPUT (SETQ ACCESS (QUOTE APPEND)))
(LISPERROR "ILLEGAL ARG" ACCESS))
(SETQ TCB (\TCP.CONNECTION DST.HOST DST.PORT SRC.PORT MODE))
(RETURN (if (NULL TCB)
then (if NOERRORFLG
then NIL
else (ERROR "TCP connection failed"))
else (SELECTQ ACCESS
(INPUT (fetch TCB.RCV.STREAM of TCB))
(APPEND (fetch TCB.SND.STREAM of TCB))
(SHOULDNT)))))))
(TCP.OTHER.STREAM
(LAMBDA (STREAM) (* ecc "14-May-84 16:52")
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (NOT (type? TCP.CONTROL.BLOCK TCB))
then (ERROR "no TCP control block"))
(RETURN (SELECTQ (fetch (TCPSTREAM ACCESS) of STREAM)
(INPUT (fetch TCB.SND.STREAM of TCB))
(APPEND (fetch TCB.RCV.STREAM of TCB))
(SHOULDNT))))))
(\TCP.BIN
(LAMBDA (STREAM) (* ecc " 3-May-84 13:55")
(do (if (ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
then (RETURN (\GETBASEBYTE (fetch CPPTR of STREAM)
(PROG1 (fetch COFFSET of STREAM)
(add (fetch COFFSET of STREAM)
1))))
elseif (NULL (\TCP.GET.SEGMENT STREAM))
then (RETURN (STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM))))))
(\TCP.BACKFILEPTR
(LAMBDA (STREAM) (* ejs: " 5-Jan-85 17:50")
(COND
((AND (fetch CPPTR of STREAM)
(IGREATERP (fetch COFFSET of STREAM)
0))
(add (fetch COFFSET of STREAM)
-1))
(T (ERROR "Can't back up this TCP Stream" STREAM)))))
(\TCP.GETNEXTBUFFER
(LAMBDA (STREAM WHATFOR NOERRORFLG) (* ejs: "12-Jan-85 22:42")
(add (fetch (TCPSTREAM PACKET.WINDOW) of STREAM)
(fetch (STREAM CBUFSIZE) of STREAM))
(SELECTQ WHATFOR
(READ (\TCP.GET.SEGMENT STREAM NOERRORFLG))
(WRITE (\TCP.FLUSH STREAM)
(\TCP.FILL.IN.SEGMENT STREAM))
(SHOULDN'T))))
(\TCP.GET.SEGMENT
(LAMBDA (STREAM NOERRORFLG) (* ejs: " 9-Mar-85 17:11")
(* * Get the next segment from the input stream. Return T if successful; otherwise, an error code.
Call the user-specified error handler to get a code, if necessary)
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))
SEGMENT SEQ LEN OLDSEGMENT OLDSEQ OLDLEN OLDTOP SUCCESS)
(if (OR (NULL TCB)
(AND (NEQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
(NEQ STREAM (fetch TCB.RCV.STREAM of TCB))))
then (ERROR "not TCP input stream"))
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(SETQ OLDSEGMENT (fetch TCB.RCV.SEGMENT of TCB))
(CHECK (OR (NULL OLDSEGMENT)
(EQ (fetch TCP.DATA.LENGTH of OLDSEGMENT)
(fetch CBUFSIZE of STREAM))
(SHOULDNT "inconsistent stream buffer size")))
(UNINTERRUPTABLY
(replace TCB.RCV.SEGMENT of TCB with NIL)
(replace CPPTR of STREAM with NIL)
(replace CBUFSIZE of STREAM with 0)
(replace COFFSET of STREAM with 0))
(if OLDSEGMENT
then (* remember sequence number range of previous segment
so we can adjust for overlap)
(SETQ OLDTOP (IPLUS (SETQ OLDSEQ (fetch TCP.SEQ of OLDSEGMENT))
(SETQ OLDLEN (fetch TCP.DATA.LENGTH
of OLDSEGMENT))))
(\TCP.RELEASE.SEGMENT OLDSEGMENT)
(SETQ OLDSEGMENT T))
(* look at first segment in input queue to see if it overlaps the sequence number range we're expecting;
there may be duplicates that must be skipped over)
(do ((CHECK (\TCP.CHECK.INPUT.QUEUE TCB))
(COND
((AND (SETQ SEGMENT (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)))
(\32BIT.LT (SETQ SEQ (fetch TCP.SEQ of SEGMENT))
(fetch TCB.RCV.NXT of TCB)))
(* this segment is within the range of contiguous
sequence numbers received so far, because its sequence
number is less than RCV.NXT)
(\DEQUEUE (fetch TCB.INPUT.QUEUE of TCB))
(SETQ LEN (fetch TCP.DATA.LENGTH of SEGMENT))
(COND
((AND OLDSEGMENT (\32BIT.LEQ (IPLUS SEQ LEN)
OLDTOP))
(* this segment is a duplicate)
(\TCP.RELEASE.SEGMENT SEGMENT))
(T (* this segment overlaps with the range of sequence
numbers we're expecting)
(CHECK (OR (NOT OLDSEGMENT)
(\32BIT.LEQ SEQ OLDTOP)
(SHOULDNT "gap in input queue")))
(UNINTERRUPTABLY
(replace CPPTR of STREAM with (fetch TCP.CONTENTS
of SEGMENT))
(* eliminate overlap)
(replace COFFSET of STREAM
with (COND
(OLDSEGMENT (IDIFFERENCE OLDLEN (IDIFFERENCE
SEQ OLDSEQ)))
(T 0)))
(replace CBUFSIZE of STREAM with LEN)
(replace TCB.RCV.SEGMENT of TCB with SEGMENT))
(SETQ SUCCESS T)
(RETURN))))
(T (SELECTQ (fetch TCB.STATE of TCB)
((LISTEN SYN.SENT SYN.RECEIVED)
(* wait until established)
(MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB)
(fetch TCB.ESTABLISHED
of TCB)))
((ESTABLISHED FIN.WAIT.1 FIN.WAIT.2)
(* wait for next segment)
(MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB)
(fetch TCB.RCV.EVENT of TCB))
(SELECTQ (fetch TCB.STATE of TCB)
((CLOSED CLOSING LAST.ACK TIME.WAIT)
(RELEASE.MONITORLOCK (fetch TCB.LOCK
of TCB))
(COND
(NOERRORFLG (APPLY* (fetch (STREAM
ENDOFSTREAMOP)
of STREAM)
STREAM T)
(RETURN NIL))
(T (RETURN (SETQ SUCCESS (\EOF.ACTION
STREAM))))))
NIL))
((CLOSED CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT)
(* return NIL to punt to ENDOFSTREAMOP in \TCP.BIN)
(RELEASE.MONITORLOCK (fetch TCB.LOCK of TCB))
(COND
(NOERRORFLG (APPLY* (fetch (STREAM ENDOFSTREAMOP)
of STREAM)
STREAM T)
(RETURN NIL))
(T (RETURN (SETQ SUCCESS (\EOF.ACTION STREAM))))))
(SHOULDNT)))))))
(RETURN SUCCESS))))
(\TCP.PEEKBIN
(LAMBDA (STREAM NOERRORFLG) (* ecc " 3-May-84 13:55")
(do (if (ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
then (RETURN (\GETBASEBYTE (fetch CPPTR of STREAM)
(fetch COFFSET of STREAM)))
elseif (NULL (\TCP.GET.SEGMENT STREAM))
then (RETURN (if NOERRORFLG
then NIL
else (STREAMOP (QUOTE ENDOFSTREAMOP)
STREAM STREAM)))))))
(\TCP.GETFILEPTR
(LAMBDA (STREAM) (* ejs: "12-Jan-85 22:43")
(IPLUS (fetch (TCPSTREAM PACKET.WINDOW) of STREAM)
(fetch (STREAM COFFSET) of STREAM))))
(\TCP.READP
(LAMBDA (STREAM) (* ecc " 7-May-84 14:22")
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (OR (NULL TCB)
(AND (NEQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
(NEQ STREAM (fetch TCB.RCV.STREAM of TCB))))
then (ERROR "not TCP input stream")
else (RETURN (ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM)))))))
(\TCP.EOFP
(LAMBDA (STREAM) (* ejs: "12-Jan-85 20:02")
(* check whether EOF has been reached on stream -- may
block waiting for next segment)
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (NULL TCB)
then (ERROR "not TCP stream")
elseif (AND (NEQ (QUOTE CLOSED)
(fetch TCB.STATE of TCB))
(EQ STREAM (fetch TCB.SND.STREAM of TCB)))
then (RETURN T) (* Always at EOF of outgoing stream.)
elseif (OR (ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
(NOT (NULL (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB)))))
then (* there is still data left to read)
(RETURN NIL)
else (RETURN (SELECTQ (fetch TCB.STATE of TCB)
(ESTABLISHED NIL)
((LISTEN SYN.SENT SYN.RECEIVED FIN.WAIT.1 FIN.WAIT.2)
(* can't tell without waiting for next segment)
(NULL (\TCP.GET.SEGMENT STREAM)))
((CLOSE.WAIT CLOSING LAST.ACK TIME.WAIT CLOSED)
(* no more data can be forthcoming)
T)
(SHOULDNT)))))))
(TCP.URGENTP
(LAMBDA (STREAM) (* ecc " 7-May-84 14:27")
(* check if current point in receive stream is before
receive urgent pointer)
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (OR (NULL TCB)
(NEQ STREAM (fetch TCB.RCV.STREAM of TCB)))
then (ERROR "not TCP input stream"))
(RETURN (AND (fetch TCB.RCV.SEGMENT of TCB)
(\32BIT.GT (fetch TCB.RCV.UP of TCB)
(IPLUS (fetch TCP.SEQ of (fetch TCB.RCV.SEGMENT of TCB))
(fetch COFFSET of STREAM))))))))
(TCP.URGENT.EVENT
(LAMBDA (STREAM) (* edited: "22-May-84 18:10")
(* return the urgent data event so that a user process
can wait for it)
(fetch TCB.URGENT.EVENT of (fetch (TCPSTREAM TCB) of STREAM))))
(\TCP.BOUT
(LAMBDA (STREAM CHAR) (* ecc " 3-May-84 13:55")
(do (if (ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
then (\PUTBASEBYTE (fetch CPPTR of STREAM)
(fetch COFFSET of STREAM)
CHAR)
(add (fetch COFFSET of STREAM)
1)
(RETURN)
else (\TCP.FLUSH STREAM)
(\TCP.FILL.IN.SEGMENT STREAM)))))
(\TCP.FLUSH
(LAMBDA (STREAM FLAGS) (* ejs: " 5-Jan-85 16:54")
(* Force out current output segment. If FLAGS is non-nil, send a segment with those flags even if we have to create
a new one)
(PROG ((TCB (fetch TCB of STREAM))
SEGMENT LENGTH)
(if (OR (NULL TCB)
(AND (NEQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
(NEQ STREAM (fetch TCB.SND.STREAM of TCB))))
then (ERROR "not TCP output stream"))
(SETQ LENGTH (fetch COFFSET of STREAM))
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(if (OR (AND (SETQ SEGMENT (fetch TCB.SND.SEGMENT of TCB))
(NOT (ZEROP LENGTH)))
(AND FLAGS (SETQ SEGMENT (\TCP.FILL.IN.SEGMENT STREAM))))
then (if (NULL FLAGS)
then (SETQ FLAGS 0))
(CHECK (OR (NOT (ZEROP LENGTH))
(NOT (ZEROP (\TCP.SYN.OR.FIN FLAGS)))
(SHOULDNT "sending empty segment")))
(if (AND (IGREATERP LENGTH 0)
(ILESSP LENGTH \TCP.DEFAULT.MAXSEG))
then (* PSH this segment to make sure it gets through to the
remote process)
(SETQ FLAGS (LOGOR FLAGS \TCP.CTRL.PSH)))
(UNINTERRUPTABLY
(replace TCB.SND.SEGMENT of TCB with NIL)
(replace CBUFSIZE of STREAM with 0)
(replace COFFSET of STREAM with 0)
(replace CPPTR of STREAM with NIL))
(add (fetch (IP IPTOTALLENGTH) of SEGMENT)
LENGTH)
(\TCP.SEND.DATA TCB SEGMENT LENGTH FLAGS))))))
(\TCP.FORCEOUTPUT
(LAMBDA (STREAM WAITFLG) (* ecc "30-May-84 10:25")
(* just call \TCP.FLUSH with no flags -- to implement
WAITFLG we should wait for SND.UNA to overtake the
current SND.NXT)
(\TCP.FLUSH STREAM)))
(TCP.URGENT.MARK
(LAMBDA (STREAM) (* ecc " 7-May-84 14:17")
(* mark the current point in the output stream as the
end of urgent data)
(\TCP.FLUSH STREAM \TCP.CTRL.URG)))
(\TCP.FILL.IN.SEGMENT
(LAMBDA (STREAM) (* ejs: " 5-Jan-85 16:15")
(* set up a new segment to be filled by the output
stream)
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM))
SEGMENT)
(SETQ SEGMENT (\TCP.SETUP.SEGMENT (\LOCAL.IP.ADDRESS)
(fetch TCB.SRC.PORT of TCB)
(fetch TCB.DST.HOST of TCB)
(fetch TCB.DST.PORT of TCB)))
(UNINTERRUPTABLY
(replace TCB.SND.SEGMENT of TCB with SEGMENT)
(replace CPPTR of STREAM with (fetch TCP.CONTENTS of SEGMENT))
(replace COFFSET of STREAM with 0)
(replace CBUFSIZE of STREAM with (fetch TCB.MAXSEG of TCB))
(replace CBUFMAXSIZE of STREAM with (fetch TCB.MAXSEG of TCB)))
(RETURN SEGMENT))))
(\TCP.CLOSE
(LAMBDA (STREAM) (* ejs: "29-Jan-85 17:19")
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (OR (NULL TCB)
(FMEMB (fetch TCB.STATE of TCB)
(QUOTE (CLOSED TIME.WAIT))))
then (RETURN))
(if (NOT (fetch TCB.CLOSEDFLG of TCB))
then (TCP.CLOSE.SENDER (fetch TCB.SND.STREAM of TCB)))
(if (EQ STREAM (fetch TCB.RCV.STREAM of TCB))
then (while (\QUEUEHEAD (fetch TCB.INPUT.QUEUE of TCB))
do (* gobble remaining segments from remote end)
(\TCP.GET.SEGMENT STREAM))))))
(TCP.CLOSE.SENDER
(LAMBDA (STREAM) (* ecc " 7-May-84 13:44")
(PROG ((TCB (fetch (TCPSTREAM TCB) of STREAM)))
(if (OR (NULL TCB)
(EQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
(fetch TCB.CLOSEDFLG of TCB))
then (RETURN))
(WITH.MONITOR (fetch TCB.LOCK of TCB)
(replace TCB.CLOSEDFLG of TCB with T)
(SELECTQ (fetch TCB.STATE of TCB)
((LISTEN SYN.SENT)
(\TCP.CONNECTION.DROPPED TCB "closed"))
((SYN.RECEIVED ESTABLISHED)
(\TCP.TRACE.TRANSITION TCB (QUOTE FIN.WAIT.1))
(replace TCB.STATE of TCB with (QUOTE FIN.WAIT.1))
(\TCP.FLUSH STREAM \TCP.CTRL.FIN))
(CLOSE.WAIT (\TCP.TRACE.TRANSITION TCB (QUOTE LAST.ACK))
(replace TCB.STATE of TCB with (QUOTE LAST.ACK))
(* There is an inconsistency in the spec about this transition: the description of the CLOSE operation says to go to
the CLOSING state, while the diagram shows a transition to the LAST.ACK state. Since the LAST.ACK state avoids the
2MSL wait, we use it.)
(\TCP.FLUSH STREAM \TCP.CTRL.FIN))
NIL)
(while (NOT (OR (EQ (fetch TCB.STATE of TCB)
(QUOTE CLOSED))
(\TCP.OUR.FIN.IS.ACKED TCB)))
do (MONITOR.AWAIT.EVENT (fetch TCB.LOCK of TCB)
(fetch TCB.FINACKED.EVENT of TCB)))))))
(TCP.STOP
(LAMBDA NIL (* ejs: "28-Dec-84 18:02")
(MAPC \TCP.CONTROL.BLOCKS (FUNCTION \TCP.DELETE.TCB))
(SETQ \TCP.CONTROL.BLOCKS NIL)
(\IP.DELETE.PROTOCOL \TCP.PROTOCOL)))
)
(* well-known ports for network standard functions)
(RPAQQ \TCP.ASSIGNED.PORTS (\TCP.ECHO.PORT \TCP.SINK.PORT \TCP.SYSTAT.PORT \TCP.DAYTIME.PORT
\TCP.NETSTAT.PORT \TCP.FAUCET.PORT \TCP.FTP.PORT
\TCP.TELNET.PORT \TCP.SMTP.PORT \TCP.TIME.PORT
\TCP.NAME.PORT \TCP.WHOIS.PORT \TCP.NAMESERVER.PORT
\TCP.FINGER.PORT \TCP.TTYLINK.PORT \TCP.SUPDUP.PORT
\TCP.HOSTNAMES.PORT \TCP.UNIXEXEC.PORT \TCP.UNIXLOGIN.PORT
\TCP.UNIXSHELL.PORT))
(DECLARE: EVAL@COMPILE
(RPAQQ \TCP.ECHO.PORT 7)
(RPAQQ \TCP.SINK.PORT 9)
(RPAQQ \TCP.SYSTAT.PORT 11)
(RPAQQ \TCP.DAYTIME.PORT 13)
(RPAQQ \TCP.NETSTAT.PORT 15)
(RPAQQ \TCP.FAUCET.PORT 19)
(RPAQQ \TCP.FTP.PORT 21)
(RPAQQ \TCP.TELNET.PORT 23)
(RPAQQ \TCP.SMTP.PORT 25)
(RPAQQ \TCP.TIME.PORT 37)
(RPAQQ \TCP.NAME.PORT 42)
(RPAQQ \TCP.WHOIS.PORT 43)
(RPAQQ \TCP.NAMESERVER.PORT 53)
(RPAQQ \TCP.FINGER.PORT 79)
(RPAQQ \TCP.TTYLINK.PORT 87)
(RPAQQ \TCP.SUPDUP.PORT 95)
(RPAQQ \TCP.HOSTNAMES.PORT 101)
(RPAQQ \TCP.UNIXEXEC.PORT 512)
(RPAQQ \TCP.UNIXLOGIN.PORT 513)
(RPAQQ \TCP.UNIXSHELL.PORT 514)
(CONSTANTS \TCP.ECHO.PORT \TCP.SINK.PORT \TCP.SYSTAT.PORT \TCP.DAYTIME.PORT \TCP.NETSTAT.PORT
\TCP.FAUCET.PORT \TCP.FTP.PORT \TCP.TELNET.PORT \TCP.SMTP.PORT \TCP.TIME.PORT
\TCP.NAME.PORT \TCP.WHOIS.PORT \TCP.NAMESERVER.PORT \TCP.FINGER.PORT \TCP.TTYLINK.PORT
\TCP.SUPDUP.PORT \TCP.HOSTNAMES.PORT \TCP.UNIXEXEC.PORT \TCP.UNIXLOGIN.PORT
\TCP.UNIXSHELL.PORT)
)
(* Stub for debugging)
(RPAQ? \TCP.DEBUGGABLE )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \TCP.DEBUGGABLE)
)
(DEFINEQ
(PPTCB
(LAMBDA (TCB FILE) (* ejs: " 5-Feb-85 16:47")
(DECLARE (GLOBALVARS \TCP.DEBUGGABLE))
(COND
(\TCP.DEBUGGABLE (printout FILE "TCP connection from " # (\IP.PRINT.ADDRESS (\LOCAL.IP.ADDRESS)
FILE)
":"
(fetch TCB.SRC.PORT of TCB)
" to " # (\IP.PRINT.ADDRESS (fetch TCB.DST.HOST of TCB)
FILE)
":"
(fetch TCB.DST.PORT of TCB)
" "
(fetch TCB.STATE of TCB)
T)
(printout FILE " iss " (fetch TCB.ISS of TCB)
" window "
(fetch TCB.SND.UNA of TCB)
".."
(IPLUS (fetch TCB.SND.UNA of TCB)
(fetch TCB.SND.WND of TCB))
" next "
(fetch TCB.SND.NXT of TCB))
(if (fetch TCB.FINSEQ of TCB)
then (printout FILE " fin " (fetch TCB.FINSEQ of TCB)))
(printout FILE " rto " (fetch TCB.RTO of TCB)
T)
(printout FILE " irs " (fetch TCB.IRS of TCB)
" next "
(fetch TCB.RCV.NXT of TCB)
" window "
(fetch TCB.RCV.NXT of TCB)
".."
(IPLUS (fetch TCB.RCV.NXT of TCB)
(fetch TCB.RCV.WND of TCB))
T)
(\TCP.PRINT.SEGMENT.QUEUE "retransmit queue" (fetch TCB.REXMT.QUEUE
of TCB)
FILE)
(\TCP.PRINT.SEGMENT.QUEUE "input queue" (fetch TCB.INPUT.QUEUE of TCB)
FILE)))))
(\TCP.TRACE.SEGMENT
(LAMBDA (CALLER SEGMENT) (* ejs: " 5-Feb-85 16:50")
(DECLARE (GLOBALVARS \TCP.DEBUGGABLE TCPTRACEFLG))
(if (AND \TCP.DEBUGGABLE (MEMB CALLER TCPTRACEFLG))
then (printout TCPTRACEFILE .TAB0 0 # (\TCP.PRINT.ELAPSED.TIME TCPTRACEFILE)
CALLER ": " # (TCP.PRINT.SEGMENT SEGMENT TCPTRACEFILE NIL (MEMB (QUOTE
CONTENTS)
TCPTRACEFLG))))
))
(\TCP.TRACE.TRANSITION
(LAMBDA (TCB NEWSTATE) (* ejs: " 5-Feb-85 16:51")
(DECLARE (GLOBALVARS \TCP.DEBUGGABLE))
(if (AND \TCP.DEBUGGABLE (MEMB (QUOTE TRANSITION)
TCPTRACEFLG)
(NEQ (fetch TCB.STATE of TCB)
NEWSTATE))
then (printout TCPTRACEFILE .TAB0 0 # (\TCP.PRINT.ELAPSED.TIME TCPTRACEFILE)
(fetch TCB.SRC.PORT of TCB)
"/"
(fetch TCB.DST.PORT of TCB)
": "
(fetch TCB.STATE of TCB)
" ---> " NEWSTATE))))
)
(* TCP initialization)
(DEFINEQ
(\TCP.INIT
(LAMBDA NIL (* ejs: " 9-Feb-85 14:24")
(if (NULL \TCP.DEVICE)
then (SETQ \TCP.DEVICE (create FDEV
FDBINABLE ← T
FDBOUTABLE ← T
BUFFERED ← T
CLOSEFILE ←(FUNCTION \TCP.CLOSE)
BIN ←(FUNCTION \BUFFERED.BIN)
BOUT ←(FUNCTION \BUFFERED.BOUT)
BLOCKIN ←(FUNCTION \BUFFERED.BINS)
PEEKBIN ←(FUNCTION \BUFFERED.PEEKBIN)
READP ←(FUNCTION \TCP.READP)
FORCEOUTPUT ←(FUNCTION \TCP.FORCEOUTPUT)
GETNEXTBUFFER ←(FUNCTION \TCP.GETNEXTBUFFER)
BACKFILEPTR ←(FUNCTION \TCP.BACKFILEPTR)
GETFILEPTR ←(FUNCTION \TCP.GETFILEPTR)
EOFP ←(FUNCTION \TCP.EOFP)
DEVICENAME ←(QUOTE TCP)
EVENTFN ←(FUNCTION NILL)))
(\DEFINEDEVICE (QUOTE TCP)
\TCP.DEVICE))
(SETQ \TCP.LOCK (CREATE.MONITORLOCK))
(if (NULL \TCP.PSEUDOHEADER)
then (SETQ \TCP.PSEUDOHEADER (create TCP.PSEUDOHEADER)))
(\IPINIT)
(\IP.ADD.PROTOCOL \TCP.PROTOCOL (FUNCTION \TCP.PORTCOMPARE))
(SETQ \TCP.MASTER.SOCKET (\IP.FIND.PROTOCOL \TCP.PROTOCOL))))
)
(\TCP.INIT)
(PUTPROPS GETOSTYPE READVICE (NIL (BEFORE NIL (if (DODIP.HOSTP HOST)
then
(* What a crock. *sigh*)
(RETURN (QUOTE UNIX))))))
(READVISE GETOSTYPE)
(PUTPROPS TCP COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (5575 7201 (SET.IP.ADDRESS 5585 . 6055) (STRING.TO.IP.ADDRESS 6057 . 6439) (
IP.ADDRESS.TO.STRING 6441 . 6766) (\LOCAL.IP.ADDRESS 6768 . 7199)) (9849 10207 (\TCP.SELECT.ISS 9859
. 10205)) (16143 22079 (\TCP.CREATE.TCB 16153 . 17647) (\TCP.SELECT.PORT 17649 . 18150) (
\TCP.LOOKUP.TCB 18152 . 19504) (\TCP.DELETE.TCB 19506 . 20535) (\TCP.PORTCOMPARE 20537 . 22077)) (
23335 27474 (\COMPUTE.CHECKSUM 23345 . 24411) (\TCP.CHECKSUM.INCOMING 24413 . 26154) (
\TCP.CHECKSUM.OUTGOING 26156 . 27472)) (27944 78187 (\TCP.PACKET.FILTER 27954 . 28400) (
\TCP.SETUP.SEGMENT 28402 . 29094) (\TCP.RELEASE.SEGMENT 29096 . 29518) (\TCP.CONNECTION 29520 . 33857)
(\TCP.FIX.INCOMING.SEGMENT 33859 . 34756) (\TCP.DATA.LENGTH 34758 . 35240) (\TCP.SYN.OR.FIN 35242 .
35768) (\TCP.INPUT 35770 . 39938) (\TCP.INPUT.INITIAL 39940 . 41282) (\TCP.INPUT.UNSYNC 41284 . 41779)
(\TCP.INPUT.LISTEN 41781 . 44086) (\TCP.INPUT.SYN.SENT 44088 . 47190) (\TCP.CHECK.WINDOW 47192 .
48556) (\TCP.CHECK.RESET 48558 . 49700) (\TCP.CHECK.SECURITY 49702 . 50089) (\TCP.CHECK.NO.SYN 50091
. 50972) (\TCP.CHECK.ACK 50974 . 51413) (\TCP.HANDLE.ACK 51415 . 53458) (\TCP.HANDLE.URG 53460 .
54357) (\TCP.QUEUE.INPUT 54359 . 58148) (\TCP.HANDLE.FIN 58150 . 59944) (\TCP.OUR.FIN.IS.ACKED 59946
. 60398) (\TCP.SIGNAL.URGENT.DATA 60400 . 60689) (\TCP.PROCESS 60691 . 64150) (\TCP.TEMPLATE 64152 .
65145) (\TCP.SEND.CONTROL 65147 . 66288) (\TCP.SEND.ACK 66290 . 66882) (\TCP.SEND.RESET 66884 . 67962)
(\TCP.FIX.OUTGOING.SEGMENT 67964 . 69044) (\TCP.SEND.DATA 69046 . 73027) (\TCP.SEND.SEGMENT 73029 .
73558) (\TCP.NEW.TEMPLATE 73560 . 73759) (\TCP.START.PROBE.TIMER 73761 . 74048) (\TCP.RETRANSMIT 74050
. 77000) (\TCP.START.TIME.WAIT 77002 . 77476) (\TCP.CONNECTION.DROPPED 77478 . 78185)) (78634 79939 (
\TCP.HANDLE.ICMP 78644 . 79937)) (79972 98265 (TCP.OPEN 79982 . 80743) (TCP.OTHER.STREAM 80745 . 81254
) (\TCP.BIN 81256 . 81813) (\TCP.BACKFILEPTR 81815 . 82176) (\TCP.GETNEXTBUFFER 82178 . 82587) (
\TCP.GET.SEGMENT 82589 . 87764) (\TCP.PEEKBIN 87766 . 88305) (\TCP.GETFILEPTR 88307 . 88536) (
\TCP.READP 88538 . 89066) (\TCP.EOFP 89068 . 90574) (TCP.URGENTP 90576 . 91314) (TCP.URGENT.EVENT
91316 . 91670) (\TCP.BOUT 91672 . 92164) (\TCP.FLUSH 92166 . 93990) (\TCP.FORCEOUTPUT 93992 . 94355) (
TCP.URGENT.MARK 94357 . 94668) (\TCP.FILL.IN.SEGMENT 94670 . 95672) (\TCP.CLOSE 95674 . 96435) (
TCP.CLOSE.SENDER 96437 . 98005) (TCP.STOP 98007 . 98263)) (99955 102614 (PPTCB 99965 . 101515) (
\TCP.TRACE.SEGMENT 101517 . 102008) (\TCP.TRACE.TRANSITION 102010 . 102612)) (102646 103947 (\TCP.INIT
102656 . 103945)))))
STOP