Commit a5575008 authored by bernd's avatar bernd

current connection is now a user value, no difficult to keep member variable

parent 0c180fdb
......@@ -50,7 +50,7 @@ UValue test# 0 to test#
: c:connect ( code data nick u ret -- )
[: .time ." Connect to: " dup hex. cr ;] $err
n2o:new-context
n2o:new-context >o rdrop o to connection
dest-key \ get our destination key
n2o:connect +flow-control +resend
[: .time ." Connected, o=" o hex. cr ;] $err ;
......
......@@ -69,6 +69,24 @@ User string-stack string-max# uallot drop
: string@ ( -- $:string )
buf-state 2@ @>$ buf-state 2! ;
\ string debugging
: printable? ( addr u -- flag )
true -rot bounds ?DO I c@ $7F and bl < IF drop false LEAVE THEN LOOP ;
: n2o:$. ( addr u -- )
2dup printable? IF
.\" \"" type
ELSE
.\" 85\" " 85type
THEN '"' emit ;
: n2o.string ( $:string -- ) cr $> n2o:$. ." $, " ;
: $.s ( $string1 .. $stringn -- )
string-stack @+ swap bounds U+DO
cr i 2@ n2o:$.
2 cells +LOOP ;
\ object stack
8 cells Constant object-max#
......@@ -132,22 +150,12 @@ Defer gen-table
body>
ELSE drop ['] net2o-crash THEN .name ;
: printable? ( addr u -- flag )
true -rot bounds ?DO I c@ $7F and bl < IF drop false LEAVE THEN LOOP ;
: n2o.string ( $:string -- ) $>
2dup printable? IF
cr .\" \"" type
ELSE
cr .\" 85\" " 85type
THEN .\" \" $, " ;
: .net2o-num ( off -- ) cell/ '<' emit 0 .r '>' emit space ;
: .net2o-name ( n -- ) cells >r
o IF token-table ELSE setup-table THEN $@ r@ u<=
IF drop r> .net2o-num EXIT THEN r> + (net2o-see) ;
: net2o-see ( -- ) hex[
: net2o-see ( cmd -- ) hex[
case
0 of ." end-code" cr 0. buf-state 2! endof
1 of p@ 64. ." lit, " endof
......@@ -173,7 +181,7 @@ Variable show-offset show-offset on
: cmd-dispatch ( addr u -- addr' u' )
buf-state 2!
cmd@ trace( .s cr ) n>cmd
cmd@ trace( dup IF dup .net2o-name THEN >r .s r> $.s cr ) n>cmd
@ ?dup-IF execute ELSE
trace( ." crashing" cr cr ) net2o-crash THEN buf-state 2@ ;
......@@ -240,12 +248,12 @@ User cmdbuf#
: cmdbuf ( -- addr ) cmd0source @ dup 0= IF drop code-dest THEN ;
\ : cmdbuf# ( -- addr ) cmd0source @ IF cmd0buf# ELSE codebuf# THEN ;
: cmdlock ( -- addr ) cmd0source @ IF cmd0lock ELSE
connection@ .code-lock THEN ;
: cmdbuf$ ( -- addr u ) connection@ >o cmdbuf cmdbuf# @ o> ;
: endcmdbuf ( -- addr' ) connection@ >o cmdbuf maxdata + o> ;
connection .code-lock THEN ;
: cmdbuf$ ( -- addr u ) connection >o cmdbuf cmdbuf# @ o> ;
: endcmdbuf ( -- addr' ) connection >o cmdbuf maxdata + o> ;
: maxstring ( -- n ) endcmdbuf cmdbuf$ + - ;
: cmdbuf+ ( n -- )
connection@ >o dup maxstring u>= !!stringfit!! cmdbuf# +! o> ;
connection >o dup maxstring u>= !!stringfit!! cmdbuf# +! o> ;
: n2o:see-me ( -- )
buf-state 2@ 2>r
......@@ -281,7 +289,7 @@ comp: :, also net2o-base ;
64dup 64-0= !!no-dest!! THEN ;
: cmd ( -- ) cmdbuf# @ 2 u< ?EXIT \ don't send if cmdbuf is empty
connection@ >o cmdbuf cmdbuf# @ cmddest send-cmd
connection >o cmdbuf cmdbuf# @ cmddest send-cmd
cmd0source @ 0= IF code-update punch-load $off THEN o> ;
also net2o-base
......@@ -312,7 +320,7 @@ previous
: net2o:expect-reply ( -- ) o?
timeout( cmd( ." expect: " cmdbuf$ n2o:see ) )
cmdbuf$
connection@ >o code-reply dup >r 2! code-vdest r> reply-dest 64! o> ;
connection >o code-reply dup >r 2! code-vdest r> reply-dest 64! o> ;
: tag-addr? ( -- flag )
tag-addr dup >r 2@
......@@ -336,7 +344,7 @@ Variable throwcount
r> sp! 2drop +cmd ;
: cmd-loop ( addr u -- )
string-stack off
string-stack off object-stack off o to connection
o IF
cmd0source off
tag-addr? IF
......@@ -475,7 +483,7 @@ gen-table $@ setup-table $!
o IF rtdelay! EXIT THEN
own-crypt? IF
64dup cookie>context?
IF >o rdrop
IF >o rdrop o to connection
ticker 64@ recv-tick 64! rtdelay! \ time stamp of arrival
EXIT
ELSE \ just check if timeout didn't expire
......@@ -977,7 +985,7 @@ cell 8 = [IF] 6 [ELSE] 5 [THEN] Constant cell>>
\ keepalive
also net2o-base
: transfer-keepalive? ( -- )
: transfer-keepalive? ( -- ) o to connection
timeout( ." transfer keepalive " expected@ hex. hex.
data-rmap @ >o dest-tail @ hex. dest-back @ hex. o>
F cr )
......
......@@ -259,20 +259,19 @@ Variable revtoken
dht-table ' new static-a with-allocater constant dht-stub
: >d#id ( addr u -- o ) connection@ { conn }
: >d#id ( addr u -- o )
2dup d#public d# @ >o
o 0= IF dht-stub >o rdrop dht-table @ token-table ! dht-hash $! THEN
conn connection ! o o> ;
o 0= IF dht-stub >o rdrop dht-hash $! THEN o> ;
: ?d#id ( -- )
o dht-stub = IF \ want to allocate it? check first!
dht-hash $@ connection@
dht-hash $@
dht-class new >o rdrop dht( ." new dht: " o hex. F cr )
connection ! dht-hash $!
dht-table @ token-table ! o dht-hash $@ d#public d# !
dht-hash dht( ." set dht-hash: " dup hex. >r 2dup 85type r> F cr ) $!
dht-table @ token-table ~~ ! o dht-hash $@ d#public d# ~~ !
THEN ;
: (d#value+) ( addr u key -- ) \ without sanity checks
cells dup k#size u>= !!no-dht-key!! ?d#id
dht-hash + dht( ." ins into: " dup hex. dup $[]# F . F cr ) $ins[]sig ;
dht-hash dht( ." access dht: " dup hex. over . F cr ) + dht( ." ins into: " dup hex. dup $[]# F . F cr ) $ins[]sig ;
: .tag ( addr u -- ) 2dup 2>r
>tag verify-tag >r sigpksize# - type r> 2r> .sigdates .check ;
......@@ -296,7 +295,7 @@ dht-table ' new static-a with-allocater constant dht-stub
cells dup k#size u>= !!no-dht-key!!
o dht-stub = IF dht( ." remove from stub" cr )
drop 2drop EXIT THEN \ we don't have it
dht-hash +
dht-hash dht( ." access dht: " dup hex. over . F cr ) +
dup dht-host = IF >r delete-host? IF r> $del[]sig dht( d#. )
ELSE 2drop rdrop THEN rdrop EXIT THEN
dup dht-tags = IF >r delete-tag? IF r> $del[]sig dht( d#. )
......@@ -312,7 +311,7 @@ dht-table ' new static-a with-allocater constant dht-stub
get-current also net2o-base definitions
100 net2o: dht-id ( $:string -- o:o ) $> >d#id n:>o ;
100 net2o: dht-id ( $:string -- o:o ) $> >d#id dht( ." set dht to: " dup hex. F cr ) n:>o ;
\g set dht id for further operations on it
dht-table >table
......@@ -330,7 +329,7 @@ set-current
\ queries
: d#value? ( key -- ) o dht-stub = IF drop EXIT THEN
k#tags umin dup cells dht-hash +
k#tags umin dup cells dht-hash dht( ." access dht: " dup hex. over . F cr ) +
[: dup $A0 + maxstring <
IF $, dup ulit, dht-value+ ELSE 2drop THEN ;] $[]map
drop ;
......@@ -348,7 +347,7 @@ end-class dht-file-class
: d#values, ( addr u mask -- addr' u' ) { mask }
k#size cell/ 1 DO
mask 1 and IF
I dup cells dht-hash +
I dup cells dht-hash dht( ." access dht: " dup hex. over . F cr ) +
[: { k# a# u# } k# d#c, a# u# d#$, k# ;] $[]map drop
THEN mask 2/ to mask
LOOP ;
......@@ -378,6 +377,8 @@ get-current definitions
previous set-current
dht-stub >o dht-table @ token-table ! o>
\ value reading requires constructing answer packet
' context-table is gen-table
......
......@@ -84,7 +84,7 @@ Variable key-table
: key:new ( addr u -- )
\ addr u is the public key
connection@ sample-key >o connection !
sample-key >o
key-entry-table @ token-table !
ke-sk ke-end over - erase
64#-1 ke-last 64!
......
......@@ -855,7 +855,6 @@ end-class cmd-class \ command interpreter
Variable cmd-table
cmd-class class
field: connection
end-class reply-class \ command interpreter with replies
Variable reply-table
......@@ -1079,9 +1078,11 @@ resend-size# buffer: resend-init
: no-timeout ( -- ) max-int64 next-timeout 64! 0 timeouts ! ;
: n2o:new-context ( addr -- )
context-class new >o rdrop timeout( ." new context: " o hex. cr )
o connection ! \ backlink to self
UValue connection
: n2o:new-context ( addr -- o )
context-class new >o timeout( ." new context: " o hex. cr )
o to connection \ current connection
context-table @ token-table ! \ copy pointer
init-context# @ context# ! 1 init-context# +!
dup return-addr be! return-address be!
......@@ -1091,7 +1092,7 @@ resend-size# buffer: resend-init
-1 blocksize !
1 blockalign !
code-lock 0 pthread_mutex_init drop
filestate-lock 0 pthread_mutex_init drop ;
filestate-lock 0 pthread_mutex_init drop o o> ;
\ insert address for punching
......@@ -1148,7 +1149,6 @@ Variable mapstart $1 mapstart !
: server? ( -- flag ) is-server c@ negate ;
: server! ( -- ) 1 is-server c! ;
: pow2? ( n -- n ) dup dup 1- and 0<> !!pow2!! ;
: connection@ ( -- addr/0 ) o IF connection @ ELSE 0 THEN ;
: n2o:new-map ( u -- addr )
drop mapstart @ 1 mapstart +! reverse
......@@ -1156,7 +1156,7 @@ Variable mapstart $1 mapstart !
: n2o:new-data pow2? { 64: addrs 64: addrd u -- }
o 0= IF
addrd >dest-map @ ?EXIT
return-addr be@ n2o:new-context server! THEN
return-addr be@ n2o:new-context >o rdrop server! THEN
msg( ." data map: " addrs $64. addrd $64. u hex. cr )
>code-flag off
addrd u data-rmap map-data-dest
......@@ -1164,7 +1164,7 @@ Variable mapstart $1 mapstart !
: n2o:new-code pow2? { 64: addrs 64: addrd u -- }
o 0= IF
addrd >dest-map @ ?EXIT
return-addr be@ n2o:new-context server! THEN
return-addr be@ n2o:new-context >o rdrop server! THEN
msg( ." code map: " addrs $64. addrd $64. u hex. cr )
>code-flag on
addrd u code-rmap map-code-dest
......@@ -1553,7 +1553,7 @@ Variable fs-table
id>addr cell < !!fileid!! ;
: new>file ( id -- )
[: fs-class new { w^ fsp } fsp cell file-state $+!
connection@ fsp @ >o connection ! fs-id !
fsp @ >o fs-id !
fs-table @ token-table ! 64#-1 fs-limit 64! o> ;]
filestate-lock c-section ;
......@@ -2453,7 +2453,7 @@ con-cookie >osize @ buffer: cookie-adder
: cookie>context? ( cookie -- context true / false )
?cookie over 0= over and IF
nip return-addr be@ n2o:new-context o 0 >o rdrop swap
nip return-addr be@ n2o:new-context swap
THEN ;
: rtdelay! ( time -- ) recv-tick 64@ 64swap 64- rtdelay 64! ;
......
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