Issue 4086/2: Add include/small-smobs.hh for smobs without extra allocation

diff --git a/lily/include/small-smobs.hh b/lily/include/small-smobs.hh
new file mode 100644 (file)
index 0000000..1794cfe
--- /dev/null
+++ b/lily/include/small-smobs.hh
@@ -0,0 +1,87 @@
+#ifndef SMALL_SMOBS_HH
+#define SMALL_SMOBS_HH
+
+#include "smobs.hh"
+
+// This is tricky: the small smobs contain all the data in the smob
+// itself.  Any derived classes must _not_ contain any data members or
+// be polymorphic (contain a virtual table pointer) as there is no
+// place to store any of that.  The class itself does not contain a
+// data member either.  Pointers to it are basically meaningless and
+// are instead reinterpreted directly as an SCM value in order to have
+// unsmob and friends behave as customary.
+
+template <class Super>
+class Smob1 : public Smob_base<Super>
+{
+  Smob1 () { } // private constructor: objects don't exist, only
+               // "pointers" to them
+public:
+  SCM self_scm () const { return SCM_PACK (this); }
+  SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
+  static SCM make_smob (SCM arg1 = SCM_UNDEFINED) {
+    SCM_RETURN_NEWSMOB (Smob_base<Super>::smob_tag (), SCM_UNPACK (arg1));
+  }
+  static const int free_smob = 0;
+  static SCM mark_smob (SCM s) { return SCM_SMOB_OBJECT (s); };
+  static Super *unchecked_unsmob (SCM s) {
+    return reinterpret_cast<Super *> (SCM_UNPACK (s));
+  }
+};
+
+template <class Super>
+class Smob2 : public Smob_base<Super>
+{
+  Smob2 () { } // private constructor: objects don't exist, only
+               // "pointers" to them
+public:
+  SCM self_scm () const { return SCM_PACK (this); }
+  SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
+  SCM & scm2 () const { return *SCM_SMOB_OBJECT_2_LOC (self_scm ()); }
+  static SCM make_smob (SCM arg1 = SCM_UNDEFINED, SCM arg2 = SCM_UNDEFINED) {
+    SCM_RETURN_NEWSMOB2 (Smob_base<Super>::smob_tag (),
+                         SCM_UNPACK (arg1),
+                         SCM_UNPACK (arg2));
+  }
+  static const int free_smob = 0;
+  static SCM mark_smob (SCM s)
+  {
+    scm_gc_mark (SCM_SMOB_OBJECT_2 (s));
+    return SCM_SMOB_OBJECT (s);
+  }
+  static Super *unchecked_unsmob (SCM s) {
+    return reinterpret_cast<Super *> (SCM_UNPACK (s));
+  }
+};
+
+template <class Super>
+class Smob3 : public Smob_base<Super>
+{
+  Smob3 () { } // private constructor: objects don't exist, only
+               // "pointers" to them
+public:
+  SCM self_scm () const { return SCM_PACK (this); }
+  SCM & scm1 () const { return *SCM_SMOB_OBJECT_LOC (self_scm ()); }
+  SCM & scm2 () const { return *SCM_SMOB_OBJECT_2_LOC (self_scm ()); }
+  SCM & scm3 () const { return *SCM_SMOB_OBJECT_3_LOC (self_scm ()); }
+  static SCM make_smob (SCM arg1 = SCM_UNDEFINED,
+                        SCM arg2 = SCM_UNDEFINED,
+                        SCM arg3 = SCM_UNDEFINED) {
+    SCM_RETURN_NEWSMOB3 (Smob_base<Super>::smob_tag (),
+                         SCM_UNPACK (arg1),
+                         SCM_UNPACK (arg2),
+                         SCM_UNPACK (arg3));
+  }
+  static const int free_smob = 0;
+  static SCM mark_smob (SCM s)
+  {
+    scm_gc_mark (SCM_SMOB_OBJECT_3 (s));
+    scm_gc_mark (SCM_SMOB_OBJECT_2 (s));
+    return SCM_SMOB_OBJECT (s);
+  }
+  static Super *unchecked_unsmob (SCM s) {
+    return reinterpret_cast<Super *> (SCM_UNPACK (s));
+  }
+};
+
+#endif