start preparing moving flow control to separate class

client-tests.fs

@@ -99,12 +99,12 @@ previous
       cookie+request
     end-code| -setip n2o:send-replace ;
 
-: c:fetch-tags ( -- )
-    net2o-code
-      expect-reply
-      0 ulit, dht-open  pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
-      n2o:done
-    end-code| ;
+\ : c:fetch-tags ( -- )
+\     net2o-code
+\       expect-reply
+\       0 ulit, dht-open  pkc keysize 2* $, $FE ulit, 0 ulit, dht-query
+\       n2o:done
+\     end-code| ;
 
 : c:dht ( n -- )  $2000 $10000 "test" ins-ip c:connect 0 ?DO
 	c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
@@ -114,20 +114,21 @@ previous
     [: .time ." Download test: 1 text file and 2 photos" cr ;] $err
     net2o-code
       expect-reply
-      !time .time s" Download test " $, type 1 ulit, . pi float, f. cr
-      ( see-me ) get-ip 0 ulit,
+      !time
+      log .time s" Download test " $, type 1 ulit, . pi float, f. cr endwith
+      get-ip 0 ulit,
       $400 blocksize! $400 blockalign! stat( request-stats )
       "net2o.fs" "net2o.fs" >cache n2o:copy
       "data/2011-05-13_11-26-57-small.jpg" "photo000s.jpg" >cache n2o:copy
       "data/2011-05-20_17-01-12-small.jpg" "photo001s.jpg" >cache n2o:copy
-      n2o:done words push' cr
+      n2o:done push' log words push' cr push' endwith
     end-code| n2o:close-all ['] .time $err ;
 
 : c:download2 ( -- )
     [: ." Download test 2: 7 medium photos" cr ;] $err
     net2o-code
       expect-reply close-all \ rewind-total
-      .time s" Download test 2" $, type cr ( see-me )
+      log .time s" Download test 2" $, type cr endwith
       $10000 blocksize! $400 blockalign! stat( request-stats )
       "data/2011-06-02_15-02-38-small.jpg" "photo002s.jpg" >cache n2o:copy
       "data/2011-06-03_10-26-49-small.jpg" "photo003s.jpg" >cache n2o:copy
@@ -143,7 +144,7 @@ previous
     [: ." Download test 3: 2 big photos" cr ;] $err
     net2o-code
       expect-reply close-all \ rewind-total
-      .time s" Download test 3" $, type cr ( see-me )
+      log .time s" Download test 3" $, type cr endwith
       $10000 blocksize! $400 blockalign! stat( request-stats )
       "data/2011-05-13_11-26-57.jpg" "photo000.jpg" >cache n2o:copy
       "data/2011-05-20_17-01-12.jpg" "photo001.jpg" >cache n2o:copy
@@ -154,7 +155,7 @@ previous
     [: ." Download test 4: 7 big photos, partial files" cr ;] $err
     net2o-code
       expect-reply close-all \ rewind-total
-      .time s" Download test 4" $, type cr ( see-me )
+      log .time s" Download test 4" $, type cr endwith
       $10000 blocksize! $400 blockalign! stat( request-stats )
       "data/2011-06-02_15-02-38.jpg" "photo002.jpg" >cache n2o:copy
       "data/2011-06-03_10-26-49.jpg" "photo003.jpg" >cache n2o:copy
@@ -177,7 +178,7 @@ previous
     [: ." Download test 4a: 7 big photos, rest" cr ;] $err
     net2o-code
       expect-reply
-      .time s" Download test 4a" $, type cr  ( see-me )
+      log .time s" Download test 4a" $, type cr endwith
       -1. 0 limit!
       -1. 1 limit!
       -1. 2 limit!

net2o-cmd.fs

@@ -256,6 +256,9 @@ User cmdbuf#
 
 Defer net2o:words
 
+: inherit-table ( addr u "name" -- )
+    ' dup IS gen-table  execute $! ;
+
 Vocabulary net2o-base
 
 get-current also net2o-base definitions previous
@@ -286,8 +289,7 @@ get-current also net2o-base definitions previous
 dup set-current
 
 gen-table $freeze
-gen-table $@ reply-table $!
-' reply-table is gen-table
+gen-table $@ inherit-table reply-table
 
 \ net2o assembler
 
@@ -459,7 +461,6 @@ dup set-current previous
 
 also net2o-base definitions
 $10 net2o: <req ( -- ) ; \ stub: push own id in reply
-+net2o: req> ( -- ) endwith ; \ generic: pop own id in reply
 +net2o: push-lit ( u -- ) \ push unsigned literal into answer packet
     lit, ;
 ' push-lit alias push-char
@@ -478,11 +479,14 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
 \ Use ko instead of throw for not acknowledge (kudos to Heinz Schnitter)
 +net2o: ko ( uerror -- ) \ receive error message
     throw ;
++net2o: nest ( $:string -- ) \ nested (self-encrypted) command
+    $> cmdnest ;
+
+: req> ( -- ) push' endwith ;
 
 \ inspection
 
-+net2o: token ( $:token n -- )
-    64>n 0 .r ." :" $> type space ; \ stub
++net2o: token ( $:token n -- ) 64drop $> 2drop ; \ stub
 
 :noname ( start -- )
     token-table $@ 2 pick cells safe/string bounds U+DO
@@ -493,11 +497,14 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
 	THEN  1+
     cell +LOOP  drop ; IS net2o:words
 
-\ setup connection class
-
 gen-table $freeze
-gen-table $@ setup-table $!
-' setup-table is gen-table
+
+\ log dump class
+
+gen-table $@ inherit-table log-table
+
+net2o' token net2o: log-token ( $:token n -- )
+    64>n 0 .r ." :" $> F type space ;
 
 $20 net2o: emit ( xc -- ) \ emit character on server log
     64>n xemit ;
@@ -509,11 +516,18 @@ $20 net2o: emit ( xc -- ) \ emit character on server log
     F f. ;
 +net2o: cr ( -- ) \ newline on server log
     F cr ;
-+net2o: see-me ( -- ) \ see received commands on server log
-    n2o:see-me ;
++net2o: .time ( -- ) \ print timer to server log
+    F .time .packets profile( .times ) ;
+
+gen-table $freeze
+
+\ setup connection class
+
+reply-table $@ inherit-table setup-table
+
+$20 net2o: log ( -- o:log ) log-context @ n:>o ;
+log-table >table
 
-+net2o: nest ( $:string -- ) \ nested (self-encrypted) command
-    $> cmdnest ;
 +net2o: tmpnest ( $:string -- ) \ nested (temporary encrypted) command
     $> cmdtmpnest ;
 
@@ -565,8 +579,6 @@ $20 net2o: emit ( xc -- ) \ emit character on server log
     ]nest  n2o:create-map  neststack @ IF  ]tmpnest  THEN
     64drop 2drop 64drop ;
 
-+net2o: disconnect ( -- ) \ close connection
-    o 0= ?EXIT n2o:dispose-context un-cmd ;
 +net2o: set-tick ( uticks -- ) \ adjust time
     adjust-ticks ;
 +net2o: get-tick ( -- ) \ request time adjust
@@ -640,8 +652,7 @@ net2o-base
 \ everything that follows here can assume to have a connection context
 
 gen-table $freeze
-gen-table $@ context-table $!
-' context-table is gen-table
+gen-table $@ inherit-table context-table
 
 \ file functions
 
@@ -649,8 +660,7 @@ $40 net2o: file-id ( uid -- o:file )
     64>n state-addr n:>o ;
 fs-table >table
 
-reply-table $@ fs-table $!
-' fs-table is gen-table
+reply-table $@ inherit-table fs-table
 
 net2o' <req net2o: <req-file ( -- ) fs-id @ ulit, file-id ;
 net2o' emit net2o: open-file ( $:string mode -- ) \ open file with mode
@@ -693,6 +703,8 @@ gen-table $freeze
 +net2o: slurp ( -- ) \ slurp in tracked files
     n2o:slurp swap ulit, flag, set-top
     ['] do-track-seek n2o:track-all-seeks net2o:send-chunks ;
++net2o: disconnect ( -- ) \ close connection
+    o 0= ?EXIT n2o:dispose-context un-cmd ;
 
 \ flow control functions
 
@@ -731,8 +743,6 @@ $50 net2o: ack-addrtime ( utime addr -- ) \ packet at addr received at time
 
 $60 net2o: !time ( -- ) \ start timer
     F !time init-timer ;
-+net2o: .time ( -- ) \ print timer to server log
-    F .time .packets profile( .times ) ;
 
 +net2o: set-ip ( $:string -- ) \ set address information
     $> setip-xt perform ;
@@ -754,7 +764,7 @@ net2o-base
 : lit<   lit, push-lit ;
 : slit<  slit, push-slit ;
 :noname ( throwcode -- )
-    server? IF
+    connection @ .server? IF
 	dup  IF  dup nlit, ko end-cmd
 	    ['] end-cmd IS expect-reply? (end-code)  THEN
     THEN  throw ; IS >throw

net2o-dht.fs

@@ -298,8 +298,7 @@ $70 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F
 \g set dht id for further operations on it
 dht-table >table
 
-reply-table $@ dht-table $!
-' dht-table is gen-table
+reply-table $@ inherit-table dht-table
 
 net2o' <req net2o: <req-dht ( -- ) dht-hash $@ $, dht-id ; \ redefine <req
 net2o' emit net2o: dht-host+ ( $:string -- ) $> d#host+ ;
@@ -353,8 +352,8 @@ get-current definitions
 
 +net2o: dht-host? ( -- ) d#host? ;
 +net2o: dht-tags? ( -- ) d#tags? ;
-+net2o: dht-open ( fid -- ) 64>n d#open ;
-+net2o: dht-query ( addr u mask fid -- ) 2*64>n d#query ;
+\ +net2o: dht-open ( fid -- ) 64>n d#open ;
+\ +net2o: dht-query ( addr u mask fid -- ) 2*64>n d#query ;
 
 previous set-current
 
@@ -465,7 +464,7 @@ Defer renew-key
     -setip n2o:send-revoke ;
 
 : do-disconnect ( -- )
-    net2o-code .time s" Disconnect" $, type cr
+    net2o-code log .time s" Disconnect" $, type cr endwith
       close-all disconnect  end-code msg( ." disconnected" F cr )
     n2o:dispose-context msg( ." Disposed context" F cr ) ;
 

net2o-keys.fs

@@ -188,8 +188,7 @@ Variable keys
 
 get-current also net2o-base definitions
 
-cmd-table $@ key-entry-table $!
-' key-entry-table is gen-table
+cmd-table $@ inherit-table key-entry-table
 
 $10 net2o: newkey ( $:string -- o:key ) $> key:new n:>o ;
 key-entry-table >table

net2o.fs

@@ -865,6 +865,11 @@ end-class reply-class \ command interpreter with replies
 
 Variable reply-table
 
+reply-class class
+end-class log-class
+
+Variable log-table
+
 reply-class class
 end-class setup-class \ setup connections
 
@@ -877,6 +882,7 @@ setup-class class
     field: data-rmap
     field: codebuf#
     field: context#
+    field: log-context
     field: wait-task
     field: resend0
     field: punch-load
@@ -901,7 +907,7 @@ setup-class class
     field: filereq#
     1 pthread-mutexes +field filestate-lock
     1 pthread-mutexes +field code-lock
-    
+
     field: data-resend
     field: data-b2b
     
@@ -914,21 +920,22 @@ setup-class class
     field: req-codesize
     field: req-datasize
     \ flow control, sender part
+    field: window-size \ packets in flight
+    field: timeouts
+    field: flyburst
+    field: flybursts
+
     64field: min-slack
     64field: max-slack
     64field: ns/burst
     64field: last-ns/burst
     64field: extra-ns
-    field: window-size \ packets in flight
     64field: bandwidth-tick \ ns
     64field: next-tick \ ns
     64field: next-timeout \ ns
-    field: timeouts
     64field: rtdelay \ ns
     64field: lastack \ ns
     64field: resend-all-to \ ns
-    field: flyburst
-    field: flybursts
     64field: lastslack
     64field: lastdeltat
     64field: slackgrow
@@ -1086,6 +1093,9 @@ resend-size# buffer: resend-init
 
 UValue connection
 
+: n2o:new-log ( -- o )
+    log-class new >o  log-table @ token-table ! o o> ;
+
 : n2o:new-context ( addr -- o )
     context-class new >o timeout( ." new context: " o hex. cr )
     o to connection \ current connection
@@ -1098,7 +1108,9 @@ UValue connection
     -1 blocksize !
     1 blockalign !
     code-lock 0 pthread_mutex_init drop
-    filestate-lock 0 pthread_mutex_init drop o o> ;
+    filestate-lock 0 pthread_mutex_init drop
+    n2o:new-log log-context !
+    o o> ;
 
 \ insert address for punching
 
@@ -1797,11 +1809,6 @@ Defer punch-reply
 
 \ send chunk
 
-: net2o:get-dest ( -- taddr )
-    data-dest ;
-: net2o:get-resend ( -- taddr )
-    resend-dest ;
-
 \ branchless version using floating point
 
 User <size-lb> 1 floats cell- uallot drop
@@ -1833,10 +1840,10 @@ User <size-lb> 1 floats cell- uallot drop
     resend$@ nip 0> data-tail? or ;
 
 : net2o:resend ( -- addr n )
-    resend$@ net2o:get-resend net2o:prep-send /resend ;
+    resend$@ resend-dest net2o:prep-send /resend ;
 
 : net2o:send ( -- addr n )
-    data-tail@ net2o:get-dest net2o:prep-send /tail ;
+    data-tail@ data-dest net2o:prep-send /tail ;
 
 : ?toggle-ack ( -- )
     data-to-send 0= IF
@@ -2289,6 +2296,7 @@ $10 Constant tmp-crypt-val
 	crypto-key sec-off
 	data-resend $off  timing-stat $off
 	dest-pubkey $off
+	log-context @ .dispose
 	dispose
 	cmd( ." disposed" cr ) ;] file-sema c-section ;