Check-in [217298f0da]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:resend0 cleaned at connect
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 217298f0dab07545a09e6b7ee8d4ab5f7aa8b4af
User & Date: bernd 2020-02-03 17:26:30
Context
2020-02-03
18:00
map finding process updated check-in: 076d2fe71d user: bernd tags: trunk
17:26
resend0 cleaned at connect check-in: 217298f0da user: bernd tags: trunk
17:06
minimum blocksize check-in: e4211e87dc user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to cmd.fs.

240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
...
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
: cmd-see ( addr u -- addr' u' )
    dup show-offset @ = IF  ." <<< "  THEN
    buf-state 2! p@ 64>n net2o-see buf-state 2@ ;

in net2o : (see) ( addr u -- )
    buf-state 2@ 2>r
    [: ." net2o-code"  dest-flags 1+ c@ stateless# and IF  '0' emit  THEN
      dup hex. t-stack $off
      [: BEGIN  cmd-see dup 0= UNTIL ;] catch
      ."  end-code" cr throw  2drop ;] see-sema c-section
    2r> buf-state 2! ;

: >see-table ( -- )
    o IF  token-table  ELSE  setup-table  THEN  @ see:table ! ;

................................................................................
cmd-buf$ ' new static-a with-allocater code-buf$^ !
' code-buf$^ cmdbuf: code-buf$

code-buf$

' cmd$lock to cmdlock
:noname  cmd$ $@ ; to cmdbuf$
:noname  cmd$ $off ; to cmdreset
' true to maxstring \ really maxuint = -1 = true
:noname ( addr u -- ) cmd$ $+! ; to +cmdbuf
:noname ( n -- )  cmd$ $@len + cmd$ $!len ; to -cmdbuf
:noname ( -- 64dest ) 64#0 ; to cmddest

: gen-cmd ( xt -- $addr )
    cmdbuf-o @ >r code-buf$ 0 cmd$ !@ >r cmdbuf# @ >r
................................................................................
:noname ( -- )
    cmd-buf0 new code0-buf^ !
    cmd-buf-c new code-buf^ !
    cmd-buf$ new code-buf$^ ! ; is alloc-code-bufs
:noname
    code0-buf^ @ .dispose
    code-buf^ @ .dispose
    code-buf$^ @ >o cmd$ $off dispose o> ; is free-code-bufs

\ stuff into code buffers

: do-<req ( -- )  o IF  req? @ 0> IF  req? on start-req  THEN  THEN ;
: cmdtmp$ ( 64n -- addr u )  cmdtmp p!+ cmdtmp tuck - ;
: cmd, ( 64n -- )  do-<req cmdtmp$ +cmdbuf ;

................................................................................
    tag( ." tag: " tag-addr dup hex. 2@ swap hex. hex. forth:cr )
    code-vdest r@ reply-dest 64!
    r> code-reply dup off  to reply-tag ;
in net2o : ok ( tag -- ) \ ." ok" forth:cr
\    timeout( ." ok: " dup hex. forth:cr )
    o 0= IF  drop EXIT  THEN
    request( ." request acked: " dup . cr )
    resend0 $off
    nat( ." ok from: " ret-addr .addr-path space dup .
    dup reply[] 2@ d0= IF ." acked"  THEN cr )
    #0. 2 pick reply[] dup >r 2!
    ticks r@ reply-time 64@ 64- ack@ >o
    rtd( ." rtdelay ok: " 64dup 64>f .ns cr )
    0 timeouts !@ rtd( dup . ) 1 u> IF  rtdelay 64@ 64umax
	rtd( ." rtdelay t-o: " 64dup 64>f .ns cr )  THEN







|







 







|







 







|







 







|







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
...
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
...
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
: cmd-see ( addr u -- addr' u' )
    dup show-offset @ = IF  ." <<< "  THEN
    buf-state 2! p@ 64>n net2o-see buf-state 2@ ;

in net2o : (see) ( addr u -- )
    buf-state 2@ 2>r
    [: ." net2o-code"  dest-flags 1+ c@ stateless# and IF  '0' emit  THEN
      dup hex. t-stack $free
      [: BEGIN  cmd-see dup 0= UNTIL ;] catch
      ."  end-code" cr throw  2drop ;] see-sema c-section
    2r> buf-state 2! ;

: >see-table ( -- )
    o IF  token-table  ELSE  setup-table  THEN  @ see:table ! ;

................................................................................
cmd-buf$ ' new static-a with-allocater code-buf$^ !
' code-buf$^ cmdbuf: code-buf$

code-buf$

' cmd$lock to cmdlock
:noname  cmd$ $@ ; to cmdbuf$
:noname  cmd$ $free ; to cmdreset
' true to maxstring \ really maxuint = -1 = true
:noname ( addr u -- ) cmd$ $+! ; to +cmdbuf
:noname ( n -- )  cmd$ $@len + cmd$ $!len ; to -cmdbuf
:noname ( -- 64dest ) 64#0 ; to cmddest

: gen-cmd ( xt -- $addr )
    cmdbuf-o @ >r code-buf$ 0 cmd$ !@ >r cmdbuf# @ >r
................................................................................
:noname ( -- )
    cmd-buf0 new code0-buf^ !
    cmd-buf-c new code-buf^ !
    cmd-buf$ new code-buf$^ ! ; is alloc-code-bufs
:noname
    code0-buf^ @ .dispose
    code-buf^ @ .dispose
    code-buf$^ @ >o cmd$ $free dispose o> ; is free-code-bufs

\ stuff into code buffers

: do-<req ( -- )  o IF  req? @ 0> IF  req? on start-req  THEN  THEN ;
: cmdtmp$ ( 64n -- addr u )  cmdtmp p!+ cmdtmp tuck - ;
: cmd, ( 64n -- )  do-<req cmdtmp$ +cmdbuf ;

................................................................................
    tag( ." tag: " tag-addr dup hex. 2@ swap hex. hex. forth:cr )
    code-vdest r@ reply-dest 64!
    r> code-reply dup off  to reply-tag ;
in net2o : ok ( tag -- ) \ ." ok" forth:cr
\    timeout( ." ok: " dup hex. forth:cr )
    o 0= IF  drop EXIT  THEN
    request( ." request acked: " dup . cr )
    resend0 $free
    nat( ." ok from: " ret-addr .addr-path space dup .
    dup reply[] 2@ d0= IF ." acked"  THEN cr )
    #0. 2 pick reply[] dup >r 2!
    ticks r@ reply-time 64@ 64- ack@ >o
    rtd( ." rtdelay ok: " 64dup 64>f .ns cr )
    0 timeouts !@ rtd( dup . ) 1 u> IF  rtdelay 64@ 64umax
	rtd( ." rtdelay t-o: " 64dup 64>f .ns cr )  THEN

Changes to connected.fs.

590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
: +resend-cmd ( -- ) resend( ." +resend-cmd" cr )
    ['] cmd-timeout        is timeout-xt o+timeout ;

: +get-time     ['] get-tick is other ;

: reqsize! ( ucode udata -- )  to req-datasize  to req-codesize ;
: connect-rest ( n -- )
    clean-request -timeout tskc KEYBYTES erase context! ;

: end-code| ( -- )  ]] end-code client-loop [[ ; immediate compile-only

: connect-request ( -- )
    net2o-code0
    net2o-version $, version?  0key,
    tpkc keysize $, receive-tmpkey







|







590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
: +resend-cmd ( -- ) resend( ." +resend-cmd" cr )
    ['] cmd-timeout        is timeout-xt o+timeout ;

: +get-time     ['] get-tick is other ;

: reqsize! ( ucode udata -- )  to req-datasize  to req-codesize ;
: connect-rest ( n -- )
    clean-request -timeout tskc KEYBYTES erase context! resend0 $free ;

: end-code| ( -- )  ]] end-code client-loop [[ ; immediate compile-only

: connect-request ( -- )
    net2o-code0
    net2o-version $, version?  0key,
    tpkc keysize $, receive-tmpkey