[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#15683: [critical] ERROR: ... close-pipe: pipe not in table
From: |
Mark H Weaver |
Subject: |
bug#15683: [critical] ERROR: ... close-pipe: pipe not in table |
Date: |
Sun, 17 Nov 2013 04:46:37 -0500 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) |
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
>From 9b48be7107f3f98cdf2e756d4c1f4c937ff233d7 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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
>From f68f42d2014bb3dfb8a0d7c502f9d3d9593ee458 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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
>From 467e1d4c0438d24e310a45bc7370bd19b0e8c659 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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ès.
- * FIXME: This is currently not thread-safe.
*/
/* Uncomment the following line to debug guardian finalization. */
@@ -72,6 +71,7 @@ static scm_t_bits tc16_guardian;
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)
}
g = GUARDIAN_DATA (SCM_CAR (guardian_list));
+
+ scm_i_pthread_mutex_lock_with_asyncs (&g->mutex);
+
if (g->live == 0)
abort ();
@@ -157,7 +160,8 @@ finalize_guarded (void *ptr, void *finalizer_data)
g->zombies = zombies;
g->live--;
- g->zombies = zombies;
+
+ scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex);
}
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;
+ scm_i_pthread_mutex_lock_with_asyncs (&g->mutex);
+
g->live++;
/* 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);
}
}
@@ -258,6 +266,8 @@ scm_i_get_one_zombie (SCM guardian)
t_guardian *g = GUARDIAN_DATA (guardian);
SCM res = SCM_BOOL_F;
+ 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 = SCM_CDR (g->zombies);
}
+ scm_i_pthread_mutex_unlock_with_asyncs (&g->mutex);
+
return res;
}
@@ -335,6 +347,8 @@ SCM_DEFINE (scm_make_guardian, "make-guardian", 0, 0, 0,
t_guardian *g = scm_gc_malloc (sizeof (t_guardian), "guardian");
SCM z;
+ scm_i_pthread_mutex_init (&g->mutex, NULL);
+
/* A tconc starts out with one tail pair. */
g->live = 0;
g->zombies = SCM_EOL;
--
1.7.5.4
>From 527a2938b55fb29b29091b96c5f803238adf42a7 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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
>From 0e9c87402bf309323ebff4def7049572cb11562a Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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
>From 40676067383d8fef9cc1690154011708c7e8e256 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
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
- bug#15683: [critical] ERROR: ... close-pipe: pipe not in table,
Mark H Weaver <=