Commit 0e03a464 authored by bernd's avatar bernd

Fix polling

parent 48cff4ef
......@@ -12,6 +12,8 @@ i'm anonymous
init-client
"" connect-nick $! strict-keys off
!time
?nextarg [IF] net2o-host $! [THEN]
......
......@@ -51,7 +51,9 @@ UValue test# 0 to test#
\ n2o:done
\ end-code| ;
: c:dht ( n -- ) $8 $8 "test" ins-ip c:connect 0 ?DO
Variable connect-nick "test" connect-nick $!
: c:dht ( n -- ) $8 $8 connect-nick $@ ins-ip c:connect 0 ?DO
c:add-tag "anonymous" c:fetch-tag \ c:fetch-tags
LOOP do-disconnect ;
......@@ -146,7 +148,7 @@ UValue test# 0 to test#
: c:test ( -- )
init-cache'
$a $e "test" ins-ip c:connect c:test-rest ;
$a $e connect-nick $@ ins-ip c:connect c:test-rest ;
event: ->throw dup DoError throw ;
......@@ -187,7 +189,7 @@ event: ->throw dup DoError throw ;
\ terminal connection
: c:terminal ( -- )
$a $e "test" ins-ip c:connect
$a $e connect-nick $@ ins-ip c:connect
[: .time ." Terminal test: connect to server" cr ;] $err
tc-permit# fs-class-permit or to fs-class-permit
net2o-code
......
......@@ -177,7 +177,7 @@ get-current net2o-cmds definitions
: server ( -- )
\G usage: n2o server
get-me-again init-server server-loop ;
get-me init-server server-loop ;
\ chat mode
......
......@@ -21,17 +21,10 @@
User buf-state cell uallot drop
[IFDEF] 64bit
: zz>n ( zigzag -- n )
dup 1 rshift swap 1 and negate xor ;
: n>zz ( n -- zigzag )
dup 0< swap 2* xor ;
[ELSE]
: zz>n ( 64u -- 64n )
64dup 1 64rshift 64swap 64>n 1 and negate n>64 64xor ;
: n>zz ( 64n -- 64u )
64dup 64-0< >r 64dup 64+ r> n>64 64xor ;
[THEN]
: zz>n ( 64u -- 64n )
64dup 1 64rshift 64swap 64>n 1 and negate n>64 64xor ;
: n>zz ( 64n -- 64u )
64dup 64-0< n>64 64swap 64-2* 64xor ;
: ps!+ ( 64n addr -- addr' )
>r n>zz r> p!+ ;
......@@ -56,9 +49,8 @@ User buf-state cell uallot drop
r> cells string-stack $!len ;
: @>$ ( addr u -- $:string addr' u' )
bounds p@+ [IFUNDEF] 64bit nip [THEN]
swap bounds ( endbuf endstring startstring )
>r 2dup u< !!stringfit!!
bounds p@+ 64>n swap bounds ( endbuf endstring startstring )
>r 2dup u< IF true !!stringfit!! THEN
dup r> over umin tuck - >$ tuck - ;
: string@ ( -- $:string )
......
......@@ -514,7 +514,7 @@ m: addr>keys ( addr -- keys )
\ generic hooks and user variables
UDefer other
UValue pollfd# 2 to pollfd#
UValue pollfd# 0 to pollfd#
Defer init-reply
......@@ -525,8 +525,8 @@ Defer init-reply
>r r@ events w! r@ fd l! r> pollfd %size + ;
: prep-socks ( -- ) pollfds >r
net2o-sock POLLIN r> fds!+ >r
epiper @ fileno POLLIN r> fds!+ drop 2 to pollfd# ;
net2o-sock POLLIN r> fds!+ >r
epiper @ fileno POLLIN r> fds!+ drop 2 to pollfd# ;
\ the policy on allocation and freeing is that both freshly allocated
\ and to-be-freed memory is erased. This makes sure that no unwanted
......@@ -584,8 +584,8 @@ Variable net2o-tasks
: net2o-pass ( params xt n task -- )
dup { w^ task }
task cell net2o-tasks $+! pass
b-out op-vector @ debug-vector !
init-reply prep-socks alloc-io catch
alloc-io b-out op-vector @ debug-vector !
init-reply prep-socks catch
1+ ?dup-IF free-io 1- ?dup-IF DoError THEN
ELSE ~~ bflush 0 (bye) ~~ THEN ;
: net2o-task ( params xt n -- task )
......@@ -1993,7 +1993,7 @@ queue-class >osize @ buffer: queue-adder
: max-timeout! ( -- ) poll-timeout# 0 ptimeout 2! ;
: >poll ( -- flag )
: >poll ( -- flag ) \ prep-socks
[IFDEF] ppoll
ptimeout 0 ppoll 0>
[ELSE]
......
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