Subject: bug#20209: GUILE 2.0.11: crash in set_port_filename_x for bytevector ports

From: Andy Wingo <[email-masked]>
Date: Thu, 23 Jun 2016 18:34:09 +0200

On Sun 29 Mar 2015 15:06, [email-masked] (Ludovic Courtès) writes:

> Mark H Weaver <[email-masked]> skribis:
>
>> For these reasons, I decided against recommending those undocumented
>> initialization functions.  Instead, I suggested that David initialize
>> binary ports by loading (ice-9 binary-ports):
>>
>>   (void) scm_c_resolve_module ("ice-9 binary-ports");
>
> That sounds like the best option, indeed.
>
>> For Guile 2.0.12, I suggest that we unconditionally do the equivalent of
>> 'scm_init_bytevectors' and 'scm_init_r6rs_ports' during Guile
>> initialization, and make those functions into deprecated no-ops.
>
> Agreed, that’s what I was going to suggest.
>
> That these init functions are not marked as internal is really an
> oversight.
>
> I wouldn’t be against simply making them SCM_INTERNAL in 2.0.12, but
> making them public + deprecated as you suggest is even better.

WDYT about something like this?

>From f763f353e438de985577ef4b88b805bd4d4c9b77 Mon Sep 17 00:00:00 2001
From: Andy Wingo <[email-masked]>
Date: Thu, 23 Jun 2016 18:31:55 +0200
Subject: [PATCH] Register R6RS port and bytevector internals early

* libguile/bytevectors.c (sym_big, sym_little): Rename from scm_sym_big
  and scm_sym_little, and don't use the snarf mechanism as we need to
  initialize this value eagerly in case the C API is used before the
  Scheme module is loaded.
  (scm_bootstrap_bytevectors): Initialize the endianness symbols here.
* libguile/r6rs-ports.c (scm_register_r6rs_ports): Register the R6RS
  port kinds here, for the same reason.
---
 libguile/bytevectors.c | 24 ++++++++++++------------
 libguile/r6rs-ports.c  | 12 ++++++------
 2 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index cb7f294..86d1bdf 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -418,8 +418,8 @@ scm_i_print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 
 /* General operations.  */
 
-SCM_SYMBOL (scm_sym_big, "big");
-SCM_SYMBOL (scm_sym_little, "little");
+static SCM sym_big;
+static SCM sym_little;
 
 SCM scm_endianness_big, scm_endianness_little;
 
@@ -799,13 +799,13 @@ bytevector_large_ref (const char *c_bv, size_t c_size, int signed_p,
 
   if (signed_p)
     {
-      if (scm_is_eq (endianness, scm_sym_big))
+      if (scm_is_eq (endianness, sym_big))
 	negative_p = c_bv[0] & 0x80;
       else
 	negative_p = c_bv[c_size - 1] & 0x80;
     }
 
-  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+  c_endianness = scm_is_eq (endianness, sym_big) ? 1 : -1;
 
   mpz_init (c_mpz);
   mpz_import (c_mpz, 1 /* 1 word */, 1 /* word order doesn't matter */,
@@ -832,7 +832,7 @@ bytevector_large_set (char *c_bv, size_t c_size, int signed_p,
   mpz_t c_mpz;
   int c_endianness, c_sign, err = 0;
 
-  c_endianness = scm_is_eq (endianness, scm_sym_big) ? 1 : -1;
+  c_endianness = scm_is_eq (endianness, sym_big) ? 1 : -1;
 
   mpz_init (c_mpz);
   scm_to_mpz (value, c_mpz);
@@ -1864,9 +1864,9 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
 		       ? "32"
 		       : "??"))));
   strcat (name,
-	  ((scm_is_eq (endianness, scm_sym_big))
+	  ((scm_is_eq (endianness, sym_big))
 	   ? "BE"
-	   : ((scm_is_eq (endianness, scm_sym_little))
+	   : ((scm_is_eq (endianness, sym_little))
 	      ? "LE"
 	      : "unknown")));
 }
@@ -1884,7 +1884,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
                                                                         \
   SCM_VALIDATE_STRING (1, str);                                         \
   if (scm_is_eq (endianness, SCM_UNDEFINED))                            \
-    endianness = scm_sym_big;                                           \
+    endianness = sym_big;                                           \
   else                                                                  \
     SCM_VALIDATE_SYMBOL (2, endianness);                                \
                                                                         \
@@ -2001,7 +2001,7 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
 									\
   SCM_VALIDATE_BYTEVECTOR (1, utf);					\
   if (scm_is_eq (endianness, SCM_UNDEFINED))                            \
-    endianness = scm_sym_big;						\
+    endianness = sym_big;						\
   else									\
     SCM_VALIDATE_SYMBOL (2, endianness);				\
 									\
@@ -2266,13 +2266,13 @@ scm_bootstrap_bytevectors (void)
       (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
        scm_make_bytevector);
   }
+
+  scm_endianness_big = sym_big = scm_from_latin1_symbol ("big");
+  scm_endianness_little = sym_little = scm_from_latin1_symbol ("little");
 }
 
 void
 scm_init_bytevectors (void)
 {
 #include "libguile/bytevectors.x"
-
-  scm_endianness_big = scm_sym_big;
-  scm_endianness_little = scm_sym_little;
 }
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index bd8a1c4..5d283d2 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1400,12 +1400,6 @@ scm_register_r6rs_ports (void)
                             "scm_init_r6rs_ports",
 			    (scm_t_extension_init_func) scm_init_r6rs_ports,
 			    NULL);
-}
-
-void
-scm_init_r6rs_ports (void)
-{
-#include "libguile/r6rs-ports.x"
 
   initialize_bytevector_input_ports ();
   initialize_custom_binary_input_ports ();
@@ -1413,3 +1407,9 @@ scm_init_r6rs_ports (void)
   initialize_custom_binary_output_ports ();
   initialize_transcoded_ports ();
 }
+
+void
+scm_init_r6rs_ports (void)
+{
+#include "libguile/r6rs-ports.x"
+}
-- 
2.8.3