lily/include/ly-smobs.icc

   1 /*
   2   ly-smobs.icc -- implement smob glue.
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 1999--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9
  10 #ifndef LY_SMOBS_ICC
  11 #define LY_SMOBS_ICC
  12
  13
  14
  15 #define IMPLEMENT_UNSMOB(CL, name)              \
  16 CL *                                            \
  17 unsmob_ ## name ( SCM s)                        \
  18 {                                               \
  19   if (SMOB_IS_TYPE_B(CL, s))                    \
  20     return SMOB_TO_TYPE(CL, s);                 \
  21   else                                          \
  22     return 0;                                   \
  23 }\
  24 SCM smobify (CL *cl)\
  25 {\
  26   SCM s;                                                                \
  27                                                                         \
  28   SCM_NEWCELL(s);                                                       \
  29   SCM_SETCAR(s,CL::smob_tag_);                                          \
  30   SCM me_s = SCM_PACK(cl);                                                      \
  31   SCM_SETCDR (s, me_s); \
  32 return s;\
  33 }\
  34
  35
  36 /*
  37   should include equal_p ?
  38  */
  39 #define IMPLEMENT_SMOBS(CL)\
  40 long CL::smob_tag_;\
  41 void                                                                    \
  42 CL::init_smobs ()                                                       \
  43 {                                                                       \
  44   smob_tag_ = scm_make_smob_type_mfpe ( \
  45      #CL, 0, CL::mark_smob, CL::free_smob, CL::print_smob, 0);\
  46 }\
  47                                                                         \
  48                                                                          \
  49 void                                                                     \
  50 CL::unsmobify_self ()                                                    \
  51 {                                                                        \
  52   SCM s = self_scm_;                                                     \
  53   scm_unprotect_object (s);                                              \
  54                                                                          \
  55   SCM_SETCAR (self_scm_, SCM_EOL); \
  56   SCM_SETCDR (self_scm_, SCM_EOL); \
  57   self_scm_ = SCM_EOL;                                                   \
  58 \
  59   scm_done_malloc ( - sizeof (CL));\
  60 }                                                                        \
  61 \
  62 SCM                                                                     \
  63 CL::smobify_self ()                                                     \
  64 {                                                                       \
  65   if (self_scm_ != SCM_EOL)                                             \
  66     return self_scm_;                                                   \
  67                                                                         \
  68   /*                                                                    \
  69     This is local. We don't assign to self_scm_ directly, to assure     \
  70     that S isn't GC-ed from under us.                                   \
  71    */                                                                   \
  72   SCM s = smobify (this); \
  73   self_scm_ = s;                                                        \
  74   scm_protect_object (s);                                               \
  75                                                                         \
  76   scm_done_malloc(sizeof(CL));\
  77   do_smobify_self();                                                    \
  78   return s;                                     \
  79 }                                               \
  80 scm_sizet                                       \
  81 CL::free_smob (SCM ses)                         \
  82 {                                               \
  83   CL * s = (CL*) SCM_CDR(ses);                  \
  84   /* someone else did the deed already; this might be an automatic var.*/ \
  85   if (s->self_scm_ != ses)\
  86      return 0; \
  87 \
  88  /* no need to call scm_unprotect_object, since this call \
  89     implies that the object is not protected. */ \
  90   SCM_SETCAR (ses, SCM_EOL); \
  91   delete s;\
  92   return sizeof (CL);\
  93 } \
  94 ADD_SCM_INIT_FUNC(CL, CL::init_smobs)\
  95
  96
  97 #endif /* LY_SMOBS_ICC */
  98