defconst, defvar: proclaim special at compile-time

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

diff --git a/libguile/smob.c b/libguile/smob.c
index 857773c..eecefd3 100644 (file)
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2015 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
@@ -32,7 +32,6 @@
 #include "libguile/async.h"
 #include "libguile/goops.h"
 #include "libguile/instructions.h"
-#include "libguile/objcodes.h"
 #include "libguile/programs.h"
 
 #include "libguile/smob.h"
@@ -206,11 +205,11 @@ scm_make_smob_type (char const *name, size_t size)
 {
   long new_smob;
 
-  SCM_CRITICAL_SECTION_START;
+  scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
   new_smob = scm_numsmob;
   if (scm_numsmob != MAX_SMOB_COUNT)
     ++scm_numsmob;
-  SCM_CRITICAL_SECTION_END;
+  scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
 
   if (new_smob == MAX_SMOB_COUNT)
     scm_misc_error (FUNC_NAME, "maximum number of smobs exceeded", SCM_EOL);
@@ -219,8 +218,8 @@ scm_make_smob_type (char const *name, size_t size)
   scm_smobs[new_smob].size = size;
 
   /* Make a class object if Goops is present. */
-  if (SCM_UNPACK (scm_smob_class[0]) != 0)
-    scm_smob_class[new_smob] = scm_make_extended_class (name, 0);
+  if (SCM_UNPACK (scm_i_smob_class[0]) != 0)
+    scm_i_smob_class[new_smob] = scm_make_extended_class (name, 0);
 
   return scm_tc7_smob + new_smob * 256;
 }
@@ -260,8 +259,8 @@ scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
   scm_smobs[SCM_TC2SMOBNUM (tc)].apply = apply;
   scm_smobs[SCM_TC2SMOBNUM (tc)].apply_trampoline = trampoline;
 
-  if (SCM_UNPACK (scm_smob_class[0]) != 0)
-    scm_i_inherit_applicable (scm_smob_class[SCM_TC2SMOBNUM (tc)]);
+  if (SCM_UNPACK (scm_i_smob_class[0]) != 0)
+    scm_i_inherit_applicable (scm_i_smob_class[SCM_TC2SMOBNUM (tc)]);
 }
 
 SCM
@@ -444,6 +443,18 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
   return ret;
 }
 
+
+\f
+
+SCM
+scm_smob_type_class (scm_t_bits tc)
+{
+  scm_load_goops ();
+
+  return scm_i_smob_class[SCM_TC2SMOBNUM (tc)];
+}
+
+
 \f
 void
 scm_smob_prehistory ()