Check-in [cd536b2adb]
Not logged in

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

Overview
Comment:Glitch in kill-tasks removed
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: cd536b2adb0277a7eb6540bf3aec755ae94741ac
User & Date: bernd 2020-05-21 09:58:51
Context
2020-05-21
11:58
Add /want and /fetch for manually fetching check-in: f5ce3e9e3a user: bernd tags: trunk
09:58
Glitch in kill-tasks removed check-in: cd536b2adb user: bernd tags: trunk
09:02
Flag for exception check-in: 1f47e4cfab user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to net2o.fs.

161
162
163
164
165
166
167





168




169
170
171
172
173
174
175
....
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
....
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
    <event :>killed event> 0 (bye) ;
: send-kill ( task -- ) <event up@ elit, :>kill event> ;

2 Constant kill-seconds#
kill-seconds# 1+ #1000000000 um* 2constant kill-timeout# \ 3s
#5000000. 2Constant kill-wait2# \ 5ms wait for threads to terminate






: net2o-kills ( -- )




    net2o-tasks get-stack kills !  net2o-tasks $free
    kills @ 0 ?DO  send-kill  LOOP
    ntime kill-timeout# d+ { d: timeout }
    kill-seconds# >r \ give time to terminate
    BEGIN  timeout ntime d- 2dup d0> kills @ and  WHILE
	    stop-dns
	    timeout ntime d- 1000000000 fm/mod nip
................................................................................
field: chunk-context
field: chunk-count
end-structure

Variable chunks
Variable chunks+
Create chunk-adder chunks-struct allot
0 Value sender-task   \ asynchronous sender thread (unused)
0 Value receiver-task \ receiver thread
0 Value timeout-task  \ for handling timeouts
0 Value query-task    \ for background queries initiated in other tasks

: .0depth ( -- ) <warn> "Stack should always be empty!" type cr <default> ;
: !!0depth!! ( -- ) ]] depth IF  .0depth ~~bt clearstack  THEN [[ ; immediate
: event-loop' ( -- )  BEGIN  stop  !!0depth!!  AGAIN ;
: create-query-task ( -- )
    ['] event-loop' 1 net2o-task to query-task ;
: ?query-task ( -- task )
................................................................................
: 0timeout ( -- )
    0 ack@ .timeouts !@  IF  timeout-task wake  THEN
    ack@ .+next-timeouts next-timeout 64! ;

: o+timeout ( -- )  0timeout
    timeout( ." +timeout: " o hex. ." task: " task# ? addr timeout-xt @ .name cr )
    o timeout-tasks +unique$
    timeout-task wake ;
: o-timeout ( -- )
    0timeout  timeout( ." -timeout: " o hex. ." task: " task# ? cr )
    [: o timeout-tasks del$cell ;] resize-sema c-section ;

: >next-timeout ( -- )  ack@ .+timeouts next-timeout 64! ;
: 64min? ( a b -- min flag )
    64over 64over 64< IF  64drop false  ELSE  64nip true  THEN ;







>
>
>
>
>

>
>
>
>







 







<
<
<
<







 







|







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
....
1192
1193
1194
1195
1196
1197
1198




1199
1200
1201
1202
1203
1204
1205
....
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
    <event :>killed event> 0 (bye) ;
: send-kill ( task -- ) <event up@ elit, :>kill event> ;

2 Constant kill-seconds#
kill-seconds# 1+ #1000000000 um* 2constant kill-timeout# \ 3s
#5000000. 2Constant kill-wait2# \ 5ms wait for threads to terminate

0 Value sender-task   \ asynchronous sender thread (unused)
0 Value receiver-task \ receiver thread
0 Value timeout-task  \ for handling timeouts
0 Value query-task    \ for background queries initiated in other tasks

: net2o-kills ( -- )
    0 to sender-task
    0 to receiver-task
    0 to timeout-task
    0 to query-task
    net2o-tasks get-stack kills !  net2o-tasks $free
    kills @ 0 ?DO  send-kill  LOOP
    ntime kill-timeout# d+ { d: timeout }
    kill-seconds# >r \ give time to terminate
    BEGIN  timeout ntime d- 2dup d0> kills @ and  WHILE
	    stop-dns
	    timeout ntime d- 1000000000 fm/mod nip
................................................................................
field: chunk-context
field: chunk-count
end-structure

Variable chunks
Variable chunks+
Create chunk-adder chunks-struct allot





: .0depth ( -- ) <warn> "Stack should always be empty!" type cr <default> ;
: !!0depth!! ( -- ) ]] depth IF  .0depth ~~bt clearstack  THEN [[ ; immediate
: event-loop' ( -- )  BEGIN  stop  !!0depth!!  AGAIN ;
: create-query-task ( -- )
    ['] event-loop' 1 net2o-task to query-task ;
: ?query-task ( -- task )
................................................................................
: 0timeout ( -- )
    0 ack@ .timeouts !@  IF  timeout-task wake  THEN
    ack@ .+next-timeouts next-timeout 64! ;

: o+timeout ( -- )  0timeout
    timeout( ." +timeout: " o hex. ." task: " task# ? addr timeout-xt @ .name cr )
    o timeout-tasks +unique$
    timeout-task ?dup-IF  wake  THEN ;
: o-timeout ( -- )
    0timeout  timeout( ." -timeout: " o hex. ." task: " task# ? cr )
    [: o timeout-tasks del$cell ;] resize-sema c-section ;

: >next-timeout ( -- )  ack@ .+timeouts next-timeout 64! ;
: 64min? ( a b -- min flag )
    64over 64over 64< IF  64drop false  ELSE  64nip true  THEN ;