Remove port free functions; just close instead

* libguile/ports.h (scm_t_port_type_flags): Replace
  SCM_PORT_TYPE_HAS_FLUSH with SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC.
  (scm_t_ptob_descriptor): Remove free function.
* libguile/ports.c (scm_set_port_needs_close_on_gc): New function.
  (scm_set_port_flush): Don't set flags.
  (scm_c_make_port_with_encoding, scm_close_port): Use the new flag to
  determine when to add a finalizer and also when to include the port in
  the weak set.
  (scm_set_port_free): Remove.
  (do_close, finalize_port): Close port instead of calling free
  function.
* libguile/r6rs-ports.c (initialize_transcoded_ports):
* libguile/vports.c (scm_make_sfptob):
* libguile/fports.c (scm_make_fptob): Mark these ports as needing close
  on GC.
* libguile/fports.c (fport_free): Remove.
* NEWS: Update.
* doc/ref/api-io.texi (Port Implementation): Update.

NEWS

@@ -24,6 +24,17 @@ as arguments to the `setvbuf' function.
 Port mark functions have not been called since the switch to the BDW
 garbage collector.
 
+** Remove `scm_set_port_free'
+
+It used to be that if an open port became unreachable, a special "free"
+function would be called instead of the "close" function.  Now that the
+BDW-GC collector allows us to run arbitrary code in finalizers, we can
+simplify to just call "close" on the port and remove the separate free
+functions.  Note that hooking into the garbage collector has some
+overhead.  For that reason Guile exposes a new interface,
+`scm_set_port_needs_close_on_gc', allowing port implementations to
+indicate to Guile whether they need closing on GC or not.
+
 
 Changes in 2.1.2 (changes since the 2.1.1 alpha release):
 

doc/ref/api-io.texi

@@ -2303,14 +2303,6 @@ A pointer to a NUL terminated string: the name of the port type.  This
 is the only element of @code{scm_ptob_descriptor} which is not
 a procedure.  Set via the first argument to @code{scm_make_port_type}.
 
-@item free
-Called when the port is collected during gc.  It
-should free any resources used by the port.
-Set using
-
-@deftypefun void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM port))
-@end deftypefun
-
 @item print
 Called when @code{write} is called on the port object, to print a
 port description.  E.g., for an fport it may produce something like:
@@ -2328,13 +2320,21 @@ Not used at present.  Set using
 @end deftypefun
 
 @item close
-Called when the port is closed, unless it was collected during gc.  It
-should free any resources used by the port.
-Set using
+Called when the port is closed.  It should free any resources used by
+the port.  Set using
 
 @deftypefun void scm_set_port_close (scm_t_bits tc, int (*close) (SCM port))
 @end deftypefun
 
+By default, ports that are garbage collected just go away without
+closing.  If your port type needs to release some external resource like
+a file descriptor, or needs to make sure that its internal buffers are
+flushed even if the port is collected while it was open, then mark the
+port type as needing a close on GC.
+
+@deftypefun void scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
+@end deftypefun
+
 @item write
 Accept data which is to be written using the port.  The port implementation
 may choose to buffer the data instead of processing it directly.

libguile/fports.c

@@ -858,19 +858,12 @@ fport_close (SCM port)
   return 0;
 }
 
-static size_t
-fport_free (SCM port)
-{
-  fport_close (port);
-  return 0;
-}
-
 static scm_t_bits
 scm_make_fptob ()
 {
   scm_t_bits tc = scm_make_port_type ("file", fport_fill_input, fport_write);
 
-  scm_set_port_free            (tc, fport_free);
+  scm_set_port_needs_close_on_gc (tc, 1);
   scm_set_port_print           (tc, fport_print);
   scm_set_port_flush           (tc, fport_flush);
   scm_set_port_end_input       (tc, fport_end_input);

libguile/ports.c

@@ -267,12 +267,6 @@ scm_make_port_type (char *name,
   return scm_tc7_port + ptobnum * 256;
 }
 
-void
-scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM))
-{
-  scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->free = free;
-}
-
 void
 scm_set_port_print (scm_t_bits tc, int (*print) (SCM exp, SCM port,
                                                  scm_print_state *pstate))
@@ -293,11 +287,20 @@ scm_set_port_close (scm_t_bits tc, int (*close) (SCM))
 }
 
 void
-scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
+scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p)
 {
   scm_t_ptob_descriptor *ptob = scm_c_port_type_ref (SCM_TC2PTOBNUM (tc));
-  ptob->flush = flush;
-  ptob->flags |= SCM_PORT_TYPE_HAS_FLUSH;
+
+  if (needs_close_p)
+    ptob->flags |= SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC;
+  else
+    ptob->flags &= ~SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC;
+}
+
+void
+scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port))
+{
+  scm_c_port_type_ref (SCM_TC2PTOBNUM (tc))->flush = flush;
 }
 
 void
@@ -633,22 +636,10 @@ SCM scm_i_port_weak_set;
 
 /* Port finalization.  */
 
-struct do_free_data
-{
-  scm_t_ptob_descriptor *ptob;
-  SCM port;
-};
-
 static SCM
-do_free (void *body_data)
+do_close (void *data)
 {
-  struct do_free_data *data = body_data;
-
-  /* `close' is for explicit `close-port' by user.  `free' is for this
-     purpose: ports collected by the GC.  */
-  data->ptob->free (data->port);
-
-  return SCM_BOOL_T;
+  return scm_close_port (SCM_PACK_POINTER (data));
 }
 
 /* Finalize the object (a port) pointed to by PTR.  */
@@ -662,16 +653,8 @@ finalize_port (void *ptr, void *data)
 
   if (SCM_OPENP (port))
     {
-      struct do_free_data data;
-
-      SCM_CLR_PORT_OPEN_FLAG (port);
-
-      data.ptob = SCM_PORT_DESCRIPTOR (port);
-      data.port = port;
-
-      scm_internal_catch (SCM_BOOL_T, do_free, &data,
+      scm_internal_catch (SCM_BOOL_T, do_close, ptr,
                           scm_handle_by_message_noexit, NULL);
-
       scm_gc_ports_collected++;
     }
 }
@@ -732,11 +715,11 @@ scm_c_make_port_with_encoding (scm_t_bits tag, unsigned long mode_bits,
   pti->pending_eof = 0;
   pti->alist = SCM_EOL;
 
-  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)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
+    {
+      scm_i_set_finalizer (SCM2PTR (ret), finalize_port, NULL);
+      scm_weak_set_add_x (scm_i_port_weak_set, ret);
+    }
 
   return ret;
 }
@@ -848,7 +831,7 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
   pti = SCM_PORT_GET_INTERNAL (port);
   SCM_CLR_PORT_OPEN_FLAG (port);
 
-  if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_HAS_FLUSH)
+  if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC)
     scm_weak_set_remove_x (scm_i_port_weak_set, port);
 
   if (SCM_PORT_DESCRIPTOR (port)->close)

libguile/ports.h

@@ -177,14 +177,15 @@ SCM_INTERNAL SCM scm_i_port_weak_set;
 
 
 typedef enum scm_t_port_type_flags {
-  SCM_PORT_TYPE_HAS_FLUSH = 1 << 0
+  /* Indicates that the port should be closed if it is garbage collected
+     while it is open.  */
+  SCM_PORT_TYPE_NEEDS_CLOSE_ON_GC = 1 << 0
 } scm_t_port_type_flags;
 
 /* port-type description.  */
 typedef struct scm_t_ptob_descriptor
 {
   char *name;
-  size_t (*free) (SCM);
   int (*print) (SCM exp, SCM port, scm_print_state *pstate);
   SCM (*equalp) (SCM, SCM);
   int (*close) (SCM port);
@@ -223,13 +224,13 @@ SCM_API scm_t_bits scm_make_port_type (char *name,
 				       void (*write) (SCM port, 
 						      const void *data,
 						      size_t size));
-SCM_API void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM));
 SCM_API void scm_set_port_print (scm_t_bits tc,
 				 int (*print) (SCM exp,
 					       SCM port,
 					       scm_print_state *pstate));
 SCM_API void scm_set_port_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM));
 SCM_API void scm_set_port_close (scm_t_bits tc, int (*close) (SCM));
+SCM_API void scm_set_port_needs_close_on_gc (scm_t_bits tc, int needs_close_p);
 
 SCM_API void scm_set_port_flush (scm_t_bits tc, void (*flush) (SCM port));
 SCM_API void scm_set_port_end_input (scm_t_bits tc,

libguile/r6rs-ports.c

@@ -1249,6 +1249,7 @@ initialize_transcoded_ports (void)
   
   scm_set_port_flush (transcoded_port_type, tp_flush);
   scm_set_port_close (transcoded_port_type, tp_close);
+  scm_set_port_needs_close_on_gc (transcoded_port_type, 1);
 }
 
 SCM_INTERNAL SCM scm_i_make_transcoded_port (SCM);

libguile/vports.c

@@ -225,6 +225,7 @@ scm_make_sfptob ()
 
   scm_set_port_flush (tc, sf_flush);
   scm_set_port_close (tc, sf_close);
+  scm_set_port_needs_close_on_gc (tc, 1);
   scm_set_port_input_waiting (tc, sf_input_waiting);
 
   return tc;