thread resource leaks if thread terminates with uncaught exception

Hi,

I have some resource leaks problems with a long running process.

I still don't have a really simple test but I am getting closer to the
problem.

Let's say we have some webserver where some requests are really
slow. For example using makiki: server.scm:

#!/bin/sh
#| -*- mode: scheme; coding: utf-8; -*-
exec gosh -I. -- $0 "$@"
|#
(use makiki)
(use text.html-lite)

(define (hello)
  (list (html-doctype)
	(html:html
	 (html:head (html:title "hello"))
	 (html:body (html:p "hello")))))

(define-http-handler (GET)  "/"     (^[req app] (respond/ok req (hello))))
(define-http-handler (GET)  "/slow" (^[req app] (sys-sleep 10) (respond/ok req (hello))))

(define (main args)
  (start-http-server :port 8081)
  0)

Then we have some reverse proxy also using makiki (that will be the
process with the leaks). It tries to fetch many urls with a timeout in
parallel and for some reason oaccasionally there might be an error (the
"(when (= i 100) (error "i=100"))").

#!/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 runtime-compile)

(compile-and-load
 `((inline-stub
    (define-cproc get-gc-no ()
      (let* ((r::(struct GC_prof_stats_s)))
        (GC_get_prof_stats (& r) (sizeof r))
        (return (SCM_MAKE_INT (ref r gc_no)))))))
 '(get-gc-no))

;; todo: linux specific
(define (num-open-files) (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-handler (GET) "/timeout" (^[req app]
					(let1 threads (map (lambda(i)
							     (make-thread
							      (lambda()
								;; if i comment this one it works
								(when (= i 100) (error "i=100"))
								(receive (status headers body)
								    (http-get "localhost:8081" "/slow")
								  body))))
							   (iota 500))
					  (for-each thread-start! threads)
					  (let1 timeout (absolute-time 1)
					    (let1 body (thread-join! (car threads) timeout #f)
					      (for-each (lambda(t)
							  (guard (e
								  [(uncaught-exception-condition? e)
								   #?=(uncaught-exception-condition-reason e)]
								  [else #?=e])
								 (thread-join! t timeout #f)))
							(cdr threads))
					      (cond [(not body)
						     (for-each thread-terminate! threads)
						     (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, "
													 (x->string (get-gc-no))
													 " gc runs"))))))]
						    [else
						     body]))))))

(define (main args)
  #?=(sys-getpid)
  (start-http-server :port 8080)
  0)

Finally we have some client fetching http://localhost:8080/timeout

maybe curl:
$ curl -s -o - 'http://localhost:8080/timeout'

What happens for me:
first request works but reports already 505 open file descriptors (we use
thread-terminate! => this is expected)
second request works but already 1004 open file descriptors (the gc did
run and should have finalized the sockets)
third request reports internal server error because the file descriptor
limit of 1024 was reached and everyhing starts failing

Now when I remove the:
(when (= i 100) (error "i=100"))
everything seems to work

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.

Best regards
Jens

PS: 
the runtime-compile module can be found here:
https://raw.githubusercontent.com/karme/gauchegc/refs/heads/master/runtime-compile/runtime-compile.scm