[Guile-commits] GNU Guile branch, master, updated. release_1-9-2-36-g43d5626

[Michael Gran]

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=43d5626ce7b51c6f9c06b3a5fe513003778402c8

The branch, master has been updated
       via  43d5626ce7b51c6f9c06b3a5fe513003778402c8 (commit)
       via  68a30f5730e73b9792565c3c99b5724752472a85 (commit)
       via  0193377d24db3ec57ea9be488069a4b86878e6e6 (commit)
       via  7f5946427e457b5588b1a5103dc4652bd9a99392 (commit)
      from  1549532ccb4eb13143bbce43ab6fdc80e6bbfb37 (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 43d5626ce7b51c6f9c06b3a5fe513003778402c8
Author: Michael Gran <address@hidden>
Date:   Thu Aug 20 21:33:49 2009 -0700

    Avoid type-limits warning in SCM_TO_TYPE_PROTO
    
    * libguile/conv-uinteger.i.c (SCM_TO_TYPE_PROTO): avoid a comparison
      that is always true due to the limited range of the data type

commit 68a30f5730e73b9792565c3c99b5724752472a85
Author: Michael Gran <address@hidden>
Date:   Thu Aug 20 21:31:58 2009 -0700

    Type-limits error in GC environment initialization
    
    * libguile/gc-malloc.c (scm_gc_init_malloc): GUILE_INIT_MALLOC_LIMIT
      is cast to unsigned then tested as if it were still signed

commit 0193377d24db3ec57ea9be488069a4b86878e6e6
Author: Michael Gran <address@hidden>
Date:   Thu Aug 20 20:30:12 2009 -0700

    Avoid accessing symbol internals in call_dsubr_1 and DEVAL
    
    The symbol's characters are only accessed in case they are needed
    for an error message.  This can be avoided by passing the symbol
    all the way to a error message function.
    
    * libguile/__scm.h (SCM_WTA_DISPATCH_1_SUBR): new macro
    
    * libguile/error.c (scm_i_wrong_type_arg_symbol): new error function
    
    * libguile/error.h: declaration of scm_i_wrong_type_arg_symbol
    
    * libguile/eval.c (call_dsubr_1): use new macro SCM_WTA_DISPATCH_1_SUBR
      to avoid having to unpack the symbol's chars
    
    * libguile/eval.i.c: use new macro SCM_WTA_DISPATCH_1_SUBR

commit 7f5946427e457b5588b1a5103dc4652bd9a99392
Author: Michael Gran <address@hidden>
Date:   Thu Aug 20 09:42:38 2009 -0700

    Use string and symbol accessors with obarrays and keyword-dash-symbols
    
    * libguile/deprecated.c (intern_obarray_soft): new function
      (scm_intern_obarray_soft, scm_string_to_obarray_symbol): use
      intern_obarray_soft
      (scm_gentemp): don't unpack string chars, use intern_obarray_soft
    
    * libguile/discouraged.c (scm_make_keyword_from_dash_symbol): use
      symbol accessor

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

Summary of changes:
 libguile/__scm.h           |    7 +++++++
 libguile/conv-uinteger.i.c |   25 +++++++++++++++++++------
 libguile/deprecated.c      |   32 ++++++++++++++++++--------------
 libguile/discouraged.c     |    2 +-
 libguile/error.c           |   13 +++++++++++++
 libguile/error.h           |    2 ++
 libguile/eval.c            |    3 +--
 libguile/eval.i.c          |    7 ++-----
 libguile/gc-malloc.c       |    6 ++++--
 9 files changed, 67 insertions(+), 30 deletions(-)

diff --git a/libguile/__scm.h b/libguile/__scm.h
index 29b371d..b92eeae 100644
--- a/libguile/__scm.h
+++ b/libguile/__scm.h
@@ -556,6 +556,13 @@ SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
   return (SCM_UNPACK (gf)                                      \
          ? scm_call_generic_1 ((gf), (a1))                     \
          : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))
+
+/* This form is for dispatching a subroutine.  */
+#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)                         \
+  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))                      \
+         ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1))       \
+         : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), 
SCM_UNSPECIFIED))
+
 #define SCM_GASSERT1(cond, gf, a1, pos, subr)          \
   if (SCM_UNLIKELY (!(cond)))                  \
     SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))
diff --git a/libguile/conv-uinteger.i.c b/libguile/conv-uinteger.i.c
index ff0d280..52f49f7 100644
--- a/libguile/conv-uinteger.i.c
+++ b/libguile/conv-uinteger.i.c
@@ -53,10 +53,17 @@ SCM_TO_TYPE_PROTO (SCM val)
 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
              return n;
 #else
-             if (n >= TYPE_MIN && n <= TYPE_MAX)
-               return n;
-             else
-               goto out_of_range;
+
+#if TYPE_MIN == 0 
+              if (n <= TYPE_MAX)
+                return n;
+#else /* TYPE_MIN != 0 */
+              if (n >= TYPE_MIN && n <= TYPE_MAX)
+                return n;
+#endif /* TYPE_MIN != 0 */
+              else
+                goto out_of_range;
+
 #endif
            }
          else
@@ -76,10 +83,16 @@ SCM_TO_TYPE_PROTO (SCM val)
          
          mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val));
 
+#if TYPE_MIN == 0
+         if (n <= TYPE_MAX)
+           return n;
+#else /* TYPE_MIN != 0 */
          if (n >= TYPE_MIN && n <= TYPE_MAX)
            return n;
-         else
-           goto out_of_range;
+#endif /* TYPE_MIN != 0 */
+          else
+            goto out_of_range;
+
        }
     }
   else
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 57a2f06..496bc22 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -749,17 +749,13 @@ scm_sym2ovcell (SCM sym, SCM obarray)
    return (SYMBOL . SCM_UNDEFINED).  */
 
 
-SCM 
-scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int 
softness)
+static SCM 
+intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness)
 {
-  SCM symbol = scm_from_locale_symboln (name, len);
   size_t raw_hash = scm_i_symbol_hash (symbol);
   size_t hash;
   SCM lsym;
 
-  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
-                                  "Use hashtables instead.");
-
   if (scm_is_false (obarray))
     {
       if (softness)
@@ -795,6 +791,18 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM 
obarray,unsigned int so
 }
 
 
+SCM 
+scm_intern_obarray_soft (const char *name, size_t len, SCM obarray,
+                         unsigned int softness)
+{
+  SCM symbol = scm_from_locale_symboln (name, len);
+
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
+                                  "Use hashtables instead.");
+
+  return intern_obarray_soft (symbol, obarray, softness);
+}
+  
 SCM
 scm_intern_obarray (const char *name,size_t len,SCM obarray)
 {
@@ -850,10 +858,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, 
"string->obarray-symbol", 2, 1, 0,
   else if (scm_is_eq (o, SCM_BOOL_T))
     o = SCM_BOOL_F;
     
-  vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
-                                  scm_i_string_length (s),
-                                  o,
-                                  softness);
+  vcell = intern_obarray_soft (scm_string_to_symbol (s), o, softness);
   if (scm_is_false (vcell))
     return vcell;
   answer = SCM_CAR (vcell);
@@ -1084,9 +1089,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
     {
       SCM_VALIDATE_STRING (1, prefix);
       len = scm_i_string_length (prefix);
-      if (len > MAX_PREFIX_LENGTH)
-       name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
-      strncpy (name, scm_i_string_chars (prefix), len);
+      name = scm_to_locale_stringn (prefix, (size_t *)(&len));
+      name = scm_realloc (name, len + SCM_INTBUFLEN);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1108,7 +1112,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
                                         obarray,
                                         0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }
diff --git a/libguile/discouraged.c b/libguile/discouraged.c
index 357cac8..2621428 100644
--- a/libguile/discouraged.c
+++ b/libguile/discouraged.c
@@ -265,7 +265,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, 
"make-keyword-from-dash-symbol",
   SCM dash_string, non_dash_symbol;
 
   SCM_ASSERT (scm_is_symbol (symbol)
-             && ('-' == scm_i_symbol_chars(symbol)[0]),
+             && (scm_i_symbol_ref (symbol, 0) == '-'),
              symbol, SCM_ARG1, FUNC_NAME);
 
   dash_string = scm_symbol_to_string (symbol);
diff --git a/libguile/error.c b/libguile/error.c
index eb513a7..bcbcd9c 100644
--- a/libguile/error.c
+++ b/libguile/error.c
@@ -233,6 +233,19 @@ scm_wrong_type_arg (const char *subr, int pos, SCM 
bad_value)
 }
 
 void
+scm_i_wrong_type_arg_symbol (SCM symbol, int pos, SCM bad_value)
+{
+  scm_error_scm (scm_arg_type_key,
+                scm_symbol_to_string (symbol),
+                (pos == 0) ? scm_from_locale_string ("Wrong type: ~S")
+                : scm_from_locale_string ("Wrong type argument in position ~A: 
~S"),
+                (pos == 0) ? scm_list_1 (bad_value)
+                : scm_list_2 (scm_from_int (pos), bad_value),
+                scm_list_1 (bad_value));
+  scm_remember_upto_here_2 (symbol, bad_value);
+}
+
+void
 scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char 
*szMessage)
 {
   SCM msg = scm_from_locale_string (szMessage);
diff --git a/libguile/error.h b/libguile/error.h
index c777a7f..8cc68b7 100644
--- a/libguile/error.h
+++ b/libguile/error.h
@@ -53,6 +53,8 @@ SCM_API void scm_wrong_num_args (SCM proc) SCM_NORETURN;
 SCM_API void scm_error_num_args_subr (const char* subr) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg (const char *subr, int pos,
                                 SCM bad_value) SCM_NORETURN;
+SCM_INTERNAL void scm_i_wrong_type_arg_symbol (SCM symbol, int pos,
+                                              SCM bad_value) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
                                     SCM bad_value, const char *sz) 
SCM_NORETURN;
 SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;
diff --git a/libguile/eval.c b/libguile/eval.c
index 1563b51..eeafb0b 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3381,8 +3381,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
     {
       return (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
     }
-  SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                     SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+  SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
 }
 
 static SCM
diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 461349a..25abf6c 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -1238,9 +1238,7 @@ dispatch:
              {
                 RETURN (scm_from_double (SCM_DSUBRF (proc) 
(scm_i_fraction2double (arg1))));
              }
-           SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                                SCM_ARG1,
-                               scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+           SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
          case scm_tc7_cxr:
            RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
          case scm_tc7_rpsubr:
@@ -1781,8 +1779,7 @@ tail:
        {
          RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double 
(arg1))));
        }
-      SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
-                          SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
+      SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
     case scm_tc7_cxr:
       if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
        scm_wrong_num_args (proc);
diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c
index d6973d3..0a7220e 100644
--- a/libguile/gc-malloc.c
+++ b/libguile/gc-malloc.c
@@ -83,7 +83,7 @@ static int scm_i_minyield_malloc;
 void
 scm_gc_init_malloc (void)
 {
-  scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
+  int mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT",
                                 SCM_DEFAULT_INIT_MALLOC_LIMIT);
   scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC",
                                          SCM_DEFAULT_MALLOC_MINYIELD);
@@ -93,8 +93,10 @@ scm_gc_init_malloc (void)
   if (scm_i_minyield_malloc < 1)
     scm_i_minyield_malloc = 1;
 
-  if (scm_mtrigger < 0)
+  if (mtrigger < 0)
     scm_mtrigger = SCM_DEFAULT_INIT_MALLOC_LIMIT;
+  else
+    scm_mtrigger = mtrigger;
 }
 
 


hooks/post-receive
-- 
GNU Guile