needs lib/str lib/struct lib/psrs io/stream mem/mark
unit com/tcb

$400 const MAXWINDOWSZ
8 const BUFCNT \ This values is super low. If you run a server, beef it up

create bufs BUFCNT MAXWINDOWSZ * allot
: buf@ ( idx -- a ) MAXWINDOWSZ * bufs + ;
: bufidx ( a -- idx ) bufs - MAXWINDOWSZ / ;

BUFCNT newmarklist const usedbufs
: findfreebuf ( -- buf-or-0 )
  usedbufs findunmarked if dup usedbufs mark buf@ else 0 then ;

struct TCB { uint buf bufseq orig last winsz ; }
extends TCB struct TCBIn { uint first ; }
extends TCB struct TCBOut { uint tosend ; }
: winlast ( tcb -- seqn ) bi orig | winsz + ;
: .tcb ."buf " @+ .x ." bufseq " @+ .x ." orig " @+ .x ." last " @+ .x
       ." winsz " @+ .x ." first/tosend " @ .x nl> ;

: ?getbuf ( tcb -- buf-or-0 )
  r! buf not if findfreebuf r@ to buf r@ orig r@ to bufseq then r> buf ;

: )buf ( tcb -- a ) buf MAXWINDOWSZ + ;
: buf[] ( n seqn tcb -- ?oa ou a u )
  oover not if 2drop bufs 0 exit then
  r! ?getbuf + r@ bufseq - ( u a V1=tcb )
  swap 2dup + r> )buf - dup 0< if drop 0 rot> else ( a u overflow )
    r! - 2dup + MAXWINDOWSZ - rot> r> rot> then ;

create concatbuf MAXWINDOWSZ allot
: peekahead ( n seqn tcb -- ?a u )
  r! last oover oover + swap- max0 rot swap- swap ( n seqn V1=tcb )
  r> buf[] rot ?dup if ( oa a u ou )
    2dup + >r rot> ( oa ou a u V1=tot )
    concatbuf swap cmove+ swap cmove ( )
    concatbuf r>
    else ( a u ) dup not if nip then then ;

: writeahead ( a u seqn tcb -- n )
  >r 2dup + r@ doto last max |
  r> buf[] rot ?dup if ( src oa a u ou )
    2dup + >r \ V1=totn
    rot> 4 dig rot> r! cmove ( src oa ou V2=u )
    rot r> + rot> cmove r>
  else ( src dst u ) r! cmove r> then ;

: winsz! dip MAXWINDOWSZ min | to winsz ;
: freebuf doto buf 0 | ?dup if bufidx usedbufs unmark then ;
:~ ( orig tcb -- orig tcb )
  dup freebuf 2dup to orig 2dup to bufseq 2dup to last
  MAXWINDOWSZ over to winsz ;
: tcbin$ ~ to first ;
: tcbout$ ~ to tosend ;

: empty? bi orig | last = ;
: ?freebuf dup empty? if freebuf else drop then ;
: tcbout ( maxn tcbout -- ?seqn ?a u )
  r! tosend r@ winlast over - rot min swap ( n seqn )
  r@ peekahead ( ?a u )
  dup if dup r> doto tosend tuck + | rot> else rdrop then ;

: tcbwrite ( a u tcbout -- n ) dup last swap writeahead ;

: tcback ( seqn tcbout -- ) tuck to orig ?freebuf ;
: tcbrewind ( tcbout -- ) dup orig swap to tosend ;

: hashole? ( tcbin -- f ) bi first | orig <> ;
: tcbread ( n tcbin -- ?neworig ?a u )
  dupbi hashole? | empty? or if 2drop 0 exit then
  dip MAXWINDOWSZ min |
  r! orig r@ peekahead dup if ( a u )
    dup r@ doto first + |
    dup r@ doto orig + dup | ( a u neworig ) rot> then
  r> ?freebuf ;

: tcbin ( a u seqn tcbin -- )
  dup empty? not if
    2dup last > if 2drop 2drop exit then then
  dup hashole? if
    2dup last > if 2drop 2drop exit then
    2dup orig > if
      oover oover + over first < if 2drop 2drop exit then then then
  r! last over < if dup r@ to first then
  dup r@ doto first min |
  r> writeahead drop ;