Really disable thread-local storage on NetBSD 5.0.

[bpt/guile.git] / libguile / deprecated.c

diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index f9a858b..30e939b 100644 (file)
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -2,7 +2,7 @@
    deprecate something, move it here when that is feasible.
 */
 
-/* Copyright (C) 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 2003, 2004, 2006, 2008, 2009 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
@@ -24,6 +24,8 @@
 # include <config.h>
 #endif
 
+#define SCM_BUILDING_DEPRECATED_CODE
+
 #include "libguile/_scm.h"
 #include "libguile/async.h"
 #include "libguile/deprecated.h"
@@ -34,6 +36,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"
@@ -49,11 +52,14 @@
 #include "libguile/smob.h"
 #include "libguile/alist.h"
 #include "libguile/keywords.h"
+#include "libguile/socket.h"
 #include "libguile/feature.h"
 
 #include <stdio.h>
 #include <string.h>
 
+#include <arpa/inet.h>
+
 #if (SCM_ENABLE_DEPRECATED == 1)
 
 /* From print.c: Internal symbol names of isyms.  Deprecated in guile 1.7.0 on
@@ -632,6 +638,21 @@ scm_set_smob_mfpe (long tc,
   if (equalp) scm_set_smob_equalp (tc, equalp);
 }
 
+size_t
+scm_smob_free (SCM obj)
+{
+  long n = SCM_SMOBNUM (obj);
+
+  scm_c_issue_deprecation_warning
+    ("`scm_smob_free' is deprecated.  "
+     "It is no longer needed.");
+
+  if (scm_smobs[n].size > 0)
+    scm_gc_free ((void *) SCM_CELL_WORD_1 (obj), 
+                scm_smobs[n].size, SCM_SMOBNAME (n));
+  return 0;
+}
+
 SCM
 scm_read_0str (char *expr)
 {
@@ -749,17 +770,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 +812,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 +879,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);
@@ -1070,7 +1096,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.");
@@ -1084,9 +1111,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))
@@ -1108,7 +1134,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
                                         obarray,
                                         0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }
@@ -1436,6 +1462,44 @@ scm_i_fluidp (SCM x)
   return scm_is_fluid (x);
 }
 
+\f
+/* Networking.  */
+
+SCM_DEFINE (scm_inet_aton, "inet-aton", 1, 0, 0, 
+            (SCM address),
+           "Convert an IPv4 Internet address from printable string\n"
+           "(dotted decimal notation) to an integer.  E.g.,\n\n"
+           "@lisp\n"
+           "(inet-aton \"127.0.0.1\") @result{} 2130706433\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_inet_aton
+{
+  scm_c_issue_deprecation_warning
+    ("`inet-aton' is deprecated.  Use `inet-pton' instead.");
+
+  return scm_inet_pton (scm_from_int (AF_INET), address);
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0, 
+            (SCM inetid),
+           "Convert an IPv4 Internet address to a printable\n"
+           "(dotted decimal notation) string.  E.g.,\n\n"
+           "@lisp\n"
+           "(inet-ntoa 2130706433) @result{} \"127.0.0.1\"\n"
+           "@end lisp")
+#define FUNC_NAME s_scm_inet_ntoa
+{
+  scm_c_issue_deprecation_warning
+    ("`inet-ntoa' is deprecated.  Use `inet-ntop' instead.");
+
+  return scm_inet_ntop (scm_from_int (AF_INET), inetid);
+}
+#undef FUNC_NAME
+
+
+\f
 void
 scm_i_defer_ints_etc ()
 {
@@ -1444,6 +1508,14 @@ scm_i_defer_ints_etc ()
      "Use a mutex instead if appropriate.");
 }
 
+int
+scm_i_mask_ints (void)
+{
+  scm_c_issue_deprecation_warning ("`scm_mask_ints' is deprecated.");
+  return (SCM_I_CURRENT_THREAD->block_asyncs != 0);
+}
+
+\f
 SCM
 scm_guard (SCM guardian, SCM obj, int throw_p)
 {
@@ -1497,6 +1569,29 @@ SCM_DEFINE (scm_destroy_guardian_x, "destroy-guardian!", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+\f
+/* GC-related things.  */
+
+unsigned long scm_mallocated, scm_mtrigger;
+size_t scm_max_segment_size;
+
+#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_map_free_list (void)
+{
+  return SCM_EOL;
+}
+#endif
+
+#if defined (GUILE_DEBUG_FREELIST)
+SCM
+scm_gc_set_debug_check_freelist_x (SCM flag)
+{
+  return SCM_UNSPECIFIED;
+}
+#endif
+
+\f
 void
 scm_i_init_deprecated ()
 {