''

[lilypond.git] / lily / include / ly-smobs.icc

diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc
index b17bd314f1487ab144a261a23baff84e79077de0..f5b8f62c10849711af81da720f10722bfb34e5e3 100644 (file)
--- a/lily/include/ly-smobs.icc
+++ b/lily/include/ly-smobs.icc
@@ -13,76 +13,85 @@
 #include "smobs.hh"
 
 
-#define IMPLEMENT_UNSMOB(CL, name)             \
-CL *                                           \
-unsmob_ ## name ( SCM s)                       \
-{                                              \
-return  CL::unsmob (s);                                \
-}
-
+#define IMPLEMENT_TYPE_P(CL, FUNCNAME)\
+void init_type_p_ ## CL ()\
+{\
+  scm_c_define_gsubr (FUNCNAME, 1, 0, 0, (Scheme_function_unknown) CL::smob_p);\
+}\
+ADD_SCM_INIT_FUNC (init_type_p_ ## CL, init_type_p_ ## CL)
 
 #ifndef SCM_CELL_TYPE
-#define SCM_CELL_TYPE(X) SCM_CAR(X)
+#define SCM_CELL_TYPE(X) SCM_CAR (X)
 #endif
 
 #ifndef SCM_CELL_WORD_1
-#define SCM_CELL_WORD_1(X) SCM_CDR(X)
+#define SCM_CELL_WORD_1(X) SCM_CDR (X)
 #endif
 
 
 #define IMPLEMENT_SIMPLE_SMOBS(CL)                             \
-long CL::smob_tag_;                                            \
+scm_t_bits CL::smob_tag_;                                       \
+SCM                                                            \
+CL::smob_p (SCM s)                                             \
+{                                                              \
+  if (SCM_NIMP (s) && SCM_CELL_TYPE (s) == smob_tag_)          \
+    return SCM_BOOL_T;                                         \
+  else                                                         \
+    return SCM_BOOL_F;                                         \
+                                                               \
+}                                                              \
 void                                                           \
 CL::init_smobs ()                                              \
 {                                                              \
-  smob_tag_ = scm_make_smob_type_mfpe (                                \
-     #CL, 0, CL::mark_smob, CL::free_smob, CL::print_smob, 0); \
+  smob_tag_ = scm_make_smob_type (#CL, 0);                      \
+  scm_set_smob_mark (smob_tag_, CL::mark_smob);                 \
+  scm_set_smob_free (smob_tag_, CL::free_smob);                 \
+  scm_set_smob_print (smob_tag_, CL::print_smob);               \
+  scm_set_smob_equalp (smob_tag_, CL::equal_p);                 \
 }                                                              \
 SCM CL::smobbed_self () const                                  \
 {                                                              \
   SCM s;                                                       \
-  s = gh_cons (SCM_PACK(CL::smob_tag_), SCM_PACK(this));       \
-  scm_done_malloc(sizeof(CL));                                 \
+  s = gh_cons (SCM_PACK (CL::smob_tag_), SCM_PACK (this));     \
+  scm_done_malloc (sizeof (CL));                               \
                                                                \
   return s;                                                    \
 }                                                              \
-CL *                                                           \
-CL::unsmob (SCM s)                                             \
-{                                                              \
-  if (SCM_NIMP(s) && SCM_CELL_TYPE(s) == smob_tag_)            \
-    return (CL*) SCM_CELL_WORD_1(s);                           \
-  else                                                         \
-    return 0;                                                  \
-}                                                              \
-scm_sizet                                                      \
+size_t                                                         \
 CL::free_smob (SCM ses)                                                \
 {                                                              \
-  CL * s = (CL*) SCM_CDR(ses);                                 \
+  CL * s = (CL*) SCM_CDR (ses);                                        \
    delete s;                                                   \
   return sizeof (CL);                                          \
 }                                                              \
-ADD_SCM_INIT_FUNC(CL, CL::init_smobs)
+ADD_SCM_INIT_FUNC (CL, CL::init_smobs)
 
 #define IMPLEMENT_SMOBS(CL)                                                    \
-IMPLEMENT_SIMPLE_SMOBS(CL)                                                     \
+IMPLEMENT_SIMPLE_SMOBS (CL)                                                    \
 SCM                                                                            \
 CL::smobify_self ()                                                            \
+{                                                                              \
+  SCM s =   unprotected_smobify_self ();\
+  scm_gc_protect_object (s);\
+  return s;\
+}\
+SCM                                                                            \
+CL::unprotected_smobify_self ()                                                                \
 {                                                                              \
   /*                                                                           \
     This is local. We don't assign to self_scm_ directly, to assure            \
     that S isn't GC-ed from under us.                                          \
                                                                                \
     We don't use smobbed_self () to ensure that mark_smob () doesn't have to   \
-    deal half-initialized objects: scm_done_malloc( ) might trigger GC.                \
+    deal half-initialized objects: scm_done_malloc ( ) might trigger GC.               \
     the warning in smobs.hh is just to be doubleplus goodly sure               \
    */                                                                          \
   SCM s;                                                                               \
-  SCM_NEWCELL(s);                                                              \
-  SCM_SETCAR(s,CL::smob_tag_);                                                 \
-  SCM_SETCDR (s, SCM_PACK(this));                                              \
+  SCM_NEWCELL (s);                                                             \
+  SCM_SETCAR (s,CL::smob_tag_);                                                        \
+  SCM_SETCDR (s, SCM_PACK (this));                                             \
   self_scm_ = s;                                                               \
- scm_done_malloc(sizeof(CL));                                                  \
-  scm_protect_object (s);                                                      \
+ scm_done_malloc (sizeof (CL));                                                        \
   return s;                                                                    \
 }