Commit 38ccf085 authored by bernd's avatar bernd

fixed shared code buf problem

parent 2530e5ad
......@@ -155,7 +155,8 @@ event: ->throw dup DoError throw ;
: c:test& ( n -- ) \ in background
up@ 2 stacksize4 NewTask4 pass >r
alloc-io ['] c:test catch ?dup-IF
elit, ->throw drop ELSE elit, ->request THEN r> event> ;
elit, ->throw drop
ELSE elit, connection elit, ->request THEN r> event> ;
#100 Value req-ms#
......
......@@ -249,8 +249,11 @@ object class
umethod cmddest
end-class cmd-buf-c
: cmdbuf: ( addr -- ) Create , DOES> @ cmdbuf-o ! ;
cmd-buf-c new cmdbuf: code-buf
: cmdbuf: ( addr -- ) Create , DOES> perform @ cmdbuf-o ! ;
cmd-buf-c new code-buf^ !
' code-buf^ cmdbuf: code-buf
code-buf
:noname ( -- ) cmdbuf# off o IF req? on THEN ; to cmdreset
......@@ -267,7 +270,8 @@ cmd-buf-c class
maxdata uvar cmd0buf
end-class cmd-buf0
cmd-buf0 new cmdbuf: code0-buf
cmd-buf0 new code0-buf^ !
' code0-buf^ cmdbuf: code0-buf
\ command buffer in a string
......@@ -277,7 +281,8 @@ cmd-buf-c class
cell uvar cmd$
end-class cmd-buf$
cmd-buf$ new cmdbuf: code-buf$
cmd-buf$ new code-buf$^ !
' code-buf$^ cmdbuf: code-buf$
code-buf$
......@@ -294,6 +299,17 @@ code0-buf \ reset default
' cmd0lock to cmdlock
' rng64 to cmddest
: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 -1 req? !@ 0= IF start-req THEN THEN ;
: cmdtmp$ ( 64n -- addr u ) cmdtmp p!+ cmdtmp tuck - ;
: cmd, ( 64n -- ) do-<req cmdtmp$ +cmdbuf ;
......@@ -483,7 +499,7 @@ previous
tag-addr dup >r 2@
?dup-IF
cmd( dest-addr 64@ $64. ." resend canned code reply " tag-addr hex. cr )
r> reply-dest 64@ send-cmd true
r> reply-dest 64@ send-cmd drop true
1 packets2 +!
ELSE dest-addr 64@ [ cell 4 = ] [IF] 0<> - [THEN] dup 0 r> 2! u>= THEN ;
......
......@@ -78,7 +78,8 @@ cmd-buf0 uclass cmdbuf-o
key-cksum# uvar keypack-chksum
end-class cmd-keybuf-c
cmd-keybuf-c new cmdbuf: code-key
cmd-keybuf-c new code-key^ !
' code-key^ cmdbuf: code-key
code-key
cmd0lock 0 pthread_mutex_init drop
......@@ -88,6 +89,11 @@ cmd0lock 0 pthread_mutex_init drop
code0-buf
:noname defers alloc-code-bufs
cmd-keybuf-c new code-key^ ! ; is alloc-code-bufs
:noname defers free-code-bufs
code-key^ @ .dispose ; is free-code-bufs
\ hashed key data base
User >storekey
......
......@@ -16,7 +16,7 @@
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
defer avalanche-to ( addr u o:context -- )
: avalanche-msg ( msgaddr u groupaddr u -- )
: avalanche-msg ( msg groupaddr u -- )
\g forward message to all next nodes of that message group
2swap { d: msg }
msg-groups #@ dup IF
......@@ -25,7 +25,7 @@ defer avalanche-to ( addr u o:context -- )
ELSE 2drop THEN ;
event: ->avalanche ( o -- )
avalanche( ." Avalanche to: " dup hex. cr )
>o last-msg 2@ last-group 2@ parent @ .avalanche-msg o> ;
>o last-msg $@ last-group $@ parent @ .avalanche-msg o> ;
event: ->chat-connect ( o -- )
drop ctrl Z unkey ;
......@@ -48,7 +48,7 @@ net2o' emit net2o: msg-start ( $:pksig -- ) \g start message
!!signed? 1 !!>order? $> 2dup startdate@ .ticks space .key-id ." : " ;
+net2o: msg-group ( $:group -- ) \g specify a chat group
!!signed? 8 $10 !!<>=order? \g already a message there
$> last-group 2!
$> last-group $!
parent @ .wait-task @ ?dup-IF
<event o elit, ->avalanche event> THEN ;
+net2o: msg-join ( $:group -- ) \g join a chat group
......@@ -73,7 +73,7 @@ net2o' emit net2o: msg-start ( $:pksig -- ) \g start message
:noname ( addr u -- addr u flag )
pk-sig? dup >r IF
2dup last-msg 2!
2dup last-msg $!
sigpksize# - 2dup + sigpksize# >$ c-state off
THEN r>
; msg-class to nest-sig
......@@ -132,11 +132,14 @@ $200 Constant maxmsg#
dup dup -56 = swap -28 = or \ quit or ^c to leave
IF drop 2drop "/bye"
ELSE
drop \ fixme: do DoError instead
dup 1+ xback-restore pad swap THEN
0= IF
dup 1+ xback-restore pad swap
ELSE \ fixme: do DoError instead
drop 0 THEN
THEN
dup 0= WHILE 2drop REPEAT
r> to history ;
: g?join ( -- ) group-master @ ?EXIT
msg-group$ $@len IF +resend-cmd send-join -timeout THEN ;
......@@ -163,7 +166,7 @@ also net2o-base
cmdbuf$ 4 /string 2 - msg-group$ $@ code-buf avalanche-msg ;
previous
: group-chat ( -- ) chat-entry
: group-chat ( -- ) chat-entry \ ['] cmd( >body on
[: up@ wait-task ! ret+beacon ;] IS do-connect
BEGIN get-input-line
2dup "/bye" str= 0=
......@@ -176,8 +179,8 @@ previous
:noname ( addr u o:context -- )
avalanche( ." Send avalance to: " pubkey $@ key>nick type cr )
o to connection +resend-cmd net2o-code expect-reply
msg $, nestsig endwith
o to connection +resend-cmd
net2o-code expect-reply msg $, nestsig endwith
cookie+request end-code ; is avalanche-to
0 [IF]
......
......@@ -107,6 +107,10 @@ object class
timestats uvar stat-tuple
maxdata 2/ key-salt# + key-cksum# + uvar init0buf
maxdata uvar aligned$
cell uvar code0-buf^
cell uvar code-buf^
cell uvar code-buf$^
cell uvar code-key^
end-class io-buffers
[IFDEF] 64bit
......@@ -638,16 +642,21 @@ ustack object-stack
ustack t-stack
ustack nest-stack
Defer alloc-code-bufs ' noop is alloc-code-bufs
Defer free-code-bufs ' noop is free-code-bufs
: alloc-io ( -- ) \ allocate IO and reset generic user variables
io-buffers new io-mem !
-other
alloc-buf to inbuf
alloc-buf to tmpbuf
alloc-buf to outbuf
alloc-code-bufs
init-ed25519 c:init ;
: free-io ( -- )
free-ed25519 c:free
free-code-bufs
0 io-mem !@ .dispose
inbuf free-buf
tmpbuf free-buf
......@@ -1026,8 +1035,8 @@ cmd-class class
end-class ack-class
cmd-class class
2field: last-msg
2field: last-group
field: last-msg
field: last-group
end-class msg-class
cmd-class class
......@@ -2369,16 +2378,19 @@ event: ->disconnect ( connection -- ) .do-disconnect n2o:dispose-context ;
next-packet !ticks nip 0= ?EXIT inbuf route?
IF route-packet ELSE handle-packet THEN ;
event: ->request ( n -- ) 1 over lshift invert reqmask and!
event: ->request ( n o -- ) >o 1 over lshift invert reqmask and!
reqmask @ 0= IF -timeout THEN o>
request( ." Request completed: " . ." task: " up@ hex. cr )else( drop ) ;
event: ->reqsave ( task n -- ) <event elit, ->request event> ;
event: ->timeout ( -- ) reqmask off msg( ." Request timed out" cr )
true !!timeout!! ;
event: ->reqsave ( task n o -- ) <event swap elit, elit, ->request event> ;
event: ->timeout ( o -- )
0 reqmask !@ >r .-timeout msg( ." Request timed out" cr )
r> 0<> !!timeout!! ;
: request-timeout ( -- )
?timeout ?dup-IF >o rdrop
timeout( ." do timeout: " o hex. timeout-xt @ .name cr ) do-timeout
ack@ .timeouts @ timeouts# >= wait-task @ and ?dup-IF ->timeout event> THEN
ack@ .timeouts @ timeouts# >= wait-task @ and ?dup-IF
o elit, ->timeout event> THEN
THEN ;
\ beacons
......@@ -2456,8 +2468,8 @@ Variable beacons \ destinations to send beacons to
BEGIN packet-event event-send AGAIN ;
: n2o:request-done ( n -- )
file-task ?dup-IF <event swap wait-task @ elit, elit, ->reqsave event>
ELSE elit, ->request THEN ;
file-task ?dup-IF <event swap wait-task @ elit, elit, o elit, ->reqsave event>
ELSE elit, o elit, ->request THEN ;
0 value core-wanted
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment