X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Fly-smobs.icc;h=c38d5458293d5f26b3d7eca2d622f23e0b3701c7;hb=af51453530b95aee167fe02ee3f4cb0c8dcd1fe2;hp=3ee8d6db515e231b4d67a963257dbb18213909fe;hpb=82731e802565546441c401a84a13b486e54eb760;p=lilypond.git

diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc
index 3ee8d6db51..c38d545829 100644
--- a/lily/include/ly-smobs.icc
+++ b/lily/include/ly-smobs.icc
@@ -3,74 +3,119 @@
   
   source file of the GNU LilyPond music typesetter
   
-  (c) 1999 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  (c) 1999--2000 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);						\
-									\
-/* no scm_done_malloc() !  */ \
-  do_smobify_self();							\
-  return s;					\
-}						\
-scm_sizet					\
-CL::free_smob (SCM ses)				\
+#include "smobs.hh"
+
+
+#define IMPLEMENT_UNSMOB(CL, name)		\
+CL *						\
+unsmob_ ## name ( SCM s)			\
 {						\
-  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 0;\
-}						\
-ADD_SCM_INIT_FUNC(CL, CL::init_smobs)\
+return  CL::unsmob (s);				\
+}
+
+#define IMPLEMENT_TYPE_P(CL, FUNCNAME)\
+void init_type_p_ ## CL ()\
+{\
+  scm_make_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)
+#endif
+
+#ifndef SCM_CELL_WORD_1
+#define SCM_CELL_WORD_1(X) SCM_CDR(X)
+#endif
+
+
+#define IMPLEMENT_SIMPLE_SMOBS(CL)				\
+long 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,	\
+     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));					\
+								\
+  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							\
+CL::free_smob (SCM ses)						\
+{								\
+  CL * s = (CL*) SCM_CDR(ses);					\
+   delete s;							\
+  return sizeof (CL);						\
+}								\
+ADD_SCM_INIT_FUNC(CL, CL::init_smobs)
+
+#define IMPLEMENT_SMOBS(CL)							\
+IMPLEMENT_SIMPLE_SMOBS(CL)							\
+SCM										\
+CL::smobify_self ()								\
+{										\
+  SCM s =   unprotected_smobify_self ();\
+  scm_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_NEWCELL(s);								\
+  SCM_SETCAR(s,CL::smob_tag_);							\
+  SCM_SETCDR (s, SCM_PACK(this));						\
+  self_scm_ = s;								\
+ scm_done_malloc(sizeof(CL));							\
+  return s;									\
+}
+
+#define IMPLEMENT_DEFAULT_EQUAL_P(CL)		\
+SCM						\
+CL::equal_p (SCM a , SCM b)			\
+{						\
+  return a == b ? SCM_BOOL_T : SCM_BOOL_F;	\
+}
 
 
 #endif /* LY_SMOBS_ICC */
 
+