port-for-each vs lazy sweep

port-for-each vs lazy sweep

[Kevin Ryde]

I've struck, in 1.8, port-for-each passing a freed cell to its iterator
func.  Eg. "guile -s foo.scm" on

    (define lst '())
    (gc) (gc) (gc)
    (make-list 1000)
    (open-input-file "/etc/passwd")
    (make-list 1000)
    (open-input-file "/etc/passwd")
    (make-list 1000)
    (open-input-file "/etc/passwd")
    (make-list 1000)
    (open-input-file "/etc/passwd")

    (gc)

    (port-for-each (lambda (port)
                     (set! lst (cons port lst))))
    (gc) (gc) (gc)

    (display lst) (newline)

gives

    (#<freed cell 0xb7c3bd20; GC missed a reference> #<freed cell 0xb7c3ed78; GC missed a reference> #<freed cell 0xb7c41558; GC missed a reference> #<input: port-weak.scm 5> #<output: standard error /dev/pts/2> #<output: standard output /dev/pts/2> #<input: standard input /dev/pts/2> #<input-output: string 805d030> #<output: string 805cf70>)


I suspect the opened ports are correctly found to be unused and left
unmarked by the gc, but they remain in the port table.  port-for-each
then passes them to its func and a little later the sweep gets to them
and they turn into freed cells.  (I noticed this when printing ports
from within port-for-each as a diagnostic.)

I suppose either port-for-each should ignore ports which are unmarked
and unswept; or the gc should sweep the port table entries immediately
instead of lazily.  Neither sounds pretty, but the latter might be safer
than letting zombies remain in the port table.  I suspect for instance
`flush-all' could suffer the same problem if it does a callback to a
soft port flush function (or a C code ptob flush func if that somehow
provoked some sweeping).

(This got me wondering why there's a port table anyway, instead of
independent objects with say a weak hash table for the "list of all
ports" needed by port-for-each and flush-all.  Historical reasons I
suppose.)


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> I suppose either port-for-each should ignore ports which are unmarked
> and unswept; or the gc should sweep the port table entries immediately
> instead of lazily.  Neither sounds pretty, but the latter might be safer
> than letting zombies remain in the port table.

In the latter case, GC would modify the port table, potentially beneath
the feet of functions that iterate over it, or that cached indices
within the table, things like that.  So the former would seem safer,
wouldn't it?

> I suspect for instance
> `flush-all' could suffer the same problem if it does a callback to a
> soft port flush function (or a C code ptob flush func if that somehow
> provoked some sweeping).

Indeed.

> (This got me wondering why there's a port table anyway, instead of
> independent objects with say a weak hash table for the "list of all
> ports" needed by port-for-each and flush-all.  Historical reasons I
> suppose.)

Why don't we remove it in HEAD?  :-)

Furthermore, `port-for-each' is questionable from a security viewpoint,
and I'm not sure it's very useful either (I haven't checked its current
uses, though).

Thanks,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Kevin Ryde]

ludovic.courtes@laas.fr (Ludovic Courtès) writes:
>
> In the latter case, GC would modify the port table, potentially beneath
> the feet of functions that iterate over it, or that cached indices
> within the table, things like that.

I think you're meant to hold scm_i_port_table_mutex if looking at or
modifying the table.  Probably have to make sure not to provoke a gc
during that, something I think flush-all doesn't ensure.  (Maybe ought
to rewrite flush-all in terms of port-for-each.)


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 380 bytes --]

Actually I see the flush func of a soft port is entirely unused, it's
never called by a force-output because nothing is ever put in the port
buffer as such.  The manual could be clearer about what it's supposed to
be for :-(.

At any rate, I put in the failing test below for port-for-each, and I
think flush-all could benefit from the rewrite below, just on general
principles.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: ports.test.diff --]
[-- Type: text/x-diff, Size: 1397 bytes --]

--- ports.test	27 Jan 2007 11:06:20 +1100	1.33.2.5
+++ ports.test	22 Aug 2007 16:43:39 +1000	
@@ -550,6 +550,38 @@
       (eqv? n (port-line port)))))
 
 ;;;
+;;; port-for-each
+;;;
+
+(with-test-prefix "port-for-each"
+
+  ;; In guile 1.8.0 through 1.8.2, port-for-each could pass a freed cell to
+  ;; its iterator func if a port was inaccessible in the last gc mark but
+  ;; the lazy sweeping has not yet reached it to remove it from the port
+  ;; table (scm_i_port_table).  Provoking those gc conditions is a little
+  ;; tricky, but the following code made it happen in 1.8.2.
+  (pass-if "passing freed cell"
+    (throw 'unresolved)
+    (let ((lst '()))
+      ;; clear out the heap
+      (gc) (gc) (gc)
+      ;; allocate cells so the opened ports aren't at the start of the heap
+      (make-list 1000)
+      (open-input-file "/dev/null")
+      (make-list 1000)
+      (open-input-file "/dev/null")
+      ;; this gc leaves the above ports unmarked, ie. inaccessible
+      (gc)
+      ;; but they're still in the port table, so this sees them
+      (port-for-each (lambda (port)
+		       (set! lst (cons port lst))))
+      ;; this forces completion of the sweeping
+      (gc) (gc) (gc)
+      ;; and (if the bug is present) the cells accumulated in LST are now
+      ;; freed cells, which give #f from `port?'
+      (not (memq #f (map port? lst))))))
+
+;;;
 ;;; seek
 ;;;
 

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: ports.c.flush-all.diff --]
[-- Type: text/x-diff, Size: 1040 bytes --]

--- ports.c	27 Jan 2007 10:51:48 +1100	1.204.2.14
+++ ports.c	21 Aug 2007 17:02:53 +1000	
@@ -929,25 +929,26 @@
 }
 #undef FUNC_NAME
 
+
+static void
+scm_flush_all_ports_one (void *dummy, SCM port)
+{
+  if (SCM_OPOUTPORTP (port))
+    scm_flush (port);
+}
+
 SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
             (),
 	    "Equivalent to calling @code{force-output} on\n"
 	    "all open output ports.  The return value is unspecified.")
 #define FUNC_NAME s_scm_flush_all_ports
 {
-  size_t i;
-
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  for (i = 0; i < scm_i_port_table_size; i++)
-    {
-      if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
-	scm_flush (scm_i_port_table[i]->port);
-    }
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  scm_c_port_for_each (scm_flush_all_ports_one);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+
 SCM_DEFINE (scm_read_char, "read-char", 0, 1, 0,
            (SCM port),
 	    "Return the next character available from @var{port}, updating\n"

[-- Attachment #4: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi,

Kevin Ryde <user42@zip.com.au> writes:

> Actually I see the flush func of a soft port is entirely unused, it's
> never called by a force-output because nothing is ever put in the port
> buffer as such.  The manual could be clearer about what it's supposed to
> be for :-(.

Maybe that's a bug, maybe it was meant to be called.  We could fix this
in HEAD, but maybe not in 1.8, in case programs rely on it.

> At any rate, I put in the failing test below for port-for-each, and I
> think flush-all could benefit from the rewrite below, just on general
> principles.

I agree with the latter.

> +(with-test-prefix "port-for-each"
> +
> +  ;; In guile 1.8.0 through 1.8.2, port-for-each could pass a freed cell to
> +  ;; its iterator func if a port was inaccessible in the last gc mark but
> +  ;; the lazy sweeping has not yet reached it to remove it from the port
> +  ;; table (scm_i_port_table).  Provoking those gc conditions is a little
> +  ;; tricky, but the following code made it happen in 1.8.2.
> +  (pass-if "passing freed cell"
> +    (throw 'unresolved)

The above line should be removed.  :-)

Once this line is removed, the test fails consistently here (HEAD),
which is good news I suppose.

> +      (open-input-file "/dev/null")

`(%make-void-port "r")' would have the same effect but would be more
portable.

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Han-Wen Nienhuys]

Kevin Ryde escreveu:
> (This got me wondering why there's a port table anyway, instead of
> independent objects with say a weak hash table for the "list of all
> ports" needed by port-for-each and flush-all.  Historical reasons I
> suppose.)

I'm hacking at a patch to junk the table for a weak hash right now.
Stay tuned.

-- 
 Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Han-Wen Nienhuys]

[-- Attachment #1: Type: text/plain, Size: 260 bytes --]

Kevin Ryde escreveu:
> I've struck, in 1.8, port-for-each passing a freed cell to its iterator
> func.  Eg. "guile -s foo.scm" on


Hi,

Please see the patch attached.  Comments welcome.

-- 
 Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen

[-- Attachment #2: ports.patch --]
[-- Type: text/x-patch, Size: 16949 bytes --]

diff --git a/libguile/fports.c b/libguile/fports.c
index 010e5dd..a1c6483 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -31,6 +31,7 @@
 #include "libguile/gc.h"
 #include "libguile/posix.h"
 #include "libguile/dynwind.h"
+#include "libguile/hashtab.h"
 
 #include "libguile/fports.h"
 
@@ -220,32 +221,35 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
 /* Move ports with the specified file descriptor to new descriptors,
  * resetting the revealed count to 0.
  */
-
-void
-scm_evict_ports (int fd)
+static SCM
+scm_i_evict_port (SCM handle, void *closure)
 {
-  long i;
-
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  int fd = * (int*) closure;
+  SCM port = SCM_CDR(handle);
 
-  for (i = 0; i < scm_i_port_table_size; i++)
+  if (SCM_FPORTP (port))
     {
-      SCM port = scm_i_port_table[i]->port;
+      scm_t_fport *fp = SCM_FSTREAM (port);
 
-      if (SCM_FPORTP (port))
+      if (fp->fdes == fd)
 	{
-	  scm_t_fport *fp = SCM_FSTREAM (port);
-
-	  if (fp->fdes == fd)
-	    {
-	      fp->fdes = dup (fd);
-	      if (fp->fdes == -1)
-		scm_syserror ("scm_evict_ports");
-	      scm_set_port_revealed_x (port, scm_from_int (0));
-	    }
+	  fp->fdes = dup (fd);
+	  if (fp->fdes == -1)
+	    scm_syserror ("scm_evict_ports");
+	  scm_set_port_revealed_x (port, scm_from_int (0));
 	}
     }
 
+  return handle;
+}
+
+void
+scm_evict_ports (int fd)
+{
+  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
+  scm_internal_hash_for_each_handle (&scm_i_evict_port,
+				     (void*) &fd,
+				     scm_i_port_doubly_weak_hash);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 }
 
diff --git a/libguile/gc-card.c b/libguile/gc-card.c
index 0639230..7fa1c7c 100644
--- a/libguile/gc-card.c
+++ b/libguile/gc-card.c
@@ -206,8 +206,7 @@ scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
 		}
 
 	      SCM_SETSTREAM (scmptr, 0);
-	      scm_remove_from_port_table (scmptr);
-	      scm_gc_ports_collected++;
+	      scm_i_remove_port (scmptr);
 	      SCM_CLR_PORT_OPEN_FLAG (scmptr);
 	    }
 	  break;
diff --git a/libguile/gc.c b/libguile/gc.c
index 9150989..12a0b58 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -232,7 +232,6 @@ static unsigned long protected_obj_count = 0;
 /* The following are accessed from `gc-malloc.c' and `gc-card.c'.  */
 int scm_gc_malloc_yield_percentage = 0;
 unsigned long scm_gc_malloc_collected = 0;
-unsigned long scm_gc_ports_collected = 0;
 
 
 SCM_SYMBOL (sym_cells_allocated, "cells-allocated");
@@ -443,7 +442,6 @@ gc_start_stats (const char *what SCM_UNUSED)
   t_before_gc = scm_c_get_internal_run_time ();
 
   scm_gc_malloc_collected = 0;
-  scm_gc_ports_collected = 0;
 }
 
 static void
@@ -971,14 +969,7 @@ scm_init_storage ()
   scm_gc_init_malloc ();
 
   j = SCM_HEAP_SEG_SIZE;
-
   
-  /* Initialise the list of ports.  */
-  scm_i_port_table = (scm_t_port **)
-    malloc (sizeof (scm_t_port *) * scm_i_port_table_room);
-  if (!scm_i_port_table)
-    return 1;
-
 #if 0
   /* We can't have a cleanup handler since we have no thread to run it
      in. */
diff --git a/libguile/gc.h b/libguile/gc.h
index 78ff024..d3c9959 100644
--- a/libguile/gc.h
+++ b/libguile/gc.h
@@ -278,7 +278,6 @@ SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist;
 SCM_API struct scm_t_cell_type_statistics scm_i_master_freelist2;
 
 SCM_API unsigned long scm_gc_malloc_collected;
-SCM_API unsigned long scm_gc_ports_collected;
 SCM_API unsigned long scm_cells_allocated;
 SCM_API int scm_gc_malloc_yield_percentage;
 SCM_API unsigned long scm_mallocated;
diff --git a/libguile/init.c b/libguile/init.c
index ff69ab9..fe7df3a 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -395,6 +395,14 @@ really_cleanup_for_exit (void *unused)
 static void
 cleanup_for_exit ()
 {
+  if (scm_i_pthread_mutex_trylock (&scm_i_init_mutex) == 0)
+    scm_i_pthread_mutex_unlock (&scm_i_init_mutex);
+  else
+    {
+      fprintf(stderr, "Cannot exit gracefully when init is in progress; aborting.\n");
+      abort();
+    }
+
   /* This function might be called in non-guile mode, so we need to
      enter it temporarily. 
   */
@@ -472,6 +480,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_backtrace ();	/* Requires fluids */
   scm_init_fports ();
   scm_init_strports ();
+  scm_init_ports ();
   scm_init_gdbint ();           /* Requires strports */
   scm_init_hash ();
   scm_init_hashtab ();
@@ -490,7 +499,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_numbers ();
   scm_init_options ();
   scm_init_pairs ();
-  scm_init_ports ();
 #ifdef HAVE_POSIX
   scm_init_filesys ();
   scm_init_posix ();
diff --git a/libguile/ioext.c b/libguile/ioext.c
index fd232e4..9aaf7ac 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -26,13 +26,14 @@
 #include <errno.h>
 
 #include "libguile/_scm.h"
-#include "libguile/ioext.h"
-#include "libguile/fports.h"
+#include "libguile/dynwind.h"
 #include "libguile/feature.h"
+#include "libguile/fports.h"
+#include "libguile/hashtab.h"
+#include "libguile/ioext.h"
 #include "libguile/ports.h"
 #include "libguile/strings.h"
 #include "libguile/validate.h"
-#include "libguile/dynwind.h"
 
 #include <fcntl.h>
 
@@ -266,6 +267,19 @@ SCM_DEFINE (scm_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM
+get_matching_port (void *closure, SCM key, SCM port, SCM result)
+{
+  int fd = * (int *) closure;
+  scm_t_port *entry = SCM_PTAB_ENTRY (port);
+  
+  if (SCM_OPFPORTP (port)
+      && ((scm_t_fport *) entry->stream)->fdes == fd)
+    result = scm_cons (port, result);
+
+  return result;
+}
+
 /* Return a list of ports using a given file descriptor.  */
 SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0, 
            (SCM fd),
@@ -275,18 +289,12 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
 #define FUNC_NAME s_scm_fdes_to_ports
 {
   SCM result = SCM_EOL;
-  int int_fd;
-  long i;
-
-  int_fd = scm_to_int (fd);
+  int int_fd = scm_to_int (fd);
 
   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  for (i = 0; i < scm_i_port_table_size; i++)
-    {
-      if (SCM_OPFPORTP (scm_i_port_table[i]->port)
-	  && ((scm_t_fport *) scm_i_port_table[i]->stream)->fdes == int_fd)
-	result = scm_cons (scm_i_port_table[i]->port, result);
-    }
+  result = scm_internal_hash_fold (get_matching_port,
+				   (void*) &int_fd, result, 
+				   scm_i_port_doubly_weak_hash);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
   return result;
 }
diff --git a/libguile/ports.c b/libguile/ports.c
index b1a25aa..5b5f363 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -40,12 +40,14 @@
 #include "libguile/dynwind.h"
 
 #include "libguile/keywords.h"
+#include "libguile/hashtab.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
 #include "libguile/mallocs.h"
 #include "libguile/validate.h"
 #include "libguile/ports.h"
 #include "libguile/vectors.h"
+#include "libguile/weaks.h"
 #include "libguile/fluids.h"
 
 #ifdef HAVE_STRING_H
@@ -86,7 +88,7 @@
 
 
 /* scm_ptobs scm_numptob
- * implement a dynamicly resized array of ptob records.
+ * implement a dynamically resized array of ptob records.
  * Indexes into this table are used when generating type
  * tags for smobjects (if you know a tag you can get an index and conversely).
  */
@@ -485,10 +487,11 @@ scm_i_dynwind_current_load_port (SCM port)
 \f
 /* The port table --- an array of pointers to ports.  */
 
-scm_t_port **scm_i_port_table;
-
-long scm_i_port_table_size = 0;	/* Number of ports in scm_i_port_table.  */
-long scm_i_port_table_room = 20;	/* Size of the array.  */
+/*
+  We need a global registry of ports to flush them all at exit, and to
+  get all the ports matching a file descriptor.
+ */
+SCM scm_i_port_doubly_weak_hash;
 
 scm_i_pthread_mutex_t scm_i_port_table_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
@@ -505,29 +508,16 @@ scm_new_port_table_entry (scm_t_bits tag)
   
   SCM z = scm_cons (SCM_EOL, SCM_EOL);
   scm_t_port *entry = (scm_t_port *) scm_gc_calloc (sizeof (scm_t_port), "port");
-  if (scm_i_port_table_size == scm_i_port_table_room)
-    {
-      /* initial malloc is in gc.c.  this doesn't use scm_gc_malloc etc.,
-	 since it can never be freed during gc.  */
-      void *newt = scm_realloc ((char *) scm_i_port_table,
-				(size_t) (sizeof (scm_t_port *)
-					  * scm_i_port_table_room * 2));
-      scm_i_port_table = (scm_t_port **) newt;
-      scm_i_port_table_room *= 2;
-    }
-
-  entry->entry = scm_i_port_table_size;
 
   entry->file_name = SCM_BOOL_F;
   entry->rw_active = SCM_PORT_NEITHER;
-
-  scm_i_port_table[scm_i_port_table_size] = entry;
-  scm_i_port_table_size++;
-
   entry->port = z;
+
   SCM_SET_CELL_TYPE(z, tag);
   SCM_SETPTAB_ENTRY(z, entry);
-  
+
+  scm_hashq_set_x (scm_i_port_doubly_weak_hash, z, z);
+
   return z;
 }
 #undef FUNC_NAME
@@ -542,7 +532,7 @@ scm_add_to_port_table (SCM port)
   pt->port = port;
   SCM_SETCAR(z, SCM_EOL);
   SCM_SETCDR(z, SCM_EOL);
-  SCM_SETPTAB_ENTRY (port, pt);
+  SCM_SETPTAB_ENTRY(port, pt);
   return pt;
 }
 #endif
@@ -551,33 +541,21 @@ 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
-scm_remove_from_port_table (SCM port)
-#define FUNC_NAME "scm_remove_from_port_table"
+scm_i_remove_port (SCM port)
+#define FUNC_NAME "scm_remove_port"
 {
   scm_t_port *p = SCM_PTAB_ENTRY (port);
-  long i = p->entry;
-
-  if (i >= scm_i_port_table_size)
-    SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port));
   if (p->putback_buf)
     scm_gc_free (p->putback_buf, p->putback_buf_size, "putback buffer");
   scm_gc_free (p, sizeof (scm_t_port), "port");
-  /* Since we have just freed slot i we can shrink the table by moving
-     the last entry to that slot... */
-  if (i < scm_i_port_table_size - 1)
-    {
-      scm_i_port_table[i] = scm_i_port_table[scm_i_port_table_size - 1];
-      scm_i_port_table[i]->entry = i;
-    }
+
   SCM_SETPTAB_ENTRY (port, 0);
-  scm_i_port_table_size--;
+  scm_hashq_remove_x (scm_i_port_doubly_weak_hash, port);
 }
 #undef FUNC_NAME
 
 
-#ifdef GUILE_DEBUG
 /* Functions for debugging.  */
 
 SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
@@ -586,26 +564,10 @@ SCM_DEFINE (scm_pt_size, "pt-size", 0, 0, 0,
 	    "is only included in @code{--enable-guile-debug} builds.")
 #define FUNC_NAME s_scm_pt_size
 {
-  return scm_from_int (scm_i_port_table_size);
+  return scm_from_int (SCM_HASHTABLE_N_ITEMS (scm_i_port_doubly_weak_hash));
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_pt_member, "pt-member", 1, 0, 0,
-            (SCM index),
-	    "Return the port at @var{index} in the port table.\n"
-	    "@code{pt-member} is only included in\n"
-	    "@code{--enable-guile-debug} builds.")
-#define FUNC_NAME s_scm_pt_member
-{
-  size_t i = scm_to_size_t (index);
-  if (i >= scm_i_port_table_size)
-    return SCM_BOOL_F;
-  else
-    return scm_i_port_table[i]->port;
-}
-#undef FUNC_NAME
-#endif
-
 void
 scm_port_non_buffer (scm_t_port *pt)
 {
@@ -762,7 +724,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
   else
     rv = 0;
   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  scm_remove_from_port_table (port);
+  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);
@@ -800,10 +762,20 @@ SCM_DEFINE (scm_close_output_port, "close-output-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+static SCM
+scm_i_collect_values_in_vector (void *closure, SCM key, SCM value, SCM result)
+{
+  int *i = (int*) closure;
+  scm_c_vector_set_x (result, *i, value);
+  (*i)++;
+
+  return result;
+}
+
 void
 scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
 {
-  long i;
+  int i = 0;
   size_t n;
   SCM ports;
 
@@ -813,20 +785,20 @@ scm_c_port_for_each (void (*proc)(void *data, SCM p), void *data)
      collect the ports into a vector. -mvo */
 
   scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  n = scm_i_port_table_size;
+  n = SCM_HASHTABLE_N_ITEMS (scm_i_port_doubly_weak_hash);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
-
   ports = scm_c_make_vector (n, SCM_BOOL_F);
 
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  if (n > scm_i_port_table_size)
-    n = scm_i_port_table_size;
-  for (i = 0; i < n; i++)
-    SCM_SIMPLE_VECTOR_SET (ports, i, scm_i_port_table[i]->port);
+  scm_i_pthread_mutex_lock (&scm_i_port_table_mutex);
+  ports = scm_internal_hash_fold (scm_i_collect_values_in_vector, &i,
+				  ports, scm_i_port_doubly_weak_hash);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 
-  for (i = 0; i < n; i++)
-    proc (data, SCM_SIMPLE_VECTOR_REF (ports, i));
+  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);
 }
@@ -929,21 +901,22 @@ SCM_DEFINE (scm_force_output, "force-output", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+
+static void
+flush_output_port (void *closure, SCM handle)
+{
+  SCM port = SCM_CDR(handle);
+  if (SCM_OPOUTPORTP (port))
+    scm_flush (port);
+}
+
 SCM_DEFINE (scm_flush_all_ports, "flush-all-ports", 0, 0, 0,
             (),
 	    "Equivalent to calling @code{force-output} on\n"
 	    "all open output ports.  The return value is unspecified.")
 #define FUNC_NAME s_scm_flush_all_ports
 {
-  size_t i;
-
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  for (i = 0; i < scm_i_port_table_size; i++)
-    {
-      if (SCM_OPOUTPORTP (scm_i_port_table[i]->port))
-	scm_flush (scm_i_port_table[i]->port);
-    }
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  scm_c_port_for_each (&flush_output_port, NULL);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1725,6 +1698,8 @@ scm_init_ports ()
   cur_errport_fluid = scm_permanent_object (scm_make_fluid ());
   cur_loadport_fluid = scm_permanent_object (scm_make_fluid ());
 
+  scm_i_port_doubly_weak_hash = scm_permanent_object (scm_make_doubly_weak_hash_table(SCM_I_MAKINUM(31)));
+  
 #include "libguile/ports.x"
 }
 
diff --git a/libguile/ports.h b/libguile/ports.h
index ab04490..ecc4d81 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -47,7 +47,6 @@ typedef enum scm_t_port_rw_active {
 typedef struct 
 {
   SCM port;			/* Link back to the port object.  */
-  long entry;			/* Index in port table. */
   int revealed;			/* 0 not revealed, > 1 revealed.
 				 * Revealed ports do not get GC'd.
 				 */
@@ -109,9 +108,10 @@ typedef struct
   size_t putback_buf_size;        /* allocated size of putback_buf.  */
 } scm_t_port;
 
-SCM_API scm_t_port **scm_i_port_table;
-SCM_API long scm_i_port_table_size; /* Number of ports in scm_i_port_table.  */
+
 SCM_API scm_i_pthread_mutex_t scm_i_port_table_mutex;
+SCM_API SCM scm_i_port_doubly_weak_hash;
+
 
 #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end)
 
@@ -241,7 +241,7 @@ 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_API void scm_remove_from_port_table (SCM port);
+SCM_API 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/weaks.h b/libguile/weaks.h
index ec9e7b4..bf854d5 100644
--- a/libguile/weaks.h
+++ b/libguile/weaks.h
@@ -70,6 +70,7 @@ SCM_API void scm_i_mark_weak_vector (SCM w);
 SCM_API int scm_i_mark_weak_vectors_non_weaks (void);
 SCM_API void scm_i_remove_weaks_from_weak_vectors (void);
 
+
 #endif  /* SCM_WEAKS_H */
 
 /*
diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4
index d921e67..2395b4c 100644
--- a/m4/gnulib-cache.m4
+++ b/m4/gnulib-cache.m4
@@ -23,6 +23,7 @@ gl_MODULES([alloca strcase])
 gl_AVOID([])
 gl_SOURCE_BASE([lib])
 gl_M4_BASE([m4])
+gl_PO_BASE([])
 gl_DOC_BASE([doc])
 gl_TESTS_BASE([tests])
 gl_LIB([libgnu])
@@ -30,3 +31,4 @@ gl_LGPL
 gl_MAKEFILE_NAME([])
 gl_LIBTOOL
 gl_MACRO_PREFIX([gl])
+gl_PO_DOMAIN([])
diff --git a/test-suite/tests/ports.test b/test-suite/tests/ports.test
index 54eb727..f1ba80b 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -561,7 +561,6 @@
   ;; table (scm_i_port_table).  Provoking those gc conditions is a little
   ;; tricky, but the following code made it happen in 1.8.2.
   (pass-if "passing freed cell"
-    (throw 'unresolved)
     (let ((lst '()))
       ;; clear out the heap
       (gc) (gc) (gc)
@@ -581,6 +580,13 @@
       ;; freed cells, which give #f from `port?'
       (not (memq #f (map port? lst))))))
 
+(with-test-prefix
+ "fdes->port"
+ (pass-if "fdes->ports finds port"
+	  (let ((port (open-file (test-file) "w")))
+
+	    (not (not (memq port (fdes->ports (port->fdes port))))))))
+
 ;;;
 ;;; seek
 ;;;

[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> @@ -472,6 +480,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
>    scm_init_backtrace ();	/* Requires fluids */
>    scm_init_fports ();
>    scm_init_strports ();
> +  scm_init_ports ();
>    scm_init_gdbint ();           /* Requires strports */
>    scm_init_hash ();
>    scm_init_hashtab ();
> @@ -490,7 +499,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
>    scm_init_numbers ();
>    scm_init_options ();
>    scm_init_pairs ();
> -  scm_init_ports ();

Why does it need to be moved?

> +/*
> +  We need a global registry of ports to flush them all at exit, and to
> +  get all the ports matching a file descriptor.
> + */
> +SCM scm_i_port_doubly_weak_hash;

[...]

> -  SCM_SETPTAB_ENTRY (port, pt);
> +  SCM_SETPTAB_ENTRY(port, pt);

Please follow GNU style.

> -#ifdef GUILE_DEBUG
>  /* Functions for debugging.  */

Why remove the `#ifdef'?

> --- a/m4/gnulib-cache.m4
> +++ b/m4/gnulib-cache.m4
> @@ -23,6 +23,7 @@ gl_MODULES([alloca strcase])
>  gl_AVOID([])
>  gl_SOURCE_BASE([lib])
>  gl_M4_BASE([m4])
> +gl_PO_BASE([])

This is unrelated.

BTW, instead of using a doubly-weak hash and do
"scm_hashq_set_x (scm_i_port_doubly_weak_hash, z, z);", maybe using a
weak-key hash table and `#t' as the value would to.  "scm_i_port_hash"
might be a better name, too.

At any rate, that's certainly an improvement.  I think this should go in
HEAD, but probably not in 1.8.

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:
>> @@ -472,6 +480,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
>>    scm_init_backtrace ();	/* Requires fluids */
>>    scm_init_fports ();
>>    scm_init_strports ();
>> +  scm_init_ports ();
>>    scm_init_gdbint ();           /* Requires strports */
>>    scm_init_hash ();
>>    scm_init_hashtab ();
>> @@ -490,7 +499,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
>>    scm_init_numbers ();
>>    scm_init_options ();
>>    scm_init_pairs ();
>> -  scm_init_ports ();
> 
> Why does it need to be moved?

because gdb instantiates a port; I forgot why it used to work
though.

>> -  SCM_SETPTAB_ENTRY (port, pt);
>> +  SCM_SETPTAB_ENTRY(port, pt);
> 
> Please follow GNU style.

I have the impression that GUILE isn't really consistent 

[lilydev@haring libguile]$ grep '[A-Z](' *c|grep -v define|wc
    394    2037   24632
[lilydev@haring libguile]$ grep '[a-z](' *c|grep -v define|wc
    490    3038   28008

time for a grand search & replace patch?

>> -#ifdef GUILE_DEBUG
>>  /* Functions for debugging.  */
> 
> Why remove the `#ifdef'?

oops.

> 
>> --- a/m4/gnulib-cache.m4
>> +++ b/m4/gnulib-cache.m4
>> @@ -23,6 +23,7 @@ gl_MODULES([alloca strcase])
>>  gl_AVOID([])
>>  gl_SOURCE_BASE([lib])
>>  gl_M4_BASE([m4])
>> +gl_PO_BASE([])
> 
> This is unrelated.

yes, I know. Too lazy to strip this from the output.  But won't apply to CVS.

-- 
 Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> Ludovic Courtès escreveu:
>>> @@ -472,6 +480,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
>>>    scm_init_backtrace ();	/* Requires fluids */
>>>    scm_init_fports ();
>>>    scm_init_strports ();
>>> +  scm_init_ports ();
>>>    scm_init_gdbint ();           /* Requires strports */
>>>    scm_init_hash ();
>>>    scm_init_hashtab ();
>>> @@ -490,7 +499,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
>>>    scm_init_numbers ();
>>>    scm_init_options ();
>>>    scm_init_pairs ();
>>> -  scm_init_ports ();
>> 
>> Why does it need to be moved?
>
> because gdb instantiates a port; I forgot why it used to work
> though.

You mean `gdbint.c', right?  Anyway, it would be better as a separate
patch.

>>> -  SCM_SETPTAB_ENTRY (port, pt);
>>> +  SCM_SETPTAB_ENTRY(port, pt);
>> 
>> Please follow GNU style.
>
> I have the impression that GUILE isn't really consistent 

That's not a valid excuse.  :-)

In addition, the above diff excerpt is altering well-formatted code for
no reason.

> time for a grand search & replace patch?

I don't think it'd be a good idea.  Let's just try to be consistent with
new code that goes in.

Thanks,
Ludovic.



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Han-Wen Nienhuys]

Ludovic Courtès escreveu:
> At any rate, that's certainly an improvement.  I think this should go in
> HEAD, but probably not in 1.8.

Applied, with corrections.


-- 
 Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen



_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi Han-Wen,

Han-Wen Nienhuys <hanwen@xs4all.nl> writes:

> Applied, with corrections.

I noticed the (supposedly related) regression compared to 1.8.  Consider
this program:

  (define p (open-output-file "TEST-FILE"))

  (setvbuf p _IOFBF 16384)

  (write "hello" p)

When running it with "guile-1.8 the-program.scm", `TEST-FILE' contains
the string "hello" upon completion.  However, with HEAD, `TEST-FILE' is
empty.

Can you try to see if it somehow relates to your patch?

(I suspect that ports used to be flushed when reclaimed, which is no
longer the case with the weak hash table.)

Thanks in advance,
Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Han-Wen Nienhuys]

[-- Attachment #1: Type: text/plain, Size: 898 bytes --]

Hi,

unfortunately, I'm traveling these two weeks, so I have little
opportunity to look at this right now.

2007/9/3, Ludovic Courtès <ludovic.courtes@laas.fr>:
> Hi Han-Wen,
>
> Han-Wen Nienhuys <hanwen@xs4all.nl> writes:
>
> > Applied, with corrections.
>
> I noticed the (supposedly related) regression compared to 1.8.  Consider
> this program:
>
>   (define p (open-output-file "TEST-FILE"))
>
>   (setvbuf p _IOFBF 16384)
>
>   (write "hello" p)
>
> When running it with "guile-1.8 the-program.scm", `TEST-FILE' contains
> the string "hello" upon completion.  However, with HEAD, `TEST-FILE' is
> empty.
>
> Can you try to see if it somehow relates to your patch?
>
> (I suspect that ports used to be flushed when reclaimed, which is no
> longer the case with the weak hash table.)
>
> Thanks in advance,
> Ludovic.
>


-- 
Han-Wen Nienhuys - hanwen@xs4all.nl - http://www.xs4all.nl/~hanwen

[-- Attachment #2: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

Hi,

ludovic.courtes@laas.fr (Ludovic Courtès) writes:

> (I suspect that ports used to be flushed when reclaimed, which is no
> longer the case with the weak hash table.)

Another unpleasant side effect is this:

  $ guile-config link
  -pthread -lguile -lltdl -L/usr/local/lib -lgmp -lcrypt -lm -lltdl
  $ echo `guile-config link`
  [no output]

This makes the M4 macros fail...

Ludovic.


_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 474 bytes --]

Hi,

ludovic.courtes@laas.fr (Ludovic Courtès) writes:

> I noticed the (supposedly related) regression compared to 1.8.  Consider
> this program:
>
>   (define p (open-output-file "TEST-FILE"))
>
>   (setvbuf p _IOFBF 16384)
>
>   (write "hello" p)
>
> When running it with "guile-1.8 the-program.scm", `TEST-FILE' contains
> the string "hello" upon completion.  However, with HEAD, `TEST-FILE' is
> empty.

I finally fixed this one (see attached file).

Thanks,
Ludovic.


[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 642 bytes --]

--- orig/libguile/ChangeLog
+++ mod/libguile/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-01  Ludovic Courtès  <ludo@gnu.org>
+
+	* ports.c (flush_output_port): Expect directly a port instead of
+	a pair.  Fixes a bug in the new port table (2007-08-26).
+
 2007-09-11  Kevin Ryde  <user42@zip.com.au>
 
 	* posix.c (scm_putenv): Confine the putenv("NAME=") bit to mingw, use


--- orig/libguile/ports.c
+++ mod/libguile/ports.c
@@ -904,9 +904,8 @@
 
 
 static void
-flush_output_port (void *closure, SCM handle)
+flush_output_port (void *closure, SCM port)
 {
-  SCM port = SCM_CDR (handle);
   if (SCM_OPOUTPORTP (port))
     scm_flush (port);
 }




[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel

Re: port-for-each vs lazy sweep

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 111 bytes --]

Hi,

I just fixed another bug (similar to the previous one) in the new port
table, in HEAD.

Thanks,
Ludovic.


[-- Attachment #2: The patch --]
[-- Type: text/x-patch, Size: 1723 bytes --]

--- orig/libguile/ChangeLog
+++ mod/libguile/ChangeLog
@@ -1,3 +1,9 @@
+2007-10-27  Ludovic Courtès  <ludo@gnu.org>
+
+	* fports.c (scm_i_evict_port): Expect a port, rather than a pair
+	containing the port.  Fixes a bug in the new port table (2007-08-26).
+	(scm_evict_ports): Use `scm_c_port_for_each ()'.
+
 2007-10-21  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* eval.c (unmemoize_delay): Extend the environment before
--- orig/libguile/fports.c
+++ mod/libguile/fports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2007 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
@@ -221,11 +221,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1
 /* Move ports with the specified file descriptor to new descriptors,
  * resetting the revealed count to 0.
  */
-static SCM
-scm_i_evict_port (SCM handle, void *closure)
+static void
+scm_i_evict_port (void *closure, SCM port)
 {
   int fd = * (int*) closure;
-  SCM port = SCM_CAR (handle);
 
   if (SCM_FPORTP (port))
     {
@@ -239,18 +238,12 @@ scm_i_evict_port (SCM handle, void *clos
 	  scm_set_port_revealed_x (port, scm_from_int (0));
 	}
     }
-
-  return handle;
 }
 
 void
 scm_evict_ports (int fd)
 {
-  scm_i_scm_pthread_mutex_lock (&scm_i_port_table_mutex);
-  scm_internal_hash_for_each_handle (&scm_i_evict_port,
-				     (void*) &fd,
-				     scm_i_port_weak_hash);
-  scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
+  scm_c_port_for_each (scm_i_evict_port, (void *) &fd);
 }
 
 


[-- Attachment #3: Type: text/plain, Size: 143 bytes --]

_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel