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 #ifndef SCM_PACK
  14 #define SCM_PACK(x) ((SCM) x)
  15 #endif
  16
  17 #define IMPLEMENT_UNSMOB(CL, name)              \
  18 CL *                                            \
  19 unsmob_ ## name ( SCM s)                        \
  20 {                                               \
  21   if (SMOB_IS_TYPE_B(CL, s))                    \
  22     return SMOB_TO_TYPE(CL, s);                 \
  23   else                                          \
  24     return 0;                                   \
  25 }\
  26 SCM smobify (CL *cl)\
  27 {\
  28   SCM s;                                                                \
  29                                                                         \
  30   SCM_NEWCELL(s);                                                       \
  31   SCM_SETCAR(s,CL::smob_tag_);                                          \
  32   SCM me_s = SCM_PACK (cl);                                                     \
  33   SCM_SETCDR (s, me_s); \
  34 return s;\
  35 }\
  36
  37
  38 /*
  39   should include equal_p ?
  40  */
  41 #define IMPLEMENT_SMOBS(CL)\
  42 long CL::smob_tag_;\
  43 static scm_smobfuns CL ## _funs = {                                     \
  44   CL::mark_smob, CL::free_smob,                                         \
  45   CL::print_smob, 0,                                                    \
  46 };                                                                      \
  47 void                                                                    \
  48 CL::init_smobs ()                                                       \
  49 {                                                                       \
  50   smob_tag_ = scm_newsmob (&CL ## _funs);                                       \
  51 }                                                                       \
  52                                                                         \
  53                                                                          \
  54 void                                                                     \
  55 CL::unsmobify_self ()                                                    \
  56 {                                                                        \
  57   SCM s = self_scm_;                                                     \
  58   scm_unprotect_object (s);                                              \
  59                                                                          \
  60   SCM_SETCAR (self_scm_, SCM_EOL); \
  61   SCM_SETCDR (self_scm_, SCM_EOL); \
  62   self_scm_ = SCM_EOL;                                                   \
  63 \
  64   scm_done_malloc ( - sizeof (CL));\
  65 }                                                                        \
  66 \
  67 SCM                                                                     \
  68 CL::smobify_self ()                                                     \
  69 {                                                                       \
  70   if (self_scm_ != SCM_EOL)                                             \
  71     return self_scm_;                                                   \
  72                                                                         \
  73   /*                                                                    \
  74     This is local. We don't assign to self_scm_ directly, to assure     \
  75     that S isn't GC-ed from under us.                                   \
  76    */                                                                   \
  77   SCM s = smobify (this); \
  78   self_scm_ = s;                                                        \
  79   scm_protect_object (s);                                               \
  80                                                                         \
  81   scm_done_malloc(sizeof(CL));\
  82   do_smobify_self();                                                    \
  83   return s;                                     \
  84 }                                               \
  85 scm_sizet                                       \
  86 CL::free_smob (SCM ses)                         \
  87 {                                               \
  88   CL * s = (CL*) SCM_CDR(ses);                  \
  89   /* someone else did the deed already; this might be an automatic var.*/ \
  90   if (s->self_scm_ != ses)\
  91      return 0; \
  92 \
  93  /* no need to call scm_unprotect_object, since this call \
  94     implies that the object is not protected. */ \
  95   SCM_SETCAR (ses, SCM_EOL); \
  96   delete s;\
  97   return sizeof (CL);\
  98 } \
  99 ADD_SCM_INIT_FUNC(CL, CL::init_smobs)\
 100
 101
 102 #endif /* LY_SMOBS_ICC */
 103