[Guile-commits] 07/18: Remove port free functions; just close instead

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit 67b147fb7a5e8771b0314fcc0fcc826db09d9949
Author: Andy Wingo <address@hidden>
Date:   Sun Apr 3 11:39:21 2016 +0200

    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                  |   11 +++++++++
 doc/ref/api-io.texi   |   22 +++++++++---------
 libguile/fports.c     |    9 +------
 libguile/ports.c      |   59 +++++++++++++++++-------------------------------
 libguile/ports.h      |    7 +++--
 libguile/r6rs-ports.c |    1 +
 libguile/vports.c     |    1 +
 7 files changed, 50 insertions(+), 60 deletions(-)

diff --git a/NEWS b/NEWS
index 0ab0b39..24c43b7 100644
--- a/NEWS
+++ b/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):
 
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 80a2272..c175d2e 100644
--- a/doc/ref/api-io.texi
+++ b/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}.
 
address@hidden free
-Called when the port is collected during gc.  It
-should free any resources used by the port.
-Set using
-
address@hidden void scm_set_port_free (scm_t_bits tc, size_t (*free) (SCM port))
address@hidden 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.
+
address@hidden void scm_set_port_needs_close_on_gc (scm_t_bits tc, int 
needs_close_p)
address@hidden 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.
diff --git a/libguile/fports.c b/libguile/fports.c
index 8ad8ba0..3f4c8cc 100644
--- a/libguile/fports.c
+++ b/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);
diff --git a/libguile/ports.c b/libguile/ports.c
index 3f1b5b1..e42f983 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -268,12 +268,6 @@ scm_make_port_type (char *name,
 }
 
 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)
diff --git a/libguile/ports.h b/libguile/ports.h
index f6c217f..379fba2 100644
--- a/libguile/ports.h
+++ b/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,
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index e4f3b5c..2745602 100644
--- a/libguile/r6rs-ports.c
+++ b/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);
diff --git a/libguile/vports.c b/libguile/vports.c
index 17eac86..c08df2e 100644
--- a/libguile/vports.c
+++ b/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;