From debbugs-submit-bounces@debbugs.gnu.org Tue Oct 22 12:25:52 2013 Received: (at submit) by debbugs.gnu.org; 22 Oct 2013 16:25:52 +0000 Received: from localhost ([127.0.0.1]:35421 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYemF-0001Na-Or for submit@debbugs.gnu.org; Tue, 22 Oct 2013 12:25:52 -0400 Received: from eggs.gnu.org ([208.118.235.92]:37666) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYemD-0001NJ-Dk for submit@debbugs.gnu.org; Tue, 22 Oct 2013 12:25:49 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VYely-0006lG-Qc for submit@debbugs.gnu.org; Tue, 22 Oct 2013 12:25:44 -0400 X-Spam-Checker-Version: SpamAssassin 3.3.2 (2011-06-06) on eggs.gnu.org X-Spam-Level: X-Spam-Status: No, score=0.8 required=5.0 tests=BAYES_50 autolearn=disabled version=3.3.2 Received: from lists.gnu.org ([2001:4830:134:3::11]:48487) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYely-0006lC-Nk for submit@debbugs.gnu.org; Tue, 22 Oct 2013 12:25:34 -0400 Received: from eggs.gnu.org ([2001:4830:134:3::10]:39324) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYelr-00035I-9j for bug-guile@gnu.org; Tue, 22 Oct 2013 12:25:34 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1VYelh-0006Mu-VO for bug-guile@gnu.org; Tue, 22 Oct 2013 12:25:27 -0400 Received: from maximusconfessor.all2all.org ([79.99.200.102]:36086) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1VYelh-0005yZ-Nn for bug-guile@gnu.org; Tue, 22 Oct 2013 12:25:17 -0400 Received: from localhost (unknown [192.168.0.2]) by maximusconfessor.all2all.org (Postfix) with ESMTP id 59132A04C106 for ; Tue, 22 Oct 2013 18:24:55 +0200 (CEST) Received: from maximusconfessor.all2all.org ([192.168.0.1]) by localhost (maximusconfessor.all2all.org [192.168.0.2]) (amavisd-new, port 10024) with ESMTP id yHTANaj3jlvY for ; Tue, 22 Oct 2013 18:10:32 +0200 (CEST) Received: from capac (unknown [189.60.30.80]) by maximusconfessor.all2all.org (Postfix) with ESMTPSA id D97AFA04C10B for ; Tue, 22 Oct 2013 18:24:46 +0200 (CEST) Date: Tue, 22 Oct 2013 14:24:43 -0200 From: David Pirotte To: Subject: [critical] ERROR: ... close-pipe: pipe not in table Message-ID: <20131022142443.120865fb@capac> X-Mailer: Claws Mail 3.9.2 (GTK+ 2.24.21; x86_64-pc-linux-gnu) Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::11 X-Spam-Score: -5.0 (-----) X-Debbugs-Envelope-To: submit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -5.0 (-----) Hello guilers, GNU Guile 2.0.9.20-10454 [cfr irc chat of October the 17th, 2013] I am facing a bug that only occurs on extremely powerful servers: in ice-9/popen.scm: 106: 1 [close-pipe #] In unknown file: ?: 0 [scm-error misc-error #f "~A" ("close-pipe: pipe not in table") #f] I can not reproduce the bug on my personal computer [i5, 4 cores], neither on the lab most powerful server we have [i7 12 cores], but on this customer's server [2 Xeons E5-2687W, 32 cores total], the bug is not random anymore, it _always_ raises, which is critical to us. Thank you for debugging this asap, Cheers, David in case it might help, here is an extract of the code that raises the error. in this code, rg-ergbd1 is an octave [heavy] script [that will be called between 1000 to 62000 depending on other factors...] ... (define (ergbd path im-name im-type seeds-dir im-ones x y threshold connectivity mutex log-port) (with-mutex mutex ;; (write-log-filename (format #f "(~A, ~A) " x y) log-port) (write-log "." log-port)) (let* ((cmd (format #f "rg-ergbd1 ~A ~A ~A ~A ~A ~A ~A ~A ~A" path im-name im-type seeds-dir im-ones x y threshold connectivity)) (s (open-input-pipe cmd)) (results (read-line s))) (unless (zero? (status:exit-val (close-pipe s))) (error "subprocess returned non-zero result code" cmd)) results)) ... ... ... (par-map (lambda (coord) (ergbd target-dir im-cpol-norm-name im-type seeds-dir im-ones (car coord) (cdr coord) threshold connectivity mutex log-port)) coords) ... From debbugs-submit-bounces@debbugs.gnu.org Tue Oct 22 14:23:08 2013 Received: (at control) by debbugs.gnu.org; 22 Oct 2013 18:23:08 +0000 Received: from localhost ([127.0.0.1]:35694 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYgbj-0004O5-Mw for submit@debbugs.gnu.org; Tue, 22 Oct 2013 14:23:07 -0400 Received: from world.peace.net ([96.39.62.75]:49249 ident=hope8) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VYgbh-0004Nu-Er for control@debbugs.gnu.org; Tue, 22 Oct 2013 14:23:06 -0400 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1VYgbb-0003RF-5k; Tue, 22 Oct 2013 14:22:59 -0400 From: Mark H Weaver To: control@debbugs.gnu.org Date: Tue, 22 Oct 2013 14:21:58 -0400 Message-ID: <87y55l414p.fsf@netris.org> MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 2.0 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: severity 15683 important thanks [...] Content analysis details: (2.0 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.8 MISSING_SUBJECT Missing Subject: header 0.2 NO_SUBJECT Extra score for no subject X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 2.0 (++) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: severity 15683 important thanks [...] Content analysis details: (2.0 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.8 MISSING_SUBJECT Missing Subject: header 0.2 NO_SUBJECT Extra score for no subject severity 15683 important thanks From debbugs-submit-bounces@debbugs.gnu.org Sun Nov 17 04:47:25 2013 Received: (at 15683) by debbugs.gnu.org; 17 Nov 2013 09:47:25 +0000 Received: from localhost ([127.0.0.1]:58098 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vhywu-0005S7-31 for submit@debbugs.gnu.org; Sun, 17 Nov 2013 04:47:25 -0500 Received: from world.peace.net ([96.39.62.75]:46287 ident=hope7) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vhywr-0005Ry-EG for 15683@debbugs.gnu.org; Sun, 17 Nov 2013 04:47:22 -0500 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1VhywY-0002ZZ-4C; Sun, 17 Nov 2013 04:47:02 -0500 From: Mark H Weaver To: David Pirotte Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table References: <20131022142443.120865fb@capac> Date: Sun, 17 Nov 2013 04:46:37 -0500 In-Reply-To: <20131022142443.120865fb@capac> (David Pirotte's message of "Tue, 22 Oct 2013 14:24:43 -0200") Message-ID: <87bo1j8io2.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683 Cc: 15683@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) --=-=-= Content-Type: text/plain Hi David, Here's a set of patches that should make (ice-9 popen) thread safe. I've also pushed these to the 'wip-thread-safe-popen' branch in git. Please let us know if they fix your problem. Regards, Mark --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Add-mutex-locking-functions-that-also-block-asyncs.patch Content-Description: [PATCH 1/6] Add mutex locking functions that also block asyncs >From 9b48be7107f3f98cdf2e756d4c1f4c937ff233d7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 04:00:29 -0500 Subject: [PATCH 1/6] Add mutex locking functions that also block asyncs. * libguile/async.h (scm_i_pthread_mutex_lock_with_asyncs, scm_i_pthread_mutex_unlock_with_asyncs): New macros. * libguile/threads.c (do_unlock_with_asyncs): New static helper. (scm_i_dynwind_pthread_mutex_lock_with_asyncs): New function. * libguile/threads.h (scm_i_dynwind_pthread_mutex_lock_with_asyncs): Add prototype. --- libguile/async.h | 12 ++++++++++++ libguile/threads.c | 16 ++++++++++++++++ libguile/threads.h | 1 + 3 files changed, 29 insertions(+), 0 deletions(-) diff --git a/libguile/async.h b/libguile/async.h index ceb2b96..6d0460c 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -78,6 +78,18 @@ SCM_API void scm_critical_section_end (void); scm_async_click (); \ } while (0) +# define scm_i_pthread_mutex_lock_with_asyncs(m) \ + do { \ + SCM_I_CURRENT_THREAD->block_asyncs++; \ + scm_i_pthread_mutex_lock(m); \ + } while (0) + +# define scm_i_pthread_mutex_unlock_with_asyncs(m) \ + do { \ + scm_i_pthread_mutex_unlock(m); \ + SCM_I_CURRENT_THREAD->block_asyncs--; \ + } while (0) + #else /* !BUILDING_LIBGUILE */ # define SCM_CRITICAL_SECTION_START scm_critical_section_start () diff --git a/libguile/threads.c b/libguile/threads.c index 8cbe1e2..6aeaeb9 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -2010,6 +2010,22 @@ scm_pthread_cond_timedwait (scm_i_pthread_cond_t *cond, #endif +static void +do_unlock_with_asyncs (void *data) +{ + scm_i_pthread_mutex_unlock ((scm_i_pthread_mutex_t *)data); + SCM_I_CURRENT_THREAD->block_asyncs--; +} + +void +scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex) +{ + SCM_I_CURRENT_THREAD->block_asyncs++; + scm_i_scm_pthread_mutex_lock (mutex); + scm_dynwind_unwind_handler (do_unlock_with_asyncs, mutex, + SCM_F_WIND_EXPLICITLY); +} + unsigned long scm_std_usleep (unsigned long usecs) { diff --git a/libguile/threads.h b/libguile/threads.h index 901c37b..5a2afa2 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -143,6 +143,7 @@ SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); +SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex); #define SCM_THREAD_SWITCHING_CODE \ do { } while (0) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-Block-system-asyncs-while-overrides_lock-is-held.patch Content-Description: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held >From f68f42d2014bb3dfb8a0d7c502f9d3d9593ee458 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:19:32 -0500 Subject: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held. * libguile/procprop.c (scm_set_procedure_property_x): Block system asyncs while overrides_lock is held. Use dynwind block in case an exception is thrown. --- libguile/procprop.c | 5 +++-- 1 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libguile/procprop.c b/libguile/procprop.c index 36228d3..dae3ea7 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -229,7 +229,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL); #endif - scm_i_pthread_mutex_lock (&overrides_lock); + scm_dynwind_begin (0); + scm_i_dynwind_pthread_mutex_lock_with_asyncs (&overrides_lock); props = scm_hashq_ref (overrides, proc, SCM_BOOL_F); if (scm_is_false (props)) { @@ -239,7 +240,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, props = SCM_EOL; } scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val)); - scm_i_pthread_mutex_unlock (&overrides_lock); + scm_dynwind_end (); return SCM_UNSPECIFIED; } -- 1.7.5.4 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: inline; filename=0003-Make-guardians-thread-safe.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH 3/6] Make guardians thread-safe >From 467e1d4c0438d24e310a45bc7370bd19b0e8c659 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:35:09 -0500 Subject: [PATCH 3/6] Make guardians thread-safe. * libguile/guardians.c (t_guardian): Add mutex. (finalize_guarded, scm_i_guard, scm_i_get_one_zombie): Lock mutex and block system asyncs during critical sections. (scm_make_guardian): Initialize mutex. --- libguile/guardians.c | 18 ++++++++++++++++-- 1 files changed, 16 insertions(+), 2 deletions(-) diff --git a/libguile/guardians.c b/libguile/guardians.c index 6ba8c0b..e59e1bb 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -40,7 +40,6 @@ * monsters we had... * * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Court=C3=A8s. - * FIXME: This is currently not thread-safe. */ =20 /* Uncomment the following line to debug guardian finalization. */ @@ -72,6 +71,7 @@ static scm_t_bits tc16_guardian; =20 typedef struct t_guardian { + scm_i_pthread_mutex_t mutex; unsigned long live; SCM zombies; struct t_guardian *next; @@ -144,6 +144,9 @@ finalize_guarded (void *ptr, void *finalizer_data) } =20 g =3D GUARDIAN_DATA (SCM_CAR (guardian_list)); + + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (g->live =3D=3D 0) abort (); =20 @@ -157,7 +160,8 @@ finalize_guarded (void *ptr, void *finalizer_data) g->zombies =3D zombies; =20 g->live--; - g->zombies =3D zombies; + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } =20 if (scm_is_true (proxied_finalizer)) @@ -208,6 +212,8 @@ scm_i_guard (SCM guardian, SCM obj) void *prev_data; SCM guardians_for_obj, finalizer_data; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + g->live++; =20 /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be @@ -249,6 +255,8 @@ scm_i_guard (SCM guardian, SCM obj) PTR2SCM (prev_data)); SCM_SETCAR (finalizer_data, proxied_finalizer); } + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } } =20 @@ -258,6 +266,8 @@ scm_i_get_one_zombie (SCM guardian) t_guardian *g =3D GUARDIAN_DATA (guardian); SCM res =3D SCM_BOOL_F; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (!scm_is_null (g->zombies)) { /* Note: We return zombies in reverse order. */ @@ -265,6 +275,8 @@ scm_i_get_one_zombie (SCM guardian) g->zombies =3D SCM_CDR (g->zombies); } =20 + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); + return res; } =20 @@ -335,6 +347,8 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0, t_guardian *g =3D scm_gc_malloc (sizeof (t_guardian), "guardian"); SCM z; =20 + scm_i_pthread_mutex_init (&g->mutex, NULL); + /* A tconc starts out with one tail pair. */ g->live =3D 0; g->zombies =3D SCM_EOL; --=20 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0004-Make-port-alists-accessible-from-Scheme.patch Content-Description: [PATCH 4/6] Make port alists accessible from Scheme >From 527a2938b55fb29b29091b96c5f803238adf42a7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 01:11:57 -0500 Subject: [PATCH 4/6] Make port alists accessible from Scheme. * libguile/ports.c (scm_i_port_alist, scm_i_set_port_alist_x): Make these available from Scheme, as '%port-alist' and '%set-port-alist!'. Validate port argument. * libguile/ports.h (scm_i_set_port_alist_x): Change return type from 'void' to 'SCM'. --- libguile/ports.c | 17 +++++++++++++---- libguile/ports.h | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 6f219d6..a20a820 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -254,17 +254,26 @@ scm_i_clear_pending_eof (SCM port) SCM_PORT_GET_INTERNAL (port)->pending_eof = 0; } -SCM -scm_i_port_alist (SCM port) +SCM_DEFINE (scm_i_port_alist, "%port-alist", 0, 1, 0, + (SCM port), + "Return the alist associated with @var{port}.") +#define FUNC_NAME s_scm_i_port_alist { + SCM_VALIDATE_OPPORT (1, port); return SCM_PORT_GET_INTERNAL (port)->alist; } +#undef FUNC_NAME -void -scm_i_set_port_alist_x (SCM port, SCM alist) +SCM_DEFINE (scm_i_set_port_alist_x, "%set-port-alist!", 0, 2, 0, + (SCM port, SCM alist), + "Set the alist associated with @var{port} to @var{alist}.") +#define FUNC_NAME s_scm_i_set_port_alist_x { + SCM_VALIDATE_OPPORT (1, port); SCM_PORT_GET_INTERNAL (port)->alist = alist; + return SCM_UNSPECIFIED; } +#undef FUNC_NAME diff --git a/libguile/ports.h b/libguile/ports.h index 39317f8..c8d08df 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -318,7 +318,7 @@ SCM_API SCM scm_set_port_column_x (SCM port, SCM line); SCM_API SCM scm_port_filename (SCM port); SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename); SCM_INTERNAL SCM scm_i_port_alist (SCM port); -SCM_INTERNAL void scm_i_set_port_alist_x (SCM port, SCM alist); +SCM_INTERNAL SCM scm_i_set_port_alist_x (SCM port, SCM alist); SCM_INTERNAL const char *scm_i_default_port_encoding (void); SCM_INTERNAL void scm_i_set_default_port_encoding (const char *); SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str); -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0005-Stylistic-improvements-for-ice-9-popen.patch Content-Description: [PATCH 5/6] Stylistic improvements for (ice-9 popen) >From 0e9c87402bf309323ebff4def7049572cb11562a Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:46:08 -0500 Subject: [PATCH 5/6] Stylistic improvements for (ice-9 popen). * module/ice-9/popen.scm (close-process, close-process-quietly): Accept 'port' and 'pid' as separate arguments. Improve style. (close-pipe, read-pipes): Improve style. --- module/ice-9/popen.scm | 45 +++++++++++++++++++++------------------------ 1 files changed, 21 insertions(+), 24 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 7d0549e..f8668cd 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -74,27 +74,26 @@ port to the process is created: it should be the value of (hashq-remove! port/pid-table port) pid)) -(define (close-process port/pid) - (close-port (car port/pid)) - (cdr (waitpid (cdr port/pid)))) +(define (close-process port pid) + (close-port port) + (cdr (waitpid pid))) ;; for the background cleanup handler: just clean up without reporting ;; errors. also avoids blocking the process: if the child isn't ready ;; to be collected, puts it back into the guardian's live list so it ;; can be tried again the next time the cleanup runs. -(define (close-process-quietly port/pid) +(define (close-process-quietly port pid) (catch 'system-error (lambda () - (close-port (car port/pid))) + (close-port port)) (lambda args #f)) (catch 'system-error (lambda () - (let ((pid/status (waitpid (cdr port/pid) WNOHANG))) - (cond ((= (car pid/status) 0) - ;; not ready for collection - (pipe-guardian (car port/pid)) - (hashq-set! port/pid-table - (car port/pid) (cdr port/pid)))))) + (let ((pid/status (waitpid pid WNOHANG))) + (when (zero? (car pid/status)) + ;; not ready for collection + (pipe-guardian port) + (hashq-set! port/pid-table port pid)))) (lambda args #f))) (define (close-pipe p) @@ -102,19 +101,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (if (not pid) - (error "close-pipe: pipe not in table")) - (close-process (cons p pid)))) - -(define reap-pipes - (lambda () - (let loop ((p (pipe-guardian))) - (cond (p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (if pid - (close-process-quietly (cons p pid)))) - (loop (pipe-guardian))))))) + (unless pid (error "close-pipe: pipe not in table")) + (close-process p pid))) + +(define (reap-pipes) + (let loop () + (let ((p (pipe-guardian))) + (when p + ;; maybe removed already by close-pipe. + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid))) + (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0006-Make-ice-9-popen-thread-safe.patch Content-Description: [PATCH 6/6] Make (ice-9 popen) thread-safe >From 40676067383d8fef9cc1690154011708c7e8e256 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:54:31 -0500 Subject: [PATCH 6/6] Make (ice-9 popen) thread-safe. * module/ice-9/popen.scm: Import (ice-9 threads). (port/pid-table): Mark as deprecated in comment. (port/pid-table-mutex): New variable. (open-pipe*): Stash the pid in the port's alist. Lock 'port/pid-table-mutex' while mutating 'port/pid-table'. (fetch-pid): Fetch the pid from the port's alist. Don't touch 'port/pid-table'. (close-process-quietly): Don't add the port to 'port/pid-table-mutex', since it was never removed. (close-pipe): Improve error message. (reap-pipes): Check to see if the port is already closed. --- module/ice-9/popen.scm | 27 +++++++++++++++++---------- 1 files changed, 17 insertions(+), 10 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index f8668cd..0e896d7 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -18,6 +18,7 @@ ;;;; (define-module (ice-9 popen) + :use-module (ice-9 threads) :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe open-output-pipe open-input-output-pipe)) @@ -40,7 +41,10 @@ (define pipe-guardian (make-guardian)) ;; a weak hash-table to store the process ids. +;; XXX use of this table is deprecated. It is no longer used, and is +;; populated only for backward compatibility (since it is exported). (define port/pid-table (make-weak-key-hash-table 31)) +(define port/pid-table-mutex (make-mutex)) (define (open-pipe* mode command . args) "Executes the program @var{command} with optional arguments @@ -57,8 +61,13 @@ port to the process is created: it should be the value of read-port write-port (%make-void-port mode)))) + (%set-port-alist! port (acons 'popen-pid pid (%port-alist port))) (pipe-guardian port) - (hashq-set! port/pid-table port pid) + + ;; XXX populate port/pid-table for backward compatibility. + (with-mutex port/pid-table-mutex + (hashq-set! port/pid-table port pid)) + port)))) (define (open-pipe command mode) @@ -70,9 +79,7 @@ port to the process is created: it should be the value of (open-pipe* mode "/bin/sh" "-c" command)) (define (fetch-pid port) - (let ((pid (hashq-ref port/pid-table port))) - (hashq-remove! port/pid-table port) - pid)) + (assq-ref (%port-alist port) 'popen-pid)) (define (close-process port pid) (close-port port) @@ -92,8 +99,7 @@ port to the process is created: it should be the value of (let ((pid/status (waitpid pid WNOHANG))) (when (zero? (car pid/status)) ;; not ready for collection - (pipe-guardian port) - (hashq-set! port/pid-table port pid)))) + (pipe-guardian port)))) (lambda args #f))) (define (close-pipe p) @@ -101,16 +107,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (unless pid (error "close-pipe: pipe not in table")) + (unless pid (error "close-pipe: pipe not created by (ice-9 popen)")) (close-process p pid))) (define (reap-pipes) (let loop () (let ((p (pipe-guardian))) (when p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (when pid (close-process-quietly p pid))) + ;; maybe closed already. + (unless (port-closed? p) + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid)))) (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Nov 17 05:04:48 2013 Received: (at 15683) by debbugs.gnu.org; 17 Nov 2013 10:04:48 +0000 Received: from localhost ([127.0.0.1]:58126 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VhzDj-0005tG-DY for submit@debbugs.gnu.org; Sun, 17 Nov 2013 05:04:48 -0500 Received: from world.peace.net ([96.39.62.75]:46314 ident=hope0) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VhzDg-0005t6-93 for 15683@debbugs.gnu.org; Sun, 17 Nov 2013 05:04:45 -0500 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1VhzDR-0002cS-RW; Sun, 17 Nov 2013 05:04:30 -0500 From: Mark H Weaver To: David Pirotte Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table References: <20131022142443.120865fb@capac> <87bo1j8io2.fsf@netris.org> Date: Sun, 17 Nov 2013 05:04:05 -0500 In-Reply-To: <87bo1j8io2.fsf@netris.org> (Mark H. Weaver's message of "Sun, 17 Nov 2013 04:46:37 -0500") Message-ID: <877gc78huy.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683 Cc: 15683@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) --=-=-= Content-Type: text/plain Mark H Weaver writes: > Here's a set of patches that should make (ice-9 popen) thread safe. > I've also pushed these to the 'wip-thread-safe-popen' branch in git. There was a minor mistake in one of the patches: the new internal scheme procedures for accessing the port alist declared their arguments as optional, but they should have been required. Here are the patches again, with that problem fixed. Mark --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-mutex-locking-functions-that-also-block-asyncs.patch Content-Description: [PATCH 1/6] Add mutex locking functions that also block asyncs >From 9b48be7107f3f98cdf2e756d4c1f4c937ff233d7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 04:00:29 -0500 Subject: [PATCH 1/6] Add mutex locking functions that also block asyncs. * libguile/async.h (scm_i_pthread_mutex_lock_with_asyncs, scm_i_pthread_mutex_unlock_with_asyncs): New macros. * libguile/threads.c (do_unlock_with_asyncs): New static helper. (scm_i_dynwind_pthread_mutex_lock_with_asyncs): New function. * libguile/threads.h (scm_i_dynwind_pthread_mutex_lock_with_asyncs): Add prototype. --- libguile/async.h | 12 ++++++++++++ libguile/threads.c | 16 ++++++++++++++++ libguile/threads.h | 1 + 3 files changed, 29 insertions(+), 0 deletions(-) diff --git a/libguile/async.h b/libguile/async.h index ceb2b96..6d0460c 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -78,6 +78,18 @@ SCM_API void scm_critical_section_end (void); scm_async_click (); \ } while (0) +# define scm_i_pthread_mutex_lock_with_asyncs(m) \ + do { \ + SCM_I_CURRENT_THREAD->block_asyncs++; \ + scm_i_pthread_mutex_lock(m); \ + } while (0) + +# define scm_i_pthread_mutex_unlock_with_asyncs(m) \ + do { \ + scm_i_pthread_mutex_unlock(m); \ + SCM_I_CURRENT_THREAD->block_asyncs--; \ + } while (0) + #else /* !BUILDING_LIBGUILE */ # define SCM_CRITICAL_SECTION_START scm_critical_section_start () diff --git a/libguile/threads.c b/libguile/threads.c index 8cbe1e2..6aeaeb9 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -2010,6 +2010,22 @@ scm_pthread_cond_timedwait (scm_i_pthread_cond_t *cond, #endif +static void +do_unlock_with_asyncs (void *data) +{ + scm_i_pthread_mutex_unlock ((scm_i_pthread_mutex_t *)data); + SCM_I_CURRENT_THREAD->block_asyncs--; +} + +void +scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex) +{ + SCM_I_CURRENT_THREAD->block_asyncs++; + scm_i_scm_pthread_mutex_lock (mutex); + scm_dynwind_unwind_handler (do_unlock_with_asyncs, mutex, + SCM_F_WIND_EXPLICITLY); +} + unsigned long scm_std_usleep (unsigned long usecs) { diff --git a/libguile/threads.h b/libguile/threads.h index 901c37b..5a2afa2 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -143,6 +143,7 @@ SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); +SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex); #define SCM_THREAD_SWITCHING_CODE \ do { } while (0) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Block-system-asyncs-while-overrides_lock-is-held.patch Content-Description: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held >From f68f42d2014bb3dfb8a0d7c502f9d3d9593ee458 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:19:32 -0500 Subject: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held. * libguile/procprop.c (scm_set_procedure_property_x): Block system asyncs while overrides_lock is held. Use dynwind block in case an exception is thrown. --- libguile/procprop.c | 5 +++-- 1 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libguile/procprop.c b/libguile/procprop.c index 36228d3..dae3ea7 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -229,7 +229,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL); #endif - scm_i_pthread_mutex_lock (&overrides_lock); + scm_dynwind_begin (0); + scm_i_dynwind_pthread_mutex_lock_with_asyncs (&overrides_lock); props = scm_hashq_ref (overrides, proc, SCM_BOOL_F); if (scm_is_false (props)) { @@ -239,7 +240,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, props = SCM_EOL; } scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val)); - scm_i_pthread_mutex_unlock (&overrides_lock); + scm_dynwind_end (); return SCM_UNSPECIFIED; } -- 1.7.5.4 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0003-Make-guardians-thread-safe.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH 3/6] Make guardians thread-safe >From 467e1d4c0438d24e310a45bc7370bd19b0e8c659 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:35:09 -0500 Subject: [PATCH 3/6] Make guardians thread-safe. * libguile/guardians.c (t_guardian): Add mutex. (finalize_guarded, scm_i_guard, scm_i_get_one_zombie): Lock mutex and block system asyncs during critical sections. (scm_make_guardian): Initialize mutex. --- libguile/guardians.c | 18 ++++++++++++++++-- 1 files changed, 16 insertions(+), 2 deletions(-) diff --git a/libguile/guardians.c b/libguile/guardians.c index 6ba8c0b..e59e1bb 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -40,7 +40,6 @@ * monsters we had... * * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Court=C3=A8s. - * FIXME: This is currently not thread-safe. */ =20 /* Uncomment the following line to debug guardian finalization. */ @@ -72,6 +71,7 @@ static scm_t_bits tc16_guardian; =20 typedef struct t_guardian { + scm_i_pthread_mutex_t mutex; unsigned long live; SCM zombies; struct t_guardian *next; @@ -144,6 +144,9 @@ finalize_guarded (void *ptr, void *finalizer_data) } =20 g =3D GUARDIAN_DATA (SCM_CAR (guardian_list)); + + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (g->live =3D=3D 0) abort (); =20 @@ -157,7 +160,8 @@ finalize_guarded (void *ptr, void *finalizer_data) g->zombies =3D zombies; =20 g->live--; - g->zombies =3D zombies; + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } =20 if (scm_is_true (proxied_finalizer)) @@ -208,6 +212,8 @@ scm_i_guard (SCM guardian, SCM obj) void *prev_data; SCM guardians_for_obj, finalizer_data; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + g->live++; =20 /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be @@ -249,6 +255,8 @@ scm_i_guard (SCM guardian, SCM obj) PTR2SCM (prev_data)); SCM_SETCAR (finalizer_data, proxied_finalizer); } + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } } =20 @@ -258,6 +266,8 @@ scm_i_get_one_zombie (SCM guardian) t_guardian *g =3D GUARDIAN_DATA (guardian); SCM res =3D SCM_BOOL_F; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (!scm_is_null (g->zombies)) { /* Note: We return zombies in reverse order. */ @@ -265,6 +275,8 @@ scm_i_get_one_zombie (SCM guardian) g->zombies =3D SCM_CDR (g->zombies); } =20 + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); + return res; } =20 @@ -335,6 +347,8 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0, t_guardian *g =3D scm_gc_malloc (sizeof (t_guardian), "guardian"); SCM z; =20 + scm_i_pthread_mutex_init (&g->mutex, NULL); + /* A tconc starts out with one tail pair. */ g->live =3D 0; g->zombies =3D SCM_EOL; --=20 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Make-port-alists-accessible-from-Scheme.patch Content-Description: [PATCH 4/6] Make port alists accessible from Scheme >From 5eb377ad8db716457b5750b54daa28b249006acd Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 01:11:57 -0500 Subject: [PATCH 4/6] Make port alists accessible from Scheme. * libguile/ports.c (scm_i_port_alist, scm_i_set_port_alist_x): Make these available from Scheme, as '%port-alist' and '%set-port-alist!'. Validate port argument. * libguile/ports.h (scm_i_set_port_alist_x): Change return type from 'void' to 'SCM'. --- libguile/ports.c | 17 +++++++++++++---- libguile/ports.h | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 6f219d6..030090c 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -254,17 +254,26 @@ scm_i_clear_pending_eof (SCM port) SCM_PORT_GET_INTERNAL (port)->pending_eof = 0; } -SCM -scm_i_port_alist (SCM port) +SCM_DEFINE (scm_i_port_alist, "%port-alist", 1, 0, 0, + (SCM port), + "Return the alist associated with @var{port}.") +#define FUNC_NAME s_scm_i_port_alist { + SCM_VALIDATE_OPPORT (1, port); return SCM_PORT_GET_INTERNAL (port)->alist; } +#undef FUNC_NAME -void -scm_i_set_port_alist_x (SCM port, SCM alist) +SCM_DEFINE (scm_i_set_port_alist_x, "%set-port-alist!", 2, 0, 0, + (SCM port, SCM alist), + "Set the alist associated with @var{port} to @var{alist}.") +#define FUNC_NAME s_scm_i_set_port_alist_x { + SCM_VALIDATE_OPPORT (1, port); SCM_PORT_GET_INTERNAL (port)->alist = alist; + return SCM_UNSPECIFIED; } +#undef FUNC_NAME diff --git a/libguile/ports.h b/libguile/ports.h index 39317f8..c8d08df 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -318,7 +318,7 @@ SCM_API SCM scm_set_port_column_x (SCM port, SCM line); SCM_API SCM scm_port_filename (SCM port); SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename); SCM_INTERNAL SCM scm_i_port_alist (SCM port); -SCM_INTERNAL void scm_i_set_port_alist_x (SCM port, SCM alist); +SCM_INTERNAL SCM scm_i_set_port_alist_x (SCM port, SCM alist); SCM_INTERNAL const char *scm_i_default_port_encoding (void); SCM_INTERNAL void scm_i_set_default_port_encoding (const char *); SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str); -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Stylistic-improvements-for-ice-9-popen.patch Content-Description: [PATCH 5/6] Stylistic improvements for (ice-9 popen) >From aa2d1143a05b82692ca965a2aa7d07e12c92e8c6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:46:08 -0500 Subject: [PATCH 5/6] Stylistic improvements for (ice-9 popen). * module/ice-9/popen.scm (close-process, close-process-quietly): Accept 'port' and 'pid' as separate arguments. Improve style. (close-pipe, read-pipes): Improve style. --- module/ice-9/popen.scm | 45 +++++++++++++++++++++------------------------ 1 files changed, 21 insertions(+), 24 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 7d0549e..f8668cd 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -74,27 +74,26 @@ port to the process is created: it should be the value of (hashq-remove! port/pid-table port) pid)) -(define (close-process port/pid) - (close-port (car port/pid)) - (cdr (waitpid (cdr port/pid)))) +(define (close-process port pid) + (close-port port) + (cdr (waitpid pid))) ;; for the background cleanup handler: just clean up without reporting ;; errors. also avoids blocking the process: if the child isn't ready ;; to be collected, puts it back into the guardian's live list so it ;; can be tried again the next time the cleanup runs. -(define (close-process-quietly port/pid) +(define (close-process-quietly port pid) (catch 'system-error (lambda () - (close-port (car port/pid))) + (close-port port)) (lambda args #f)) (catch 'system-error (lambda () - (let ((pid/status (waitpid (cdr port/pid) WNOHANG))) - (cond ((= (car pid/status) 0) - ;; not ready for collection - (pipe-guardian (car port/pid)) - (hashq-set! port/pid-table - (car port/pid) (cdr port/pid)))))) + (let ((pid/status (waitpid pid WNOHANG))) + (when (zero? (car pid/status)) + ;; not ready for collection + (pipe-guardian port) + (hashq-set! port/pid-table port pid)))) (lambda args #f))) (define (close-pipe p) @@ -102,19 +101,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (if (not pid) - (error "close-pipe: pipe not in table")) - (close-process (cons p pid)))) - -(define reap-pipes - (lambda () - (let loop ((p (pipe-guardian))) - (cond (p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (if pid - (close-process-quietly (cons p pid)))) - (loop (pipe-guardian))))))) + (unless pid (error "close-pipe: pipe not in table")) + (close-process p pid))) + +(define (reap-pipes) + (let loop () + (let ((p (pipe-guardian))) + (when p + ;; maybe removed already by close-pipe. + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid))) + (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-Make-ice-9-popen-thread-safe.patch Content-Description: [PATCH 6/6] Make (ice-9 popen) thread-safe >From 7feebb721114e0a20a19ec152bfceaf27b7bb57d Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:54:31 -0500 Subject: [PATCH 6/6] Make (ice-9 popen) thread-safe. * module/ice-9/popen.scm: Import (ice-9 threads). (port/pid-table): Mark as deprecated in comment. (port/pid-table-mutex): New variable. (open-pipe*): Stash the pid in the port's alist. Lock 'port/pid-table-mutex' while mutating 'port/pid-table'. (fetch-pid): Fetch the pid from the port's alist. Don't touch 'port/pid-table'. (close-process-quietly): Don't add the port to 'port/pid-table-mutex', since it was never removed. (close-pipe): Improve error message. (reap-pipes): Check to see if the port is already closed. --- module/ice-9/popen.scm | 27 +++++++++++++++++---------- 1 files changed, 17 insertions(+), 10 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index f8668cd..0e896d7 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -18,6 +18,7 @@ ;;;; (define-module (ice-9 popen) + :use-module (ice-9 threads) :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe open-output-pipe open-input-output-pipe)) @@ -40,7 +41,10 @@ (define pipe-guardian (make-guardian)) ;; a weak hash-table to store the process ids. +;; XXX use of this table is deprecated. It is no longer used, and is +;; populated only for backward compatibility (since it is exported). (define port/pid-table (make-weak-key-hash-table 31)) +(define port/pid-table-mutex (make-mutex)) (define (open-pipe* mode command . args) "Executes the program @var{command} with optional arguments @@ -57,8 +61,13 @@ port to the process is created: it should be the value of read-port write-port (%make-void-port mode)))) + (%set-port-alist! port (acons 'popen-pid pid (%port-alist port))) (pipe-guardian port) - (hashq-set! port/pid-table port pid) + + ;; XXX populate port/pid-table for backward compatibility. + (with-mutex port/pid-table-mutex + (hashq-set! port/pid-table port pid)) + port)))) (define (open-pipe command mode) @@ -70,9 +79,7 @@ port to the process is created: it should be the value of (open-pipe* mode "/bin/sh" "-c" command)) (define (fetch-pid port) - (let ((pid (hashq-ref port/pid-table port))) - (hashq-remove! port/pid-table port) - pid)) + (assq-ref (%port-alist port) 'popen-pid)) (define (close-process port pid) (close-port port) @@ -92,8 +99,7 @@ port to the process is created: it should be the value of (let ((pid/status (waitpid pid WNOHANG))) (when (zero? (car pid/status)) ;; not ready for collection - (pipe-guardian port) - (hashq-set! port/pid-table port pid)))) + (pipe-guardian port)))) (lambda args #f))) (define (close-pipe p) @@ -101,16 +107,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (unless pid (error "close-pipe: pipe not in table")) + (unless pid (error "close-pipe: pipe not created by (ice-9 popen)")) (close-process p pid))) (define (reap-pipes) (let loop () (let ((p (pipe-guardian))) (when p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (when pid (close-process-quietly p pid))) + ;; maybe closed already. + (unless (port-closed? p) + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid)))) (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Nov 17 06:29:44 2013 Received: (at 15683) by debbugs.gnu.org; 17 Nov 2013 11:29:44 +0000 Received: from localhost ([127.0.0.1]:58196 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi0Xv-00082V-Ig for submit@debbugs.gnu.org; Sun, 17 Nov 2013 06:29:43 -0500 Received: from world.peace.net ([96.39.62.75]:46355 ident=hope7) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi0Xt-00082M-5R for 15683@debbugs.gnu.org; Sun, 17 Nov 2013 06:29:41 -0500 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1Vi0Xm-0002u2-L1; Sun, 17 Nov 2013 06:29:34 -0500 From: Mark H Weaver To: David Pirotte Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table References: <20131022142443.120865fb@capac> <87bo1j8io2.fsf@netris.org> <877gc78huy.fsf@netris.org> Date: Sun, 17 Nov 2013 06:29:12 -0500 In-Reply-To: <877gc78huy.fsf@netris.org> (Mark H. Weaver's message of "Sun, 17 Nov 2013 05:04:05 -0500") Message-ID: <87y54n6zcn.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683 Cc: 15683@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) To gain some confidence in these patches, I wrote a little test program: --8<---------------cut here---------------start------------->8--- (use-modules (ice-9 popen)) (define threads (map (lambda (_) (call-with-new-thread (lambda () (let loop () (let ((pipe (open-pipe* OPEN_READ "echo" "foo"))) (read pipe) (close-pipe pipe)) (loop))))) (iota 4))) --8<---------------cut here---------------end--------------->8--- Replace the '4' with the number of cores in your machine. The code above will create the requested number of threads, which run in the background forever, rapidly creating and closing pipes. The above program is able to reproduce the bug within a few seconds on both of the multicore machines I have access to (a dual-core x86_64 box and a 4-core MIPS-compatible Loongson 3A box). With my patches applied, the above program runs indefinitely without a problem (I let it run for several minutes). Please try the code above on the largest machines you have access to. Thanks, Mark From debbugs-submit-bounces@debbugs.gnu.org Sun Nov 17 11:00:13 2013 Received: (at 15683) by debbugs.gnu.org; 17 Nov 2013 16:00:13 +0000 Received: from localhost ([127.0.0.1]:58828 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi4le-0008D6-Dr for submit@debbugs.gnu.org; Sun, 17 Nov 2013 11:00:12 -0500 Received: from world.peace.net ([96.39.62.75]:46569 ident=hope6) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi4lV-0008C4-Pt for 15683@debbugs.gnu.org; Sun, 17 Nov 2013 11:00:05 -0500 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1Vi4l9-0003MZ-Il; Sun, 17 Nov 2013 10:59:40 -0500 From: Mark H Weaver To: David Pirotte Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table References: <20131022142443.120865fb@capac> <87bo1j8io2.fsf@netris.org> <877gc78huy.fsf@netris.org> <87y54n6zcn.fsf@netris.org> Date: Sun, 17 Nov 2013 10:59:16 -0500 In-Reply-To: <87y54n6zcn.fsf@netris.org> (Mark H. Weaver's message of "Sun, 17 Nov 2013 06:29:12 -0500") Message-ID: <87txfb6muj.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683 Cc: 15683@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) --=-=-= Content-Type: text/plain Sorry, I discovered that the reaper wasn't working properly, and that slightly more radical changes were necessary. I've attached a new version of the patch set. The only patch that changed here is the last one, but I include all of them again for simplicity. I deleted the old 'wip-thread-safe-popen' branch and pushed a new one called 'thread-safe-popen', because I believe this one finally does the entire job correctly. Mark --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Add-mutex-locking-functions-that-also-block-asyncs.patch Content-Description: [PATCH 1/6] Add mutex locking functions that also block asyncs >From 9b48be7107f3f98cdf2e756d4c1f4c937ff233d7 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 04:00:29 -0500 Subject: [PATCH 1/6] Add mutex locking functions that also block asyncs. * libguile/async.h (scm_i_pthread_mutex_lock_with_asyncs, scm_i_pthread_mutex_unlock_with_asyncs): New macros. * libguile/threads.c (do_unlock_with_asyncs): New static helper. (scm_i_dynwind_pthread_mutex_lock_with_asyncs): New function. * libguile/threads.h (scm_i_dynwind_pthread_mutex_lock_with_asyncs): Add prototype. --- libguile/async.h | 12 ++++++++++++ libguile/threads.c | 16 ++++++++++++++++ libguile/threads.h | 1 + 3 files changed, 29 insertions(+), 0 deletions(-) diff --git a/libguile/async.h b/libguile/async.h index ceb2b96..6d0460c 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -78,6 +78,18 @@ SCM_API void scm_critical_section_end (void); scm_async_click (); \ } while (0) +# define scm_i_pthread_mutex_lock_with_asyncs(m) \ + do { \ + SCM_I_CURRENT_THREAD->block_asyncs++; \ + scm_i_pthread_mutex_lock(m); \ + } while (0) + +# define scm_i_pthread_mutex_unlock_with_asyncs(m) \ + do { \ + scm_i_pthread_mutex_unlock(m); \ + SCM_I_CURRENT_THREAD->block_asyncs--; \ + } while (0) + #else /* !BUILDING_LIBGUILE */ # define SCM_CRITICAL_SECTION_START scm_critical_section_start () diff --git a/libguile/threads.c b/libguile/threads.c index 8cbe1e2..6aeaeb9 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -2010,6 +2010,22 @@ scm_pthread_cond_timedwait (scm_i_pthread_cond_t *cond, #endif +static void +do_unlock_with_asyncs (void *data) +{ + scm_i_pthread_mutex_unlock ((scm_i_pthread_mutex_t *)data); + SCM_I_CURRENT_THREAD->block_asyncs--; +} + +void +scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex) +{ + SCM_I_CURRENT_THREAD->block_asyncs++; + scm_i_scm_pthread_mutex_lock (mutex); + scm_dynwind_unwind_handler (do_unlock_with_asyncs, mutex, + SCM_F_WIND_EXPLICITLY); +} + unsigned long scm_std_usleep (unsigned long usecs) { diff --git a/libguile/threads.h b/libguile/threads.h index 901c37b..5a2afa2 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -143,6 +143,7 @@ SCM_INTERNAL void scm_init_threads (void); SCM_INTERNAL void scm_init_thread_procs (void); SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); +SCM_INTERNAL void scm_i_dynwind_pthread_mutex_lock_with_asyncs (scm_i_pthread_mutex_t *mutex); #define SCM_THREAD_SWITCHING_CODE \ do { } while (0) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Block-system-asyncs-while-overrides_lock-is-held.patch Content-Description: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held >From f68f42d2014bb3dfb8a0d7c502f9d3d9593ee458 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:19:32 -0500 Subject: [PATCH 2/6] Block system asyncs while 'overrides_lock' is held. * libguile/procprop.c (scm_set_procedure_property_x): Block system asyncs while overrides_lock is held. Use dynwind block in case an exception is thrown. --- libguile/procprop.c | 5 +++-- 1 files changed, 3 insertions(+), 2 deletions(-) diff --git a/libguile/procprop.c b/libguile/procprop.c index 36228d3..dae3ea7 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -229,7 +229,8 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, SCM_MISC_ERROR ("arity is a deprecated read-only property", SCM_EOL); #endif - scm_i_pthread_mutex_lock (&overrides_lock); + scm_dynwind_begin (0); + scm_i_dynwind_pthread_mutex_lock_with_asyncs (&overrides_lock); props = scm_hashq_ref (overrides, proc, SCM_BOOL_F); if (scm_is_false (props)) { @@ -239,7 +240,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0, props = SCM_EOL; } scm_hashq_set_x (overrides, proc, scm_assq_set_x (props, key, val)); - scm_i_pthread_mutex_unlock (&overrides_lock); + scm_dynwind_end (); return SCM_UNSPECIFIED; } -- 1.7.5.4 --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0003-Make-guardians-thread-safe.patch Content-Transfer-Encoding: quoted-printable Content-Description: [PATCH 3/6] Make guardians thread-safe >From 467e1d4c0438d24e310a45bc7370bd19b0e8c659 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 03:35:09 -0500 Subject: [PATCH 3/6] Make guardians thread-safe. * libguile/guardians.c (t_guardian): Add mutex. (finalize_guarded, scm_i_guard, scm_i_get_one_zombie): Lock mutex and block system asyncs during critical sections. (scm_make_guardian): Initialize mutex. --- libguile/guardians.c | 18 ++++++++++++++++-- 1 files changed, 16 insertions(+), 2 deletions(-) diff --git a/libguile/guardians.c b/libguile/guardians.c index 6ba8c0b..e59e1bb 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -40,7 +40,6 @@ * monsters we had... * * Rewritten for the Boehm-Demers-Weiser GC by Ludovic Court=C3=A8s. - * FIXME: This is currently not thread-safe. */ =20 /* Uncomment the following line to debug guardian finalization. */ @@ -72,6 +71,7 @@ static scm_t_bits tc16_guardian; =20 typedef struct t_guardian { + scm_i_pthread_mutex_t mutex; unsigned long live; SCM zombies; struct t_guardian *next; @@ -144,6 +144,9 @@ finalize_guarded (void *ptr, void *finalizer_data) } =20 g =3D GUARDIAN_DATA (SCM_CAR (guardian_list)); + + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (g->live =3D=3D 0) abort (); =20 @@ -157,7 +160,8 @@ finalize_guarded (void *ptr, void *finalizer_data) g->zombies =3D zombies; =20 g->live--; - g->zombies =3D zombies; + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } =20 if (scm_is_true (proxied_finalizer)) @@ -208,6 +212,8 @@ scm_i_guard (SCM guardian, SCM obj) void *prev_data; SCM guardians_for_obj, finalizer_data; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + g->live++; =20 /* Note: GUARDIANS_FOR_OBJ is a weak list so that a guardian can be @@ -249,6 +255,8 @@ scm_i_guard (SCM guardian, SCM obj) PTR2SCM (prev_data)); SCM_SETCAR (finalizer_data, proxied_finalizer); } + + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); } } =20 @@ -258,6 +266,8 @@ scm_i_get_one_zombie (SCM guardian) t_guardian *g =3D GUARDIAN_DATA (guardian); SCM res =3D SCM_BOOL_F; =20 + scm_i_pthread_mutex_lock_with_asyncs (&g->mutex); + if (!scm_is_null (g->zombies)) { /* Note: We return zombies in reverse order. */ @@ -265,6 +275,8 @@ scm_i_get_one_zombie (SCM guardian) g->zombies =3D SCM_CDR (g->zombies); } =20 + scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex); + return res; } =20 @@ -335,6 +347,8 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0, t_guardian *g =3D scm_gc_malloc (sizeof (t_guardian), "guardian"); SCM z; =20 + scm_i_pthread_mutex_init (&g->mutex, NULL); + /* A tconc starts out with one tail pair. */ g->live =3D 0; g->zombies =3D SCM_EOL; --=20 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-Make-port-alists-accessible-from-Scheme.patch Content-Description: [PATCH 4/6] Make port alists accessible from Scheme >From 5eb377ad8db716457b5750b54daa28b249006acd Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 01:11:57 -0500 Subject: [PATCH 4/6] Make port alists accessible from Scheme. * libguile/ports.c (scm_i_port_alist, scm_i_set_port_alist_x): Make these available from Scheme, as '%port-alist' and '%set-port-alist!'. Validate port argument. * libguile/ports.h (scm_i_set_port_alist_x): Change return type from 'void' to 'SCM'. --- libguile/ports.c | 17 +++++++++++++---- libguile/ports.h | 2 +- 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/ports.c b/libguile/ports.c index 6f219d6..030090c 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -254,17 +254,26 @@ scm_i_clear_pending_eof (SCM port) SCM_PORT_GET_INTERNAL (port)->pending_eof = 0; } -SCM -scm_i_port_alist (SCM port) +SCM_DEFINE (scm_i_port_alist, "%port-alist", 1, 0, 0, + (SCM port), + "Return the alist associated with @var{port}.") +#define FUNC_NAME s_scm_i_port_alist { + SCM_VALIDATE_OPPORT (1, port); return SCM_PORT_GET_INTERNAL (port)->alist; } +#undef FUNC_NAME -void -scm_i_set_port_alist_x (SCM port, SCM alist) +SCM_DEFINE (scm_i_set_port_alist_x, "%set-port-alist!", 2, 0, 0, + (SCM port, SCM alist), + "Set the alist associated with @var{port} to @var{alist}.") +#define FUNC_NAME s_scm_i_set_port_alist_x { + SCM_VALIDATE_OPPORT (1, port); SCM_PORT_GET_INTERNAL (port)->alist = alist; + return SCM_UNSPECIFIED; } +#undef FUNC_NAME diff --git a/libguile/ports.h b/libguile/ports.h index 39317f8..c8d08df 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -318,7 +318,7 @@ SCM_API SCM scm_set_port_column_x (SCM port, SCM line); SCM_API SCM scm_port_filename (SCM port); SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename); SCM_INTERNAL SCM scm_i_port_alist (SCM port); -SCM_INTERNAL void scm_i_set_port_alist_x (SCM port, SCM alist); +SCM_INTERNAL SCM scm_i_set_port_alist_x (SCM port, SCM alist); SCM_INTERNAL const char *scm_i_default_port_encoding (void); SCM_INTERNAL void scm_i_set_default_port_encoding (const char *); SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str); -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Stylistic-improvements-for-ice-9-popen.patch Content-Description: [PATCH 5/6] Stylistic improvements for (ice-9 popen) >From aa2d1143a05b82692ca965a2aa7d07e12c92e8c6 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:46:08 -0500 Subject: [PATCH 5/6] Stylistic improvements for (ice-9 popen). * module/ice-9/popen.scm (close-process, close-process-quietly): Accept 'port' and 'pid' as separate arguments. Improve style. (close-pipe, read-pipes): Improve style. --- module/ice-9/popen.scm | 45 +++++++++++++++++++++------------------------ 1 files changed, 21 insertions(+), 24 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index 7d0549e..f8668cd 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -74,27 +74,26 @@ port to the process is created: it should be the value of (hashq-remove! port/pid-table port) pid)) -(define (close-process port/pid) - (close-port (car port/pid)) - (cdr (waitpid (cdr port/pid)))) +(define (close-process port pid) + (close-port port) + (cdr (waitpid pid))) ;; for the background cleanup handler: just clean up without reporting ;; errors. also avoids blocking the process: if the child isn't ready ;; to be collected, puts it back into the guardian's live list so it ;; can be tried again the next time the cleanup runs. -(define (close-process-quietly port/pid) +(define (close-process-quietly port pid) (catch 'system-error (lambda () - (close-port (car port/pid))) + (close-port port)) (lambda args #f)) (catch 'system-error (lambda () - (let ((pid/status (waitpid (cdr port/pid) WNOHANG))) - (cond ((= (car pid/status) 0) - ;; not ready for collection - (pipe-guardian (car port/pid)) - (hashq-set! port/pid-table - (car port/pid) (cdr port/pid)))))) + (let ((pid/status (waitpid pid WNOHANG))) + (when (zero? (car pid/status)) + ;; not ready for collection + (pipe-guardian port) + (hashq-set! port/pid-table port pid)))) (lambda args #f))) (define (close-pipe p) @@ -102,19 +101,17 @@ port to the process is created: it should be the value of to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." (let ((pid (fetch-pid p))) - (if (not pid) - (error "close-pipe: pipe not in table")) - (close-process (cons p pid)))) - -(define reap-pipes - (lambda () - (let loop ((p (pipe-guardian))) - (cond (p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (if pid - (close-process-quietly (cons p pid)))) - (loop (pipe-guardian))))))) + (unless pid (error "close-pipe: pipe not in table")) + (close-process p pid))) + +(define (reap-pipes) + (let loop () + (let ((p (pipe-guardian))) + (when p + ;; maybe removed already by close-pipe. + (let ((pid (fetch-pid p))) + (when pid (close-process-quietly p pid))) + (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0006-Make-ice-9-popen-thread-safe.patch Content-Description: [PATCH 6/6] Make (ice-9 popen) thread-safe >From 7bc28986ebdacbe77a43c52f36645c20b2bdf442 Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 17 Nov 2013 02:54:31 -0500 Subject: [PATCH 6/6] Make (ice-9 popen) thread-safe. * module/ice-9/popen.scm: Import (ice-9 threads). (port/pid-table): Mark as deprecated in comment. (port/pid-table-mutex): New variable. (open-pipe*): Store the pid in the port's alist. Guard the alist entry instead of the port. Lock 'port/pid-table-mutex' while mutating 'port/pid-table'. (fetch-pid): Removed. (fetch-alist-entry): New procedure. (close-process-quietly): Removed. (close-pipe): Use 'fetch-alist-entry' instead of 'fetch-pid'. Clear the cdr of the alist entry. Improve error messages. (reap-pipes): Adapt to the fact that the alist entries are now guarded instead of the ports. Incorporate the 'waitpid' code that was previously in 'close-process-quietly', but let the port finalizer close the port. Clear the cdr of the alist entry. --- module/ice-9/popen.scm | 76 +++++++++++++++++++++++++++-------------------- 1 files changed, 44 insertions(+), 32 deletions(-) diff --git a/module/ice-9/popen.scm b/module/ice-9/popen.scm index f8668cd..8e43112 100644 --- a/module/ice-9/popen.scm +++ b/module/ice-9/popen.scm @@ -18,6 +18,7 @@ ;;;; (define-module (ice-9 popen) + :use-module (ice-9 threads) :export (port/pid-table open-pipe* open-pipe close-pipe open-input-pipe open-output-pipe open-input-output-pipe)) @@ -40,7 +41,10 @@ (define pipe-guardian (make-guardian)) ;; a weak hash-table to store the process ids. +;; XXX use of this table is deprecated. It is no longer used here, and +;; is populated for backward compatibility only (since it is exported). (define port/pid-table (make-weak-key-hash-table 31)) +(define port/pid-table-mutex (make-mutex)) (define (open-pipe* mode command . args) "Executes the program @var{command} with optional arguments @@ -56,9 +60,19 @@ port to the process is created: it should be the value of (make-rw-port read-port write-port)) read-port write-port - (%make-void-port mode)))) - (pipe-guardian port) - (hashq-set! port/pid-table port pid) + (%make-void-port mode))) + (alist-entry (cons 'popen-pid pid))) + + ;; Store the alist-entry in the guardian instead of the port, + ;; so that we can still call 'waitpid' even if 'close-port' + ;; is called (which clears the port entry). + (pipe-guardian alist-entry) + (%set-port-alist! port (cons alist-entry (%port-alist port))) + + ;; XXX populate port/pid-table for backward compatibility. + (with-mutex port/pid-table-mutex + (hashq-set! port/pid-table port pid)) + port)))) (define (open-pipe command mode) @@ -69,48 +83,46 @@ port to the process is created: it should be the value of @code{OPEN_READ}, @code{OPEN_WRITE} or @code{OPEN_BOTH}." (open-pipe* mode "/bin/sh" "-c" command)) -(define (fetch-pid port) - (let ((pid (hashq-ref port/pid-table port))) - (hashq-remove! port/pid-table port) - pid)) +(define (fetch-alist-entry port) + (assq 'popen-pid (%port-alist port))) (define (close-process port pid) (close-port port) (cdr (waitpid pid))) -;; for the background cleanup handler: just clean up without reporting -;; errors. also avoids blocking the process: if the child isn't ready -;; to be collected, puts it back into the guardian's live list so it -;; can be tried again the next time the cleanup runs. -(define (close-process-quietly port pid) - (catch 'system-error - (lambda () - (close-port port)) - (lambda args #f)) - (catch 'system-error - (lambda () - (let ((pid/status (waitpid pid WNOHANG))) - (when (zero? (car pid/status)) - ;; not ready for collection - (pipe-guardian port) - (hashq-set! port/pid-table port pid)))) - (lambda args #f))) - (define (close-pipe p) "Closes the pipe created by @code{open-pipe}, then waits for the process to terminate and returns its status value, @xref{Processes, waitpid}, for information on how to interpret this value." - (let ((pid (fetch-pid p))) - (unless pid (error "close-pipe: pipe not in table")) + (let* ((alist-entry (fetch-alist-entry p)) + (pid (cdr alist-entry))) + ;; set the cdr to #f so that the reaper won't wait on this pid + ;; again, and to detect repeated calls to 'close-pipe'. + (set-cdr! alist-entry #f) + (unless alist-entry + (error "close-pipe: port not created by (ice-9 popen)")) + (unless pid + (error "close-pipe: pid has already been cleared")) (close-process p pid))) (define (reap-pipes) (let loop () - (let ((p (pipe-guardian))) - (when p - ;; maybe removed already by close-pipe. - (let ((pid (fetch-pid p))) - (when pid (close-process-quietly p pid))) + (let ((alist-entry (pipe-guardian))) + (when alist-entry + (let ((pid (cdr alist-entry))) + ;; maybe 'close-pipe' was already called. + (when pid + ;; clean up without reporting errors. also avoids blocking + ;; the process: if the child isn't ready to be collected, + ;; puts it back into the guardian's live list so it can be + ;; tried again the next time the cleanup runs. + (catch 'system-error + (lambda () + (let ((pid/status (waitpid pid WNOHANG))) + (if (zero? (car pid/status)) + (pipe-guardian alist-entry) ; not ready for collection + (set-cdr! alist-entry #f)))) ; avoid calling waitpid again + (lambda args #f)))) (loop))))) (add-hook! after-gc-hook reap-pipes) -- 1.7.5.4 --=-=-=-- From debbugs-submit-bounces@debbugs.gnu.org Sun Nov 17 12:54:41 2013 Received: (at 15683) by debbugs.gnu.org; 17 Nov 2013 17:54:41 +0000 Received: from localhost ([127.0.0.1]:58897 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi6YS-0002eZ-SJ for submit@debbugs.gnu.org; Sun, 17 Nov 2013 12:54:41 -0500 Received: from maximusconfessor.all2all.org ([79.99.200.102]:60064) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1Vi6YP-0002eQ-Se for 15683@debbugs.gnu.org; Sun, 17 Nov 2013 12:54:38 -0500 Received: from localhost (unknown [192.168.0.2]) by maximusconfessor.all2all.org (Postfix) with ESMTP id B109EA04C0C7; Sun, 17 Nov 2013 18:54:35 +0100 (CET) Received: from maximusconfessor.all2all.org ([192.168.0.1]) by localhost (maximusconfessor.all2all.org [192.168.0.2]) (amavisd-new, port 10024) with ESMTP id SpSU6pdoUIhw; Sun, 17 Nov 2013 18:39:40 +0100 (CET) Received: from capac (unknown [189.60.13.50]) by maximusconfessor.all2all.org (Postfix) with ESMTPSA id AA759A04C0B5; Sun, 17 Nov 2013 18:54:27 +0100 (CET) Date: Sun, 17 Nov 2013 15:54:23 -0200 From: David Pirotte To: Mark H Weaver Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table Message-ID: <20131117155423.5bedeb57@capac> In-Reply-To: <87y54n6zcn.fsf@netris.org> References: <20131022142443.120865fb@capac> <87bo1j8io2.fsf@netris.org> <877gc78huy.fsf@netris.org> <87y54n6zcn.fsf@netris.org> X-Mailer: Claws Mail 3.9.2 (GTK+ 2.24.21; x86_64-pc-linux-gnu) Mime-Version: 1.0 Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683 Cc: 15683@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) Hello Mark, Thank you for your work on this [tremendous] problem [for us]. I am running the test on our 12 cores machine on the lab and so far so good [it did crash immediately when running the 'old' guile...] Not sure it interest you, but i made a module version of your test, where I also call (current-processor-count), here below... Many thanks again, David ;; -- > To gain some confidence in these patches, I wrote a little test program: > --8<---------------cut here---------------start------------->8--- (define-module (tests thread-safe-popen) :use-module (ice-9 popen) :export (thread-safe-popen-test)) (define (thread-safe-popen-test) (map (lambda (_) (call-with-new-thread (lambda () (let loop () (let ((pipe (open-pipe* OPEN_READ "echo" "foo"))) (read pipe) (close-pipe pipe)) (loop))))) (iota (current-processor-count)))) #! (use-modules (tests thread-safe-popen)) (reload-module (resolve-module '(tests thread-safe-popen))) (thread-safe-popen-test) !# --8<---------------cut here---------------end--------------->8--- From debbugs-submit-bounces@debbugs.gnu.org Sat Nov 23 18:08:43 2013 Received: (at 15683-done) by debbugs.gnu.org; 23 Nov 2013 23:08:43 +0000 Received: from localhost ([127.0.0.1]:40713 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VkMJf-0001tK-6g for submit@debbugs.gnu.org; Sat, 23 Nov 2013 18:08:43 -0500 Received: from world.peace.net ([96.39.62.75]:53153 ident=hope4) by debbugs.gnu.org with esmtp (Exim 4.80) (envelope-from ) id 1VkMJc-0001tB-KB for 15683-done@debbugs.gnu.org; Sat, 23 Nov 2013 18:08:41 -0500 Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1VkMJV-0002Wh-6D; Sat, 23 Nov 2013 18:08:33 -0500 From: Mark H Weaver To: David Pirotte Subject: Re: bug#15683: [critical] ERROR: ... close-pipe: pipe not in table References: <20131022142443.120865fb@capac> Date: Sat, 23 Nov 2013 18:07:56 -0500 In-Reply-To: <20131022142443.120865fb@capac> (David Pirotte's message of "Tue, 22 Oct 2013 14:24:43 -0200") Message-ID: <87r4a6zpgz.fsf@netris.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: 15683-done Cc: 15683-done@debbugs.gnu.org X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.15 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.0 (/) Hi David, David Pirotte writes: > I am facing a bug that only occurs on extremely powerful servers: > > in ice-9/popen.scm: > 106: 1 [close-pipe #] > In unknown file: > ?: 0 [scm-error misc-error #f "~A" ("close-pipe: pipe not in table") #f] This bug should now be fixed on the stable-2.0 branch, which will become Guile 2.0.10. http://git.savannah.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=e7bd20f7d9b2110fdc0fa25db5a2bfe6b2214923 I'm closing this bug now. Thanks! Mark From unknown Thu Jun 19 14:24:43 2025 Received: (at fakecontrol) by fakecontrolmessage; To: internal_control@debbugs.gnu.org From: Debbugs Internal Request Subject: Internal Control Message-Id: bug archived. Date: Sun, 22 Dec 2013 12:24:04 +0000 User-Agent: Fakemail v42.6.9 # This is a fake control message. # # The action: # bug archived. thanks # This fakemail brought to you by your local debbugs # administrator