[Gauche-devel] native busy loop and thread-terminate!

[Jens T. <ka...@ka...>]

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)