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.305
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
Unified Diff Ignore Whitespace Patch
Changes to net2o.fs.
161
162
163
164
165
166
167





168




169
170
171
172
173
174
175
    <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







>
>
>
>
>

>
>
>
>







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
    <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
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
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 )







<
<
<
<







1192
1193
1194
1195
1196
1197
1198




1199
1200
1201
1202
1203
1204
1205
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 )
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
: 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 ;







|







1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
: 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 ;