Merge remote-tracking branch 'origin/stable-2.0'

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

diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index c43acdf..dbebf77 100644 (file)
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -34,7 +34,6 @@
 #include "libguile/hash.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
-#include "libguile/weaks.h"
 #include "libguile/gc.h"
 
 #include "libguile/validate.h"
@@ -62,7 +61,6 @@ SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
 SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
 
 static SCM scm_source_whash;
-static scm_i_pthread_mutex_t source_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
 
 
 /*
@@ -94,15 +92,23 @@ static SCM scm_srcprops_to_alist (SCM obj);
 
 scm_t_bits scm_tc16_srcprops;
 
+
+static int
+supports_source_props (SCM obj)
+{
+  return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj);
+}
+
+
 static int
 srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
 {
   int writingp = SCM_WRITINGP (pstate);
-  scm_puts ("#<srcprops ", port);
+  scm_puts_unlocked ("#<srcprops ", port);
   SCM_SET_WRITINGP (pstate, 1);
   scm_iprin1 (scm_srcprops_to_alist (obj), port, pstate);
   SCM_SET_WRITINGP (pstate, writingp);
-  scm_putc ('>', port);
+  scm_putc_unlocked ('>', port);
   return 1;
 }
 
@@ -160,6 +166,16 @@ scm_srcprops_to_alist (SCM obj)
   return alist;
 }
 
+SCM_DEFINE (scm_supports_source_properties_p, "supports-source-properties?", 1, 0, 0,
+            (SCM obj),
+            "Return #t if @var{obj} supports adding source properties,\n"
+            "otherwise return #f.")
+#define FUNC_NAME s_scm_supports_source_properties_p
+{
+  return scm_from_bool (supports_source_props (obj));
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0, 
             (SCM obj),
            "Return the source property association list of @var{obj}.")
@@ -169,11 +185,7 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
     return SCM_EOL;
   else
     {
-      SCM p;
-
-      scm_i_pthread_mutex_lock (&source_lock);
-      p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
-      scm_i_pthread_mutex_unlock (&source_lock);
+      SCM p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL); 
 
       if (SRCPROPSP (p))
         return scm_srcprops_to_alist (p);
@@ -194,9 +206,7 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
 {
   SCM_VALIDATE_NIM (1, obj);
 
-  scm_i_pthread_mutex_lock (&source_lock);
-  scm_hashq_set_x (scm_source_whash, obj, alist);
-  scm_i_pthread_mutex_unlock (&source_lock);
+  scm_weak_table_putq_x (scm_source_whash, obj, alist);
 
   return alist;
 }
@@ -209,15 +219,7 @@ scm_i_has_source_properties (SCM obj)
   if (SCM_IMP (obj))
     return 0;
   else
-    {
-      int ret;
-
-      scm_i_pthread_mutex_lock (&source_lock);
-      ret = scm_is_true (scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F));
-      scm_i_pthread_mutex_unlock (&source_lock);
-
-      return ret;
-    }
+    return scm_is_true (scm_weak_table_refq (scm_source_whash, obj, SCM_BOOL_F));
 }
 #undef FUNC_NAME
   
@@ -228,14 +230,12 @@ scm_i_set_source_properties_x (SCM obj, long line, int col, SCM fname)
 {
   SCM_VALIDATE_NIM (1, obj);
 
-  scm_i_pthread_mutex_lock (&source_lock);
-  scm_hashq_set_x (scm_source_whash, obj,
-                   scm_make_srcprops (line, col, fname,
-                                      SCM_COPY_SOURCE_P
-                                      ? scm_copy_tree (obj)
-                                      : SCM_UNDEFINED,
-                                      SCM_EOL));
-  scm_i_pthread_mutex_unlock (&source_lock);
+  scm_weak_table_putq_x (scm_source_whash, obj,
+                         scm_make_srcprops (line, col, fname,
+                                            SCM_COPY_SOURCE_P
+                                            ? scm_copy_tree (obj)
+                                            : SCM_UNDEFINED,
+                                            SCM_EOL));
 }
 #undef FUNC_NAME
 
@@ -245,32 +245,27 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
            "@var{obj}'s source property list.")
 #define FUNC_NAME s_scm_source_property
 {
+  SCM p;
+
   if (SCM_IMP (obj))
     return SCM_BOOL_F;
+
+  p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
+
+  if (!SRCPROPSP (p))
+    goto alist;
+  if (scm_is_eq (scm_sym_line, key))
+    return scm_from_int (SRCPROPLINE (p));
+  else if (scm_is_eq (scm_sym_column, key))
+    return scm_from_int (SRCPROPCOL (p));
+  else if (scm_is_eq (scm_sym_copy, key))
+    return SRCPROPCOPY (p);
   else
     {
-      SCM p;
-
-      scm_i_pthread_mutex_lock (&source_lock);
-      p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
-      scm_i_pthread_mutex_unlock (&source_lock);
-
-      if (!SRCPROPSP (p))
-        goto alist;
-      if (scm_is_eq (scm_sym_line, key))
-        p = scm_from_int (SRCPROPLINE (p));
-      else if (scm_is_eq (scm_sym_column, key))
-        p = scm_from_int (SRCPROPCOL (p));
-      else if (scm_is_eq (scm_sym_copy, key))
-        p = SRCPROPCOPY (p);
-      else
-        {
-          p = SRCPROPALIST (p);
-        alist:
-          p = scm_assoc (key, p);
-          return (SCM_NIMP (p) ? SCM_CDR (p) : SCM_BOOL_F);
-        }
-      return SCM_UNBNDP (p) ? SCM_BOOL_F : p;
+      p = SRCPROPALIST (p);
+    alist:
+      p = scm_assoc (key, p);
+      return (scm_is_pair (p) ? SCM_CDR (p) : SCM_BOOL_F);
     }
 }
 #undef FUNC_NAME
@@ -284,44 +279,44 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
   SCM p;
   SCM_VALIDATE_NIM (1, obj);
 
-  scm_i_pthread_mutex_lock (&source_lock);
-  p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
+  p = scm_weak_table_refq (scm_source_whash, obj, SCM_EOL);
 
   if (scm_is_eq (scm_sym_line, key))
     {
       if (SRCPROPSP (p))
        SETSRCPROPLINE (p, scm_to_int (datum));
       else
-       scm_hashq_set_x (scm_source_whash, obj,
-                         scm_make_srcprops (scm_to_int (datum), 0,
-                                            SCM_UNDEFINED, SCM_UNDEFINED, p));
+       scm_weak_table_putq_x (scm_source_whash, obj,
+                               scm_make_srcprops (scm_to_int (datum), 0,
+                                                  SCM_UNDEFINED, SCM_UNDEFINED, p));
     }
   else if (scm_is_eq (scm_sym_column, key))
     {
       if (SRCPROPSP (p))
        SETSRCPROPCOL (p, scm_to_int (datum));
       else
-       scm_hashq_set_x (scm_source_whash, obj,
-                         scm_make_srcprops (0, scm_to_int (datum),
-                                            SCM_UNDEFINED, SCM_UNDEFINED, p));
+       scm_weak_table_putq_x (scm_source_whash, obj,
+                               scm_make_srcprops (0, scm_to_int (datum),
+                                                  SCM_UNDEFINED, SCM_UNDEFINED, p));
     }
   else if (scm_is_eq (scm_sym_copy, key))
     {
       if (SRCPROPSP (p))
        SETSRCPROPCOPY (p, datum);
       else
-       scm_hashq_set_x (scm_source_whash, obj,
-                         scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p));
+       scm_weak_table_putq_x (scm_source_whash, obj,
+                               scm_make_srcprops (0, 0, SCM_UNDEFINED, datum, p));
     }
   else
     {
       if (SRCPROPSP (p))
        SETSRCPROPALIST (p, scm_acons (key, datum, SRCPROPALIST (p)));
       else
-       scm_hashq_set_x (scm_source_whash, obj,
-                         scm_acons (key, datum, p));
+       scm_weak_table_putq_x (scm_source_whash, obj,
+                               scm_acons (key, datum, p));
     }
-  scm_i_pthread_mutex_unlock (&source_lock);
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
 
   return SCM_UNSPECIFIED;
 }
@@ -337,12 +332,10 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0,
 {
   SCM p, z;
   z = scm_cons (x, y);
-  scm_i_pthread_mutex_lock (&source_lock);
   /* Copy source properties possibly associated with xorig. */
-  p = scm_hashq_ref (scm_source_whash, xorig, SCM_BOOL_F);
+  p = scm_weak_table_refq (scm_source_whash, xorig, SCM_BOOL_F);
   if (scm_is_true (p))
-    scm_hashq_set_x (scm_source_whash, z, p);
-  scm_i_pthread_mutex_unlock (&source_lock);
+    scm_weak_table_putq_x (scm_source_whash, z, p);
   return z;
 }
 #undef FUNC_NAME
@@ -354,7 +347,7 @@ scm_init_srcprop ()
   scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
   scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
 
-  scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
+  scm_source_whash = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
   scm_c_define ("source-whash", scm_source_whash);
 
   scm_last_alist_filename = scm_cons (SCM_EOL,