X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=lily%2Finclude%2Fly-smobs.icc;h=2fba5f55a480a005137ef85cfd76f7425559260a;hb=0b544cfb7332615ef809b71b57ab656741311ae1;hp=b17bd314f1487ab144a261a23baff84e79077de0;hpb=9c8bcb9a2a1fedb5459e593b18a8c550318e6800;p=lilypond.git diff --git a/lily/include/ly-smobs.icc b/lily/include/ly-smobs.icc index b17bd314f1..2fba5f55a4 100644 --- a/lily/include/ly-smobs.icc +++ b/lily/include/ly-smobs.icc @@ -1,99 +1,139 @@ -/* - ly-smobs.icc -- implement smob glue. - - source file of the GNU LilyPond music typesetter - - (c) 1999--2000 Han-Wen Nienhuys - - */ +/* + This file is part of LilyPond, the GNU music typesetter. -#ifndef LY_SMOBS_ICC -#define LY_SMOBS_ICC - -#include "smobs.hh" + Copyright (C) 1999--2014 Han-Wen Nienhuys + LilyPond is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. -#define IMPLEMENT_UNSMOB(CL, name) \ -CL * \ -unsmob_ ## name ( SCM s) \ -{ \ -return CL::unsmob (s); \ -} + LilyPond is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + You should have received a copy of the GNU General Public License + along with LilyPond. If not, see . +*/ -#ifndef SCM_CELL_TYPE -#define SCM_CELL_TYPE(X) SCM_CAR(X) -#endif +#ifndef LY_SMOBS_ICC +#define LY_SMOBS_ICC -#ifndef SCM_CELL_WORD_1 -#define SCM_CELL_WORD_1(X) SCM_CDR(X) -#endif +#include "lily-guile-macros.hh" +#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, \ + (scm_t_subr) 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_SIMPLE_SMOBS(CL) \ -long CL::smob_tag_; \ -void \ -CL::init_smobs () \ -{ \ - smob_tag_ = scm_make_smob_type_mfpe ( \ - #CL, 0, CL::mark_smob, CL::free_smob, CL::print_smob, 0); \ -} \ -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_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_SMOBS(CL) \ -IMPLEMENT_SIMPLE_SMOBS(CL) \ -SCM \ -CL::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)); \ - scm_protect_object (s); \ - return s; \ -} +#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_DEFAULT_EQUAL_P(CL) \ -SCM \ -CL::equal_p (SCM a , SCM b) \ -{ \ - return a == b ? SCM_BOOL_T : SCM_BOOL_F; \ -} +#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; \ + } #endif /* LY_SMOBS_ICC */ -