[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-15-48-g79
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-15-48-g7948811 |
|
Date: |
Thu, 10 Feb 2011 22:13:06 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7948811252c38bb80ed6bcf8d060bc29eeac382b
The branch, master has been updated
via 7948811252c38bb80ed6bcf8d060bc29eeac382b (commit)
via 8269ba5b2c48b49ad3418214b7f2af1d84930b3c (commit)
via fcfbe5f96a0c14730e6978db519741a6a773427c (commit)
via b7b4aef97cc4b84e1f5ff4707f4a39f1b637544d (commit)
via e8065fe452208b82cd36f9437d55760d132fde32 (commit)
via 4b69f6ad26dc35681efc13aee14febf9338e0cce (commit)
via 05e7481311957b8fdbc61275cac6584bdef061ca (commit)
via c46345e69e862823629c0e108d907b5a9638fadc (commit)
from c2c550ca9d2442d070f79ed8bacb8db173c72df3 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 7948811252c38bb80ed6bcf8d060bc29eeac382b
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 23:07:03 2011 +0100
deprecate primitive properties
* libguile.h:
* libguile/Makefile.am:
* libguile/deprecated.h:
* libguile/deprecated.c:
* libguile/init.c:
* libguile/properties.c:
* libguile/properties.h: Deprecate the "primitive properties"
interface. It was only used to implement object properties, and that
is no longer the case.
* module/ice-9/boot-9.scm (make-object-property): Reimplement just in
terms of weak hash tables, and make threadsafe.
* NEWS:
* doc/ref/api-utility.texi: Update.
commit 8269ba5b2c48b49ad3418214b7f2af1d84930b3c
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 22:28:19 2011 +0100
ports.c safely accesses the port weak hash table
* libguile/ports.h (scm_i_remove_port): Remove declaration, as it was
SCM_INTERNAL.
* libguile/ports.c (scm_add_to_port_table): Issue a deprecation
warning if this function is called. Remove needless SCM_API
declaration, it was already declared as such in ports.h. Safely
access the port table.
(scm_i_remove_port): Remove bogus comment about lack of need for
threadsafety. Take the port table mutex.
(scm_close_port): No need to take port table mutex around calling
scm_i_remove_port.
commit fcfbe5f96a0c14730e6978db519741a6a773427c
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:56:46 2011 +0100
pre-deprecate scm_ptobs
* libguile/ports.h (scm_t_ptob_descriptor): Add comment about impending
ptob deprecation.
commit b7b4aef97cc4b84e1f5ff4707f4a39f1b637544d
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:40:25 2011 +0100
fix potential concurrency bugs in port-for-each
* libguile/ports.c (scm_c_port_for_each): Simplify to avoid concurrency-
and gc-related bugs.
commit e8065fe452208b82cd36f9437d55760d132fde32
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:19:33 2011 +0100
comment on scm_pre_modules_obarray re threadsafety
* libguile/modules.c (scm_pre_modules_obarray): Add comment to the
effect that this global variable does not need a lock around it.
commit 4b69f6ad26dc35681efc13aee14febf9338e0cce
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:11:47 2011 +0100
instructions.c: threadsafe static var
* libguile/instructions.c (fetch_instruction_table): Lock access to the
static, lazily-generated table.
commit 05e7481311957b8fdbc61275cac6584bdef061ca
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:06:55 2011 +0100
make static hash table access thread-safe in foreign.c
* libguile/foreign.c (register_weak_reference): Wrap static hash table
access in a mutex.
commit c46345e69e862823629c0e108d907b5a9638fadc
Author: Andy Wingo <address@hidden>
Date: Thu Feb 10 21:06:14 2011 +0100
fix potential deadlock in issue-deprecation-warning
* libguile/deprecation.c (scm_c_issue_deprecation_warning): Avoid
printing to a Scheme port while in a mutex.
-----------------------------------------------------------------------
Summary of changes:
NEWS | 8 +++
doc/ref/api-utility.texi | 57 ++-----------------
libguile.h | 3 +-
libguile/Makefile.am | 6 +--
libguile/deprecated.c | 113 ++++++++++++++++++++++++++++++++++++-
libguile/deprecated.h | 13 ++++-
libguile/deprecation.c | 48 ++++++++++------
libguile/foreign.c | 5 ++
libguile/init.c | 2 -
libguile/instructions.c | 10 +++-
libguile/modules.c | 2 +
libguile/ports.c | 68 ++++++++++------------
libguile/ports.h | 4 +-
libguile/properties.c | 142 ----------------------------------------------
libguile/properties.h | 41 -------------
module/ice-9/boot-9.scm | 14 ++++-
16 files changed, 229 insertions(+), 307 deletions(-)
delete mode 100644 libguile/properties.c
delete mode 100644 libguile/properties.h
diff --git a/NEWS b/NEWS
index 7912259..3c65d98 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,14 @@ latest prerelease, and a full NEWS corresponding to 1.8 ->
2.0.
Changes since the 1.9.15 prerelease:
+** Deprecated: primitive properties
+
+The `primitive-make-property', `primitive-property-set!',
+`primitive-property-ref', and `primitive-property-del!' procedures were
+crufty and only used to implement object properties, which has a new,
+threadsafe implementation. Use object properties or weak hash tables
+instead.
+
** New syntax: define-once
`define-once' is like Lisp's `defvar': it creates a toplevel binding,
diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi
index fb747ee..ba6139f 100644
--- a/doc/ref/api-utility.texi
+++ b/doc/ref/api-utility.texi
@@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004
address@hidden Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2011
@c Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@@ -229,57 +229,10 @@ protected. When the Scheme value is collected, its entry
in the
property table is removed and so the (ex-) property values are no longer
protected by the table.
address@hidden
-* Property Primitives:: Low level property implementation.
-* Old-fashioned Properties:: An older approach to properties.
address@hidden menu
-
-
address@hidden Property Primitives
address@hidden Low Level Property Implementation.
-
address@hidden {Scheme Procedure} primitive-make-property not-found-proc
address@hidden {C Function} scm_primitive_make_property (not_found_proc)
-Create a @dfn{property token} that can be used with
address@hidden and @code{primitive-property-set!}.
-See @code{primitive-property-ref} for the significance of
address@hidden
address@hidden deffn
-
address@hidden {Scheme Procedure} primitive-property-ref prop obj
address@hidden {C Function} scm_primitive_property_ref (prop, obj)
-Return the property @var{prop} of @var{obj}.
-
-When no value has yet been associated with @var{prop} and @var{obj},
-the @var{not-found-proc} from @var{prop} is used. A call
address@hidden(@var{not-found-proc} @var{prop} @var{obj})} is made and the
-result set as the property value. If @var{not-found-proc} is
address@hidden then @code{#f} is the property value.
address@hidden deffn
-
address@hidden {Scheme Procedure} primitive-property-set! prop obj val
address@hidden {C Function} scm_primitive_property_set_x (prop, obj, val)
-Set the property @var{prop} of @var{obj} to @var{val}.
address@hidden deffn
-
address@hidden {Scheme Procedure} primitive-property-del! prop obj
address@hidden {C Function} scm_primitive_property_del_x (prop, obj)
-Remove any value associated with @var{prop} and @var{obj}.
address@hidden deffn
-
-
address@hidden Old-fashioned Properties
address@hidden An Older Approach to Properties
-
-Traditionally, Lisp systems provide a different object property
-interface to that provided by @code{make-object-property}, in which the
-object property that is being set or retrieved is indicated by a symbol.
-
-Guile includes this older kind of interface as well, but it may well be
-removed in a future release, as it is less powerful than
address@hidden and so increases the size of the Guile
-library for no benefit. (And it is trivial to write a compatibility
-layer in Scheme.)
+Guile also implements a more traditional Lispy interface to properties,
+in which each object has an list of key-value pairs associated with it.
+Properties in that list are keyed by symbols. This is a legacy
+interface; you should use weak hash tables or object properties instead.
@deffn {Scheme Procedure} object-properties obj
@deffnx {C Function} scm_object_properties (obj)
diff --git a/libguile.h b/libguile.h
index 5e8c792..2c10d05 100644
--- a/libguile.h
+++ b/libguile.h
@@ -1,7 +1,7 @@
#ifndef SCM_LIBGUILE_H
#define SCM_LIBGUILE_H
-/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008,
2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008,
2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -82,7 +82,6 @@ extern "C" {
#include "libguile/print.h"
#include "libguile/procprop.h"
#include "libguile/promises.h"
-#include "libguile/properties.h"
#include "libguile/procs.h"
#include "libguile/r6rs-ports.h"
#include "libguile/random.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index dd797ea..79f886b 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,6 +1,6 @@
## Process this file with Automake to create Makefile.in
##
-## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
2008, 2009, 2010 Free Software Foundation, Inc.
+## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
2008, 2009, 2010, 2011 Free Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -177,7 +177,6 @@ address@hidden@_la_SOURCES =
\
procs.c \
programs.c \
promises.c \
- properties.c \
r6rs-ports.c \
random.c \
rdelim.c \
@@ -274,7 +273,6 @@ DOT_X_FILES = \
procprop.x \
procs.x \
promises.x \
- properties.x \
r6rs-ports.x \
random.x \
rdelim.x \
@@ -375,7 +373,6 @@ DOT_DOC_FILES = \
procprop.doc \
procs.doc \
promises.doc \
- properties.doc \
r6rs-ports.doc \
random.doc \
rdelim.doc \
@@ -550,7 +547,6 @@ modinclude_HEADERS = \
procs.h \
programs.h \
promises.h \
- properties.h \
pthread-threads.h \
r6rs-ports.h \
random.h \
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 59ff341..fd23e2d 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,7 +2,7 @@
deprecate something, move it here when that is feasible.
*/
-/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010 Free Software Foundation,
Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009, 2010, 2011 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -2390,9 +2390,120 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
+/* {Properties}
+ */
+
+static SCM properties_whash;
+
+SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
+ (SCM not_found_proc),
+ "Create a @dfn{property token} that can be used with\n"
+ "@code{primitive-property-ref} and
@code{primitive-property-set!}.\n"
+ "See @code{primitive-property-ref} for the significance of\n"
+ "@var{not_found_proc}.")
+#define FUNC_NAME s_scm_primitive_make_property
+{
+ scm_c_issue_deprecation_warning
+ ("`primitive-make-property' is deprecated. Use object properties.");
+
+ if (not_found_proc != SCM_BOOL_F)
+ SCM_VALIDATE_PROC (SCM_ARG1, not_found_proc);
+ return scm_cons (not_found_proc, SCM_EOL);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
+ (SCM prop, SCM obj),
+ "Return the property @var{prop} of @var{obj}.\n"
+ "\n"
+ "When no value has yet been associated with @var{prop} and\n"
+ "@var{obj}, the @var{not-found-proc} from @var{prop} is used. A\n"
+ "call @code{(@var{not-found-proc} @var{prop} @var{obj})} is made\n"
+ "and the result set as the property value. If\n"
+ "@var{not-found-proc} is @code{#f} then @code{#f} is the\n"
+ "property value.")
+#define FUNC_NAME s_scm_primitive_property_ref
+{
+ SCM h;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-ref' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+
+ h = scm_hashq_get_handle (properties_whash, obj);
+ if (scm_is_true (h))
+ {
+ SCM assoc = scm_assq (prop, SCM_CDR (h));
+ if (scm_is_true (assoc))
+ return SCM_CDR (assoc);
+ }
+
+ if (scm_is_false (SCM_CAR (prop)))
+ return SCM_BOOL_F;
+ else
+ {
+ SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
+ if (scm_is_false (h))
+ h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
+ SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
+ return val;
+ }
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
+ (SCM prop, SCM obj, SCM val),
+ "Set the property @var{prop} of @var{obj} to @var{val}.")
+#define FUNC_NAME s_scm_primitive_property_set_x
+{
+ SCM h, assoc;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-set!' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+ h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
+ assoc = scm_assq (prop, SCM_CDR (h));
+ if (SCM_NIMP (assoc))
+ SCM_SETCDR (assoc, val);
+ else
+ {
+ assoc = scm_acons (prop, val, SCM_CDR (h));
+ SCM_SETCDR (h, assoc);
+ }
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
+ (SCM prop, SCM obj),
+ "Remove any value associated with @var{prop} and @var{obj}.")
+#define FUNC_NAME s_scm_primitive_property_del_x
+{
+ SCM h;
+
+ scm_c_issue_deprecation_warning
+ ("`primitive-property-del!' is deprecated. Use object properties.");
+
+ SCM_VALIDATE_CONS (SCM_ARG1, prop);
+ h = scm_hashq_get_handle (properties_whash, obj);
+ if (scm_is_true (h))
+ SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
+
void
scm_i_init_deprecated ()
{
+ properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
#include "libguile/deprecated.x"
}
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index 84258fa..68aee63 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -5,7 +5,7 @@
#ifndef SCM_DEPRECATED_H
#define SCM_DEPRECATED_H
-/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010 Free Software
Foundation, Inc.
+/* Copyright (C) 2003,2004, 2005, 2006, 2007, 2009, 2010, 2011 Free Software
Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -738,7 +738,16 @@ SCM_DEPRECATED int scm_internal_select (int fds,
/* Deprecated because the cuserid call is deprecated.
*/
-SCM_API SCM scm_cuserid (void);
+SCM_DEPRECATED SCM scm_cuserid (void);
+
+
+
+/* Deprecated because it's yet another property interface.
+ */
+SCM_DEPRECATED SCM scm_primitive_make_property (SCM not_found_proc);
+SCM_DEPRECATED SCM scm_primitive_property_ref (SCM prop, SCM obj);
+SCM_DEPRECATED SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
+SCM_DEPRECATED SCM scm_primitive_property_del_x (SCM prop, SCM obj);
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index d3f0fd0..192667d 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2006, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2006, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -63,24 +63,36 @@ scm_c_issue_deprecation_warning (const char *msg)
scm_i_pthread_mutex_lock (&warn_lock);
for (iw = issued_warnings; iw; iw = iw->prev)
if (!strcmp (iw->message, msg))
- goto done;
- if (scm_gc_running_p)
- fprintf (stderr, "%s\n", msg);
- else
- {
- scm_puts (msg, scm_current_error_port ());
- scm_newline (scm_current_error_port ());
- }
- msg = strdup (msg);
- iw = malloc (sizeof (struct issued_warning));
- if (msg == NULL || iw == NULL)
- goto done;
- iw->message = msg;
- iw->prev = issued_warnings;
- issued_warnings = iw;
-
- done:
+ {
+ msg = NULL;
+ break;
+ }
+ if (msg)
+ {
+ msg = strdup (msg);
+ iw = malloc (sizeof (struct issued_warning));
+ if (msg == NULL || iw == NULL)
+ /* Nothing sensible to do if you can't allocate this small
+ amount of memory. */
+ abort ();
+ iw->message = msg;
+ iw->prev = issued_warnings;
+ issued_warnings = iw;
+ }
scm_i_pthread_mutex_unlock (&warn_lock);
+
+ /* All this dance is to avoid printing to a port inside a mutex,
+ which could recurse and deadlock. */
+ if (msg)
+ {
+ if (scm_gc_running_p)
+ fprintf (stderr, "%s\n", msg);
+ else
+ {
+ scm_puts (msg, scm_current_error_port ());
+ scm_newline (scm_current_error_port ());
+ }
+ }
}
}
diff --git a/libguile/foreign.c b/libguile/foreign.c
index c546c79..6f008e7 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -30,6 +30,7 @@
#include "libguile/_scm.h"
#include "libguile/bytevectors.h"
#include "libguile/instructions.h"
+#include "libguile/threads.h"
#include "libguile/foreign.h"
@@ -86,11 +87,15 @@ static SCM cif_to_procedure (SCM cif, SCM func_ptr);
static SCM pointer_weak_refs = SCM_BOOL_F;
+static scm_i_pthread_mutex_t weak_refs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
static void
register_weak_reference (SCM from, SCM to)
{
+ scm_i_pthread_mutex_lock (&weak_refs_lock);
scm_hashq_set_x (pointer_weak_refs, from, to);
+ scm_i_pthread_mutex_unlock (&weak_refs_lock);
}
static void
diff --git a/libguile/init.c b/libguile/init.c
index cf7447d..243e15e 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -99,7 +99,6 @@
#include "libguile/procs.h"
#include "libguile/programs.h"
#include "libguile/promises.h"
-#include "libguile/properties.h"
#include "libguile/array-map.h"
#include "libguile/random.h"
#include "libguile/rdelim.h"
@@ -458,7 +457,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_deprecation ();
scm_init_objprop ();
scm_init_promises (); /* requires smob_prehistory */
- scm_init_properties ();
scm_init_hooks (); /* Requires smob_prehistory */
scm_init_gc (); /* Requires hooks */
scm_init_gc_protect_object (); /* requires threads_prehistory */
diff --git a/libguile/instructions.c b/libguile/instructions.c
index 72e1fa1..ef4a9ce 100644
--- a/libguile/instructions.c
+++ b/libguile/instructions.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -23,8 +23,10 @@
#include <string.h>
#include "_scm.h"
+#include "threads.h"
#include "instructions.h"
+
struct scm_instruction {
enum scm_opcode opcode; /* opcode */
const char *name; /* instruction name */
@@ -45,11 +47,15 @@ struct scm_instruction {
} while (0)
+static scm_i_pthread_mutex_t itable_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
+
static struct scm_instruction*
fetch_instruction_table ()
{
static struct scm_instruction *table = NULL;
+ scm_i_pthread_mutex_lock (&itable_lock);
if (SCM_UNLIKELY (!table))
{
size_t bytes = SCM_VM_NUM_INSTRUCTIONS * sizeof(struct scm_instruction);
@@ -71,6 +77,8 @@ fetch_instruction_table ()
table[i].symname = SCM_BOOL_F;
}
}
+ scm_i_pthread_mutex_unlock (&itable_lock);
+
return table;
}
diff --git a/libguile/modules.c b/libguile/modules.c
index c4e08e5..40f9c84 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -326,6 +326,8 @@ resolve_duplicate_binding (SCM module, SCM sym,
return result;
}
+/* No lock is needed for access to this variable, as there are no
+ threads before modules are booted. */
SCM scm_pre_modules_obarray;
/* Lookup SYM as an imported variable of MODULE. */
diff --git a/libguile/ports.c b/libguile/ports.c
index 1da6a83..b65650e 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -40,6 +40,7 @@
#include "libguile/_scm.h"
#include "libguile/async.h"
+#include "libguile/deprecation.h"
#include "libguile/eval.h"
#include "libguile/fports.h" /* direct access for seek and truncate */
#include "libguile/goops.h"
@@ -624,16 +625,23 @@ scm_new_port_table_entry (scm_t_bits tag)
#undef FUNC_NAME
#if SCM_ENABLE_DEPRECATED==1
-SCM_API scm_t_port *
+scm_t_port *
scm_add_to_port_table (SCM port)
{
- SCM z = scm_new_port_table_entry (scm_tc7_port);
- scm_t_port * pt = SCM_PTAB_ENTRY(z);
+ SCM z;
+ scm_t_port * pt;
+ scm_c_issue_deprecation_warning ("scm_add_to_port_table is deprecated.");
+
+ scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+ z = scm_new_port_table_entry (scm_tc7_port);
+ pt = SCM_PTAB_ENTRY(z);
pt->port = port;
SCM_SETCAR (z, SCM_EOL);
SCM_SETCDR (z, SCM_EOL);
SCM_SETPTAB_ENTRY (port, pt);
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+
return pt;
}
#endif
@@ -641,20 +649,23 @@ scm_add_to_port_table (SCM port)
/* Remove a port from the table and destroy it. */
-/* This function is not and should not be thread safe. */
-void
+static void
scm_i_remove_port (SCM port)
#define FUNC_NAME "scm_remove_port"
{
- scm_t_port *p = SCM_PTAB_ENTRY (port);
+ scm_t_port *p;
- scm_port_non_buffer (p);
+ scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+ p = SCM_PTAB_ENTRY (port);
+ scm_port_non_buffer (p);
p->putback_buf = NULL;
p->putback_buf_size = 0;
-
SCM_SETPTAB_ENTRY (port, 0);
+
scm_hashq_remove_x (scm_i_port_weak_hash, port);
+
+ scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
}
#undef FUNC_NAME
@@ -827,9 +838,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
rv = (scm_ptobs[i].close) (port);
else
rv = 0;
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
scm_i_remove_port (port);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
SCM_CLR_PORT_OPEN_FLAG (port);
return scm_from_bool (rv >= 0);
}
@@ -867,44 +876,29 @@ SCM_DEFINE (scm_close_output_port, "close-output-port",
1, 0, 0,
#undef FUNC_NAME
static SCM
-scm_i_collect_keys_in_vector (void *closure, SCM key, SCM value, SCM result)
+collect_keys (void *unused, SCM key, SCM value, SCM result)
{
- int *i = (int*) closure;
- scm_c_vector_set_x (result, *i, key);
- (*i)++;
-
- return result;
+ return scm_cons (key, result);
}
void
scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
{
- int i = 0;
- size_t n;
SCM ports;
- /* Even without pre-emptive multithreading, running arbitrary code
- while scanning the port table is unsafe because the port table
- can change arbitrarily (from a GC, for example). So we first
- collect the ports into a vector. -mvo */
-
- scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
- n = SCM_HASHTABLE_N_ITEMS (scm_i_port_weak_hash);
- scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
- ports = scm_c_make_vector (n, SCM_BOOL_F);
-
+ /* Copy out the port table as a list so that we get strong references
+ to all the values. */
scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
- ports = scm_internal_hash_fold (scm_i_collect_keys_in_vector, &i,
- ports, scm_i_port_weak_hash);
+ ports = scm_internal_hash_fold (collect_keys, NULL,
+ SCM_EOL, scm_i_port_weak_hash);
scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
- for (i = 0; i < n; i++) {
- SCM p = SCM_SIMPLE_VECTOR_REF (ports, i);
- if (SCM_PORTP (p))
- proc (data, p);
- }
-
- scm_remember_upto_here_1 (ports);
+ for (; scm_is_pair (ports); ports = scm_cdr (ports))
+ {
+ SCM p = scm_car (ports);
+ if (SCM_PORTP (p))
+ proc (data, p);
+ }
}
SCM_DEFINE (scm_port_for_each, "port-for-each", 1, 0, 0,
diff --git a/libguile/ports.h b/libguile/ports.h
index cc0b987..6a669b6 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -205,6 +205,9 @@ typedef struct scm_t_ptob_descriptor
+/* Hey you! Yes you, reading the header file! We're going to deprecate
+ scm_ptobs in 2.2, so please don't write any new code that uses it.
+ Thanks. */
SCM_API scm_t_ptob_descriptor *scm_ptobs;
SCM_API long scm_numptob;
@@ -252,7 +255,6 @@ SCM_API void scm_dynwind_current_input_port (SCM port);
SCM_API void scm_dynwind_current_output_port (SCM port);
SCM_API void scm_dynwind_current_error_port (SCM port);
SCM_API SCM scm_new_port_table_entry (scm_t_bits tag);
-SCM_INTERNAL void scm_i_remove_port (SCM port);
SCM_API void scm_grow_port_cbuf (SCM port, size_t requested);
SCM_API SCM scm_pt_size (void);
SCM_API SCM scm_pt_member (SCM member);
diff --git a/libguile/properties.c b/libguile/properties.c
deleted file mode 100644
index 1f3c668..0000000
--- a/libguile/properties.c
+++ /dev/null
@@ -1,142 +0,0 @@
-/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008, 2009 Free Software
Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/hashtab.h"
-#include "libguile/alist.h"
-#include "libguile/root.h"
-#include "libguile/weaks.h"
-#include "libguile/validate.h"
-#include "libguile/eval.h"
-
-#include "libguile/properties.h"
-
-
-/* {Properties}
- */
-
-static SCM properties_whash;
-
-SCM_DEFINE (scm_primitive_make_property, "primitive-make-property", 1, 0, 0,
- (SCM not_found_proc),
- "Create a @dfn{property token} that can be used with\n"
- "@code{primitive-property-ref} and
@code{primitive-property-set!}.\n"
- "See @code{primitive-property-ref} for the significance of\n"
- "@var{not_found_proc}.")
-#define FUNC_NAME s_scm_primitive_make_property
-{
- if (not_found_proc != SCM_BOOL_F)
- SCM_VALIDATE_PROC (SCM_ARG1, not_found_proc);
- return scm_cons (not_found_proc, SCM_EOL);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_primitive_property_ref, "primitive-property-ref", 2, 0, 0,
- (SCM prop, SCM obj),
- "Return the property @var{prop} of @var{obj}.\n"
- "\n"
- "When no value has yet been associated with @var{prop} and\n"
- "@var{obj}, the @var{not-found-proc} from @var{prop} is used. A\n"
- "call @code{(@var{not-found-proc} @var{prop} @var{obj})} is made\n"
- "and the result set as the property value. If\n"
- "@var{not-found-proc} is @code{#f} then @code{#f} is the\n"
- "property value.")
-#define FUNC_NAME s_scm_primitive_property_ref
-{
- SCM h;
-
- SCM_VALIDATE_CONS (SCM_ARG1, prop);
-
- h = scm_hashq_get_handle (properties_whash, obj);
- if (scm_is_true (h))
- {
- SCM assoc = scm_assq (prop, SCM_CDR (h));
- if (scm_is_true (assoc))
- return SCM_CDR (assoc);
- }
-
- if (scm_is_false (SCM_CAR (prop)))
- return SCM_BOOL_F;
- else
- {
- SCM val = scm_call_2 (SCM_CAR (prop), prop, obj);
- if (scm_is_false (h))
- h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
- SCM_SETCDR (h, scm_acons (prop, val, SCM_CDR (h)));
- return val;
- }
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_primitive_property_set_x, "primitive-property-set!", 3, 0, 0,
- (SCM prop, SCM obj, SCM val),
- "Set the property @var{prop} of @var{obj} to @var{val}.")
-#define FUNC_NAME s_scm_primitive_property_set_x
-{
- SCM h, assoc;
- SCM_VALIDATE_CONS (SCM_ARG1, prop);
- h = scm_hashq_create_handle_x (properties_whash, obj, SCM_EOL);
- assoc = scm_assq (prop, SCM_CDR (h));
- if (SCM_NIMP (assoc))
- SCM_SETCDR (assoc, val);
- else
- {
- assoc = scm_acons (prop, val, SCM_CDR (h));
- SCM_SETCDR (h, assoc);
- }
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_primitive_property_del_x, "primitive-property-del!", 2, 0, 0,
- (SCM prop, SCM obj),
- "Remove any value associated with @var{prop} and @var{obj}.")
-#define FUNC_NAME s_scm_primitive_property_del_x
-{
- SCM h;
- SCM_VALIDATE_CONS (SCM_ARG1, prop);
- h = scm_hashq_get_handle (properties_whash, obj);
- if (scm_is_true (h))
- SCM_SETCDR (h, scm_assq_remove_x (SCM_CDR (h), prop));
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-void
-scm_init_properties ()
-{
- properties_whash = scm_make_weak_key_hash_table (SCM_UNDEFINED);
-#include "libguile/properties.x"
-}
-
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/
diff --git a/libguile/properties.h b/libguile/properties.h
deleted file mode 100644
index efeaf3a..0000000
--- a/libguile/properties.h
+++ /dev/null
@@ -1,41 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_PROPERTIES_H
-#define SCM_PROPERTIES_H
-
-/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-
-#include "libguile/__scm.h"
-
-SCM_API SCM scm_primitive_make_property (SCM not_found_proc);
-SCM_API SCM scm_primitive_property_ref (SCM prop, SCM obj);
-SCM_API SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val);
-SCM_API SCM scm_primitive_property_del_x (SCM prop, SCM obj);
-
-SCM_INTERNAL void scm_init_properties (void);
-
-#endif /* SCM_PROPERTIES_H */
-
-/*
- Local Variables:
- c-file-style: "gnu"
- End:
-*/
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index f706a71..83b87fd 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -587,10 +587,18 @@ VALUE."
;; properties within the object itself.
(define (make-object-property)
- (let ((prop (primitive-make-property #f)))
+ (define-syntax with-mutex
+ (syntax-rules ()
+ ((_ lock exp)
+ (dynamic-wind (lambda () (lock-mutex lock))
+ (lambda () exp)
+ (lambda () (unlock-mutex lock))))))
+ (let ((prop (make-weak-key-hash-table))
+ (lock (make-mutex)))
(make-procedure-with-setter
- (lambda (obj) (primitive-property-ref prop obj))
- (lambda (obj val) (primitive-property-set! prop obj val)))))
+ (lambda (obj) (with-mutex lock (hashq-ref prop obj)))
+ (lambda (obj val) (with-mutex lock (hashq-set! prop obj val))))))
+
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-15-48-g7948811,
Andy Wingo <=