guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. v2.1.0-47-g6978c67


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-47-g6978c67
Date: Sun, 19 Feb 2012 21:43:55 +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=6978c673393a960d7caf604b8c72ff2b5fe0f4ec

The branch, master has been updated
       via  6978c673393a960d7caf604b8c72ff2b5fe0f4ec (commit)
       via  6e9ec86dc0dad255ac120e1a5e77e10f1c544fbc (commit)
       via  7932759fc751393155ed80a765d89fefb758c893 (commit)
       via  917b0e72f72944ecc6af48f43604593974b752de (commit)
       via  3753e22736feb56ad22ec802bbad16e080066789 (commit)
       via  bc1bc9e32088958c1b381f9ec0056e40340433a1 (commit)
      from  8dfb7bbfd908ca883d0fdd0d868e13e6b20803ae (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 6978c673393a960d7caf604b8c72ff2b5fe0f4ec
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 12:23:29 2012 +0100

    use the new finalizer helpers
    
    * libguile/foreign.c (scm_set_pointer_finalizer_x)
    * libguile/ports.c (finalize_port, scm_c_make_port_with_encoding)
      (open_iconv_descriptors)
    * libguile/smob.c (scm_i_new_smob, scm_i_new_double_smob)
    * libguile/struct.c (scm_i_alloc_struct)
    * libguile/weak-set.c (weak_gc_finalizer)
      (scm_c_register_weak_gc_callback)
    * libguile/weak-table.c (scm_c_register_weak_gc_callback)
      (weak_gc_finalizer)
    * libguile/numbers.c (make_bignum): Use the new API.

commit 6e9ec86dc0dad255ac120e1a5e77e10f1c544fbc
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 12:22:12 2012 +0100

    add scm_i_set_finalizer, scm_i_add_finalizer, scm_i_add_resuscitator
    
    * libguile/finalizers.h:
    * libguile/finalizers.c: New files.
    
    * libguile.h:
    * libguile/Makefile.am: Add to build.

commit 7932759fc751393155ed80a765d89fefb758c893
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 20:34:26 2012 +0100

    better hysteresis in weak-set, weak-table
    
    * libguile/weak-set.c:
    * libguile/weak-table.c: Attempt to avoid bouncing between sizes when
      growing the vector causes elements to be removed from the set/table.

commit 917b0e72f72944ecc6af48f43604593974b752de
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 15:19:14 2012 +0100

    tune default hash table sizes
    
    * libguile/modules.c: In my current image, there are 1790 bindings in
      the root module, which tips over to the next hash vector size, so
      declare that to prevent rehashing.
    * libguile/srcprop.c (scm_init_srcprop): Don't preallocate a big
      source_whash table, as we might not need it (if everything is
      compiled, for example).
    * module/ice-9/boot-9.scm (make-module): Don't preall-cate big hash
      tables for imported bindings.  Instead trust that resizing works
      correctly.

commit 3753e22736feb56ad22ec802bbad16e080066789
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 12:34:20 2012 +0100

    move revealed-count mechanism to fports.c
    
    * libguile/fports.c (scm_revealed_count, scm_port_revealed)
      (scm_set_port_revealed_x, scm_adjust_port_revealed_x): Move these APIs
      here, and only operate on fports.  To keep revealed ports alive, now
      we will just keep them in a data structure that the GC knows about --
      a static list.
    
    * libguile/fports.h: Add revealed count to scm_t_fport, and move decls
      of revealed-count functions here.
    
    * libguile/ports.h:
    * libguile/ports.c: Adapt to change.  Remove SCM_REVEALED and
      SCM_SETREVEALED; since they only apply to fports now, keeping them
      around would be inviting type errors.
      (finalize_port): We don't need to worry about resuscitating ports
      here.
    
    * libguile/init.c: Use the scm_set_port_revealed_x function to set the
      revealed counts on stream ports.

commit bc1bc9e32088958c1b381f9ec0056e40340433a1
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 19 13:29:59 2012 +0100

    ice-9/poll optimization
    
    * module/ice-9/poll.scm (poll-set-add!): Use fileno instead of
      port->fdes, to avoid manipulating revealed counts.

-----------------------------------------------------------------------

Summary of changes:
 libguile.h                                |    3 +-
 libguile/Makefile.am                      |    4 +-
 libguile/finalizers.c                     |  126 ++++++++++++++++++++++++++++
 libguile/{debug-malloc.h => finalizers.h} |   30 +++----
 libguile/foreign.c                        |   25 +-----
 libguile/fports.c                         |  100 ++++++++++++++++++++++-
 libguile/fports.h                         |   14 +++-
 libguile/init.c                           |    3 +-
 libguile/modules.c                        |    4 +-
 libguile/numbers.c                        |    8 +--
 libguile/ports.c                          |  129 +++--------------------------
 libguile/ports.h                          |   11 ---
 libguile/smob.c                           |   20 +----
 libguile/srcprop.c                        |    2 +-
 libguile/struct.c                         |   14 +---
 libguile/weak-set.c                       |   42 +++++++++-
 libguile/weak-table.c                     |   42 +++++++++-
 module/ice-9/boot-9.scm                   |    6 +-
 module/ice-9/poll.scm                     |   10 +--
 19 files changed, 364 insertions(+), 229 deletions(-)
 create mode 100644 libguile/finalizers.c
 copy libguile/{debug-malloc.h => finalizers.h} (55%)

diff --git a/libguile.h b/libguile.h
index 7ac98a5..9a97429 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, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2006, 2008, 
2009, 2010, 2011, 2012 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
@@ -49,6 +49,7 @@ extern "C" {
 #include "libguile/extensions.h"
 #include "libguile/feature.h"
 #include "libguile/filesys.h"
+#include "libguile/finalizers.h"
 #include "libguile/fluids.h"
 #include "libguile/foreign.h"
 #include "libguile/fports.h"
diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 52ffc34..df3e9d0 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, 2011 Free Software Foundation, Inc.
+##     Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 
2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -142,6 +142,7 @@ address@hidden@_la_SOURCES =                                
\
        extensions.c                            \
        feature.c                               \
        filesys.c                               \
+       finalizers.c                            \
        fluids.c                                \
        foreign.c                               \
        fports.c                                \
@@ -536,6 +537,7 @@ modinclude_HEADERS =                                \
        expand.h                                \
        extensions.h                            \
        feature.h                               \
+       finalizers.h                            \
        filesys.h                               \
        fluids.h                                \
        foreign.h                               \
diff --git a/libguile/finalizers.c b/libguile/finalizers.c
new file mode 100644
index 0000000..8b4178f
--- /dev/null
+++ b/libguile/finalizers.c
@@ -0,0 +1,126 @@
+/* Copyright (C) 2012 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/bdw-gc.h"
+#include "libguile/_scm.h"
+#include "libguile/finalizers.h"
+#include "libguile/gc.h"
+#include "libguile/threads.h"
+
+
+
+void
+scm_i_set_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
+{
+  GC_finalization_proc prev;
+  GC_PTR prev_data;
+  GC_REGISTER_FINALIZER_NO_ORDER (obj, proc, data, &prev, &prev_data);
+}
+
+struct scm_t_chained_finalizer
+{
+  int resuscitating_p;
+  scm_t_finalizer_proc proc;
+  void *data;
+  scm_t_finalizer_proc prev;
+  void *prev_data;
+};
+
+static void
+chained_finalizer (void *obj, void *data)
+{
+  struct scm_t_chained_finalizer *chained_data = data;
+  if (chained_data->resuscitating_p)
+    {
+      if (chained_data->prev)
+        scm_i_set_finalizer (obj, chained_data->prev, chained_data->prev_data);
+      chained_data->proc (obj, chained_data->data);
+    }
+  else
+    {
+      chained_data->proc (obj, chained_data->data);
+      if (chained_data->prev)
+        chained_data->prev (obj, chained_data->prev_data);
+    }
+}
+
+void
+scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc proc, void *data)
+{
+  struct scm_t_chained_finalizer *chained_data;
+  chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
+  chained_data->resuscitating_p = 1;
+  chained_data->proc = proc;
+  chained_data->data = data;
+  GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
+                                  &chained_data->prev,
+                                  &chained_data->prev_data);
+}
+
+static void
+shuffle_resuscitators_to_front (struct scm_t_chained_finalizer *cd)
+{
+  while (cd->prev == chained_finalizer)
+    {
+      struct scm_t_chained_finalizer *prev = cd->prev_data;
+      scm_t_finalizer_proc proc = cd->proc;
+      void *data = cd->data;
+
+      if (!prev->resuscitating_p)
+        break;
+
+      cd->resuscitating_p = 1;
+      cd->proc = prev->proc;
+      cd->data = prev->data;
+
+      prev->resuscitating_p = 0;
+      prev->proc = proc;
+      prev->data = data;
+
+      cd = prev;
+    }
+}
+
+void
+scm_i_add_finalizer (void *obj, scm_t_finalizer_proc proc, void *data)
+{
+  struct scm_t_chained_finalizer *chained_data;
+  chained_data = scm_gc_malloc (sizeof (*chained_data), "chained finalizer");
+  chained_data->resuscitating_p = 0;
+  chained_data->proc = proc;
+  chained_data->data = data;
+  GC_REGISTER_FINALIZER_NO_ORDER (obj, chained_finalizer, chained_data,
+                                  &chained_data->prev,
+                                  &chained_data->prev_data);
+  shuffle_resuscitators_to_front (chained_data);
+}
+
+
+
+
+void
+scm_init_finalizers (void)
+{
+}
diff --git a/libguile/debug-malloc.h b/libguile/finalizers.h
similarity index 55%
copy from libguile/debug-malloc.h
copy to libguile/finalizers.h
index 7830adb..bad96e1 100644
--- a/libguile/debug-malloc.h
+++ b/libguile/finalizers.h
@@ -1,9 +1,7 @@
-/* classes: h_files */
+#ifndef SCM_FINALIZERS_H
+#define SCM_FINALIZERS_H
 
-#ifndef SCM_DEBUG_MALLOC_H
-#define SCM_DEBUG_MALLOC_H
-
-/* Copyright (C) 2000,2001, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2012 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
@@ -27,19 +25,15 @@
 
 
 
-SCM_API void scm_malloc_register (void *obj, const char *what);
-SCM_API void scm_malloc_unregister (void *obj);
-SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what);
-
-SCM_API SCM scm_malloc_stats (void);
+typedef void (*scm_t_finalizer_proc) (void *obj, void *data);
 
-SCM_INTERNAL void scm_debug_malloc_prehistory (void);
-SCM_INTERNAL void scm_init_debug_malloc (void);
+SCM_INTERNAL void scm_i_set_finalizer (void *obj, scm_t_finalizer_proc,
+                                       void *data);
+SCM_INTERNAL void scm_i_add_finalizer (void *obj, scm_t_finalizer_proc,
+                                       void *data);
+SCM_INTERNAL void scm_i_add_resuscitator (void *obj, scm_t_finalizer_proc,
+                                          void *data);
 
-#endif  /* SCM_DEBUG_MALLOC_H */
+SCM_INTERNAL void scm_init_finalizers (void);
 
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/
+#endif  /* SCM_FINALIZERS_H */
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 33df963..00e9c75 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -157,16 +157,8 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer 
finalizer)
       ret = scm_cell (scm_tc7_pointer, (scm_t_bits) ptr);
 
       if (finalizer)
-       {
-         /* Register a finalizer for the newly created instance.  */
-         GC_finalization_proc prev_finalizer;
-         GC_PTR prev_finalizer_data;
-         GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
-                                         pointer_finalizer_trampoline,
-                                         finalizer,
-                                         &prev_finalizer,
-                                         &prev_finalizer_data);
-       }
+        scm_i_set_finalizer (SCM2PTR (ret), pointer_finalizer_trampoline,
+                             finalizer);
     }
 
   return ret;
@@ -316,20 +308,11 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, 
"set-pointer-finalizer!", 2, 0, 0,
             "Scheme. If you need a Scheme finalizer, use guardians.")
 #define FUNC_NAME s_scm_set_pointer_finalizer_x
 {
-  void *c_finalizer;
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalizer_data;
-
   SCM_VALIDATE_POINTER (1, pointer);
   SCM_VALIDATE_POINTER (2, finalizer);
 
-  c_finalizer = SCM_POINTER_VALUE (finalizer);
-
-  GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer),
-                                  pointer_finalizer_trampoline,
-                                  c_finalizer,
-                                  &prev_finalizer,
-                                  &prev_finalizer_data);
+  scm_i_add_finalizer (SCM2PTR (pointer), pointer_finalizer_trampoline,
+                       SCM_POINTER_VALUE (finalizer));
 
   return SCM_UNSPECIFIED;
 }
diff --git a/libguile/fports.c b/libguile/fports.c
index bb998e7..9fcfbcb 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+ *   2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 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
@@ -633,6 +633,104 @@ fport_input_waiting (SCM port)
 #endif
 }
 
+
+
+
+/* Revealed counts --- an oddity inherited from SCSH.  */
+
+#define SCM_REVEALED(x) (SCM_FSTREAM(x)->revealed)
+
+static SCM revealed_ports = SCM_EOL;
+static scm_i_pthread_mutex_t revealed_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+SCM_PTHREAD_ATFORK_LOCK_STATIC_MUTEX (revealed_lock);
+
+/* Find a port in the table and return its revealed count.
+   Also used by the garbage collector.
+ */
+int
+scm_revealed_count (SCM port)
+{
+  int ret;
+
+  scm_i_pthread_mutex_lock (&revealed_lock);
+  ret = SCM_REVEALED (port);
+  scm_i_pthread_mutex_unlock (&revealed_lock);
+
+  return ret;
+}
+
+SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
+           (SCM port),
+           "Return the revealed count for @var{port}.")
+#define FUNC_NAME s_scm_port_revealed
+{
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPFPORT (1, port);
+  return scm_from_int (scm_revealed_count (port));
+}
+#undef FUNC_NAME
+
+/* Set the revealed count for a port.  */
+SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
+           (SCM port, SCM rcount),
+           "Sets the revealed count for a port to a given value.\n"
+           "The return value is unspecified.")
+#define FUNC_NAME s_scm_set_port_revealed_x
+{
+  int r, prev;
+
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPFPORT (1, port);
+
+  r = scm_to_int (rcount);
+
+  scm_i_pthread_mutex_lock (&revealed_lock);
+
+  prev = SCM_REVEALED (port);
+  SCM_REVEALED (port) = r;
+
+  if (r && !prev)
+    revealed_ports = scm_cons (port, revealed_ports);
+  else if (prev && !r)
+    revealed_ports = scm_delq_x (port, revealed_ports);
+
+  scm_i_pthread_mutex_unlock (&revealed_lock);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+/* Set the revealed count for a port.  */
+SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
+           (SCM port, SCM addend),
+           "Add @var{addend} to the revealed count of @var{port}.\n"
+           "The return value is unspecified.")
+#define FUNC_NAME s_scm_adjust_port_revealed_x
+{
+  int a;
+
+  port = SCM_COERCE_OUTPORT (port);
+  SCM_VALIDATE_OPFPORT (1, port);
+
+  a = scm_to_int (addend);
+  if (!a)
+    return SCM_UNSPECIFIED;
+
+  scm_i_pthread_mutex_lock (&revealed_lock);
+
+  SCM_REVEALED (port) += a;
+  if (SCM_REVEALED (port) == a)
+    revealed_ports = scm_cons (port, revealed_ports);
+  else if (!SCM_REVEALED (port))
+    revealed_ports = scm_delq_x (port, revealed_ports);
+
+  scm_i_pthread_mutex_unlock (&revealed_lock);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
 
 static int 
 fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
diff --git a/libguile/fports.h b/libguile/fports.h
index 32b6a59..4094f14 100644
--- a/libguile/fports.h
+++ b/libguile/fports.h
@@ -3,7 +3,7 @@
 #ifndef SCM_FPORTS_H
 #define SCM_FPORTS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011 
Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2011, 
2012 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
@@ -32,6 +32,9 @@
 /* struct allocated for each buffered FPORT.  */
 typedef struct scm_t_fport {
   int fdes;                    /* file descriptor.  */
+  int revealed;                        /* 0 not revealed, > 1 revealed.
+                                * Revealed ports do not get GC'd.
+                                */
 } scm_t_fport;
 
 SCM_API scm_t_bits scm_tc16_fport;
@@ -54,6 +57,15 @@ SCM_API void scm_evict_ports (int fd);
 SCM_API SCM scm_open_file (SCM filename, SCM modes);
 SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name);
 SCM_API SCM scm_file_port_p (SCM obj);
+
+
+/* Revealed counts.  */
+SCM_API int scm_revealed_count (SCM port);
+SCM_API SCM scm_port_revealed (SCM port);
+SCM_API SCM scm_set_port_revealed_x (SCM port, SCM rcount);
+SCM_API SCM scm_adjust_port_revealed_x (SCM port, SCM addend);
+
+
 SCM_INTERNAL void scm_init_fports (void);
 
 /* internal functions */
diff --git a/libguile/init.c b/libguile/init.c
index 35fbedb..7dec116 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -165,8 +165,7 @@ stream_body (void *data)
 {
   stream_body_data *body_data = (stream_body_data *) data;
   SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, SCM_BOOL_F);
-
-  SCM_REVEALED (port) = 1;
+  scm_set_port_revealed_x (port, SCM_INUM1);
   return port;
 }
 
diff --git a/libguile/modules.c b/libguile/modules.c
index 7498549..a5150f8 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011 
Free Software Foundation, Inc.
+/* Copyright (C) 
1998,2000,2001,2002,2003,2004,2006,2007,2008,2009,2010,2011,2012 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
@@ -1000,7 +1000,7 @@ SCM_SYMBOL (scm_sym_system_module, "system-module");
 void
 scm_modules_prehistory ()
 {
-  scm_pre_modules_obarray = scm_c_make_hash_table (1533);
+  scm_pre_modules_obarray = scm_c_make_hash_table (1790);
 }
 
 void
diff --git a/libguile/numbers.c b/libguile/numbers.c
index cb457d1..20877d3 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 
2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005, 2006, 
2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  *
  * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
  * and Bellcore.  See scm_divide.
@@ -217,17 +217,13 @@ static inline SCM
 make_bignum (void)
 {
   scm_t_bits *p;
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalizer_data;
 
   /* Allocate one word for the type tag and enough room for an `mpz_t'.  */
   p = scm_gc_malloc_pointerless (sizeof (scm_t_bits) + sizeof (mpz_t),
                                 "bignum");
   p[0] = scm_tc16_big;
 
-  GC_REGISTER_FINALIZER_NO_ORDER (p, finalize_bignum, NULL,
-                                 &prev_finalizer,
-                                 &prev_finalizer_data);
+  scm_i_set_finalizer (p, finalize_bignum, NULL);
 
   return SCM_PACK (p);
 }
diff --git a/libguile/ports.c b/libguile/ports.c
index 414ea94..12174bc 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -533,22 +533,6 @@ SCM scm_i_port_weak_set;
 
 /* Port finalization.  */
 
-static void finalize_port (GC_PTR, GC_PTR);
-
-/* Register a finalizer for PORT.  */
-static SCM_C_INLINE_KEYWORD void
-register_finalizer_for_port (SCM port)
-{
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalization_data;
-
-  /* Register a finalizer for PORT so that its iconv CDs get freed and
-     optionally its type's `free' function gets called.  */
-  GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (port), finalize_port, 0,
-                                 &prev_finalizer,
-                                 &prev_finalization_data);
-}
-
 struct do_free_data
 {
   scm_t_ptob_descriptor *ptob;
@@ -578,23 +562,17 @@ finalize_port (GC_PTR ptr, GC_PTR data)
 
   if (SCM_OPENP (port))
     {
-      if (SCM_REVEALED (port) > 0)
-       /* Keep "revealed" ports alive and re-register a finalizer.  */
-       register_finalizer_for_port (port);
-      else
-       {
-          struct do_free_data data;
+      struct do_free_data data;
 
-         SCM_CLR_PORT_OPEN_FLAG (port);
+      SCM_CLR_PORT_OPEN_FLAG (port);
 
-          data.ptob = SCM_PORT_DESCRIPTOR (port);
-          data.port = port;
+      data.ptob = SCM_PORT_DESCRIPTOR (port);
+      data.port = port;
 
-          scm_internal_catch (SCM_BOOL_T, do_free, &data,
-                              scm_handle_by_message_noexit, NULL);
+      scm_internal_catch (SCM_BOOL_T, do_free, &data,
+                          scm_handle_by_message_noexit, NULL);
 
-         scm_gc_ports_collected++;
-       }
+      scm_gc_ports_collected++;
     }
 }
 
@@ -633,12 +611,12 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned 
long mode_bits,
   entry->ilseq_handler = handler;
   entry->iconv_descriptors = NULL;
 
+  if (SCM_PORT_DESCRIPTOR (ret)->free)
+    scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
+
   if (SCM_PORT_DESCRIPTOR (ret)->flags & SCM_PORT_TYPE_HAS_FLUSH)
     scm_weak_set_add_x (scm_i_port_weak_set, ret);
 
-  if (SCM_PORT_DESCRIPTOR (ret)->free)
-    register_finalizer_for_port (ret);
-
   return ret;
 }
 
@@ -912,14 +890,8 @@ open_iconv_descriptors (const char *encoding, int reading, 
int writing)
   id->input_cd = input_cd;
   id->output_cd = output_cd;
 
-  {
-    GC_finalization_proc prev_finalizer;
-    GC_PTR prev_finalization_data;
-
-    /* Register a finalizer to close the descriptors.  */
-    GC_REGISTER_FINALIZER_NO_ORDER (id, finalize_iconv_descriptors, 0,
-                                    &prev_finalizer, &prev_finalization_data);
-  }
+  /* Register a finalizer to close the descriptors.  */
+  scm_i_set_finalizer (id, finalize_iconv_descriptors, NULL);
 
   return id;
 
@@ -1235,83 +1207,6 @@ scm_dynwind_lock_port (SCM port)
 
 
 
-/* Revealed counts --- an oddity inherited from SCSH.  */
-
-/* Find a port in the table and return its revealed count.
-   Also used by the garbage collector.
- */
-int
-scm_revealed_count (SCM port)
-{
-  scm_i_pthread_mutex_t *lock;
-  int ret;
-  
-  scm_c_lock_port (port, &lock);
-  ret = SCM_REVEALED (port);
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  
-  return ret;
-}
-
-SCM_DEFINE (scm_port_revealed, "port-revealed", 1, 0, 0,
-           (SCM port),
-           "Return the revealed count for @var{port}.")
-#define FUNC_NAME s_scm_port_revealed
-{
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  return scm_from_int (scm_revealed_count (port));
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port.  */
-SCM_DEFINE (scm_set_port_revealed_x, "set-port-revealed!", 2, 0, 0,
-           (SCM port, SCM rcount),
-           "Sets the revealed count for a port to a given value.\n"
-           "The return value is unspecified.")
-#define FUNC_NAME s_scm_set_port_revealed_x
-{
-  int r;
-  scm_i_pthread_mutex_t *lock;
-  
-  /* FIXME: It doesn't make sense to manipulate revealed counts on ports
-     without a free function.  */
-
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  r = scm_to_int (rcount);
-  scm_c_lock_port (port, &lock);
-  SCM_REVEALED (port) = r;
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-/* Set the revealed count for a port.  */
-SCM_DEFINE (scm_adjust_port_revealed_x, "adjust-port-revealed!", 2, 0, 0,
-           (SCM port, SCM addend),
-           "Add @var{addend} to the revealed count of @var{port}.\n"
-           "The return value is unspecified.")
-#define FUNC_NAME s_scm_adjust_port_revealed_x
-{
-  scm_i_pthread_mutex_t *lock;
-  int a;
-  port = SCM_COERCE_OUTPORT (port);
-  SCM_VALIDATE_OPENPORT (1, port);
-  a = scm_to_int (addend);
-  scm_c_lock_port (port, &lock);
-  SCM_REVEALED (port) += a;
-  if (lock)
-    scm_i_pthread_mutex_unlock (lock);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
-
-
-
 /* Input.  */
 
 int
diff --git a/libguile/ports.h b/libguile/ports.h
index b44ec66..c42b501 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -69,9 +69,6 @@ typedef struct
   SCM port;                    /* Link back to the port object.  */
   scm_i_pthread_mutex_t *lock;  /* A recursive lock for this port.  */
 
-  int revealed;                        /* 0 not revealed, > 1 revealed.
-                                * Revealed ports do not get GC'd.
-                                */
   /* data for the underlying port implementation as a raw C value. */
   scm_t_bits stream;
 
@@ -177,8 +174,6 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
 #define SCM_SET_FILENAME(x, n)    (SCM_PTAB_ENTRY(x)->file_name = (n))
 #define SCM_LINUM(x)              (SCM_PTAB_ENTRY(x)->line_number)
 #define SCM_COL(x)                (SCM_PTAB_ENTRY(x)->column_number)
-#define SCM_REVEALED(x)           (SCM_PTAB_ENTRY(x)->revealed)
-#define SCM_SETREVEALED(x, s)      (SCM_PTAB_ENTRY(x)->revealed = (s))
 
 #define SCM_INCLINE(port)      do {SCM_LINUM (port) += 1; SCM_COL (port) = 0;} 
while (0)
 #define SCM_ZEROCOL(port)      do {SCM_COL (port) = 0;} while (0)
@@ -316,12 +311,6 @@ SCM_API void scm_dynwind_lock_port (SCM port);
 SCM_INLINE int scm_c_lock_port (SCM port, scm_i_pthread_mutex_t **lock);
 SCM_INLINE int scm_c_try_lock_port (SCM port, scm_i_pthread_mutex_t **lock);
 
-/* Revealed counts.  */
-SCM_API int scm_revealed_count (SCM port);
-SCM_API SCM scm_port_revealed (SCM port);
-SCM_API SCM scm_set_port_revealed_x (SCM port, SCM rcount);
-SCM_API SCM scm_adjust_port_revealed_x (SCM port, SCM addend);
-
 /* Input.  */
 SCM_API int scm_get_byte_or_eof (SCM port);
 SCM_INLINE int scm_get_byte_or_eof_unlocked (SCM port);
diff --git a/libguile/smob.c b/libguile/smob.c
index 0c3a544..e7975d0 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 
2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 
2011, 2012 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
@@ -597,14 +597,7 @@ scm_i_new_smob (scm_t_bits tc, scm_t_bits data)
   SCM_SET_CELL_WORD_0 (ret, tc);
 
   if (scm_smobs[smobnum].free)
-    {
-      GC_finalization_proc prev_finalizer;
-      GC_PTR prev_finalizer_data;
-
-      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
-                                      finalize_smob, NULL,
-                                      &prev_finalizer, &prev_finalizer_data);
-    }
+    scm_i_set_finalizer (SCM2PTR (ret), finalize_smob, NULL);
 
   return ret;
 }
@@ -631,14 +624,7 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
   SCM_SET_CELL_WORD_0 (ret, tc);
 
   if (scm_smobs[smobnum].free)
-    {
-      GC_finalization_proc prev_finalizer;
-      GC_PTR prev_finalizer_data;
-
-      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
-                                      finalize_smob, NULL,
-                                      &prev_finalizer, &prev_finalizer_data);
-    }
+    scm_i_set_finalizer (SCM2PTR (ret), finalize_smob, NULL);
 
   return ret;
 }
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index cc71fd1..dbebf77 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -347,7 +347,7 @@ scm_init_srcprop ()
   scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
   scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
 
-  scm_source_whash = scm_c_make_weak_table (2047, SCM_WEAK_TABLE_KIND_KEY);
+  scm_source_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
   scm_c_define ("source-whash", scm_source_whash);
 
   scm_last_alist_filename = scm_cons (SCM_EOL,
diff --git a/libguile/struct.c b/libguile/struct.c
index 35e6c68..12a8842 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 
2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 
2009, 2010, 2011, 2012 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
@@ -444,16 +444,8 @@ scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
 
   /* vtable_data can be null when making a vtable vtable */
   if (vtable_data && vtable_data[scm_vtable_index_instance_finalize])
-    {
-      /* Register a finalizer for the newly created instance.  */
-      GC_finalization_proc prev_finalizer;
-      GC_PTR prev_finalizer_data;
-      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
-                                     struct_finalizer_trampoline,
-                                     NULL,
-                                     &prev_finalizer,
-                                     &prev_finalizer_data);
-    }
+    /* Register a finalizer for the newly created instance.  */
+    scm_i_set_finalizer (SCM2PTR (ret), struct_finalizer_trampoline, NULL);
 
   return ret;
 }
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index a1ae4ea..249c703 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -308,6 +308,42 @@ compute_size_index (scm_t_weak_set *set)
   return i;
 }
 
+static int
+is_acceptable_size_index (scm_t_weak_set *set, int size_index)
+{
+  int computed = compute_size_index (set);
+
+  if (size_index == computed)
+    /* We were going to grow or shrink, and allocating the new vector
+       didn't change the target size.  */
+    return 1;
+
+  if (size_index == computed + 1)
+    {
+      /* We were going to enlarge the set, but allocating the new
+         vector finalized some objects, making an enlargement
+         unnecessary.  It might still be a good idea to use the larger
+         set, though.  (This branch also gets hit if, while allocating
+         the vector, some other thread was actively removing items from
+         the set.  That is less likely, though.)  */
+      unsigned long new_lower = hashset_size[size_index] / 5;
+
+      return set->size > new_lower;
+    }
+
+  if (size_index == computed - 1)
+    {
+      /* We were going to shrink the set, but when we dropped the lock
+         to allocate the new vector, some other thread added elements to
+         the set.  */
+      return 0;
+    }
+
+  /* The computed size differs from our newly allocated size by more
+     than one size index -- recalculate.  */
+  return 0;
+}
+
 static void
 resize_set (scm_t_weak_set *set)
 {
@@ -328,7 +364,7 @@ resize_set (scm_t_weak_set *set)
                                                "weak set");
       scm_i_pthread_mutex_unlock (&set->lock);
     }
-  while (new_size_index != compute_size_index (set));
+  while (!is_acceptable_size_index (set, new_size_index));
 
   old_entries = set->entries;
   old_size = set->size;
@@ -764,7 +800,7 @@ static void
 weak_gc_finalizer (void *ptr, void *data)
 {
   if (weak_gc_callback (ptr))
-    GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_finalizer, data, NULL, NULL);
+    scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
 }
 #endif
 
@@ -780,7 +816,7 @@ scm_c_register_weak_gc_callback (SCM obj, void (*callback) 
(SCM))
 #ifdef HAVE_GC_SET_START_CALLBACK
   scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0);
 #else
-  GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_finalizer, NULL, NULL, NULL);
+  scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
 #endif
 }
 
diff --git a/libguile/weak-table.c b/libguile/weak-table.c
index 3d453ba..49d5b6d 100644
--- a/libguile/weak-table.c
+++ b/libguile/weak-table.c
@@ -431,6 +431,42 @@ compute_size_index (scm_t_weak_table *table)
   return i;
 }
 
+static int
+is_acceptable_size_index (scm_t_weak_table *table, int size_index)
+{
+  int computed = compute_size_index (table);
+
+  if (size_index == computed)
+    /* We were going to grow or shrink, and allocating the new vector
+       didn't change the target size.  */
+    return 1;
+
+  if (size_index == computed + 1)
+    {
+      /* We were going to enlarge the table, but allocating the new
+         vector finalized some objects, making an enlargement
+         unnecessary.  It might still be a good idea to use the larger
+         table, though.  (This branch also gets hit if, while allocating
+         the vector, some other thread was actively removing items from
+         the table.  That is less likely, though.)  */
+      unsigned long new_lower = hashtable_size[size_index] / 5;
+
+      return table->size > new_lower;
+    }
+
+  if (size_index == computed - 1)
+    {
+      /* We were going to shrink the table, but when we dropped the lock
+         to allocate the new vector, some other thread added elements to
+         the table.  */
+      return 0;
+    }
+
+  /* The computed size differs from our newly allocated size by more
+     than one size index -- recalculate.  */
+  return 0;
+}
+
 static void
 resize_table (scm_t_weak_table *table)
 {
@@ -450,7 +486,7 @@ resize_table (scm_t_weak_table *table)
       new_entries = allocate_entries (new_size, table->kind);
       scm_i_pthread_mutex_unlock (&table->lock);
     }
-  while (new_size_index != compute_size_index (table));
+  while (!is_acceptable_size_index (table, new_size_index));
 
   old_entries = table->entries;
   old_size = table->size;
@@ -891,7 +927,7 @@ static void
 weak_gc_finalizer (void *ptr, void *data)
 {
   if (weak_gc_callback (ptr))
-    GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_finalizer, data, NULL, NULL);
+    scm_i_set_finalizer (ptr, weak_gc_finalizer, data);
 }
 #endif
 
@@ -907,7 +943,7 @@ scm_c_register_weak_gc_callback (SCM obj, void (*callback) 
(SCM))
 #ifdef HAVE_GC_TABLE_START_CALLBACK
   scm_c_hook_add (&scm_after_gc_c_hook, weak_gc_hook, weak, 0);
 #else
-  GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_finalizer, NULL, NULL, NULL);
+  scm_i_set_finalizer (weak, weak_gc_finalizer, NULL);
 #endif
 }
 
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a7cd47a..68f54a7 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1803,10 +1803,6 @@ VALUE."
 ;; initial uses list, or binding procedure.
 ;;
 (define* (make-module #:optional (size 31) (uses '()) (binder #f))
-  (define %default-import-size
-    ;; Typical number of imported bindings actually used by a module.
-    600)
-
   (if (not (integer? size))
       (error "Illegal size to make-module." size))
   (if (not (and (list? uses)
@@ -1819,7 +1815,7 @@ VALUE."
   (let ((module (module-constructor (make-hash-table size)
                                     uses binder #f macroexpand
                                     #f #f #f
-                                    (make-hash-table %default-import-size)
+                                    (make-hash-table)
                                     '()
                                     (make-weak-key-hash-table 31) #f
                                     (make-hash-table 7) #f #f #f)))
diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm
index 2ba8687..1633dcb 100644
--- a/module/ice-9/poll.scm
+++ b/module/ice-9/poll.scm
@@ -1,6 +1,6 @@
 ;; poll
 
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012 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
@@ -139,13 +139,7 @@
          (off (pollfd-offset idx))
          (fd (if (integer? fd-or-port)
                  fd-or-port
-                 (port->fdes fd-or-port))))
-
-    (if (port? fd-or-port)
-        ;; As we store the port in the fdset, there is no need to
-        ;; increment the revealed count to prevent the fd from being
-        ;; closed by a gc'd port.
-        (release-port-handle fd-or-port))
+                 (fileno fd-or-port))))
 
     (ensure-pset-size! set (1+ idx))
     (bytevector-s32-native-set! (pset-pollfds set) off fd)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]