/****************************************************************************
   
    OS/A65 Version 1.4.0
    Multitasking Operating System for 6502 Computers

    Copyright (C) 1989-1997 Andre Fachat 

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

****************************************************************************/

/*
 * This file is a TCP implementation for 6502 computer
 *
 * it exports:
 *	tcpinit		- init TCP
 *	tcploop		- must be called 
 *	tcprx		- gets incoming packets
 *
 *	tcp_open	- (active) open TCP connection
 *	tcp_listen	- (passive) open TCP connection
 *	tcp_close	- close TCP connection
 *	
 */

/* TODO: make the thing 32-bit-modulo save for ack and seq! */
/* TODO: retransmission timeout increase with retransmission */
/* TODO: abort & close after n retransmissions */
/* TODO: take more care about possibly lost packets */

#define	DEBUGTCP

	.(
	.zero
tcbp	.word 0
p2	.word 0
srv	=p2		;srv	=syszp+4

	.data
dlen	.word 0		; length tcp data received
doffset	.byt 0		; data offset from pp!
;toffset	=sysmem+3	; tcp header offset from pp!
	.byt 0		; ???
seg_flag .byt 0		; incoming segment flag byte
conn	.byt 0		; connection number
discd	.word 0		; data preceding valid data in segment
timer	.word 0		; timer counter

tcb	.dsb MAXCONN*TCB_LEN

tmp	.byt 0
tmp2	.dsb 3		; should be able to hold seq number

state	.byt 0

	.text

&&tcpinit .(
	ldx #0

	stx timer
	stx timer+1
i1
	jsr settcb
	lda #TCP_CLOSED
	ldy #TCB_STATE
	sta (tcbp),y
	inx
	cpx #MAXCONN
	bcc i1

	jsr user_init

	clc
	rts
	.)

&&tcploop .(
	.data
fl	.byt 0
	.text

	/* I have - yet - no way to measure the time, so we do a simple loop */
	lda timer
	ora timer+1
	sta fl
	beq load
	lda timer
	bne l1
	dec timer+1
l1	dec timer
	jmp te
end	rts
load	lda #<TIMER
	sta timer
	lda #>TIMER
	sta timer+1
te
	ldx #<-1
i1 	inx
	cpx #MAXCONN
	bcs end
	stx conn
	jsr settcb
	ldy #TCB_STATE
	lda (tcbp),y
	cmp #TCP_CLOSED
	beq i1

	ldy #TCB_LSTATE
	cmp (tcbp),y
	beq same
	sta (tcbp),y
	; ok, state has changed since last loop
	cmp #TCP_CLOSEW
	bne n1

;	ldx conn
;	jsr tcp_close	; TODO we should actually signal the user process...
	lda #TE_SIG_FIN
	jsr signal_user
n1
same	lda fl
	bne noti

	ldy #TCB_MSL+1
	lda (tcbp),y
	dey
	ora (tcbp),y
	beq nomsl

	sec
	lda (tcbp),y
	sbc #1
	sta (tcbp),y
	tax
	iny
	lda (tcbp),y
	sbc #0
	sta (tcbp),y
	bne nomsl
	txa
	bne nomsl
	
	ldy #TCB_STATE
	lda (tcbp),y
	cmp #TCP_FINW2
	beq lastack
	cmp #TCP_LASTACK
	beq lastack
	cmp #TCP_TIMEW
	bne nomsl
lastack	;lda #TCP_CLOSED
	;sta (tcbp),y
	jsr tclose
	jmp noretrans
nomsl
	ldy #TCB_RETRANS+1
	lda (tcbp),y
	dey
	ora (tcbp),y
	beq noretrans

	sec
	lda (tcbp),y
	sbc #1
	sta (tcbp),y
	tax
	iny
	lda (tcbp),y
	sbc #0
	sta (tcbp),y
	bne noretrans
	txa
	bne noretrans

	jsr retransmit
noretrans
noti	
	ldy #TCB_STATE
	lda (tcbp),y
	cmp #TCP_ESTAB
	bne next

	ldy #TCB_FLAG
	lda (tcbp),y
	and #1
	beq noqueuedfin

	jsr send_fin
	bcs next

	lda #TCP_FINW1
	ldy #TCB_STATE
	sta (tcbp),y
	jmp next

noqueuedfin	

	ldy #TCB_SERVICE
	lda (tcbp),y
	sta srv
	iny
	lda (tcbp),y
	sta srv+1

	ldy #SRV_LOOP
	lda (srv),y
	iny
	ora (srv),y
	beq next

	jsr end2 
next
	ldx conn
	jmp i1
	
end2	lda (srv),y
	pha
	dey
	lda (srv),y
	pha
	rts
	.)

&&tcprx2 .(

	jsr getpinfo
	bcc piok
	DB("getpi error in tcprx2^m^j")
	rts
piok
	jsr ip2tcp

#if 0 /*def DEBUGTCP*/
DB("TCP check: pd=")
lda pd+1: jsr EHexout: lda pd: jsr EHexout
DB(", pdl=")
lda pdl+1: jsr EHexout: lda pdl: jsr EHexout
DB(", pp=")
lda pp+1: jsr EHexout: lda pp: jsr EHexout
DB(", ppl=")
lda ppl+1: jsr EHexout: lda ppl: jsr EHexout
jsr ECrlfout
#endif

	lda pdl
	ldy pdl+1
	ldx #pd
	jsr checksum3

#if 0 /*def DEBUGTCP*/
php
pha
txa
pha
DB("TCP Checksum=")
pla
tay
jsr EHexout
pla
pha
jsr EHexout
jsr ECrlfout
tya
tax
pla
plp
#endif
	bcc tcpok

tdisc_check
        DB("Packet discarded: TCP checksum^m^j")
&tdisc	ldx pslot
	bmi illtd
	jsr bfree
	lda #<-1
	sta pslot
	clc
	rts
illtd	DB("tdisc with illegal slot!^m^j")
	sec
	rts
	

tcpok	/* here we have a valid TCP packet in (pd),0-pdl. */
/*
DB("tcpok pp=")
lda pp+1:jsr EHexout:lda pp:jsr EHexout
jsr ECrlfout
*/
	lda #0		; data to be discarded at packet beginning.
	sta discd
	sta discd+1

	ldy #TH_FLAG
	lda (pd),y
	sta seg_flag

	ldy #TH_DOFFSET
	lda (pd),y
	and #$f0
	lsr
	lsr
	clc
	adc #TPH_LEN
	sta doffset	; data offset from pseudo header start
	lda pdl
	sec
	sbc doffset
	sta dlen
	lda pdl+1
	sbc #0
	sta dlen+1	; TCP data received length

	lda phl
	sec
	sbc #TPH_LEN
	sta phl		; offset from pp to pd
	clc
	adc doffset
	sta doffset	; offset 

	bcc looktcb
datl
	DB("Data offset too large^m^j")
tdisc1	jmp tdisc

/* we now also have: phl    = offset from pp to TCP pseudo header (pd)
		     doffset= offset from pp to TCP data start 
		     dlen   = length of TCP data received
		     discd  = TCP data to be discarded
*/

looktcb
/*	DB("LookTCB^m^j")*/

	jsr findtcb
	bcc found		/* TODO: send reset on no connection? */
	jmp tcp_closed
found
	stx conn
#if 1
	DB("rP=")
	ldy #TH_SRCP
	lda (pd),y
	jsr EHexout
	iny
	lda (pd),y
	jsr EHexout
	DB(" tp=")
	lda tcbp+1
	jsr EHexout
	lda tcbp
	jsr EHexout
	DB(" s=")
	ldy #TH_SEQ+2
	lda (pd),y
	jsr EHexout
	iny
	lda (pd),y
	jsr EHexout
	DB(" a=")
	ldy #TH_ACK+2
	lda (pd),y
	jsr EHexout
	iny
	lda (pd),y
	jsr EHexout
	DB(" f=")
	ldy #TH_FLAG
	lda (pd),y
	jsr EHexout
	jsr ECrlfout
#endif
	ldy #TCB_STATE
	lda (tcbp),y
	sta state

#if 0 /*def DEBUGTCP*/
	pha
	lda tcbp+1
	jsr EHexout
	lda tcbp
	jsr EHexout
	lda #":"
	jsr ECout

	lda state
	asl
	tax
	lda ttab+1,x
	tay
	lda ttab,x
	jsr ETxtout
	pla
	jmp noout

ttab	.word tclosed, tlisten, tsynrxd, tsyntxd, testab, tfinw1, tfinw2
	.word tclosew, tlastack, tclosing, ttimew

tclosed	.asc "Closed:^m^j",0
tlisten	.asc "Listen:^m^j",0
tsynrxd .asc "SynRXd:^m^j",0
tsyntxd .asc "SynTXd:^m^j",0
testab 	.asc "Established:^m^j",0
tfinw1	.asc "FinW1:^m^j",0
tfinw2	.asc "FinW2:^m^j",0
tclosew	.asc "CloseWait:^m^j",0
tlastack .asc "LastAck:^m^j",0
tclosing .asc "Closing:^m^j",0
ttimew	.asc "TimeWait^m^j",0

noout
#endif
	cmp #TCP_CLOSED
	beq tcp_closed
	cmp #TCP_LISTEN
	bne nolisten
	jmp tcp_listen2
nolisten 
	cmp #TCP_SYNTXD
	bne nosyntxd
	jmp tcp_syntxd
nosyntxd
	jmp tcp_else
	.)

tcp_closed .(
	lda seg_flag
	and #THF_RST
	bne end

	lda seg_flag
	and #THF_ACK
	bne ackset

	jsr seql2ack
	jsr clrseq
	lda #THF_ACK + THF_RST
	bne noack

&send_rst
&listen_ack
ackset	
	jsr ack2seq
	lda #THF_RST
noack
	ldy #TH_FLAG
	sta (pd),y
	jmp bangbuf
	
end	jmp tdisc
	.)

tcp_listen2 .(
	lda seg_flag
	and #THF_RST
	beq norst
	DB("RST while listening^m^j")
	jmp tdisc
norst
	lda seg_flag
	and #THF_ACK
	beq noack
	DB("ACK while listening^m^j")
	jmp listen_ack
noack
	lda seg_flag
	and #THF_SYN
	bne listen_syn
	DB("Listen but no Syn!^m^j")
	jmp tdisc
listen_syn
	DB("Listen_syn^m^j")
	jsr seqsyn
	jsr hasdata
	beq nodat

	DB("rxd syn has data!^m^j")
	jsr copy_n_queue
nodat
	ldy #TH_FLAG
	lda #THF_SYN + THF_ACK
	sta (pd),y

	jsr iniseq
	jsr setseq
	jsr setack

	ldy #TCB_STATE
	lda #TCP_SYNRXD
	sta (tcbp),y
	sta state

	lda #1
	ldx #0
	jsr addtxnxt

	jmp bangbuf
	.)

tcp_else .(
	.data
&needack .byt 0
	.text

	lda #0
	sta needack
/*
DB("tcp_*: ip=")
lda pp+1:jsr EHexout:lda pp:jsr EHexout
DB(", qslot=")
lda pslot:jsr EHexout
DB(", sla=")
lda slotladr:jsr EHexout
jsr ECrlfout
*/
	/* first, check sequence number */
	jsr checkseq
	bcc seqok

	lda seg_flag
	and #THF_RST
	bne disca	/* discard packet */

	DB("bad SEQ!^m^j")

	jsr setseq
	jsr setack
	ldy #TH_FLAG
	lda #THF_ACK
	sta (pd),y
	jmp bangbuf

disca	DB("got RST with bad SEQ!^m^j")
	jmp tdisc

seqok	/* second, check the RST bit */
	lda seg_flag
	and #THF_RST
	beq noreset

	DB("got RST!^m^j")

	lda state
	cmp #TCP_SYNRXD
	bne seq1

	/* TODO: if from active open, then close! */
	DB("Reset rxd!^m^j")
	ldy #TCB_STATE
	lda #TCP_SYNRXD
	sta (tcbp),y
	sta state
	jsr tdisc
	
	/* signal_user may use q* variables! */
	lda #TE_SIG_RESET
	jmp signal_user

seq1	cmp #TCP_LASTACK
	bcs seq2

	/* flush and close everything */
	jsr tdisc

	/* signal_user may use q* variables! */
	;lda #TE_RESET1
	;jmp signal_user
	jmp tclose

seq2 	jsr tdisc
	jmp tclose

noreset	/* third, check security and precedence... */

	/* fourth, check SYN bit */

	lda seg_flag
	and #THF_SYN
	beq nosyn
	; this is an error - abort anything

	DB("got SYN!^m^j")

	/* flush everything, close */
	jsr send_rst

	;lda #TE_RESET2
	;jmp signal_user
	jmp tclose

nosyn	/* fifth, check the ACK bit */
	lda seg_flag
	and #THF_ACK
	bne ackok

	DB("No Ack^m^j")
	jmp tdisc
ackok
	jsr checkack
	sta tmp
DB("checkack returns "): lda tmp: jsr EHexout: jsr ECrlfout

	lda state
	cmp #TCP_SYNRXD
	bne ack1

	lda tmp
	beq badack
	cmp #3
	bcc ackok2

badack	DB("Bad Ack in packet^m^j")
	jmp send_rst
ackok2
	ldy #TCB_STATE	/* everything ok -> enter estab and continue... */
	lda #TCP_ESTAB
	sta (tcbp),y
	sta state

	/* TODO: check queued FIN */

ack1	lda tmp
	beq aignore
	cmp #3
	bcc a0

	/* TODO: ack ahead send_next -> send ack, return */
DB("Ack ahead send_next^m^jpkt.ack=")
ldy #TH_ACK:ldx #4:x0 lda (pd),y:jsr EHexout:iny:dex:bne x0
DB(" seq.sndnxt=")
ldy #TCB_SND_NXT: ldx #4:x1 lda (tcbp),y: jsr EHexout: iny: dex: bne x1
jsr ECrlfout

	jmp tdisc
a0
	jsr getuna
	lda tmp
	pha
	jsr ackxmit
	pla
	sta tmp
aignore
	lda state
	cmp #TCP_FINW1
	bcc do6a
	bne ack3

	lda tmp
	cmp #2		; exactly SND_NXT -> FIN ack'd
	bne do6a

	ldy #TCB_MSL
	lda #<TIME_FINW2
	sta (tcbp),y
	iny
	lda #>TIME_FINW2
	sta (tcbp),y

	ldy #TCB_STATE
	lda #TCP_FINW2
	sta (tcbp),y
	sta state

ack3	cmp #TCP_FINW2
	bne ack4

do6a	jmp do6

ack4	cmp #TCP_CLOSING
	bne ack5

	lda tmp
	cmp #2
	bne atw
	ldy #TCB_STATE
	lda #TCP_TIMEW
	sta state
	sta (tcbp),y

	ldy #TCB_MSL
	lda #<TIME_MSL
	sta (tcbp),y
	iny
	lda #>TIME_MSL
	sta (tcbp),y

atw	jmp tdisc

ack5	cmp #TCP_LASTACK
	bne ack6

	DB("LAST ACK received^m^j")
	
	lda tmp
	cmp #2
	bne atw
	jsr tdisc
	jmp tclose

ack6	cmp #TCP_TIMEW
	bne do6

	ldy #TCB_MSL
	lda #<TIME_MSL
	sta (tcbp),y
	iny
	lda #>TIME_MSL
	sta (tcbp),y
	
	; ack retransmitted FIN 
	jsr setack
	jsr setseq
	ldy #TH_FLAG
	lda #THF_ACK
	sta (pd),y
	jmp bangbuf

	/* sixth, check the URG bit */
&do6
	/* seventh, process segment text */ 
	
	lda state
	cmp #TCP_ESTAB
	bcc idat
	cmp #TCP_FINW2+1
	bcs idat

	/* TODO: discd? */
	ldy #0
	lda doffset
	sta (pp),y
	tya
	iny
	sta (pp),y
	iny
	lda dlen
	sta (pp),y
	iny
	lda dlen+1
	sta (pp),y

	jsr hasdata
	beq idat
	jsr copy_n_queue	; ok, we need not copy without FIN...
	inc needack
idat	
	/* eighth, check the FIN bit */
	
	lda state
	cmp #TCP_CLOSED
	beq nofin
	cmp #TCP_LISTEN
	beq nofin
	cmp #TCP_SYNTXD
	beq nofin

	tax

	lda seg_flag
	and #THF_FIN
	beq nofin

	cpx #TCP_FINW2
	bne nofinw2

	inc needack

	ldy #TCB_STATE
	lda #TCP_TIMEW
	sta state
	sta (tcbp),y

	ldy #TCB_MSL
	lda #<TIME_MSL
	sta (tcbp),y
	iny
	lda #>TIME_MSL
	sta (tcbp),y
	jmp nofin
nofinw2
	lda #1
	ldx #0
	jsr addrxnxt

	;inc needack		; bangbuf does it already

	jsr setack
	jsr setseq
	ldy #TH_FLAG
	lda #THF_ACK
	sta (pd),y
	jsr bangbuf

	lda state
	cmp #TCP_ESTAB+1
	bcs f1
	lda #TCP_CLOSEW
	bne fe

fe	ldy #TCB_STATE
	sta (tcbp),y

f1	
	/* TODO: check other states */

nofin	
	ldx pslot
	bmi noslot

	lda needack
	bne needit
	jmp tdisc
needit	
	jsr setack
	jsr setseq
	ldy #TH_FLAG
	lda #THF_ACK
	sta (pd),y
	jmp bangbuf	; maybe check with retransmissions...

noslot	clc
	rts
	.)

tcp_syntxd .(
	/*DB("SynTxd^m^j")*/

	/* first, check ack bit */
	lda seg_flag
	and #THF_ACK
	beq noack

	jsr checkack
	bcc noack

badack	DB("Bad Ack in packet^m^j")
	jmp send_rst
noack	
	/* second, check rst bit */
	lda seg_flag
	and #THF_RST
	beq norst

	lda seg_flag
	and #THF_ACK
	beq rstack

	jsr tdisc
	;lda #TE_RESET3
	;jmp signal_user
	jmp tclose

	/* TODO: close? or define that user signal routine should do that... */
rstack	jmp tdisc

norst
	/* third, check security */

	/* fourth, check syn bit */
	lda seg_flag
	and #THF_SYN
	beq nosyn

	jsr getseq	; get rcv_nxt number from packet

	lda #1
	ldx #0
	jsr addrxnxt

	lda seg_flag
	and #THF_ACK
	beq nosynack

	jsr getuna

	jsr ackxmit
nosynack
	jsr aheadiss
	bcs noiss	; SYN not yet ACK'd

	lda #TCP_ESTAB
	ldy #TCB_STATE
	sta (tcbp),y
	sta state

	lda #1
	sta needack

	jmp do6

noiss	lda #TCP_SYNRXD
	ldy #TCB_STATE
	sta (tcbp),y

	jsr setack
	jsr decseq	; dec snd_nxt back to ISS
	jsr setseq
	lda #1
	ldx #0
	jsr addtxnxt	; and inc for SYN

	jsr do_queue

	ldy #TH_FLAG
	lda #THF_ACK+THF_SYN
	jmp bangbuf

nosyn	jmp tdisc
	.)

/* check acknowledge of packets in retransmission queue */
/* TODO: save end pointer for each packet in queue -> no calculations here */

ackxmit	.(

#if 1
DB("ackxmit:")
.(:ldy #TCB_SND_UNA+2: x1 lda (tcbp),y: jsr EHexout: iny: cpy #TCB_SND_UNA+4:bcc x1: .)
lda #":":jsr ECout
jsr ECrlfout
#endif
	ldy #TCB_NTXBUF
	lda (tcbp),y
	bne noend2
	clc
	rts
noend2
	ldy #TCB_TXBUF
	lda (tcbp),y
	tax
/*pha: DB("slot:"): pla: jsr EHexout: lda #":": jsr ECout*/
	jsr getbadr
	bcc adrok
	DB("illegal slot# in ackxmit^m^j")
	jmp freebuf
adrok
	sta p2
	sty p2+1

	ldx #3
	ldy #TH_SEQ+TCP_OFFSET+3
l0	lda (p2),y
	sta tmp,x
/*jsr EHexout*/
	dey
	dex
	bpl l0

	ldy #IPH_LEN+1
	lda (p2),y
	clc
	adc tmp+3
	sta tmp+3
	dey
	lda (p2),y
	adc tmp+2
	sta tmp+2
	bcc l1
	inc tmp+1
	beq l1
	inc tmp
l1	lda tmp+3
	sec
	sbc #<TCP_OFFSET+TH_OPTIONS
	sta tmp+3
	lda tmp+2
	sbc #>TCP_OFFSET+TH_OPTIONS
	sta tmp+2
	bcs l2
	lda tmp
	bne l3
	dec tmp+1
l3	dec tmp
l2
/*
lda #":": jsr ECout
.(:ldy #0: x1 lda tmp,y: jsr EHexout: iny: cpy #4:bcc x1: .)
jsr ECrlfout
*/
	ldy #TCB_SND_UNA
l4	lda (tcbp),y
	cmp tmp-TCB_SND_UNA,y
	bcc end
	iny
	cpy #TCB_SND_UNA+4
	bcc l4
freebuf
	; got ack for first packet in queue
	ldy #TCB_TXBUF
	lda (tcbp),y
	tax
	jsr bfree

	ldy #TCB_NTXBUF
	lda (tcbp),y
	tax
	dex
	txa
	sta (tcbp),y
	beq end		; ok, end, nothing left

	ldy #TCB_TXBUF
l5	iny
	lda (tcbp),y
	dey
	sta (tcbp),y
	iny
	dex
	bne l5

	jmp ackxmit

end	rts
	.)

	.data
d2len	.word 0
	.text

hasdata	.(		/* TODO: check with discd */
	lda dlen
	ora dlen+1
	rts
	.)

bangbuf	.(
#if 0
DB("bangbuf: pp=")
lda pp+1:jsr EHexout: lda pp:jsr EHexout
DB(", pd=")
lda pd+1:jsr EHexout: lda pd:jsr EHexout
DB(", sla="):lda slotladr:jsr EHexout
jsr ECrlfout
#endif
	; first exchange port and IP addresses
	jsr tcpxp
	jsr tcpxip
	jsr shortpk

/*DB("from bangbuf: ")*/

&mkpacket2

#if 0
DB("mkpacket: pp=")
lda pp+1: jsr EHexout: lda pp: jsr EHexout
DB(", pd=")
lda pd+1: jsr EHexout: lda pd: jsr EHexout
DB(", ppl=")
lda ppl+1: jsr EHexout: lda ppl: jsr EHexout
DB(", pdl=")
lda pdl+1: jsr EHexout: lda pdl: jsr EHexout
DB(", slotladr=")
lda slotladr:jsr EHexout
jsr ECrlfout
#endif
	; this is for other packets also...
	jsr preptcp

	; make IP header from TCP pseudo header
	; (i.e. copy the IP addresses to the right location and set protocol
	; the rest is done in the IP layer

	jsr tcp2ip
	bcs needmove

	jsr prepip

#if 0 /*def DEBUGTCP*/
	DB("Send Seq: ")
	ldy #TH_SEQ
x1	lda (pd),y
	jsr EHexout
	iny
	cpy #TH_SEQ+4
	bcc x1
	DB("^m^jSend Ack: ")
	ldy #TH_ACK
x2	lda (pd),y
	jsr EHexout
	iny
	cpy #TH_ACK+4
	bcc x2
	DB("^m^jFlag= ")
	ldy #TH_FLAG
	lda (pd),y
	jsr EHexout
	jsr ECrlfout
#endif
	ldx pslot
	lda #<-1
	sta pslot
	jmp queueslot
needmove
	jmp tdisc
	.)
/*
incuna	.(
	ldy #TCB_SND_UNA+3
	ldx #3
	lda (tcbp),y
	clc
	adc #1
	sta (tcbp),y
	dey
l5	lda (tcbp),y
	adc #0
	sta (tcbp),y
	dey
	dex
	bne l5
	rts
	.)
*/
/*
setqseq	.(
	lda tcbp
	clc
	adc #8
	sta p2
	lda tcbp+1
	adc #0
	sta p2+1

	ldy #TH_SEQ
l5	lda (p2),y
	sta (qd),y
	iny
	cpy #TH_SEQ+4
	bcc l5
	rts
	.)

setqack	.(
	lda qd
	clc
	adc #4
	sta p2
	lda qd+1
	adc #0
	sta p2+1

	ldy #TCB_RCV_NXT
l5	lda (tcbp),y
	sta (p2),y
	iny
	cpy #TCB_RCV_NXT+4
	bcc l5
	rts
	.)
*/

/* The following routine takes the packet from 
 * islot/ip/id/ipl/idlen/dlen/doffset/toffset
 * and queues it to the user data rx queue.
 * It sets ack appropriately. 
 * It copies the TCP header into a new packet and sets
 * islot/ip/..., but dlen is zero.
 */
copy_n_queue .(
	.data
myslot	.byt 0
myhl	.byt 0
mydlen	.word 0
	.zero
myp	.word 0
	.text
#if 0
DB("copy_n_queue: ip=")
lda ip+1: jsr EHexout: lda ip: jsr EHexout
DB(", request ")
lda doffset: jsr EHexout
DB(" b., dlen=")
lda dlen+1: jsr EHexout: lda dlen: jsr EHexout
DB(" , discd=")
lda discd+1: jsr EHexout: lda discd: jsr EHexout
jsr ECrlfout
#endif
	lda dlen+1	; dlen = discd ? then return ok
	cmp discd+1
	bne ok
	lda dlen
	cmp discd
	bne ok
	clc
	rts
ok
	lda doffset
	ldy #0
	jsr balloc
	bcc gotbuffer
	rts
gotbuffer
	stx myslot
	jsr getbadr
	bcc adrok
	DB("illegal slot# in copy_n_queue^m^j")
	sec
	rts
adrok
	sta myp
	sty myp+1

	lda phl
	sta myhl
/*
DB("got buffer slot ")
lda myslot: jsr EHexout: DB(" @ address ")
lda myp+1: jsr EHexout: lda myp: jsr EHexout
jsr ECrlfout
*/
	ldy #0
l0	lda (pp),y
	sta (myp),y
/*jsr EHexout*/
	iny
	cpy doffset
	bne l0

	ldy #0
	lda doffset
	clc
	adc discd
	sta (pp),y		/* save for queue routines */
	tya
	adc discd+1
	iny
	sta (pp),y
	iny
	lda dlen
	sec
	sbc discd
	sta mydlen
	sta (pp),y
	iny
	lda dlen+1
	sbc discd+1
	sta mydlen+1
	sta (pp),y

/*lda #" ": jsr ECout: tya: jsr EHexout*/
/*
	lda myp
	sta ip
	clc
	adc phl
	sta id
	lda myp+1
	sta ip+1
	adc #0
	sta id+1

	lda doffset
	sec
	sbc phl
	sta idlen
	lda #0
	sta idlen+1
*/
	lda pslot
	jsr rx_queue_packet
	bcs boom

	lda mydlen
	ldx mydlen+1
	jsr addrxnxt
boom
	lda #0
	sta mydlen
	sta mydlen+1

	ldx myslot
	lda myhl
	jsr getpinfo
	bcc piok
	DB("getpi error in copy_n_queue^m^j")
piok
/*
DB("copy_n_queue returns ip=")
lda ip+1: jsr EHexout: lda ip: jsr EHexout
DB(", id=")
lda id+1: jsr EHexout: lda id: jsr EHexout
jsr ECrlfout
*/
	clc
nobuffer
	rts
	.)

/* retransmit the first packet in the retransmission queue */
&retransmit .(
	ldy #TCB_NTXBUF
	lda (tcbp),y
	beq ende

	ldy #TCB_TXBUF
	lda (tcbp),y
	tax

	ldy #TCB_TRIES
	lda (tcbp),y
	clc
	adc #1
	cmp #10		; retransmit 6 times only ?
	bcs error
	jsr iniretrans

	jsr incownr
	jmp queueslot
error	jsr tclose
ende	rts
	.)

iniretrans .( 
	ldy #TCB_TRIES
	sta (tcbp),y

	ldy #TCB_RETRANS
	lda #<TIME_RETRANS
	sta (tcbp),y
	iny
	lda #>TIME_RETRANS
	sta (tcbp),y

	rts
	.)

/* this routine puts outgoing packets into the retransmission queue and sends
 * them. It needs tcbp, and the packet buffer number in x
 */
&tx_queue_packet .(
	lda #TCP_OFFSET
	jsr getpinfo
	bcc piok
	DB("getpi error in tx_queue_packet^m^j")
	sec
	rts
piok
	ldy #0
	lda (pp),y
	cmp #<TCP_DOFFSET
	bne move
	iny
	lda (pp),y
	cmp #>TCP_DOFFSET
	beq ok

move	DB("TCP offset wrong!^m^j")
#if 1
	lda pslot:jsr EHexout:lda #"-":jsr ECout
	lda pp+1: jsr EHexout: lda pp: jsr EHexout: lda #":": jsr ECout
	ldy #0: xx lda (pp),y: jsr EHexout: iny: cpy #10: bcc xx
	jsr ECrlfout
#endif

	ldx pslot
	lda #<-1
	sta pslot
	jsr bfree
	sec
	rts

ok
	iny
	lda (pp),y
	sta dlen	; len
	iny
	lda (pp),y
	sta dlen+1

	jsr do_queue

	jsr setout
	jsr setseq
	jsr setack

	lda dlen
	ldx dlen+1
	jsr addtxnxt		; inc seq number

	jmp mkpacket2
	.)

do_queue .(
	ldy #TCB_NTXBUF
	lda (tcbp),y
	cmp #TCP_MAXTXB
	bcc queueok
	rts
queueok
	adc #1
	sta (tcbp),y
	clc
	adc #TCB_TXBUF-1
	tay
	lda pslot
	sta (tcbp),y

	cpy #TCB_TXBUF
	bne notime

	lda #1
	jsr iniretrans
notime
	ldx pslot
	jmp incownr
	.)

setout	.(
	; make TCP packet from data
	clc
	lda #4
	adc pd
	sta p2
	lda #0
	adc pd+1
	sta p2+1

	ldy #TH_SRCIP
l0	lda (tcbp),y
	sta (p2),y
	iny
	cpy #TH_SRCIP+4
	bcc l0

	sec
	lda pd
	sbc #4
	sta p2
	lda pd+1
	sbc #0
	sta p2+1

	ldy #TH_TRGIP
l1	lda (tcbp),y
	sta (p2),y
	iny
	cpy #TH_TRGIP+4
	bcc l1

	ldy #TCB_SRCP
	lda (tcbp),y
	tax
	iny
	lda (tcbp),y
	ldy #TH_TRGP+1
	sta (pd),y
	dey
	txa
	sta (pd),y

	ldy #TCB_TRGP
	lda (tcbp),y
	tax
	iny
	lda (tcbp),y
	ldy #TH_SRCP+1
	sta (pd),y
	dey
	txa
	sta (pd),y

	ldy #TH_PTCL-1
	lda #0
	sta (pd),y
	iny
	lda #6
	sta (pd),y
	iny 
	iny
	lda pdl
	sec
	sbc #<TPH_LEN
	sta (pd),y
	dey
	lda pdl+1
	sbc #>TPH_LEN
	sta (pd),y

	ldy #TH_DOFFSET
	lda #$50
	sta (pd),y
	iny
	lda #THF_ACK
	sta (pd),y

	rts
	.)

&send_syn
	lda #THF_SYN
	.byt $2c
&send_reset
	lda #THF_RST
	.byt $2c
&send_fin
	lda #THF_FIN+THF_ACK
	.(
		/* TODO: set queued FIN until everything is really ok */
	sta tmp

	lda #<TH_OPTIONS+TCP_OFFSET
	ldy #>TH_OPTIONS+TCP_OFFSET
	jsr balloc
	bcc ok
	DB("Couldn't alloc send_* buffer!^m^j")
	sec
	rts
ok	;stx qslot
	lda #TCP_OFFSET
	jsr getpinfo
	bcc piok
	DB("getpi error in send_*^m^j")
	sec
	rts
piok
#if 0
DB("send_* slot=")
lda pslot:jsr EHexout:jsr ECrlfout
#endif
	jsr setout
	jsr setseq
	jsr setack

	lda tmp
	and #THF_FIN+THF_SYN
	beq nofin

DB("send FIN/SYN: tcbp=")
lda tcbp+1:jsr EHexout:lda tcbp:jsr EHexout:DB(", sndnxt=")
ldy #TCB_SND_NXT:ldx #4:x2 lda (tcbp),y:jsr EHexout:iny:dex:bne x2
DB(" ret=")
tsx:lda $102,x:jsr EHexout:lda $101,x:jsr EHexout
jsr ECrlfout
	
	ldx pslot
	jsr do_queue	; everthing adding to snd_nxt should be queued!

	lda #1
	ldx #0
	jsr addtxnxt
nofin
	ldy #TH_FLAG
	lda tmp
	sta (pd),y

	jmp mkpacket2
	.)

&tclose	.(
	/* ok, clean up connection specific stuff */
	lda #TE_SIG_TERM
	jsr signal_user

	ldy #TCB_STATE
	lda #TCP_CLOSED
	sta (tcbp),y

&&flushqueue
	ldy #TCB_NTXBUF
	lda (tcbp),y
	beq end
	clc
	adc #TCB_TXBUF-1
	sta tmp
l1	ldy tmp
	cpy #TCB_TXBUF		; -1
	bcc end

	lda (tcbp),y
	tax
	jsr bfree
	dec tmp
	jmp l1

end	ldy #TCB_NTXBUF
	lda #0
	sta (tcbp),y
	rts
	.)


settcb	.(
#if (TCB_LEN - 64)
#warning TCB length not correct!
#else
	lda #0
	sta tcbp+1
	txa
	asl
	rol tcbp+1
	asl
	rol tcbp+1
	asl
	rol tcbp+1
	asl
	rol tcbp+1
	asl
	rol tcbp+1
	asl
	rol tcbp+1
	clc
	adc #<tcb
	sta tcbp
	lda #>tcb
	adc tcbp+1
	sta tcbp+1
	rts
#endif
	.)

gettcb	.(
	ldx #0
l0	jsr settcb
	ldy #TCB_STATE
	lda (tcbp),y
	cmp #TCP_CLOSED
	beq l1
	inx
	cpx #MAXCONN
	bcc l0
	sec
	rts
l1	ldy #TCB_NTXBUF
	lda #0
	sta (tcbp),y
	ldy #TCB_FLAG
	sta (tcbp),y
	ldy #TCB_LSTATE
	lda #TCP_CLOSED
	sta (tcbp),y

	; clear connection specific data 
	lda #0
	ldy #TCB_CONN
l2	sta (tcbp),y
	iny
	cpy #TCB_LEN
	bcc l2
	clc
	rts
	.)

#include "tutil.a65"
#include "tcpuser.a65"
#include "tcpsrv.a65"
#ifndef NO_FSTCP
#include "fstcp.a65"
#endif
#ifndef NO_WWW
#include "wwwsrv.a65"
#endif

	.)

