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.439
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
Unified Diff Ignore Whitespace Patch
Changes to cmd.fs.
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
: 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 ! ;








|







240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
: 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 ! ;

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
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







|







330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
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
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
: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 ;








|







357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
: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 ;

598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
    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







|







598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
    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