lily/include/small-smobs.hh

   1 #ifndef SMALL_SMOBS_HH
   2 #define SMALL_SMOBS_HH
   3
   4 #include "smobs.hh"
   5
   6 #if GUILEV2
   7 // Fix the APIs of GUILE2.x, broken in 2009--2014
   8 #undef SCM_SMOB_OBJECT_LOC
   9 #undef SCM_SMOB_OBJECT_2_LOC
  10 #undef SCM_SMOB_OBJECT_3_LOC
  11 #define SCM_SMOB_OBJECT_LOC(x)          (SCM_SMOB_OBJECT_N_LOC ((x), 1))
  12 #define SCM_SMOB_OBJECT_2_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 2))
  13 #define SCM_SMOB_OBJECT_3_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 3))
  14 #endif
  15
  16 // This is tricky: the small smobs contain all the data in the smob
  17 // itself.  Any derived classes must _not_ contain any data members or
  18 // be polymorphic (contain a virtual table pointer) as there is no
  19 // place to store any of that.  The class itself does not contain a
  20 // data member either.  Pointers to it are basically meaningless and
  21 // are instead reinterpreted directly as an SCM value in order to have
  22 // unsmob and friends behave as customary.
  23
  24 template <class Super>
  25 class Smob1 : public Smob_base<Super>
  26 {
  27   Smob1 () { } // private constructor: objects don't exist, only
  28                // "pointers" to them
  29 public:
  30   SCM self_scm () const { return SCM_PACK (this); }
  31   SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
  32   static SCM make_smob (SCM arg1 = SCM_UNDEFINED) {
  33     SCM_RETURN_NEWSMOB (Smob_base<Super>::smob_tag (), SCM_UNPACK (arg1));
  34   }
  35   static const int free_smob = 0;
  36   SCM mark_smob () { return scm1 (); };
  37   static Super *unchecked_unsmob (SCM s) {
  38     return reinterpret_cast<Super *> (SCM_UNPACK (s));
  39   }
  40 };
  41
  42 template <class Super>
  43 class Smob2 : public Smob_base<Super>
  44 {
  45   Smob2 () { } // private constructor: objects don't exist, only
  46                // "pointers" to them
  47 public:
  48   SCM self_scm () const { return SCM_PACK (this); }
  49   SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
  50   SCM & scm2 () const { return *SCM_SMOB_OBJECT_2_LOC (self_scm ()); }
  51   static SCM make_smob (SCM arg1 = SCM_UNDEFINED, SCM arg2 = SCM_UNDEFINED) {
  52     SCM_RETURN_NEWSMOB2 (Smob_base<Super>::smob_tag (),
  53                          SCM_UNPACK (arg1),
  54                          SCM_UNPACK (arg2));
  55   }
  56   static const int free_smob = 0;
  57   SCM mark_smob ()
  58   {
  59     scm_gc_mark (scm2 ());
  60     return scm1 ();
  61   }
  62   static Super *unchecked_unsmob (SCM s) {
  63     return reinterpret_cast<Super *> (SCM_UNPACK (s));
  64   }
  65 };
  66
  67 template <class Super>
  68 class Smob3 : public Smob_base<Super>
  69 {
  70   Smob3 () { } // private constructor: objects don't exist, only
  71                // "pointers" to them
  72 public:
  73   SCM self_scm () const { return SCM_PACK (this); }
  74   SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
  75   SCM & scm2 () const { return *SCM_SMOB_OBJECT_2_LOC (self_scm ()); }
  76   SCM & scm3 () const { return *SCM_SMOB_OBJECT_3_LOC (self_scm ()); }
  77   static SCM make_smob (SCM arg1 = SCM_UNDEFINED,
  78                         SCM arg2 = SCM_UNDEFINED,
  79                         SCM arg3 = SCM_UNDEFINED) {
  80     SCM_RETURN_NEWSMOB3 (Smob_base<Super>::smob_tag (),
  81                          SCM_UNPACK (arg1),
  82                          SCM_UNPACK (arg2),
  83                          SCM_UNPACK (arg3));
  84   }
  85   static const int free_smob = 0;
  86   static SCM mark_smob (SCM s)
  87   {
  88     scm_gc_mark (scm3 ());
  89     scm_gc_mark (scm2 ());
  90     return scm1 ();
  91   }
  92   static Super *unchecked_unsmob (SCM s) {
  93     return reinterpret_cast<Super *> (SCM_UNPACK (s));
  94   }
  95 };
  96
  97 #endif