Initial commit of OpenSPARC T2 architecture model.
[OpenSPARC-T2-SAM] / obp / obp / pkg / netinet / tcp-input.fth
\ ========== Copyright Header Begin ==========================================
\
\ Hypervisor Software File: tcp-input.fth
\
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\
\ - Do no alter or remove copyright notices
\
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ conditions are met:
\
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility.
\
\ ========== Copyright Header End ============================================
id: @(#)tcp-input.fth 1.1 04/09/08
purpose: TCP input and FSM management
copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
headerless
: tcp-find-option ( pkt option# -- adr len true | false )
>r ( pkt ) ( r: option# )
dup dup tcpip-hlen@ ca+ swap >tcp-options ( end start )
begin 2dup > while ( end nxt )
dup c@ case
TCPOPT_NOP of ca1+ endof
TCPOPT_EOL of r> 3drop false exit endof
r@ of
nip dup ca1+ c@ r> drop true exit
endof
( default )
drop dup ca1+ c@ ca+ 0
endcase
repeat ( end nxt' )
r> 3drop false ( false ) ( r: )
;
\ Drop the connection in response to a bad incoming segment, marking the
\ specified error in the TCB. Send an acceptable RST segment to peer.
: tcp-abort ( tcb pkt error# -- )
>r over swap tcp-reset r> ( tcb error# )
over tcb-error! ( tcb )
TCPS_CLOSED over tcb-state! ( tcb )
tcb-kill-timers ( )
;
\ Determine if a received segment is acceptable (states >= SYN_RCVD).
\ There are 4 cases for the acceptability test
\ SEG.LEN RCV.WND Test
\ 0 0 SEG.SEQ = RCV.NXT
\ 0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND
\ >0 0 not acceptable
\ >0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND
\ or RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND
: tcp-segok? ( tcb pkt -- ok? )
over rcv-wnd@ 0= if ( tcb pkt )
dup seg-len@ 0= if ( tcb pkt )
seg-seq@ swap rcv-nxt@ seq= ( result )
else ( tcb pkt )
2drop false ( result )
then ( result )
else ( tcb pkt )
>r ( tcb ) ( r: pkt )
dup rcv-nxt@ swap rcv-wnd@ over + ( wnd.start wnd.end )
2dup r@ seg-seq@ -rot seq-within ( wnd.start wnd.end flag )
r@ seg-len@ if ( wnd.start wnd.end flag )
r@ seg-lastseq@ 2over seq-within or ( wnd.start wnd.end result )
then nip nip ( result )
r> drop ( result ) ( r: )
then ( result )
;
\ Generate an ACK in response to an incorrect incoming segment. The ACK
\ reports the correctly received sequence and the current window size.
\ An ACK is generated only if the incoming segment is not a RST segment.
: tcp-sendack ( tcb pkt -- )
is-tcprst? 0= if ( tcb )
dup TF_ACKNOW tcb-set-flags tcp-output ( )
else ( tcb )
drop ( )
then ( )
;
\ Determine if the received ACK is acceptable (states >= ESTABLISHED).
\ If this ACKs something not sent yet (SEG.ACK > SND.NXT), an ACK should
\ be sent in response, and this segment must be dropped.
: tcp-ackok? ( tcb pkt -- flag )
2dup seg-ack@ swap snd-nxt@ seq> if ( tcb pkt )
tcp-sendack false ( false )
else ( tcb pkt )
2drop true ( true )
then ( flag )
;
\ Process incoming SYN and schedule an immediate ACK.
: tcp-process-syn ( tcb pkt -- )
2dup seg-seq@ 1+ swap rcv-nxt! ( tcb pkt )
2dup seg-wnd@ swap snd-wnd! ( tcb pkt )
2dup seg-seq@ swap snd-wl1! ( tcb pkt )
TCPOPT_MSS tcp-find-option if ( tcb adr len )
drop 2 ca+ ntohw@ ( tcb mss )
else ( tcb )
TCP_DEFAULT_MSS ( tcb mss )
then ( tcb mss )
over tcb-mss@ min ( tcb mss' )
over 2dup tcb-mss! snd-cwnd! ( tcb )
TF_ACKNOW tcb-set-flags ( )
;
\ Handle send window updates from remote end.
: tcp-swindow-update ( tcb pkt -- )
swap ( pkt tcb )
over seg-seq@ over snd-wl1@ seq< if ( pkt tcb )
2drop exit ( )
then ( pkt tcb )
over seg-seq@ over snd-wl1@ seq= if ( pkt tcb )
over seg-ack@ over snd-wl2@ seq< if ( pkt tcb )
2drop exit ( )
then ( pkt tcb )
then ( pkt tcb )
over seg-wnd@ over snd-wnd! ( pkt tcb )
over seg-seq@ over snd-wl1! ( pkt tcb )
swap seg-ack@ swap snd-wl2! ( )
;
\ ACK processing. Accept send window updates, remove acknowledged data
\ from the retransmission queue, collect RTT estimates, manage the
\ retransmission timer, and update congestion window.
: tcp-process-ack ( tcb pkt -- )
\ Check for send window updates from all legal ACKs.
2dup tcp-swindow-update ( tcb pkt )
\ If the ACK is a duplicate, it can be ignored.
swap ( pkt tcb )
over seg-ack@ over snd-una@ seq<= if ( pkt tcb )
2drop exit ( )
then ( pkt tcb )
\ Remove acknowledged bytes from the send buffer.
over seg-ack@ over snd-una@ - ( pkt tcb #acked )
over tcb>sndbuf swap tcpbuf-drop ( pkt tcb )
\ Update SND.UNA
over seg-ack@ over snd-una! ( pkt tcb )
\ Update RTT estimators if this ACK acknowledges the
\ sequence number being timed and the segment was
\ not retransmitted.
dup tcb-flags@ TF_RTTGET and if ( pkt tcb )
over seg-ack@ over >tcb-rttseq l@ seq>= if ( pkt tcb )
dup TF_RTTGET tcb-clear-flags ( pkt tcb )
dup tcp-retransmitting? 0= if ( pkt tcb )
dup dup >tcbt-rexmit get-timer ( pkt tcb tcb rtt )
tcp-update-rto ( pkt tcb )
then ( pkt tcb )
then ( pkt tcb )
then ( pkt tcb )
\ If all outstanding data has now been acknowledged,
\ cancel the retransmission timer. Else, restart it
\ using the current RTO estimate.
over seg-ack@ over snd-max@ seq= if ( pkt tcb )
dup tcp-clear-rexmit-timer ( pkt tcb )
else ( pkt tcb )
dup tcp-set-rexmit-timer ( pkt tcb )
then ( pkt tcb )
\ Retransmitted data, if any, has now been ACKed.
0 over >tcb-nrexmits l! ( pkt tcb )
\ The congestion window is increased by 1 segment per
\ ACK during slow start, or by MSS*MSS/SND.CWND for
\ congestion avoidance.
nip dup snd-cwnd@ 2dup swap ssthresh@ < if ( tcb cwnd )
over tcb-mss@ + ( tcb cwnd' )
else ( tcb cwnd )
over tcb-mss@ dup * over / + ( tcb cwnd' )
then ( tcb cwnd' )
swap snd-cwnd! ( )
;
\ Update receive sequence variables to reflect the sequence of
\ contiguous data received successfully.
: tcp-rcvspace-update ( tcb seq len -- )
+ over rcv-nxt@ - dup if ( tcb n )
2dup over rcv-nxt@ + swap rcv-nxt! ( tcb n )
2dup over rcv-wnd@ swap - swap rcv-wnd! ( tcb n )
over tcb>rcvbuf over tcpbuf-count+! ( tcb n )
then 2drop ( )
;
\ Adding entries to the sequencing queue. When an out-of-order data
\ segment arrives, record the sequence number and length of the
\ segment in an entry and do an ordered insert. Sequencing queue
\ entries are ordered on sequence numbers.
: tcpseg-higher-seq#? ( n entry -- n flag )
>tseg-seq l@ over seq>=
;
: tcp-segq-insert ( tcb seq len -- )
rot >tcb-segq >r ( seq len ) ( r: segq )
/tcp-segq-entry alloc-mem ( seq len entry )
tuck >tseg-len l! 2dup >tseg-seq l! ( seq entry )
swap r@ ['] tcpseg-higher-seq#? find-queue-entry ( entry seq elt )
nip dup if ( entry elt )
queue-prev swap insqueue ( )
else ( entry 0 )
drop r@ queue-last swap insqueue ( )
then ( )
r> drop ( ) ( r: )
;
\ Coalescing sequence queue entries. On arrival of an in-order data
\ segment, check to see if this segment fills any "holes" in the list.
\ The receive sequence space variables are updated to reflect the
\ sequence of contiguous data that has been received successfully.
: tcp-segq-join ( tcb seq len -- )
2 pick >r tcp-rcvspace-update ( ) ( r: tcb )
r@ >tcb-segq dup queue-first ( segq elt )
begin ( segq elt )
2dup queue-end? 0= if ( segq elt )
dup >tseg-seq l@ r@ rcv-nxt@ seq<= ( segq elt flag )
else ( segq elt )
false ( segq elt false )
then ( segq elt flag )
while ( segq elt )
r@ over dup >tseg-seq l@ swap >tseg-len l@ ( segq elt tcb seq len )
tcp-rcvspace-update ( segq elt )
dup queue-next over remqueue swap ( segq nextelt elt )
/tcp-segq-entry free-mem ( segq nextelt )
repeat 2drop ( )
r> drop ( ) ( r: )
;
\ Copy data from segment into the (circular) receive buffer.
: tcp-copy-data ( tcb pkt seq len -- )
2swap over >r ( seq len tcb pkt ) ( r: tcb )
swap tcb>rcvbuf swap ( seq len buf pkt )
3 pick ( seq len buf pkt seq )
over seg-seq@ - /tcpip-header + + ( seq len buf adr )
rot 2swap swap ( adr len buf seq )
r@ rcv-nxt@ - over tcpbuf-count@ + ( adr len buf offset )
2swap ( buf offset adr len )
tcpbuf-write ( len' )
r> 2drop ( ) ( r: )
;
\ Trim segment so that it contains only data within advertised window.
: tcp-trim-data ( tcb pkt -- start.seq datalen )
over rcv-nxt@ over seg-seq@ 2dup seq> if ( tcb pkt rcv.nxt seq )
over swap - >r over seg-datalen@ r> - ( tcb pkt start.seq len )
else ( tcb pkt rcv.nxt seq )
nip over seg-datalen@ ( tcb pkt start.seq len )
then ( tcb pkt start.seq len )
2swap ( start.seq len tcb pkt )
2dup seg-lastseq@ swap rcv-lastseq@ seq> if ( start.seq len tcb pkt )
dup TH_FIN tcp-clear-flags ( start.seq len tcb pkt )
seg-lastseq@ swap rcv-lastseq@ - - ( start.seq len' )
else ( start.seq len tcb pkt )
2drop ( start.seq len )
then ( start.seq datalen )
;
\ Processing segment data. Copy data from the segment into the receive
\ buffer and update sequencing queue entries. We ACK every other segment
\ received. Out of order segments must be ACKed immediately. If data
\ is being "pushed", we record the push sequence number in the TCB.
: tcp-process-data ( tcb pkt -- )
\ Check if the segment contains data.
dup seg-datalen@ 0= if 2drop exit then ( tcb pkt )
\ Trim segment to fit in window.
2dup tcp-trim-data ( tcb pkt seq len )
\ Copy data from the segment.
2over 2over tcp-copy-data ( tcb pkt seq len )
\ Update sequencing queue entries and schedule an
\ ACK as appropriate.
2swap >r ( seq len tcb )( r:pkt )
dup 2swap ( tcb tcb seq len )
2 pick rcv-nxt@ 2 pick seq= if ( tcb tcb seq len )
tcp-segq-join ( tcb )
dup dup tcb-flags@ TF_DELACK and if ( tcb tcb )
TF_ACKNOW tcb-set-flags ( tcb )
else ( tcb tcb )
TF_DELACK tcb-set-flags ( tcb )
then ( tcb )
else ( tcb tcb seq len )
tcp-segq-insert ( tcb )
dup TF_ACKNOW tcb-set-flags ( tcb )
then ( tcb )
r> ( tcb pkt ) ( r: )
\ Record PUSH sequence number, if any
dup is-tcppsh? if ( tcb pkt )
2dup seg-lastseq@ 1+ swap >tcb-pushseq l! ( tcb pkt )
over TF_PUSH tcb-set-flags ( tcb pkt )
then 2drop ( )
;
\ FIN processing. Since segments can arrive out of order, we must
\ handle delayed controls. On receiving a FIN, information about it
\ is stored in the TCB. Once all data up though the FIN has been
\ received, we extend the receive sequence space past the FIN.
: tcp-process-fin ( tcb pkt -- )
\ If this a FIN, record its sequence number and
\ schedule an immediate ACK.
dup is-tcpfin? if ( tcb pkt )
2dup seg-lastseq@ swap >tcb-finseq l! ( tcb pkt )
over TF_RCVDFIN TF_ACKNOW or tcb-set-flags ( tcb pkt )
then drop ( tcb )
\ Advance RCV.NXT over FIN.
dup tcb-flags@ TF_RCVDFIN and if ( tcb )
dup rcv-nxt@ over >tcb-finseq l@ seq= if ( tcb )
dup rcv-nxt@ 1+ over rcv-nxt! ( tcb )
then ( tcb )
then drop ( )
;
\ Determine whether any more data can arrive on this connection.
: tcp-receive-done? ( tcb -- flag )
dup tcb-flags@ TF_RCVDFIN and if ( tcb )
dup rcv-nxt@ swap >tcb-finseq l@ 1+ seq= ( flag )
else ( tcb )
drop false ( false )
then ( flag )
;
\ Check whether our FIN has been acknowledged.
: tcp-ourfin-acked? ( tcb pkt -- flag )
over tcb-flags@ TF_SENTFIN and if ( tcb pkt )
seg-ack@ swap snd-max@ seq= ( flag )
else ( tcb pkt )
2drop false ( false )
then ( flag )
;
\ CLOSED state processing. Respond to all incoming segments with
\ an acceptable RST.
: tcps-closed ( tcb pkt -- )
tcp-reset
;
\ LISTEN state processing. We are waiting for incoming connections. Our
\ simple implementation does not allocate a new TCB. On receipt of a SYN,
\ determine MSS to use, record the sender's address and port numbers in
\ the INPCB, initialize window information and enter SYN_RCVD state.
: tcps-listen ( tcb pkt -- )
\ Ignore incoming RST segments. If the segment is
\ an ACK, send an acceptable RST segment. Drop the
\ segment if it is not a SYN.
dup is-tcprst? if 2drop exit then ( tcb pkt )
dup is-tcpack? if tcp-reset exit then ( tcb pkt )
dup is-tcpsyn? 0= if 2drop exit then ( tcb pkt )
\ Record the remote client's IP address and port
\ identifiers in our PCB.
over tcb>inpcb ( tcb pkt pcb )
over dup >ip-src swap >tcp-sport ntohw@ ( tcb pkt faddr fport )
inpcb-connect ( tcb pkt )
\ Process SYN (schedules an immediate ACK)
over swap tcp-process-syn ( tcb )
\ Initialize send sequence variables
dup tcp-sendseq-init ( tcb )
\ Enter SYN_RCVD state and send <SYN,ACK>
TCPS_SYN_RCVD over tcb-state! ( tcb )
tcp-output ( )
;
\ SYN_SENT state processing. We are waiting for our SYN to be ACKed.
\ On receiving a SYN, determine MSS to use on this connection. If
\ the segment ACKs our SYN, enter ESTABLISHED state. Else (no ACK),
\ this is a simultaneous open, enter SYN_RCVD state.
: tcps-synsent ( tcb pkt -- )
\ If this is an ACK, but not for our SYN, send a RST.
dup is-tcpack? if ( tcb pkt )
over snd-nxt@ over seg-ack@ seq<> if ( tcb pkt )
tcp-reset exit ( )
then ( tcb pkt )
then ( tcb pkt )
\ If this is a RST, and the ACK was acceptable, drop
\ the connection. Otherwise (no ACK), drop the segment
\ and return.
dup is-tcprst? if ( tcb pkt )
dup is-tcpack? if ( tcb pkt )
ECONNREFUSED tcp-abort exit ( )
then ( tcb pkt )
2drop exit ( )
then ( tcb pkt )
\ If this is not a SYN, drop it and return.
dup is-tcpsyn? 0= if 2drop exit then ( tcb pkt )
\ Process SYN (schedules immediate ACK).
2dup tcp-process-syn ( tcb pkt )
\ Make appropriate state transition.
dup is-tcpack? if ( tcb pkt )
over swap tcp-process-ack ( tcb )
TCPS_ESTABLISHED over tcb-state! ( tcb )
else ( tcb pkt )
drop ( tcb )
TCPS_SYN_RCVD over tcb-state! ( tcb )
then ( tcb )
tcp-output ( )
;
\ SYN_RCVD state processing. This state is entered either as a result
\ of a simultaneous open or after a SYN is received in the LISTEN state.
\ We are waiting for our SYN to be ACKed to move to ESTABLISHED state.
: tcps-synrcvd ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? over is-tcpsyn? or if ( tcb pkt )
ECONNRESET tcp-abort exit ( )
then ( tcb pkt )
\ If this is not an ACK, drop it and return
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
\ If this ACK is not acceptable, send a RST.
over snd-una@ over seg-ack@ seq> >r ( tcb pkt )
over snd-max@ over seg-ack@ swap seq> r> or if ( tcb pkt )
tcp-reset exit ( )
then ( tcb pkt )
\ Process the ACK.
over swap tcp-process-ack ( tcb )
\ Enter ESTABLISHED state
TCPS_ESTABLISHED swap tcb-state! ( tcb )
;
\ ESTABLISHED state processing. Once the connection has been established
\ we remain in this state exchanging data and ACKs. Segments may
\ arrive out of order. If a FIN has arrived, we transition to the
\ CLOSE_WAIT state once all data up through the FIN has been received.
: tcps-established ( tcb tcpip-pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? over is-tcpsyn? or if ( tcb pkt )
ECONNRESET tcp-abort exit ( )
then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
2dup tcp-process-ack ( tcb pkt )
\ Process segment data and FIN.
2dup tcp-process-data ( tcb pkt )
2dup tcp-process-fin ( tcb pkt )
\ If a FIN has arrived, and all data upto the FIN
\ has been received, enter CLOSE_WAIT state.
drop dup tcp-receive-done? if ( tcb )
TCPS_CLOSE_WAIT over tcb-state! ( tcb )
then ( tcb )
\ Send any necessary ACK
tcp-output ( )
;
\ CLOSE_WAIT state processing. All data has been received, and the other
\ end has issued a "half-close". We are waiting for the application
\ to issue a "close" before moving to the LAST_ACK state. ACKs for
\ any data we may send must be processed.
: tcps-closewait ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? over is-tcpsyn? or if ( tcb pkt )
ECONNRESET tcp-abort exit ( )
then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
tcp-process-ack ( )
;
\ LAST_ACK state processing. A FIN has been sent when the application
\ issues a "close", and we are awaiting an ACK for our FIN. We can
\ return from "close" once our FIN has been ACKed.
: tcps-lastack ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt )
dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
2dup tcp-process-ack ( tcb pkt )
\ Enter CLOSED state once our FIN is ACKed.
over swap tcp-ourfin-acked? if ( tcb )
TCPS_CLOSED over tcb-state! ( tcb )
then drop ( )
;
\ FIN_WAIT_1 state processing. A FIN has been sent on "close". The other
\ end may respond with a ACK for our FIN or with its own FIN or both. If
\ the ACK arrives alone, move to FIN_WAIT_2. If only the FIN arrives,
\ move to CLOSING. If both arrive, move to TIME_WAIT state.
: tcps-finwait1 ( tcb tcpip-pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? over is-tcpsyn? or if ( tcb pkt )
ECONNRESET tcp-abort exit ( )
then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
2dup tcp-process-ack ( tcb pkt )
\ Process segment data and FIN.
2dup tcp-process-data ( tcb pkt )
2dup tcp-process-fin ( tcb pkt )
\ Make appropriate state transition.
over swap tcp-ourfin-acked? if ( tcb )
dup tcp-receive-done? if ( tcb )
TCPS_TIME_WAIT over tcb-state! ( tcb )
else ( tcb )
TCPS_FIN_WAIT_2 over tcb-state! ( tcb )
then ( tcb )
else ( tcb )
dup tcp-receive-done? if ( tcb )
TCPS_CLOSING over tcb-state! ( tcb )
then ( tcb )
then ( tcb )
\ Send any necessary ACK
tcp-output ( )
;
\ CLOSING state processing. FINs have been exchanged, and we are
\ waiting for our FIN to be ACKed.
: tcps-closing ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt )
dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
2dup tcp-process-ack ( tcb pkt )
\ Enter CLOSED state.
drop TCPS_CLOSED swap tcb-state! ( )
;
\ FIN_WAIT_2 state processing. Our FIN has been ACKed, and the connection
\ is "half-closed". We must process any incoming data while waiting for
\ a FIN from the other end.
: tcps-finwait2 ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable segments.
dup is-tcprst? over is-tcpsyn? or if ( tcb pkt )
ECONNRESET tcp-abort exit ( )
then ( tcb pkt )
\ Process incoming ACKs.
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt )
2dup tcp-process-ack ( tcb pkt )
\ Process segment data and FIN.
2dup tcp-process-data ( tcb pkt )
2dup tcp-process-fin ( tcb pkt )
drop dup tcp-receive-done? if ( tcb )
TCPS_TIME_WAIT over tcb-state! ( tcb )
then ( tcb )
tcp-output ( )
;
\ TIME_WAIT state processing. The only segment that should arrive is
\ a retransmission of the remote FIN. Send an ACK. We dont implement
\ the 2 MSL timer.
: tcps-timewait ( tcb pkt -- )
2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt )
\ Handle unacceptable packets
dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt )
dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt )
\ Process ACK
dup is-tcpack? 0= if 2drop exit then ( tcb pkt )
over swap tcp-process-ack ( tcb )
\ Acknowledge receipt of segment
dup TF_ACKNOW tcb-set-flags tcp-output ( )
;
\ TCP FSM state switch table.
create tcp-state-table
' tcps-closed , \ CLOSED
' tcps-listen , \ LISTEN
' tcps-synsent , \ SYN_SENT
' tcps-synrcvd , \ SYN_RCVD
' tcps-established , \ ESTABLISHED
' tcps-closewait , \ CLOSE_WAIT
' tcps-finwait1 , \ FIN_WAIT_1
' tcps-closing , \ CLOSING
' tcps-lastack , \ LAST_ACK
' tcps-finwait2 , \ FIN_WAIT_2
' tcps-timewait , \ TIME_WAIT
\ Switch to routine corresponding to the current input state to process
\ the segment.
: tcp-process-segment ( tcb pkt -- )
tcp-state-table 2 pick tcb-state@ na+ @ execute ( )
;
\ Check if segment is meant for this TCB/INPCB.
: tcb-match? ( pkt inpcb -- pkt match? )
over >tcp-dport ntohw@ over in-lport@ <> if drop false exit then
over >ip-dest over >in-laddr ip<> if drop false exit then
dup inpcb>tcb tcb-state@ TCPS_LISTEN = if drop true exit then
over >ip-src over >in-faddr ip<> if drop false exit then
over >tcp-sport ntohw@ swap in-fport@ =
;
\ TCP port demultiplexing.
: tcb-locate ( pkt -- tcb | 0 )
tcp-inpcb-list ['] tcb-match? find-queue-entry nip dup if
inpcb>tcb
then
;
\ Handle incoming segments. If no matching TCB is found, an acceptable
\ RST is sent.
: tcp-input ( pkt -- )
dup tcp-checksum 0= if ( pkt )
dup tcb-locate over ( pkt tcb pkt )
2dup TR_INPUT 0 tcp-trace ( pkt tcb pkt )
over if ( pkt tcb pkt )
tcp-process-segment ( pkt )
else ( pkt 0 pkt )
tcp-reset ( pkt )
then ( pkt )
then ( pkt )
pkt-free ( )
;
['] tcp-input to (tcp-input)
: tcp-poll ( -- )
tcp-do-timer-events ip-poll
;
\ Drain input.
: tcp-drain-input ( -- )
get-msecs begin dup get-msecs = while tcp-poll repeat drop
;
headers