X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Fly-smobs.icc;h=efbdb0647b70ffa9de382348f29637aac14e8bc5;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=3875b2c4a18617bd2c7f4343dcd0dec60e687053;hpb=37ec023ff30dca4f6850331fbd526940f8570939;p=lilypond.git diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc index 3875b2c4a1..efbdb0647b 100644 --- a/lily/include/ly-smobs.icc +++ b/lily/include/ly-smobs.icc @@ -1,109 +1,127 @@ -/* - ly-smobs.icc -- implement smob glue. - +/* + ly-smobs.icc -- implement smob glue. + source file of the GNU LilyPond music typesetter - - (c) 1999--2004 Han-Wen Nienhuys - */ + + (c) 1999--2008 Han-Wen Nienhuys +*/ #ifndef LY_SMOBS_ICC #define LY_SMOBS_ICC #include "smobs.hh" +#define IMPLEMENT_TYPE_P(CL, FUNCNAME) \ + SCM CL ## _type_p_proc; \ + void init_type_ ## CL () \ + { \ + SCM subr = scm_c_define_gsubr (FUNCNAME, 1, 0, 0, \ + (Scheme_function_unknown) CL::smob_p); \ + CL ## _type_p_proc = subr; \ + 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) -#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) \ + void \ + CL ## _type_adder () \ + {\ + ly_add_type_predicate ((void*) &CL::unsmob, #CL); \ + }\ + ADD_SCM_INIT_FUNC(CL ## _type_adder_ctor, \ + CL ## _type_adder);\ + const char *CL::smob_name_ = #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_CELL_WORD_1 (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 = scm_cons (SCM_PACK (CL::smob_tag_), SCM_PACK (ptr)); \ + scm_gc_register_collectable_memory ((CL *)this, sizeof (CL), #CL " smob"); \ + \ + return s; \ + } - -#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_SMOBS(CL) \ + IMPLEMENT_BASE_SMOBS (CL) \ + void \ + CL::smobify_self () \ + { \ + protection_cons_ = SCM_EOL; \ + self_scm_ = unprotected_smobify_self (); \ + protect (); \ + } \ + void \ + CL::protect () \ + { \ + protect_smob (self_scm_, &protection_cons_); \ + } \ + SCM \ + CL::unprotect () \ + { \ + unprotect_smob (self_scm_, &protection_cons_); \ + return self_scm_; \ + } \ + 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) \ -{ \ - return a == b ? SCM_BOOL_T : SCM_BOOL_F; \ -} - + SCM \ + CL::equal_p (SCM a, SCM b) \ + { \ + return a == b ? SCM_BOOL_T : SCM_BOOL_F; \ + } #endif /* LY_SMOBS_ICC */ -