+++ /dev/null
-/*
- This file is part of LilyPond, the GNU music typesetter.
-
- Copyright (C) 1999--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
-
- 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.
-
- 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 <http://www.gnu.org/licenses/>.
-*/
-
-#ifndef LY_SMOBS_ICC
-#define LY_SMOBS_ICC
-
-#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_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_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; \
- self_scm_ = SCM_UNDEFINED; \
- 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 */
-
#include "lily-guile.hh"
#include "warn.hh"
+#include <string>
/*
Smobs are GUILEs mechanism of exporting C(++) objects to the Scheme
world. They are documented in the GUILE manual.
- In LilyPond, smobs are created from C++ objects through macros.
+ In LilyPond, C++ objects can be placed under the control of GUILE's
+ type system and garbage collection mechanism by inheriting from one
+ of several Smob base classes.
+
There are two types of smob objects.
1. Simple smobs are intended for simple objects like numbers:
To obtain an SCM version of a simple smob, use the member function
SCM smobbed_copy ().
- Simple smobs are created by adding the
- DECLARE_SIMPLE_SMOBS(Classname) to the declaration
+ Simple smobs are created by deriving from Simple_smob<Classname>.
A simple smob is only optionally under the reign of the GUILE
garbage collector: its usual life time is that of a normal C++
For example,
- Complex_smob::Complex_smob () {
+ Complex_smob::Complex_smob : public Smob<Complex_smob> () {
scm_member_ = SCM_EOL;
smobify_self ();
scm_member_ = <..what you want to store..>
Complex_smob *p = new Complex_smob;
list = scm_cons (p->unprotect (), list);
- Complex smobs are made with DECLARE_SMOBS (Classname) in the class
- declaration.
+ Complex smobs are created by deriving from Smob<Classname>.
CALLING INTERFACE
Common public methods to C++ smob objects:
- unsmob (SCM x) - unpacks X and returns pointer to the C++ object, or 0
- if it has the wrong type.
-
- SCM equal_p (SCM a, SCM b) - compare A and B. Returns a Scheme boolean
-
+ - unsmob (SCM x) - unpacks X and returns pointer to the C++ object,
+ or 0 if it has the wrong type. This can be used as a boolean
+ condition at C++ level.
+ - smob_p (SCM x) returns #t or #f at Scheme level.
IMPLEMENTATION
- For implementating a class, the following should be provided
+ For implementating a class, the following public members can be
+ provided in the top class itself:
- - an equal_p () function (a default is in the
- IMPLEMENT_DEFAULT_EQUAL_P macro in ly-smobs.icc)
+ - SCM equal_p (SCM a, SCM b) - compare A and B. Returns a Scheme
+ boolean. If the class does not define this function, equal? will
+ be equivalent to eq?. The function will only be called when both
+ objects are of the respective type and not eq? to each other.
- mark_smob () function, that calls scm_gc_mark () on all Scheme
- objects in the class
+ objects in the class. If the class does not define this function,
+ it must not contain non-immediate Scheme values.
- a print_smob () function, that displays a representation for
- debugging purposes
+ debugging purposes. If the class does not define this function,
+ the output will be #<Classname> when printing.
+
+ - a static const type_p_name_[] string set to something like
+ "ly:grob?". When provided, an accordingly named function for
+ checking for the given smob type will be available in Scheme.
- - A call to one of the IMPLEMENT_SMOBS or IMPLEMENT_SIMPLE_SMOBS macros
- from file "ly-smobs.icc"
*/
-#define DECLARE_SIMPLE_SMOBS(CL) \
- public: \
- SCM smobbed_copy () const; \
- DECLARE_BASE_SMOBS (CL)
-
-#define DECLARE_BASE_SMOBS(CL) \
- friend class Non_existent_class; \
- private: \
- static const char* smob_name_; \
- static scm_t_bits smob_tag_; \
- static SCM mark_smob (SCM); \
- static size_t free_smob (SCM s); \
- static int print_smob (SCM s, SCM p, scm_print_state*); \
- public: \
- static SCM equal_p (SCM a, SCM b); \
- static CL *unsmob (SCM s) __attribute__((pure)) \
- { \
- if (SCM_NIMP (s) && SCM_CELL_TYPE (s) == smob_tag_) \
- return (CL *) SCM_CELL_WORD_1 (s); \
- else \
- return 0; \
- } \
- static SCM smob_p (SCM); \
- static void init_smobs (); \
- private:
-
-#define DECLARE_SMOBS(CL) \
- DECLARE_BASE_SMOBS (CL) \
- protected: \
- virtual ~CL (); \
- SCM unprotected_smobify_self (); \
- private: \
- void smobify_self (); \
- SCM self_scm_; \
- SCM protection_cons_; \
- public: \
- SCM unprotect (); \
- void protect (); \
- SCM self_scm () const { return self_scm_; } \
- private:
+// Initialization class. Create a variable or static data member of
+// this type at global scope (or creation will happen too late for
+// Scheme initialization), initialising with a function to be called.
+// Reference somewhere (like in the constructor of the containing
+// class) to make sure the variable is actually instantiated.
+
+class Scm_init {
+public:
+ Scm_init () { }
+ Scm_init (void (*fun) (void))
+ {
+ add_scm_init_func (fun);
+ }
+};
+
+template <class Super>
+class Smob_base
+{
+ static scm_t_bits smob_tag_;
+ static Scm_init scm_init_;
+ static void init (void);
+ static string smob_name_;
+ static Super *unchecked_unsmob (SCM s)
+ {
+ return reinterpret_cast<Super *> (SCM_SMOB_DATA (s));
+ }
+protected:
+ // reference scm_init_ in smob_tag which is sure to be called. The
+ // constructor, in contrast, may not be called at all in classes
+ // like Smob1.
+ static scm_t_bits smob_tag () { (void) scm_init_; return smob_tag_; }
+ Smob_base () { }
+ static SCM register_ptr (Super *p);
+ static Super *unregister_ptr (SCM obj);
+private:
+ // Those fallbacks are _only_ for internal use by Smob_base. They
+ // are characterized by no knowledge about the implemented type
+ // apart from the type's name. Overriding them as a template
+ // specialization is _not_ intended since a type-dependent
+ // implementation will in general need access to possibly private
+ // parts of the Super class. So any class-dependent override should
+ // be done by redefining the respective function in the Super class
+ // (where it will mask the private template member) rather than
+ // specializing a different template function/pointer.
+ //
+ // Since we consider those internal-only, two of them are actually
+ // implemented as literal zero constant. That allows us to fall
+ // back to GUILE's default implementation. Arguably the same could
+ // be done for print_smob, but the resulting default output of, say,
+ // #<Context_mod 0x7352414> would depend on memory layout, thus
+ // being unsuitable for regtest comparisons unless filtered.
+
+ static const int mark_smob = 0;
+ static const int equal_p = 0;
+ static int print_smob (SCM, SCM, scm_print_state *);
+ static size_t free_smob (SCM obj)
+ {
+ delete Smob_base<Super>::unregister_ptr (obj);
+ return 0;
+ }
+ // type_p_name_ can be overriden in the Super class with a static
+ // const char [] string. This requires both a declaration in the
+ // class as well as a single instantiation outside. Using a
+ // template specialization for supplying a different string name
+ // right in Smob_base<Super> itself seems tempting, but the C++
+ // rules would then require a specialization declaration at the
+ // class definition site as well as a specialization instantiation
+ // in a single compilation unit. That requires just as much source
+ // code maintenance while being harder to understand and quite
+ // trickier in its failure symptoms when things go wrong. So we
+ // just do things like with the other specializations.
+ static const int type_p_name_ = 0;
+public:
+ static bool is_smob (SCM s)
+ {
+ return SCM_SMOB_PREDICATE (smob_tag (), s);
+ }
+ static SCM smob_p (SCM s)
+ {
+ return is_smob (s) ? SCM_BOOL_T : SCM_BOOL_F;
+ }
+ static Super *unsmob (SCM s)
+ {
+ return is_smob (s) ? Super::unchecked_unsmob (s) : 0;
+ }
+};
+
+
+template <class Super>
+class Simple_smob : public Smob_base<Super> {
+public:
+ SCM smobbed_copy () const
+ {
+ Super *p = new Super(*static_cast<const Super *> (this));
+ return Smob_base<Super>::register_ptr (p);
+ }
+};
void protect_smob (SCM smob, SCM *prot_cons);
void unprotect_smob (SCM smob, SCM *prot_cons);
+template <class Super>
+class Smob : public Smob_base<Super> {
+private:
+ SCM self_scm_;
+ SCM protection_cons_;
+public:
+ SCM unprotected_smobify_self ()
+ {
+ self_scm_ = SCM_UNDEFINED;
+ self_scm_ = Smob_base<Super>::register_ptr (static_cast<Super *> (this));
+ return self_scm_;
+ }
+ void protect ()
+ {
+ protect_smob (self_scm_, &protection_cons_);
+ }
+ SCM unprotect ()
+ {
+ unprotect_smob (self_scm_, &protection_cons_);
+ return self_scm_;
+ }
+ void smobify_self () {
+ protection_cons_ = SCM_EOL;
+ self_scm_ = unprotected_smobify_self ();
+ protect ();
+ }
+ SCM self_scm () const { return self_scm_; }
+};
+
extern bool parsed_objects_should_be_dead;
class parsed_dead
{
while (0)
#endif
+#include "smobs.tcc"
#endif /* SMOBS_HH */
-
--- /dev/null
+/* -*- C++ -*-
+ This file is part of LilyPond, the GNU music typesetter.
+
+ Copyright (C) 2005--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ 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.
+
+ 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 <http://www.gnu.org/licenses/>.
+*/
+
+#ifndef SMOBS_TCC
+#define SMOBS_TCC
+
+// Contains generic template definitions. With GCC, it is just
+// included from smobs.hh, but other template expansion systems might
+// make it feasible to compile this only a single time.
+
+#include "lily-guile-macros.hh"
+#include "smobs.hh"
+#include <typeinfo>
+
+template <class Super>
+SCM
+Smob_base<Super>::register_ptr (Super *p)
+{
+ // Don't use SCM_RETURN_NEWSMOB since that would require us to
+ // first register the memory and then create the smob. That would
+ // announce the memory as being GC-controlled before even
+ // allocating the controlling smob.
+ SCM s = SCM_UNDEFINED;
+ SCM_NEWSMOB (s, smob_tag (), p);
+ scm_gc_register_collectable_memory (p, sizeof (*p), smob_name_.c_str ());
+ return s;
+}
+
+template <class Super>
+int
+Smob_base<Super>::print_smob (SCM, SCM p, scm_print_state *)
+{
+ scm_puts ("#<", p);
+ scm_puts (smob_name_.c_str (), p);
+ scm_puts (">", p);
+ return 1;
+}
+
+template <class Super>
+Super *
+Smob_base<Super>::unregister_ptr (SCM obj)
+{
+ Super *p = Super::unchecked_unsmob (obj);
+ scm_gc_unregister_collectable_memory (p, sizeof (*p), smob_name_.c_str ());
+ return p;
+}
+
+template <class Super>
+scm_t_bits Smob_base<Super>::smob_tag_ = 0;
+
+template <class Super>
+Scm_init Smob_base<Super>::scm_init_ = init;
+
+template <class Super>
+string Smob_base<Super>::smob_name_;
+
+template <class Super>
+void Smob_base<Super>::init ()
+{
+ smob_name_ = typeid (Super).name ();
+ // Primitive demangling, suitable for GCC, should be harmless
+ // elsewhere. The worst that can happen is that we get material
+ // unsuitable for Texinfo documentation. If that proves to be an
+ // issue, we need some smarter strategy.
+ smob_name_ = smob_name_.substr (smob_name_.find_first_not_of ("0123456789"));
+ assert(!smob_tag_);
+ smob_tag_ = scm_make_smob_type (smob_name_.c_str (), 0);
+ // The following have trivial private default definitions not
+ // referring to any aspect of the Super class apart from its name.
+ // They should be overridden (or rather masked) at Super level: that
+ // way they can refer to Super-private data.
+ // While that's not a consideration for type_p_name_, it's easier
+ // doing it like the rest.
+
+ if (Super::free_smob != 0)
+ scm_set_smob_free (smob_tag_, Super::free_smob);
+ if (Super::mark_smob != 0)
+ scm_set_smob_mark (smob_tag_, Super::mark_smob);
+ if (Super::print_smob != 0)
+ scm_set_smob_print (smob_tag_, Super::print_smob);
+ if (Super::equal_p != 0)
+ scm_set_smob_equalp (smob_tag_, Super::equal_p);
+ if (Super::type_p_name_ != 0)
+ {
+ SCM subr = scm_c_define_gsubr (Super::type_p_name_, 1, 0, 0,
+ (scm_t_subr) smob_p);
+ string fundoc = string("Is @var{x} a @code{") + smob_name_
+ + "} object?";
+ ly_add_function_documentation (subr, Super::type_p_name_, "(SCM x)",
+ fundoc);
+ scm_c_export (Super::type_p_name_, NULL);
+ }
+ ly_add_type_predicate ((void *) unsmob, smob_name_.c_str ());
+}
+
+#endif
projects / lilypond.git / commitdiff