diff --git a/scheduler.scm b/scheduler.scm
index 4e86807..c0ab3b1 100644
a
|
b
|
|
34 | 34 | ##sys#remove-from-ready-queue ##sys#unblock-threads-for-i/o ##sys#force-primordial |
35 | 35 | ##sys#fdset-input-set ##sys#fdset-output-set ##sys#fdset-clear |
36 | 36 | ##sys#fdset-select-timeout ##sys#fdset-restore |
37 | | ##sys#clear-i/o-state-for-thread!) |
| 37 | ##sys#clear-i/o-state-for-thread! ##sys#abandon-mutexes) |
38 | 38 | (not inline ##sys#interrupt-hook) |
39 | 39 | (foreign-declare #<<EOF |
40 | 40 | #ifdef HAVE_ERRNO_H |
… |
… |
EOF |
241 | 241 | (##sys#setislot t 13 #f) |
242 | 242 | (##sys#setslot t 11 t2) ) ) ) |
243 | 243 | |
| 244 | (define (##sys#abandon-mutexes thread) |
| 245 | (let ((ms (##sys#slot thread 8))) |
| 246 | (unless (null? ms) |
| 247 | (##sys#for-each |
| 248 | (lambda (m) |
| 249 | (##sys#setislot m 2 #f) |
| 250 | (##sys#setislot m 4 #t) |
| 251 | (##sys#setislot m 5 #f) |
| 252 | (let ((wts (##sys#slot m 3))) |
| 253 | (unless (null? wts) |
| 254 | (for-each |
| 255 | (lambda (t2) |
| 256 | (dbg " unblocking: " t2) |
| 257 | (##sys#thread-basic-unblock! t2) ) |
| 258 | wts) ) ) |
| 259 | (##sys#setislot m 3 '()) ) |
| 260 | ms) ) ) ) |
| 261 | |
244 | 262 | (define (##sys#thread-kill! t s) |
245 | 263 | (dbg "killing: " t " -> " s ", recipients: " (##sys#slot t 12)) |
246 | 264 | (##sys#abandon-mutexes t) |
| 265 | (let ((blocked (##sys#slot t 11))) |
| 266 | (cond |
| 267 | ((##sys#structure? blocked 'condition-variable) |
| 268 | (##sys#setslot blocked 2 (##sys#delq thread (##sys#slot blocked 2)))) |
| 269 | ((##sys#structure? blocked 'thread) |
| 270 | (##sys#setslot blocked 12 (##sys#delq thread (##sys#slot blocked 12))))) ) |
| 271 | (##sys#remove-from-timeout-list t) |
| 272 | (##sys#clear-i/o-state-for-thread! t) |
247 | 273 | (##sys#setslot t 3 s) |
248 | 274 | (##sys#setislot t 4 #f) |
249 | 275 | (##sys#setislot t 11 #f) |
250 | 276 | (##sys#setislot t 8 '()) |
251 | | (##sys#remove-from-timeout-list t) |
252 | | (let ([rs (##sys#slot t 12)]) |
| 277 | (let ((rs (##sys#slot t 12))) |
253 | 278 | (unless (null? rs) |
254 | 279 | (for-each |
255 | 280 | (lambda (t2) |
… |
… |
EOF |
287 | 312 | (let ([o (open-output-string)]) |
288 | 313 | (display "Warning (" o) |
289 | 314 | (display ct o) |
290 | | (display "): " o) |
| 315 | (display ")" o) |
291 | 316 | (print-error-message arg ##sys#standard-error (get-output-string o)) |
292 | 317 | (print-call-chain ##sys#standard-error 0 ct) ) ] ) |
293 | 318 | (##sys#setslot ct 7 arg) |
… |
… |
EOF |
306 | 331 | "timeout.tv_usec = (tm % 1000) * 1000;" |
307 | 332 | "C_fdset_input_2 = C_fdset_input;" |
308 | 333 | "C_fdset_output_2 = C_fdset_output;" |
309 | | "return(select(FD_SETSIZE, &C_fdset_input, &C_fdset_output, NULL, to ? &timeout : NULL));") ) |
| 334 | "C_return(select(FD_SETSIZE, &C_fdset_input, &C_fdset_output, NULL, to ? &timeout : NULL));") ) |
310 | 335 | |
311 | 336 | (define ##sys#fdset-restore |
312 | 337 | (foreign-lambda* void () |
… |
… |
EOF |
461 | 486 | ;;; Unblock thread cleanly: |
462 | 487 | |
463 | 488 | (define (##sys#thread-unblock! t) |
464 | | (when (eq? 'blocked (##sys#slot t 3)) |
| 489 | (when (or (eq? 'blocked (##sys#slot t 3)) |
| 490 | (eq? 'sleeping (##sys#slot r 3))) |
465 | 491 | (##sys#remove-from-timeout-list t) |
466 | 492 | (set! ##sys#fd-list |
467 | 493 | (let loop ([fdl ##sys#fd-list]) |
… |
… |
EOF |
472 | 498 | (cons (##sys#slot a 0) |
473 | 499 | (##sys#delq t (##sys#slot a 1)) ) |
474 | 500 | (loop (##sys#slot fdl 1)) ) ) ) ) ) |
475 | | (##sys#setislot t 12 '()) |
476 | 501 | (##sys#thread-basic-unblock! t) ) ) |