X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Fly-smobs.icc;h=59429c2517735aaf3a5b8d3f86167d27dd5fea1c;hb=7c99507d1fab4e99a60f490469a8d3221ac036db;hp=fe5baaca0cfd41cb8951b7408a4ca0a639933703;hpb=be4269aace4cc63ebd2b2ae6e43bb0189e6280e2;p=lilypond.git

diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc
index fe5baaca0c..59429c2517 100644
--- a/lily/include/ly-smobs.icc
+++ b/lily/include/ly-smobs.icc
@@ -3,101 +3,107 @@
   
   source file of the GNU LilyPond music typesetter
   
-  (c) 1999--2000 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
 
-#ifndef SCM_PACK
-#define SCM_PACK(x) ((SCM) x)
-#endif
+#include "smobs.hh"
 
-#define IMPLEMENT_UNSMOB(CL, name)		\
-CL *						\
-unsmob_ ## name ( SCM s)			\
-{						\
-  if (SMOB_IS_TYPE_B(CL, s))			\
-    return SMOB_TO_TYPE(CL, s);			\
-  else						\
-    return 0;					\
-}\
-SCM smobify (CL *cl)\
+
+#define IMPLEMENT_TYPE_P(CL, FUNCNAME)\
+void init_type_ ## CL ()\
 {\
-  SCM s;								\
-									\
-  SCM_NEWCELL(s);							\
-  SCM_SETCAR(s,CL::smob_tag_);						\
-  SCM me_s = SCM_PACK (cl);							\
-  SCM_SETCDR (s, me_s); \
-return s;\
+  SCM subr = scm_c_define_gsubr (FUNCNAME, 1, 0, 0, (Scheme_function_unknown) CL::smob_p);\
+  ly_add_function_documentation (subr, FUNCNAME, "(SCM x)", "Check if @var{x} is 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
 
-/*
-  should include equal_p ? 
- */
-#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_SETCAR (self_scm_, SCM_EOL); \
-  SCM_SETCDR (self_scm_, SCM_EOL); \
-  self_scm_ = SCM_EOL;							 \
-\
-  scm_done_malloc ( - sizeof (CL));\
-}									 \
-\
-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 = smobify (this); \
-  self_scm_ = s;							\
-  scm_protect_object (s);						\
-									\
-  scm_done_malloc(sizeof(CL));\
-  do_smobify_self();							\
-  return s;					\
-}						\
-scm_sizet					\
-CL::free_smob (SCM ses)				\
+#ifndef SCM_CELL_WORD_1
+#define SCM_CELL_WORD_1(X) SCM_CDR (X)
+#endif
+
+
+
+#define IMPLEMENT_SIMPLE_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);                 \
+}								\
+SCM CL::smobbed_self () const					\
+{								\
+  SCM s;							\
+  s = gh_cons (SCM_PACK (CL::smob_tag_), SCM_PACK (this));	\
+  scm_gc_register_collectable_memory ((CL*)this, sizeof (CL), #CL " smob");				\
+								\
+  return s;							\
+}								\
+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_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.		\
+    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; \
-\
- /* no need to call scm_unprotect_object, since this call \
-    implies that the object is not protected. */ \
-  SCM_SETCAR (ses, SCM_EOL); \
-  delete s;\
-  return sizeof (CL);\
-} \
-ADD_SCM_INIT_FUNC(CL, CL::init_smobs)\
+  return a == b ? SCM_BOOL_T : SCM_BOOL_F;	\
+}
 
 
 #endif /* LY_SMOBS_ICC */
 
+