native busy loop and thread-terminate!
Jens Thiele <[email protected]> Mon, 27 Jan 2025 18:25:23 +0100
| Newsgroups | gmane.lisp.scheme.gauche |
|---|---|
| Message-ID | <[email protected]> |
Hi,
It looks like native busy loops are not interrupted by thread-terminate!
=> they have to cooperate.
A first test below. Does that make sense? Is it ok to use
SCM_INTERNAL_MUTEX_LOCK/SCM_INTERNAL_MUTEX_UNLOCK/SCM_INTERNAL_THREAD_EXIT
?
#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
exec gosh -I. -- $0 "$@"
|#
;; native busy loops are not interrupted by thread-terminate!
;; => they have to cooperate
(use gauche.threads)
(use file.util)
(use runtime-compile)
(compile-and-load
`((inline-stub
(define-cproc busy-loop ()
(let* ((i::int 0))
(while (1)
;; you would do some calculations here
(inc! i)
;; poll whether we have to terminate
;; otherwise we keep running on thread-terminate! below
(when (not (% i 100000))
(let* ((state::int 0))
(SCM_INTERNAL_MUTEX_LOCK (-> (Scm_VM) vmlock))
(set! state (-> (Scm_VM) state))
(SCM_INTERNAL_MUTEX_UNLOCK (-> (Scm_VM) vmlock))
(printf "%d %d %d\n" i state SCM_VM_TERMINATED)
(when (== state SCM_VM_TERMINATED)
(SCM_INTERNAL_THREAD_EXIT)))))))))
'(busy-loop))
;; todo: linux specific
(define (num-threads)
(guard (e
[else
+nan.0])
(length (directory-list "/proc/self/task" :children? #t))))
(define (main args)
#?=(num-threads)
(let1 t (thread-start! (make-thread (lambda()
(busy-loop))))
(sys-sleep 1)
#?=(num-threads)
(thread-terminate! t)
#?=(num-threads)
(guard (e [else #?=e])
(thread-join! t)))
#?=(num-threads)
(sys-sleep 1)
#?=(num-threads)
(sys-sleep 10)
0)