Avoid unpacking symbols in GOOPS
[bpt/guile.git] / libguile / deprecated.c
index bb17967..ed3a11e 100644 (file)
@@ -2,23 +2,28 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008 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
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
  *
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  * Lesser General Public License for more details.
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
  */
 
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
+
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/deprecated.h"
@@ -319,14 +324,14 @@ scm_load_scheme_module (SCM name)
 static void
 maybe_close_port (void *data, SCM port)
 {
-  SCM except = (SCM)data;
+  SCM except_set = (SCM) data;
 
-  while (!scm_is_null (except))
+  while (!scm_is_null (except_set))
     {
-      SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except));
+      SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set));
       if (scm_is_eq (p, port))
        return;
-      except = SCM_CDR (except);
+      except_set = SCM_CDR (except_set);
     }
 
   scm_close_port (port);
@@ -744,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)
@@ -790,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)
 {
@@ -845,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);
@@ -1065,7 +1075,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 {
   char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
   char *name = buf;
-  int len, n_digits;
+  int n_digits;
+  size_t len;
 
   scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
                                   "Use `gensym' instead.");
@@ -1079,9 +1090,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, &len);
+      name = scm_realloc (name, len + SCM_INTBUFLEN);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1103,7 +1113,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
                                         obarray,
                                         0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }