gauche-devel — news and discussions about Gauche development

Re: [Gauche-devel] problem with test

[Andreas E. <and...@gm...>]

On Di 22 Jul 2025 at 13:56, Shiro Kawai <shi...@gm...> wrote:

> Hi Andreas, welcome to the list.
> Did you re-run ./configure after pulling from git repo?
> --shiro

Thanks, that fixed it!
How foolish of me.

Andreas
-- 
ceterum censeo redmondinem esse delendam

Re: [Gauche-devel] problem with test

[Shiro K. <shi...@gm...>]

Hi Andreas, welcome to the list.
Did you re-run ./configure after pulling from git repo?
--shiro


On Tue, Jul 22, 2025 at 12:25 PM Andreas Eder via Gauche-devel <
gau...@li...> wrote:

> Hello list,
>
> this is my first mail here.
>
> when doing a 'make check' it dies with tje following error:
>
> ,----
> | Testing integer arithmetic macros ...                            passed.
> | cat: ../test/TESTS: No such file or directory
> | *** ERROR: cannot find "../test/capi.scm" to load
> | Stack Trace:
> | _______________________________________
> |   0  (report-error e)
> |   1  (find-load-file file paths suffixes :error-if-not-found error ...
> |   2  (load (cadr args))
> |   3  (main args)
> | make[1]: *** [Makefile:482: test] Error 70
> | make[1]: Leaving directory '/source/Gauche/src'
> | make: *** [Makefile:55: check] Error 2
> `----
>
> I guess the '../test/TESTS' should be a 'tests/TEST'. and
> '../test/capi.scm' should be '../tests/capi.scm'.
>
> Yours,
>
> Andreas
>
> --
> ceterum censeo redmondinem esse delendam
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

[Gauche-devel] problem with test

[Andreas E. <and...@gm...>]

Hello list,

this is my first mail here.

when doing a 'make check' it dies with tje following error:

,----
| Testing integer arithmetic macros ...                            passed.
| cat: ../test/TESTS: No such file or directory
| *** ERROR: cannot find "../test/capi.scm" to load
| Stack Trace:
| _______________________________________
|   0  (report-error e)
|   1  (find-load-file file paths suffixes :error-if-not-found error ...
|   2  (load (cadr args))
|   3  (main args)
| make[1]: *** [Makefile:482: test] Error 70
| make[1]: Leaving directory '/source/Gauche/src'
| make: *** [Makefile:55: check] Error 2
`----

I guess the '../test/TESTS' should be a 'tests/TEST'. and '../test/capi.scm' should be '../tests/capi.scm'.

Yours,

Andreas

-- 
ceterum censeo redmondinem esse delendam

Re: [Gauche-devel] rfc.zlib doesn't use checksum?

[Shiro K. <shi...@gm...>]

Hmm.  From the doc it seems that it should be handled by zlib size by
default.  Gauche side does not do anything special.  Need to dig more.


On Wed, Mar 19, 2025 at 12:30 AM Jens Thiele <ka...@ka...> wrote:

> Hi,
>
> Looks like the rfc.zlib module doesn't use the checksum?
>
> Simulating corruption using tr:
>
> $ echo hello > hello; zopfli -c --zlib hello|tr H I|pigz -d
> lello
> pigz: skipping: <stdin>: corrupted -- adler32 mismatch
>
> $ echo hello > hello; zopfli -c --zlib hello|tr H I \
> |gosh -urfc.zlib -E \
> 'display (inflate-string (port->string (current-input-port)))'
> lello
>
> jens
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

[Gauche-devel] rfc.zlib doesn't use checksum?

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

Hi,

Looks like the rfc.zlib module doesn't use the checksum?

Simulating corruption using tr:

$ echo hello > hello; zopfli -c --zlib hello|tr H I|pigz -d
lello
pigz: skipping: <stdin>: corrupted -- adler32 mismatch

$ echo hello > hello; zopfli -c --zlib hello|tr H I \
|gosh -urfc.zlib -E \
'display (inflate-string (port->string (current-input-port)))'
lello

jens

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

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

Hi,

sorry for the late reply

Shiro Kawai <shi...@gm...> writes:

> The last pushed commit addresses the busy loop issue; thread-terminate!
> sends a signal and wait a bit, and if the target is still running, sends
> the signal again.  In the receiving side, if thread termination signal is
> received while the previous one hasn't been processed, it terminates itself.

tested this in a debian/trixie amd64 schroot
seems to work

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
exec gosh -I. -- $0 "$@"
|#

;; native busy loops are not interrupted by thread-terminate!
;; nb: that changed in commit 7f3cfd906 (Thread termination by signal overhaul)

(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))))))
 '(busy-loop))

(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)

(trixie-amd64-sbuild)karme@amalthea:/tmp/test$ ./busy-loop3.scm
#?="././busy-loop3.scm":29:(num-threads)
#?-    4
#?="././busy-loop3.scm":33:(num-threads)
#?-    5
#?="././busy-loop3.scm":35:(num-threads)
#?-    4
#?=e
#?-    #<terminated-thread-exception: #<thread #f (1) terminated 0x7 ...
#?="././busy-loop3.scm":38:(num-threads)
#?-    4
#?="././busy-loop3.scm":40:(num-threads)
#?-    4

> This does not address the cleanup issue.

ok

jens

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

[Shiro K. <shi...@gm...>]

The last pushed commit addresses the busy loop issue; thread-terminate!
sends a signal and wait a bit, and if the target is still running, sends
the signal again.  In the receiving side, if thread termination signal is
received while the previous one hasn't been processed, it terminates itself.

This does not address the cleanup issue.


On Tue, Jan 28, 2025 at 9:35 AM Jens Thiele <ka...@ka...> wrote:

> Shiro Kawai <shi...@gm...> writes:
>
> > Aah, right. On Unix-based systems, thread-terminate! uses a signal to
> tell
> > the target to terminate.  It can't be intercepted by Scheme-level, but it
> > is still queued by the receiving side, and only becomes effective when
> the
> > thread calls Scm_SigCheck()---usually from the VM loop.
>
> > I think the supposed way is that C extension code needs to invoke
> > Scm_SigCheck() occasionally if it doesn't return control to Scheme.
>
> thanks!
> will try to use Scm_SigCheck. Looking at data.queue as example.
>
> > But that can't be enforced, especially if it's in the third party
> > code.
> >
> > We can employ a similar handling mechanism like typing ^C several times
> to
> > force gosh quit.  That is, thread-terminate! resends thread termination
> > signal after a short wait, and if the receiving side gets multiple
> > termination signal queued, it terminates the thread then.
>
> I see you created an issue for that:
> https://github.com/shirok/Gauche/issues/1106
>
> Jens
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

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

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

Shiro Kawai <shi...@gm...> writes:

> Aah, right. On Unix-based systems, thread-terminate! uses a signal to tell
> the target to terminate.  It can't be intercepted by Scheme-level, but it
> is still queued by the receiving side, and only becomes effective when the
> thread calls Scm_SigCheck()---usually from the VM loop.

> I think the supposed way is that C extension code needs to invoke
> Scm_SigCheck() occasionally if it doesn't return control to Scheme.

thanks!
will try to use Scm_SigCheck. Looking at data.queue as example.

> But that can't be enforced, especially if it's in the third party
> code.
>
> We can employ a similar handling mechanism like typing ^C several times to
> force gosh quit.  That is, thread-terminate! resends thread termination
> signal after a short wait, and if the receiving side gets multiple
> termination signal queued, it terminates the thread then.

I see you created an issue for that:
https://github.com/shirok/Gauche/issues/1106

Jens

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

[Shiro K. <shi...@gm...>]

Aah, right. On Unix-based systems, thread-terminate! uses a signal to tell
the target to terminate.  It can't be intercepted by Scheme-level, but it
is still queued by the receiving side, and only becomes effective when the
thread calls Scm_SigCheck()---usually from the VM loop.

I think the supposed way is that C extension code needs to invoke
Scm_SigCheck() occasionally if it doesn't return control to Scheme.  But
that can't be enforced, especially if it's in the third party code.

We can employ a similar handling mechanism like typing ^C several times to
force gosh quit.  That is, thread-terminate! resends thread termination
signal after a short wait, and if the receiving side gets multiple
termination signal queued, it terminates the thread then.







On Mon, Jan 27, 2025 at 7:26 AM Jens Thiele <ka...@ka...> wrote:

> 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)
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

[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)

Re: [Gauche-devel] Typo fixes

[Shiro K. <shi...@gm...>]

Thanks.  Patch applied.


On Wed, Jan 22, 2025 at 5:15 AM Jens Thiele <ka...@ka...> wrote:

> diff --git a/doc/modsrfi.texi b/doc/modsrfi.texi
> index 391dcd3f6..490d3f878 100644
> --- a/doc/modsrfi.texi
> +++ b/doc/modsrfi.texi
> @@ -13433,7 +13433,7 @@ Same as @code{(map enum-name (enum-set->enum-list
> eset))}.
>  @mdindex srfi.210
>  @c EN
>  This module provides macros and procedures to blend multiple-value
> -expressions naturally into the orinary single-value expressions.
> +expressions naturally into the ordinary single-value expressions.
>  @c JP
>  このモジュールは、複数の値を返す式を通常の単一の値を扱う式にうまく混ぜて使えるようにする
>  マクロや手続きを提供します。
> diff --git a/doc/modutil.texi b/doc/modutil.texi
> index 6092151bb..e01d1216d 100644
> --- a/doc/modutil.texi
> +++ b/doc/modutil.texi
> @@ -2489,7 +2489,7 @@ returned input port.
>  This module provides high-level utilities to run code in parallel
>  using threads.
>  For example, the @code{pmap} procedure applies the given procedure
> -on each elements in the collection and gathers the restuls into a list,
> +on each elements in the collection and gathers the results into a list,
>  just like @code{map}, but the appliation of the procedure is done in
> parallel.
>  @c JP
>  このモジュールは、コードを複数スレッドで並列に走らせる高レベルユーティリティを提供します。
> @@ -2601,7 +2601,7 @@ cancelled and the condition is reraised.
>  @subheading Mappers
>
>  @c EN
> -A mapper is an object that encapsulates a storategy to run
> +A mapper is an object that encapsulates a strategy to run
>  tasks in parallel.  We provide the following mappers.
>  @c JP
>  mapperはタスクを並列に走らせる戦略をカプセル化したものです。
> diff --git a/lib/control/future.scm b/lib/control/future.scm
> index b512b505c..b0e17ed70 100644
> --- a/lib/control/future.scm
> +++ b/lib/control/future.scm
> @@ -34,7 +34,7 @@
>  ;; This is a provisional implementation; we'll use implicit thread pool
>  ;; to avoid thread creation overhead eventually.
>
> -;; Guile and Racket uses 'touch' to retrive the result of a future, but
> +;; Guile and Racket uses 'touch' to retrieve the result of a future, but
>  ;; that name seems too generic.  We adopt 'future-get'.
>
>  ;; If a future already finished computation, 'future-get' returns
> immediately
> diff --git a/lib/control/pmap.scm b/lib/control/pmap.scm
> index 428a75ce6..69176efc4 100644
> --- a/lib/control/pmap.scm
> +++ b/lib/control/pmap.scm
> @@ -54,7 +54,7 @@
>  ;;   sequential-mapper - A sigleton mapper that runs in a single
> (current) thread.
>  ;;      If the running system is single-core, this is the default mapper.
>  ;;
> -;;   pool-mapper - Use thread pool.  This is ideal when each task requies
> +;;   pool-mapper - Use thread pool.  This is ideal when each task requires
>  ;;      some processing time, so that the overhead of thread pool is
>  ;;      negligible.
>  ;;
> diff --git a/lib/text/unicode/ucd.scm b/lib/text/unicode/ucd.scm
> index 706f10137..111989fb0 100644
> --- a/lib/text/unicode/ucd.scm
> +++ b/lib/text/unicode/ucd.scm
> @@ -603,7 +603,7 @@
>  ;;;
>
>  ;; Dump format should be regarded as internal - we may change it at any
> -;; tiem as we like.
> +;; time as we like.
>
>  ;; For now, we dump it in three parts, correspoinding to the unichar-db
>  ;; slots.  To suppress the size of the dump, we use simple run-length
> diff --git a/src/thread.c b/src/thread.c
> index e26a22f5e..a78b0fdeb 100644
> --- a/src/thread.c
> +++ b/src/thread.c
> @@ -376,7 +376,7 @@ ScmObj Scm_ThreadSleep(ScmObj timeout)
>     in VM loop, it responds to the flag and terminates itself.
>
>     If that fails, we send a signal to the thread.  If the thread is
> blocked
> -   by a system call, this most likely unblocks the thread and termnates
> it.
> +   by a system call, this most likely unblocks the thread and terminates
> it.
>     (We use a dedicated signal.
>
>     There are cases when signals can fail.  On POSIX platform, if the
> thread
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

[Gauche-devel] Typo fixes

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

diff --git a/doc/modsrfi.texi b/doc/modsrfi.texi
index 391dcd3f6..490d3f878 100644
--- a/doc/modsrfi.texi
+++ b/doc/modsrfi.texi
@@ -13433,7 +13433,7 @@ Same as @code{(map enum-name (enum-set->enum-list eset))}.
 @mdindex srfi.210
 @c EN
 This module provides macros and procedures to blend multiple-value
-expressions naturally into the orinary single-value expressions.
+expressions naturally into the ordinary single-value expressions.
 @c JP
 このモジュールは、複数の値を返す式を通常の単一の値を扱う式にうまく混ぜて使えるようにする
 マクロや手続きを提供します。
diff --git a/doc/modutil.texi b/doc/modutil.texi
index 6092151bb..e01d1216d 100644
--- a/doc/modutil.texi
+++ b/doc/modutil.texi
@@ -2489,7 +2489,7 @@ returned input port.
 This module provides high-level utilities to run code in parallel
 using threads.
 For example, the @code{pmap} procedure applies the given procedure
-on each elements in the collection and gathers the restuls into a list,
+on each elements in the collection and gathers the results into a list,
 just like @code{map}, but the appliation of the procedure is done in parallel.
 @c JP
 このモジュールは、コードを複数スレッドで並列に走らせる高レベルユーティリティを提供します。
@@ -2601,7 +2601,7 @@ cancelled and the condition is reraised.
 @subheading Mappers
 
 @c EN
-A mapper is an object that encapsulates a storategy to run
+A mapper is an object that encapsulates a strategy to run
 tasks in parallel.  We provide the following mappers.
 @c JP
 mapperはタスクを並列に走らせる戦略をカプセル化したものです。
diff --git a/lib/control/future.scm b/lib/control/future.scm
index b512b505c..b0e17ed70 100644
--- a/lib/control/future.scm
+++ b/lib/control/future.scm
@@ -34,7 +34,7 @@
 ;; This is a provisional implementation; we'll use implicit thread pool
 ;; to avoid thread creation overhead eventually.
 
-;; Guile and Racket uses 'touch' to retrive the result of a future, but
+;; Guile and Racket uses 'touch' to retrieve the result of a future, but
 ;; that name seems too generic.  We adopt 'future-get'.
 
 ;; If a future already finished computation, 'future-get' returns immediately
diff --git a/lib/control/pmap.scm b/lib/control/pmap.scm
index 428a75ce6..69176efc4 100644
--- a/lib/control/pmap.scm
+++ b/lib/control/pmap.scm
@@ -54,7 +54,7 @@
 ;;   sequential-mapper - A sigleton mapper that runs in a single (current) thread.
 ;;      If the running system is single-core, this is the default mapper.
 ;;
-;;   pool-mapper - Use thread pool.  This is ideal when each task requies
+;;   pool-mapper - Use thread pool.  This is ideal when each task requires
 ;;      some processing time, so that the overhead of thread pool is
 ;;      negligible.
 ;;
diff --git a/lib/text/unicode/ucd.scm b/lib/text/unicode/ucd.scm
index 706f10137..111989fb0 100644
--- a/lib/text/unicode/ucd.scm
+++ b/lib/text/unicode/ucd.scm
@@ -603,7 +603,7 @@
 ;;;
 
 ;; Dump format should be regarded as internal - we may change it at any
-;; tiem as we like.
+;; time as we like.
 
 ;; For now, we dump it in three parts, correspoinding to the unichar-db
 ;; slots.  To suppress the size of the dump, we use simple run-length
diff --git a/src/thread.c b/src/thread.c
index e26a22f5e..a78b0fdeb 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -376,7 +376,7 @@ ScmObj Scm_ThreadSleep(ScmObj timeout)
    in VM loop, it responds to the flag and terminates itself.
 
    If that fails, we send a signal to the thread.  If the thread is blocked
-   by a system call, this most likely unblocks the thread and termnates it.
+   by a system call, this most likely unblocks the thread and terminates it.
    (We use a dedicated signal.
 
    There are cases when signals can fail.  On POSIX platform, if the thread

Re: [Gauche-devel] experimental control.timeout/with-timeout

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

maybe another point (missing multiple values support):

gosh> (with-timeout (lambda() (values 1 2)) 1)
1

Re: [Gauche-devel] experimental control.timeout/with-timeout

[Shiro K. <shi...@gm...>]

Good point.

Safe termination of threads has always been a concern.  I vaguely remember
I once tried a condition mechanism (e.g. termination sends a special
exception to a thread, and the thread rewinds dynamic handlers) but didn't
work---the condition mechanism can intercept it.  Since the after-thunk of
the dynamic handler is free to invoke previously captured continuations, we
can't guarantee that it terminates.

We may still introduce rewinding of dynamic handlers, just prohibit certain
control transfers from them.  Another option is to have a separate
cleanup stack like pthread_cleanup_push/pop.  Current termination semantics
is very hard to use safely, anyway, so it may be good to dive and fix this
now in some way.






On Mon, Jan 20, 2025 at 11:02 PM Jens Thiele <ka...@ka...> wrote:

> Hi,
>
> very likely you are already aware of this:
>
> some "real-world" examples of imho unexpected behaviour with
> control.timeout/with-timeout (one could argue pmap with fully concurrent
> mapper + timeout also has this problem)
>
> 1) stop motor isn't printed:
> gosh> (with-timeout
>         (lambda() (unwind-protect (begin (print "start motor")
>                                          (sys-sleep 10))
>                                   (print "stop motor"))) 1)
> start motor
> #f
>
> 2) timer isn't stopped:
> gosh> (use gauche.time)
> gosh> (let1 tc (make <real-time-counter>)
>         (guard (e [else #?=e])
>                (with-timeout (lambda() (with-time-counter tc
>                                          (sys-sleep 10)
>                                          (error "foo")))
>                  1))
>         (time-counter-value tc))
> 0
>
> looks like guile does run dynamic-wind post thunks before thread
> termination (I don't know whether this is really a good idea?):
>
> test.sh:
> ,----
> | #!/bin/bash -xe
> | cat > test.scm <<EOF
> | (cond-expand
> |   (guile
> |     (use-modules (srfi srfi-18))
> |     (use-modules (srfi srfi-34)))
> |   (gauche
> |     (use gauche.threads)
> |     (define sleep sys-sleep)))
> | (let ((t (thread-start!
> |           (make-thread (lambda()
> |                          (dynamic-wind
> |                           (lambda _ #t)
> |                           (lambda()
> |                             (display "start motor\n")
> |                             (sleep 10))
> |                           (lambda()
> |                             (display "stop motor\n"))))))))
> |   (sleep 1)
> |   (thread-terminate! t)
> |   (guard (e (else (display e) (newline)))
> |        (thread-join! t)))
> | EOF
> | guile -s test.scm
> | gosh test.scm
> `----
>
> ./test.sh
> + cat
> + guile -s test.scm
> [...]
> start motor
> stop motor
> #<&terminated-thread-exception>
> + gosh test.scm
> start motor
> #<terminated-thread-exception: #<thread #f (1) terminated ...
>
> jens
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

[Gauche-devel] experimental control.timeout/with-timeout

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

Hi,

very likely you are already aware of this:

some "real-world" examples of imho unexpected behaviour with
control.timeout/with-timeout (one could argue pmap with fully concurrent
mapper + timeout also has this problem)

1) stop motor isn't printed:
gosh> (with-timeout
        (lambda() (unwind-protect (begin (print "start motor")
                                         (sys-sleep 10))
                                  (print "stop motor"))) 1)
start motor
#f

2) timer isn't stopped:
gosh> (use gauche.time)
gosh> (let1 tc (make <real-time-counter>)
	(guard (e [else #?=e])
	       (with-timeout (lambda() (with-time-counter tc
                                         (sys-sleep 10)
                                         (error "foo")))
		 1))
	(time-counter-value tc))
0

looks like guile does run dynamic-wind post thunks before thread
termination (I don't know whether this is really a good idea?):

test.sh:
,----
| #!/bin/bash -xe
| cat > test.scm <<EOF
| (cond-expand
|   (guile
|     (use-modules (srfi srfi-18))
|     (use-modules (srfi srfi-34)))
|   (gauche
|     (use gauche.threads)
|     (define sleep sys-sleep)))
| (let ((t (thread-start!
|           (make-thread (lambda()
|                          (dynamic-wind
|                           (lambda _ #t)
|                           (lambda()
|                             (display "start motor\n")
|                             (sleep 10))
|                           (lambda()
|                             (display "stop motor\n"))))))))
|   (sleep 1)
|   (thread-terminate! t)
|   (guard (e (else (display e) (newline)))
| 	 (thread-join! t)))
| EOF
| guile -s test.scm
| gosh test.scm
`----

./test.sh
+ cat
+ guile -s test.scm
[...]
start motor
stop motor
#<&terminated-thread-exception>
+ gosh test.scm
start motor
#<terminated-thread-exception: #<thread #f (1) terminated ...

jens

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Shiro Kawai <shi...@gm...> writes:

> I'll come back regarding the resource leak.

I am still playing around there. I now have a reverse proxy using pmap
which still exposes a similar problem after some time but I am not sure
it is really a leak. It looks more like the GC sometimes isn't running
often enough => the finalizers aren't called. After some digging I am
not even sure why the GC tends to run often enough most of the time. Is
that just good luck? At first I thought it is the GC_gcollect() in
port.c - but it isn't called at all?

If I add something like:

(when (> (num-open-files) 550)
  (with-output-to-port (current-error-port)
    (lambda()
      (print "WARNING: explicit gc run because we are getting low on file descriptors")
      (flush)
      (gc))))

just before the pmap call, this seems to suffice and it doesn't happen
very often. Something like this is also suggested here:
https://www.hboehm.info/gc/finalization.html
"If scarce resources are managed with finalization, the allocation
routine for that resource (e.g. open for file handles) should force a
garbage collection (two if that doesn't suffice) if it finds itself
short of the resource."

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
export GC_PRINT_STATS=1
export GC_PRINT_VERBOSE_STATS=1
exec gosh -I. -- $0 "$@"
|#
(use makiki)
(use text.html-lite)
(use rfc.http)
(use gauche.threads)
(use file.util)
(use gauche.sequence)
(use control.pmap)

(with-module control.pmap
  (define join-exc (make-parameter #f))
  
  (define (%make-joiner r)
    (^[thread :optional (timeout #f) (timeout-val #f)]
      (guard (e [(terminated-thread-exception? e) r]
		[else (join-exc e) r])
	     (thread-join! thread timeout timeout-val))))
  
  (define-syntax %with-wrapped-join
    (syntax-rules ()
      [(_ body ...)
       (parameterize ([join-exc #f])
	 (receive rs (begin body ...)
           (if (join-exc)
             (raise (join-exc))
             (apply values rs))))]))
  
  (define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
    (let ([unique (list #f)]
          [ts (map (^e (make-thread (^[] (proc e)))) coll)]
          [timeout (absolute-time (~ mapper'timeout))]
          [timeout-val (~ mapper'timeout-val)])
      (%start-threads ts)
      (%with-wrapped-join
       (let1 join! (%make-joiner #f)
	 (if timeout
           ($ map (^r (if (and (pair? r) (eq? (car r) unique))
			(begin (thread-terminate! (cdr r)) timeout-val)
			r))
	      $ map (^t (join! t timeout (cons unique t))) ts)
           (map join! ts)))))))

;; todo: linux specific
(define (num-open-files)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/fd" :children? #t))))

(define-http-handler (GET) "/" (^[req app]
				 (receive (status headers body)
				     (http-get "localhost:8081" "/")
				   (respond/ok req body))))

(define (http-get-body)
  (receive (status headers body)
      ;; todo: detect host name and use it to force a real
      ;; dns lookup to occur?
      (http-get "localhost:8081" "/slow")
    body))

(define-http-handler (GET)
  "/timeout"
  (lambda(req app)
    #;(when (> (num-open-files) 550)
      #?=(port-buffering (current-error-port))
      (with-output-to-port (current-error-port)
	(lambda()
	  (print "WARNING: explicit gc run because we are getting low on file descriptors")
	  (gc))))

    (let1 r (guard (e
		    [(uncaught-exception-condition? e)
		     #?=(uncaught-exception-condition-reason e)]
		    [else #?=e])
		   (pmap (lambda(i)
			   #;(when (= i 100) (error "i=100"))
			   (http-get-body))
			 (iota 400)
			 :mapper (make-fully-concurrent-mapper
				  0.1 'timeout)))
      (cond [(and (list? r) (eq? (car r) 'timeout))
	     (respond/ok req
			 (list
			  (html-doctype)
			  (html:html
			   (html:head (html:title "timeout"))
			   (html:body
			    (html:p "timeout")
			    (html:p
			     (string-append
			      (x->string (num-open-files))
			      " open files"))))))]
	    [(and (message-condition? r) (string=? (~ r 'message) "i=100"))
	     (respond/ok req "i=100\n")]
	    [else
	     (request-error :body r)]))))

(define (main args)
  #?=(sys-getpid)
  (debug-print-width 4000)
  (start-http-server :port 8080 :error-log #t)
  0)

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

[Shiro K. <shi...@gm...>]

On Sun, Jan 12, 2025 at 8:35 PM Jens Thiele <ka...@ka...> wrote:

>
> I still wonder about the timeout case. But it looks like one doesn't
> have to join after a successful thread-terminate!. Then only a failing
> thread-terminate! case might cause a problem/"died a lonely death"?
>

Correct.  Explicit terminate! is obviously an intended behavior.  Only
uncaught exceptions matter, because it's either intended to be handled
after join!, or an unintended exception.

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Shiro Kawai <shi...@gm...> writes:

> I pushed a fix of pmap to ensure all worker threads are joined.  Seems to
> be working with simple manual tests.  It's a bit difficult to write an
> automated test for it, though.

looking at:

(define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
  (let ([unique (list #f)]
        [ts (map (^e (make-thread (^[] (proc e)))) coll)]
        [timeout (absolute-time (~ mapper'timeout))]
        [timeout-val (~ mapper'timeout-val)])
    (%start-threads ts)
    (%with-wrapped-join
     (let1 join! (%make-joiner #f)
       (if timeout
         ($ map (^r (if (and (pair? r) (eq? (car r) unique))
                      (begin (thread-terminate! (cdr r)) timeout-val)
                      r))
            $ map (^t (join! t timeout (cons unique t))) ts)
         (map join! ts))))))
)

A difference to my "solution" is that you don't terminate all threads in
case of an early error immediately, but maybe this is a good thing.

I still wonder about the timeout case. But it looks like one doesn't
have to join after a successful thread-terminate!. Then only a failing
thread-terminate! case might cause a problem/"died a lonely death"?

Jens

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

[Shiro K. <shi...@gm...>]

I pushed a fix of pmap to ensure all worker threads are joined.  Seems to
be working with simple manual tests.  It's a bit difficult to write an
automated test for it, though.

On Fri, Jan 10, 2025 at 5:55 AM Shiro Kawai <shi...@gm...> wrote:

> Your point that pmap should be able to be used just like a parallel
> version of map, is valid.  It should be.
> Since 'map' pass-through an error from proc (and you don't know which
> iteration the proc throws it), I think it is ok that pmap throws just one
> of the errors.  The point is to ensure thread-join! is called on all the
> threads.  I'll make that change first.
>
>
>
> On Fri, Jan 10, 2025 at 3:51 AM Jens Thiele <ka...@ka...> wrote:
>
>> Shiro Kawai <shi...@gm...> writes:
>>
>> > Regarding pmap semantics in case of uncaught exception, it is not
>> defined
>> > at all; I guess I thought to leave the caller handle any exceptions
>> within
>> > proc, but that's probably a bad API.
>>
>> From a user point of view it is tempting to have it as close as possible
>> to map. Then one could add a p here and there to parallelize. But maybe
>> this is just a dangerous/bad invitation. I am really not sure what
>> should happen in the case with multiple uncaught exceptions. Collecting
>> them and returning them doesn't look that nice either (and what about
>> the terminated threads)?. Picking one exception raises the question
>> which one? Are there exceptions more important than others? And ignoring
>> exceptions doesn't feel right. Maybe it really should be the callers job
>> as you write.
>>
>> A quick search how others do that, didn't help either.
>>
>> > I'll come back regarding the resource leak.
>>
>> thanks
>>
>> Jens
>>
>>
>> _______________________________________________
>> Gauche-devel mailing list
>> Gau...@li...
>> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>>
>

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

[Shiro K. <shi...@gm...>]

Your point that pmap should be able to be used just like a parallel version
of map, is valid.  It should be.
Since 'map' pass-through an error from proc (and you don't know which
iteration the proc throws it), I think it is ok that pmap throws just one
of the errors.  The point is to ensure thread-join! is called on all the
threads.  I'll make that change first.



On Fri, Jan 10, 2025 at 3:51 AM Jens Thiele <ka...@ka...> wrote:

> Shiro Kawai <shi...@gm...> writes:
>
> > Regarding pmap semantics in case of uncaught exception, it is not defined
> > at all; I guess I thought to leave the caller handle any exceptions
> within
> > proc, but that's probably a bad API.
>
> From a user point of view it is tempting to have it as close as possible
> to map. Then one could add a p here and there to parallelize. But maybe
> this is just a dangerous/bad invitation. I am really not sure what
> should happen in the case with multiple uncaught exceptions. Collecting
> them and returning them doesn't look that nice either (and what about
> the terminated threads)?. Picking one exception raises the question
> which one? Are there exceptions more important than others? And ignoring
> exceptions doesn't feel right. Maybe it really should be the callers job
> as you write.
>
> A quick search how others do that, didn't help either.
>
> > I'll come back regarding the resource leak.
>
> thanks
>
> Jens
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Shiro Kawai <shi...@gm...> writes:

> Regarding pmap semantics in case of uncaught exception, it is not defined
> at all; I guess I thought to leave the caller handle any exceptions within
> proc, but that's probably a bad API.

>From a user point of view it is tempting to have it as close as possible
to map. Then one could add a p here and there to parallelize. But maybe
this is just a dangerous/bad invitation. I am really not sure what
should happen in the case with multiple uncaught exceptions. Collecting
them and returning them doesn't look that nice either (and what about
the terminated threads)?. Picking one exception raises the question
which one? Are there exceptions more important than others? And ignoring
exceptions doesn't feel right. Maybe it really should be the callers job
as you write.

A quick search how others do that, didn't help either.

> I'll come back regarding the resource leak.

thanks

Jens

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

[Shiro K. <shi...@gm...>]

Regarding pmap semantics in case of uncaught exception, it is not defined
at all; I guess I thought to leave the caller handle any exceptions within
proc, but that's probably a bad API.

I'll come back regarding the resource leak.

On Fri, Jan 10, 2025 at 12:56 AM Jens Thiele <ka...@ka...> wrote:

> Jens Thiele <ka...@ka...> writes:
>
> > Jens Thiele <ka...@ka...> writes:
> >
> >>                 (pmap (lambda(i) (http-get-body))
> >>                       (iota 400)
> >>                       :mapper (make-fully-concurrent-mapper
> >>                                0.1 'timeout)))
> >
> > wanted to improve the pmap method (with fully-concurrent-mapper with
> > timeout):
> >
> > (define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
> >   (let ([unique (list #f)]
> >         [ts (map (^e (make-thread (^[] (proc e)))) coll)]
> >         [timeout (absolute-time (~ mapper'timeout))]
> >         [timeout-val (~ mapper'timeout-val)])
> >     (%start-threads ts)
> >     (if timeout
> >       ($ map (^r (if (and (pair? r) (eq? (car r) unique))
> >                    (begin (thread-terminate! (cdr r)) timeout-val)
> >                    r))
> >          $ map (^t (thread-join! t timeout (cons unique t))) ts)
> >       (map thread-join! ts))))
> >
> > but I am not even sure what should happen if there are multiple uncaught
> > exceptions. At the moment the first uncaught exception is raised by
> > thread-join!
>
> maybe just keep it like that
>
> but this seems not to be good enough:
>
> (with-module control.pmap
> (define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
>   (let* ([unique (list #f)]
>          [ts (map (^e (make-thread (^[] (proc e)))) coll)]
>          [cleanup-ts (lambda()
>                        (let loop ((ts ts))
>                          (unless (null? ts)
>                            (set-car! ts #f)
>                            (loop (cdr ts)))))]
>          [timeout (absolute-time (~ mapper'timeout))]
>          [timeout-val (~ mapper'timeout-val)])
>     (%start-threads ts)
>     (if timeout
>       (let1 results (guard (e [(uncaught-exception-condition? e)
>                                ;; kill still running threads
>                                (for-each thread-terminate! ts)
>                                ;; otherwise we get thread died a
>                                ;; lonely death with an uncaught
>                                ;; exception
>                                (for-each
>                                 (lambda(t)
>                                   (guard
>                                    (e [(terminated-thread-exception? e)
>                                        #t]
>                                       [else
>                                        ;; #?=e
>                                        #t
>                                        ])
>                                    (thread-join! t)))
>                                 ts)
>                                (cleanup-ts)
>                                (raise e)])
>                            (map (lambda(t)
>                                   (thread-join! t
>                                                 timeout
>                                                 (cons unique t)))
>                                 ts))
>         (cleanup-ts)
>         (map
>          (lambda(r)
>            (if (and (pair? r) (eq? (car r) unique))
>              (begin
>                (thread-terminate! (cdr r))
>                (set-cdr! r #f)
>                timeout-val)
>              r))
>          results))
>       (map thread-join! ts))))
> )
>
> The complete reverse proxy example that still fails for me:
>
> #!/bin/sh
> #| -*- mode: scheme; coding: utf-8; -*-
> #export GC_PRINT_STATS=1
> exec gosh -I. -- $0 "$@"
> |#
> (use makiki)
> (use text.html-lite)
> (use rfc.http)
> (use gauche.threads)
> (use file.util)
> (use gauche.sequence)
> (use control.pmap)
>
> (with-module control.pmap
> (define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
>   (let* ([unique (list #f)]
>          [ts (map (^e (make-thread (^[] (proc e)))) coll)]
>          [cleanup-ts (lambda()
>                        (let loop ((ts ts))
>                          (unless (null? ts)
>                            (set-car! ts #f)
>                            (loop (cdr ts)))))]
>          [timeout (absolute-time (~ mapper'timeout))]
>          [timeout-val (~ mapper'timeout-val)])
>     (%start-threads ts)
>     (if timeout
>       (let1 results (guard (e [(uncaught-exception-condition? e)
>                                ;; kill still running threads
>                                (for-each thread-terminate! ts)
>                                ;; otherwise we get thread died a
>                                ;; lonely death with an uncaught
>                                ;; exception
>                                (for-each
>                                 (lambda(t)
>                                   (guard
>                                    (e [(terminated-thread-exception? e)
>                                        #t]
>                                       [else
>                                        ;; #?=e
>                                        #t
>                                        ])
>                                    (thread-join! t)))
>                                 ts)
>                                (cleanup-ts)
>                                (raise e)])
>                            (map (lambda(t)
>                                   (thread-join! t
>                                                 timeout
>                                                 (cons unique t)))
>                                 ts))
>         (cleanup-ts)
>         (map
>          (lambda(r)
>            (if (and (pair? r) (eq? (car r) unique))
>              (begin
>                (thread-terminate! (cdr r))
>                (set-cdr! r #f)
>                timeout-val)
>              r))
>          results))
>       (map thread-join! ts))))
> )
>
> ;; todo: linux specific
> (define (num-open-files)
>   (guard (e
>           [else
>            +nan.0])
>          (length (directory-list "/proc/self/fd" :children? #t))))
>
> (define (num-threads)
>   (guard (e
>           [else
>            +nan.0])
>          (length (directory-list "/proc/self/task" :children? #t))))
>
> (define-http-handler (GET) "/" (^[req app]
>                                  (receive (status headers body)
>                                      (http-get "localhost:8081" "/")
>                                    (respond/ok req body))))
>
> (define (http-get-body)
>   (receive (status headers body)
>       ;; todo: detect host name and use it to force a real
>       ;; dns lookup to occur?
>       (http-get "localhost:8081" "/slow")
>     body))
>
> (define-http-handler (GET)
>   "/timeout"
>   (lambda(req app)
>     (let1 r (guard (e
>                     [(uncaught-exception-condition? e)
>                      #?=(uncaught-exception-condition-reason e)]
>                     [else #?=e])
>                    (pmap (lambda(i) (http-get-body))
>                          (iota 400)
>                          :mapper (make-fully-concurrent-mapper
>                                   0.1 'timeout)))
>       (cond [(and (list? r) (eq? (car r) 'timeout))
>              (respond/ok req
>                          (list
>                           (html-doctype)
>                           (html:html
>                            (html:head (html:title "timeout"))
>                            (html:body
>                             (html:p "timeout")
>                             (html:p
>                              (string-append
>                               (x->string (num-open-files))
>                               " open files"))))))]
>             [(list? r)
>              (car body)]
>             [else
>              (request-error :body r)]))))
>
> (define (main args)
>   #?=(sys-getpid)
>   (debug-print-width 4000)
>   (start-http-server :port 8080 :error-log #t)
>   0)
>
> running out of ideas - should I just stop it?
>
> Jens
>
>
> _______________________________________________
> Gauche-devel mailing list
> Gau...@li...
> https://lists.sourceforge.net/lists/listinfo/gauche-devel
>

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Jens Thiele <ka...@ka...> writes:

> Jens Thiele <ka...@ka...> writes:
>
>> 		   (pmap (lambda(i) (http-get-body))
>> 			 (iota 400)
>> 			 :mapper (make-fully-concurrent-mapper
>> 				  0.1 'timeout)))
>
> wanted to improve the pmap method (with fully-concurrent-mapper with
> timeout):
>
> (define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
>   (let ([unique (list #f)]
>         [ts (map (^e (make-thread (^[] (proc e)))) coll)]
>         [timeout (absolute-time (~ mapper'timeout))]
>         [timeout-val (~ mapper'timeout-val)])
>     (%start-threads ts)
>     (if timeout
>       ($ map (^r (if (and (pair? r) (eq? (car r) unique))
>                    (begin (thread-terminate! (cdr r)) timeout-val)
>                    r))
>          $ map (^t (thread-join! t timeout (cons unique t))) ts)
>       (map thread-join! ts))))
>
> but I am not even sure what should happen if there are multiple uncaught
> exceptions. At the moment the first uncaught exception is raised by
> thread-join!

maybe just keep it like that

but this seems not to be good enough:

(with-module control.pmap
(define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
  (let* ([unique (list #f)]
         [ts (map (^e (make-thread (^[] (proc e)))) coll)]
	 [cleanup-ts (lambda()
		       (let loop ((ts ts))
			 (unless (null? ts)
			   (set-car! ts #f)
			   (loop (cdr ts)))))]
         [timeout (absolute-time (~ mapper'timeout))]
         [timeout-val (~ mapper'timeout-val)])
    (%start-threads ts)
    (if timeout
      (let1 results (guard (e [(uncaught-exception-condition? e)
			       ;; kill still running threads
			       (for-each thread-terminate! ts)
			       ;; otherwise we get thread died a
			       ;; lonely death with an uncaught
			       ;; exception
			       (for-each
				(lambda(t)
				  (guard
				   (e [(terminated-thread-exception? e)
				       #t]
				      [else
				       ;; #?=e
				       #t
				       ])
				   (thread-join! t)))
				ts)
			       (cleanup-ts)
			       (raise e)])
			   (map (lambda(t)
				  (thread-join! t
						timeout
						(cons unique t)))
				ts))
	(cleanup-ts)
	(map
	 (lambda(r)
	   (if (and (pair? r) (eq? (car r) unique))
	     (begin
	       (thread-terminate! (cdr r))
	       (set-cdr! r #f)
	       timeout-val)
	     r))
	 results))
      (map thread-join! ts))))
)

The complete reverse proxy example that still fails for me:

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
#export GC_PRINT_STATS=1
exec gosh -I. -- $0 "$@"
|#
(use makiki)
(use text.html-lite)
(use rfc.http)
(use gauche.threads)
(use file.util)
(use gauche.sequence)
(use control.pmap)

(with-module control.pmap
(define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
  (let* ([unique (list #f)]
         [ts (map (^e (make-thread (^[] (proc e)))) coll)]
	 [cleanup-ts (lambda()
		       (let loop ((ts ts))
			 (unless (null? ts)
			   (set-car! ts #f)
			   (loop (cdr ts)))))]
         [timeout (absolute-time (~ mapper'timeout))]
         [timeout-val (~ mapper'timeout-val)])
    (%start-threads ts)
    (if timeout
      (let1 results (guard (e [(uncaught-exception-condition? e)
			       ;; kill still running threads
			       (for-each thread-terminate! ts)
			       ;; otherwise we get thread died a
			       ;; lonely death with an uncaught
			       ;; exception
			       (for-each
				(lambda(t)
				  (guard
				   (e [(terminated-thread-exception? e)
				       #t]
				      [else
				       ;; #?=e
				       #t
				       ])
				   (thread-join! t)))
				ts)
			       (cleanup-ts)
			       (raise e)])
			   (map (lambda(t)
				  (thread-join! t
						timeout
						(cons unique t)))
				ts))
	(cleanup-ts)
	(map
	 (lambda(r)
	   (if (and (pair? r) (eq? (car r) unique))
	     (begin
	       (thread-terminate! (cdr r))
	       (set-cdr! r #f)
	       timeout-val)
	     r))
	 results))
      (map thread-join! ts))))
)

;; todo: linux specific
(define (num-open-files)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/fd" :children? #t))))

(define (num-threads)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/task" :children? #t))))

(define-http-handler (GET) "/" (^[req app]
				 (receive (status headers body)
				     (http-get "localhost:8081" "/")
				   (respond/ok req body))))

(define (http-get-body)
  (receive (status headers body)
      ;; todo: detect host name and use it to force a real
      ;; dns lookup to occur?
      (http-get "localhost:8081" "/slow")
    body))

(define-http-handler (GET)
  "/timeout"
  (lambda(req app)
    (let1 r (guard (e
		    [(uncaught-exception-condition? e)
		     #?=(uncaught-exception-condition-reason e)]
		    [else #?=e])
		   (pmap (lambda(i) (http-get-body))
			 (iota 400)
			 :mapper (make-fully-concurrent-mapper
				  0.1 'timeout)))
      (cond [(and (list? r) (eq? (car r) 'timeout))
	     (respond/ok req
			 (list
			  (html-doctype)
			  (html:html
			   (html:head (html:title "timeout"))
			   (html:body
			    (html:p "timeout")
			    (html:p
			     (string-append
			      (x->string (num-open-files))
			      " open files"))))))]
	    [(list? r)
	     (car body)]
	    [else
	     (request-error :body r)]))))

(define (main args)
  #?=(sys-getpid)
  (debug-print-width 4000)
  (start-http-server :port 8080 :error-log #t)
  0)

running out of ideas - should I just stop it?

Jens

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Jens Thiele <ka...@ka...> writes:

> 		   (pmap (lambda(i) (http-get-body))
> 			 (iota 400)
> 			 :mapper (make-fully-concurrent-mapper
> 				  0.1 'timeout)))

wanted to improve the pmap method (with fully-concurrent-mapper with
timeout):

(define-method run-map ((mapper <fully-concurrent-mapper>) proc coll)
  (let ([unique (list #f)]
        [ts (map (^e (make-thread (^[] (proc e)))) coll)]
        [timeout (absolute-time (~ mapper'timeout))]
        [timeout-val (~ mapper'timeout-val)])
    (%start-threads ts)
    (if timeout
      ($ map (^r (if (and (pair? r) (eq? (car r) unique))
                   (begin (thread-terminate! (cdr r)) timeout-val)
                   r))
         $ map (^t (thread-join! t timeout (cons unique t))) ts)
      (map thread-join! ts))))

but I am not even sure what should happen if there are multiple uncaught
exceptions. At the moment the first uncaught exception is raised by
thread-join! and then neither thread-join! nor thread-teminate! is
called on the other threads. Example session:

gosh> (use file.util)
gosh> (use control.pmap)
gosh> (define (num-threads) (length (directory-list "/proc/self/task" :children? #t)))
num-threads
gosh> (begin (guard (e [else #?=e]) (pmap (lambda(i)
					    (when (= i 1) (error "i=1"))
					    (when (= i 8) (error "i=8"))
					    (sys-sleep 2))
					  (iota 10)
					  :mapper (make-fully-concurrent-mapper 0.2 'timeout)))
	     (num-threads))
#?=e
#?-    #<uncaught-exception in thread #<thread #f (162) terminated 0 ...
12
gosh> (gc)
WARNING: A thread #f (169) died a lonely death with an uncaught exception #<error "i=8">.
#<undef>
gosh> (num-threads)
4

Best regards
Jens

Re: [Gauche-devel] thread resource leaks if thread terminates with uncaught exception

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

Jens Thiele <ka...@ka...> writes:

> Slightly off-topic/different topic (but this is how I ended up here):
> it looks like pmap with the fully-concurrent-mapper doesn't join all
> threads in run-map in the case where proc raised an error.

the reverse proxy example using pmap:

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
#export GC_PRINT_STATS=1
exec gosh -I. -- $0 "$@"
|#
(use makiki)
(use text.html-lite)
(use rfc.http)
(use gauche.threads)
(use file.util)
(use gauche.sequence)
(use control.pmap)

;; todo: linux specific
(define (num-open-files)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/fd" :children? #t))))

(define (num-threads)
  (guard (e
	  [else
	   +nan.0])
	 (length (directory-list "/proc/self/task" :children? #t))))

(define-http-handler (GET) "/" (^[req app]
				 (receive (status headers body)
				     (http-get "localhost:8081" "/")
				   (respond/ok req body))))

(define (http-get-body)
  (receive (status headers body)
      ;; todo: detect host name and use it to force a real
      ;; dns lookup to occur?
      (http-get "localhost:8081" "/slow")
    body))

(define-http-handler (GET)
  "/timeout"
  (lambda(req app)
    (let1 r (guard (e
		    [(uncaught-exception-condition? e)
		     #?=(uncaught-exception-condition-reason e)]
		    [else #?=e])
		   (pmap (lambda(i) (http-get-body))
			 (iota 400)
			 :mapper (make-fully-concurrent-mapper
				  0.1 'timeout)))
      (cond [(and (list? r) (eq? (car r) 'timeout))
	     (respond/ok req
			 (list
			  (html-doctype)
			  (html:html
			   (html:head (html:title "timeout"))
			   (html:body
			    (html:p "timeout")
			    (html:p
			     (string-append
			      (x->string (num-open-files))
			      " open files"))))))]
	    [(list? r)
	     (car body)]
	    [else
	     (request-error :body r)]))))

(define (main args)
  #?=(sys-getpid)
  (debug-print-width 4000)
  (start-http-server :port 8080 :error-log #t)
  0)

I run it with setarch -R to "reduce the randomness" (the pointer
addresses still vary between runs) like this:

$ time setarch -R ./reverse-proxy-pmap.scm 2>&1|tee /tmp/log

and get relatively early:
#?="././reverse-proxy-pmap.scm":68:(sys-getpid)
#?-    1648580
#?=[5]"././reverse-proxy-pmap.scm":44:(uncaught-exception-condition-reason e)
#?-[5]    #<system-error "getaddrinfo failed: System error: Device or resource busy">
WARNING: A thread #f (11848) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
WARNING: A thread #f (11830) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
WARNING: A thread #f (11849) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
WARNING: A thread #f (11839) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
WARNING: A thread #f (11850) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
...
WARNING: A thread #f (16812) died a lonely death with an uncaught exception #<system-error "getaddrinfo failed: System error: Device or resource busy">.
*** SYSTEM-ERROR: accept(2) failed: Too many open files
Stack Trace:
_______________________________________
  0  (report-error e)
  1  (socket-accept s)
        at "/usr/share/gauche-0.98/site/lib/makiki.scm":800
  2  (proc (car xs))
  3  (for-each (^h (apply (car h) (cdr h))) (append (pick-handlers ...
        at "/usr/share/gauche-0.98/0.9.15/lib/gauche/selector.scm":121
  4  (selector-select sel)
        at "/usr/share/gauche-0.98/site/lib/makiki.scm":819
  5  (do () ((not (unbox looping))) (selector-select sel))
        at "/usr/share/gauche-0.98/0.9.15/lib/gauche/common-macros.scm":104
        expanded from (while (unbox looping) (selector-select sel))
        at "/usr/share/gauche-0.98/site/lib/makiki.scm":819
  6  thunk
  7  (start-http-server :port 8080 :error-log #t)
        at "././reverse-proxy-pmap.scm":70
  8  (main args)

Best regards
Jens