X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Fly-smobs.icc;h=7e93c837f3638902448296c88229e3daddec0735;hb=7949941eb50f6243b76ded2dd331501027b68448;hp=2bb82ae41bf1a6da07a2637b3e515549c47302c1;hpb=3a0e9efb7f067e5b334ba0596b95e15d96d7cc49;p=lilypond.git

diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc
index 2bb82ae41b..7e93c837f3 100644
--- a/lily/include/ly-smobs.icc
+++ b/lily/include/ly-smobs.icc
@@ -3,73 +3,113 @@
   
   source file of the GNU LilyPond music typesetter
   
-  (c) 1999 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-  
+  (c)  1999--2004 Han-Wen Nienhuys <hanwen@cs.uu.nl>
  */
 
 #ifndef LY_SMOBS_ICC
 #define LY_SMOBS_ICC
 
-#define IMPLEMENT_SMOBS(CL)\
-long CL::smob_tag_;\
-static scm_smobfuns CL ## _funs = {					\
-  CL::mark_smob, CL::free_smob,						\
-  CL::print_smob, 0,							\
-};									\
-void									\
-CL::init_smobs ()							\
-{									\
-  smob_tag_ = scm_newsmob (&CL ## _funs);					\
-}									\
-									\
-									 \
-void									 \
-CL::unsmobify_self ()							 \
-{									 \
-  SCM s = self_scm_;							 \
-  scm_unprotect_object (s);						 \
-  									 \
-  SCM_CAR(self_scm_) = SCM_EOL;	 \
-  SCM_CDR(self_scm_) = SCM_EOL;						 \
-  self_scm_ = SCM_EOL;							 \
-}									 \
-\
-SCM									\
-CL::smobify_self ()							\
-{									\
-  if (self_scm_ != SCM_EOL)						\
-    return self_scm_;							\
-									\
-  /*									\
-    This is local. We don't assign to self_scm_ directly, to assure	\
-    that S isn't GC-ed from under us.					\
-   */									\
-  SCM s;								\
-									\
-  SCM_NEWCELL(s);							\
-  self_scm_ = s;							\
-									\
-  SCM_SETCAR(s,smob_tag_);						\
-  void * me_p = this; 							\
-  SCM_SETCDR(s,me_p);							\
-  scm_protect_object (s);						\
-									\
-  do_smobify_self();							\
-  return s;					\
-}						\
-scm_sizet					\
-CL::free_smob (SCM ses)				\
+#include "smobs.hh"
+
+
+#define IMPLEMENT_TYPE_P(CL, FUNCNAME)\
+void init_type_ ## CL ()\
+{\
+  SCM subr = scm_c_define_gsubr (FUNCNAME, 1, 0, 0, (Scheme_function_unknown) CL::smob_p);\
+  ly_add_function_documentation (subr, FUNCNAME, "(SCM x)", "Is @var{x} a @code{" #CL "} object?");\
+  scm_c_export (FUNCNAME, NULL);\
+}\
+ADD_SCM_INIT_FUNC (init_type_ ## CL, init_type_ ## CL)
+
+#ifndef SCM_CELL_TYPE
+#define SCM_CELL_TYPE(X) SCM_CAR (X)
+#endif
+
+#ifndef SCM_CELL_WORD_1
+#define SCM_CELL_WORD_1(X) SCM_CDR (X)
+#endif
+
+
+
+#define IMPLEMENT_BASE_SMOBS(CL)				\
+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 (#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);                 \
+}								\
+size_t  							\
+CL::free_smob (SCM ses)						\
+{								\
+  CL * s = (CL*) SCM_CDR (ses);					\
+  delete s;							\
+  scm_gc_unregister_collectable_memory (s, sizeof (CL), #CL " smob");  \
+  return SMOB_FREE_RETURN_VAL(CL);\
+}\
+ADD_SCM_INIT_FUNC (CL, CL::init_smobs)
+
+
+#define IMPLEMENT_SIMPLE_SMOBS(CL)				\
+IMPLEMENT_BASE_SMOBS(CL);\
+SCM CL::smobbed_copy () const					\
+{								\
+  CL * ptr  = new CL (*this);\
+  SCM s;							\
+  s = gh_cons (SCM_PACK (CL::smob_tag_), SCM_PACK (ptr));	\
+  scm_gc_register_collectable_memory ((CL*)this, sizeof (CL), #CL " smob"); \
+								\
+  return s;							\
+}								\
+
+
+#define IMPLEMENT_SMOBS(CL)							\
+IMPLEMENT_BASE_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.		\
+    the warning in smobs.hh is just to be doubleplus goodly sure		\
+   */										\
+  SCM s;\
+  SCM_NEWSMOB (s, CL::smob_tag_, this);\
+  self_scm_ = s;								\
+ scm_gc_register_collectable_memory (this, sizeof (CL), #CL " smob");							\
+  return s;									\
+}
+
+#define IMPLEMENT_DEFAULT_EQUAL_P(CL)		\
+SCM						\
+CL::equal_p (SCM a , SCM b)			\
 {						\
-  CL * s = (CL*) SCM_CDR(ses);			\
-  /* someone else did the deed already; this might be an automatic var.*/ \
-  if (s->self_scm_ != ses)\
-     return 0; \
-  SCM_CAR(ses) = SCM_EOL;\
-  					\
-  return sizeof(CL);				\
-}						\
-ADD_SCM_INIT_FUNC(CL, CL::init_smobs)\
+  return a == b ? SCM_BOOL_T : SCM_BOOL_F;	\
+}
 
 
 #endif /* LY_SMOBS_ICC */
 
+