libguile/smob.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM_SMOB_H
   4 #define SCM_SMOB_H
   5
   6 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2009,
   7  *   2010, 2011 Free Software Foundation, Inc.
   8  *
   9  * This library is free software; you can redistribute it and/or
  10  * modify it under the terms of the GNU Lesser General Public License
  11  * as published by the Free Software Foundation; either version 3 of
  12  * the License, or (at your option) any later version.
  13  *
  14  * This library is distributed in the hope that it will be useful, but
  15  * WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  * Lesser General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU Lesser General Public
  20  * License along with this library; if not, write to the Free Software
  21  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  22  * 02110-1301 USA
  23  */
  24
  25 \f
  26
  27 #include "libguile/__scm.h"
  28 #include "libguile/print.h"
  29
  30 #include "libguile/bdw-gc.h"
  31
  32
  33 \f
  34 /* This is the internal representation of a smob type */
  35
  36 typedef struct scm_smob_descriptor
  37 {
  38   char const *name;
  39   size_t size;
  40   SCM (*mark) (SCM);
  41   size_t (*free) (SCM);
  42   int (*print) (SCM exp, SCM port, scm_print_state *pstate);
  43   SCM (*equalp) (SCM, SCM);
  44   scm_t_subr apply;
  45   SCM apply_trampoline_objcode;
  46 } scm_smob_descriptor;
  47
  48
  49 \f
  50 SCM_API SCM scm_i_new_smob_with_mark_proc (scm_t_bits tc,
  51                                            scm_t_bits, scm_t_bits, scm_t_bits);
  52
  53
  54
  55 #define SCM_NEWSMOB(z, tc, data)                                          \
  56 do                                                                        \
  57   {                                                                       \
  58     register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc);                   \
  59     z = (scm_smobs[_smobnum].mark                                         \
  60          ? scm_i_new_smob_with_mark_proc ((tc), (scm_t_bits)(data),       \
  61                                           0, 0)                           \
  62          : scm_cell (tc, (scm_t_bits)(data)));                            \
  63     if (scm_smobs[_smobnum].free)                                         \
  64       {                                                                   \
  65         GC_finalization_proc _prev_finalizer;                             \
  66         GC_PTR _prev_finalizer_data;                                      \
  67                                                                           \
  68         GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
  69                                         NULL,                             \
  70                                         &_prev_finalizer,                 \
  71                                         &_prev_finalizer_data);           \
  72       }                                                                   \
  73   }                                                                       \
  74 while (0)
  75
  76 #define SCM_RETURN_NEWSMOB(tc, data)                    \
  77   do { SCM __SCM_smob_answer;                           \
  78        SCM_NEWSMOB (__SCM_smob_answer, (tc), (data));   \
  79        return __SCM_smob_answer;                        \
  80   } while (0)
  81
  82 #define SCM_NEWSMOB2(z, tc, data1, data2)       \
  83   SCM_NEWSMOB3 (z, tc, data1, data2, 0)
  84
  85 #define SCM_RETURN_NEWSMOB2(tc, data1, data2)                           \
  86   do { SCM __SCM_smob_answer;                                           \
  87        SCM_NEWSMOB2 (__SCM_smob_answer, (tc), (data1), (data2));        \
  88        return __SCM_smob_answer;                                        \
  89   } while (0)
  90
  91 #define SCM_NEWSMOB3(z, tc, data1, data2, data3)                          \
  92 do                                                                        \
  93   {                                                                       \
  94     register scm_t_bits _smobnum = SCM_TC2SMOBNUM (tc);                   \
  95     z = (scm_smobs[_smobnum].mark                                         \
  96          ? scm_i_new_smob_with_mark_proc (tc, (scm_t_bits)(data1),        \
  97                                           (scm_t_bits)(data2),            \
  98                                           (scm_t_bits)(data3))            \
  99          : scm_double_cell ((tc), (scm_t_bits)(data1),                    \
 100                             (scm_t_bits)(data2),                          \
 101                             (scm_t_bits)(data3)));                        \
 102     if (scm_smobs[_smobnum].free)                                         \
 103       {                                                                   \
 104         GC_finalization_proc _prev_finalizer;                             \
 105         GC_PTR _prev_finalizer_data;                                      \
 106                                                                           \
 107         GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (z), scm_i_finalize_smob, \
 108                                         NULL,                             \
 109                                         &_prev_finalizer,                 \
 110                                         &_prev_finalizer_data);           \
 111       }                                                                   \
 112   }                                                                       \
 113 while (0)
 114
 115 #define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3)                        \
 116   do { SCM __SCM_smob_answer;                                               \
 117        SCM_NEWSMOB3 (__SCM_smob_answer, (tc), (data1), (data2), (data3));   \
 118        return __SCM_smob_answer;                                            \
 119   } while (0)
 120
 121
 122 #define SCM_SMOB_DATA_N(x, n)           (SCM_CELL_WORD ((x), (n)))
 123 #define SCM_SET_SMOB_DATA_N(x, n, data) (SCM_SET_CELL_WORD ((x), (n), (data)))
 124
 125 #define SCM_SMOB_DATA_0(x)              (SCM_SMOB_DATA_N ((x), 0))
 126 #define SCM_SMOB_DATA_1(x)              (SCM_SMOB_DATA_N ((x), 1))
 127 #define SCM_SMOB_DATA_2(x)              (SCM_SMOB_DATA_N ((x), 2))
 128 #define SCM_SMOB_DATA_3(x)              (SCM_SMOB_DATA_N ((x), 3))
 129 #define SCM_SET_SMOB_DATA_0(x, data)    (SCM_SET_SMOB_DATA_N ((x), 0, (data)))
 130 #define SCM_SET_SMOB_DATA_1(x, data)    (SCM_SET_SMOB_DATA_N ((x), 1, (data)))
 131 #define SCM_SET_SMOB_DATA_2(x, data)    (SCM_SET_SMOB_DATA_N ((x), 2, (data)))
 132 #define SCM_SET_SMOB_DATA_3(x, data)    (SCM_SET_SMOB_DATA_N ((x), 3, (data)))
 133
 134 #define SCM_SMOB_FLAGS(x)               (SCM_SMOB_DATA_0 (x) >> 16)
 135 #define SCM_SMOB_DATA(x)                (SCM_SMOB_DATA_1 (x))
 136 #define SCM_SET_SMOB_FLAGS(x, data)     (SCM_SET_SMOB_DATA_0 ((x), (SCM_CELL_TYPE (x)&0xffff)|((data)<<16)))
 137 #define SCM_SET_SMOB_DATA(x, data)      (SCM_SET_SMOB_DATA_1 ((x), (data)))
 138
 139 #define SCM_SMOB_OBJECT_N(x,n)          (SCM_CELL_OBJECT ((x), (n)))
 140 #define SCM_SET_SMOB_OBJECT_N(x,n,obj)  (SCM_SET_CELL_OBJECT ((x), (n), (obj)))
 141 #define SCM_SMOB_OBJECT_N_LOC(x,n)      (SCM_CELL_OBJECT_LOC ((x), (n)))
 142
 143 /*#define SCM_SMOB_OBJECT_0(x)          (SCM_SMOB_OBJECT_N ((x), 0))*/
 144 #define SCM_SMOB_OBJECT_1(x)            (SCM_SMOB_OBJECT_N ((x), 1))
 145 #define SCM_SMOB_OBJECT_2(x)            (SCM_SMOB_OBJECT_N ((x), 2))
 146 #define SCM_SMOB_OBJECT_3(x)            (SCM_SMOB_OBJECT_N ((x), 3))
 147 /*#define SCM_SET_SMOB_OBJECT_0(x,obj)  (SCM_SET_SMOB_OBJECT_N ((x), 0, (obj)))*/
 148 #define SCM_SET_SMOB_OBJECT_1(x,obj)    (SCM_SET_SMOB_OBJECT_N ((x), 1, (obj)))
 149 #define SCM_SET_SMOB_OBJECT_2(x,obj)    (SCM_SET_SMOB_OBJECT_N ((x), 2, (obj)))
 150 #define SCM_SET_SMOB_OBJECT_3(x,obj)    (SCM_SET_SMOB_OBJECT_N ((x), 3, (obj)))
 151 #define SCM_SMOB_OBJECT_0_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 0)))
 152 #define SCM_SMOB_OBJECT_1_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 1)))
 153 #define SCM_SMOB_OBJECT_2_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 2)))
 154 #define SCM_SMOB_OBJECT_3_LOC(x)        (SCM_SMOB_OBJECT_N_LOC ((x), 3)))
 155
 156 #define SCM_SMOB_OBJECT(x)              (SCM_SMOB_OBJECT_1 (x))
 157 #define SCM_SET_SMOB_OBJECT(x,obj)      (SCM_SET_SMOB_OBJECT_1 ((x), (obj)))
 158 #define SCM_SMOB_OBJECT_LOC(x)          (SCM_SMOB_OBJECT_1_LOC (x)))
 159
 160
 161 #define SCM_SMOB_TYPE_MASK              0xffff
 162 #define SCM_SMOB_TYPE_BITS(tc)          (tc)
 163 #define SCM_TC2SMOBNUM(x)               (0x0ff & ((x) >> 8))
 164 #define SCM_SMOBNUM(x)                  (SCM_TC2SMOBNUM (SCM_CELL_TYPE (x)))
 165 /* SCM_SMOBNAME can be 0 if name is missing */
 166 #define SCM_SMOBNAME(smobnum)           (scm_smobs[smobnum].name)
 167 #define SCM_SMOB_PREDICATE(tag, obj)    SCM_TYP16_PREDICATE (tag, obj)
 168 #define SCM_SMOB_DESCRIPTOR(x)          (scm_smobs[SCM_SMOBNUM (x)])
 169 #define SCM_SMOB_APPLICABLE_P(x)        (SCM_SMOB_DESCRIPTOR (x).apply)
 170 #define SCM_SMOB_APPLY_0(x)             (scm_call_0 (x))
 171 #define SCM_SMOB_APPLY_1(x, a1)         (scm_call_1 (x, a1))
 172 #define SCM_SMOB_APPLY_2(x, a1, a2)     (scm_call_2 (x, a1, a2))
 173 #define SCM_SMOB_APPLY_3(x, a1, a2, rst) (scm_call_3 (x, a1, a2, a3))
 174
 175 /* Maximum number of SMOB types.  */
 176 #define SCM_I_MAX_SMOB_TYPE_COUNT  256
 177
 178 SCM_API long scm_numsmob;
 179 SCM_API scm_smob_descriptor scm_smobs[];
 180
 181 SCM_API void scm_i_finalize_smob (GC_PTR obj, GC_PTR data);
 182
 183 \f
 184
 185 SCM_API SCM scm_mark0 (SCM ptr);
 186 SCM_API SCM scm_markcdr (SCM ptr);
 187 SCM_API size_t scm_free0 (SCM ptr);
 188 SCM_API int scm_smob_print (SCM exp, SCM port, scm_print_state *pstate);
 189
 190 /* The following set of functions is the standard way to create new
 191  * SMOB types.
 192  *
 193  * Create a type tag using `scm_make_smob_type', accept default values
 194  * for mark, free, print and/or equalp functions, or set your own
 195  * values using `scm_set_smob_xxx'.
 196  */
 197
 198 SCM_API scm_t_bits scm_make_smob_type (char const *name, size_t size);
 199
 200 SCM_API void scm_set_smob_mark (scm_t_bits tc, SCM (*mark) (SCM));
 201 SCM_API void scm_set_smob_free (scm_t_bits tc, size_t (*free) (SCM));
 202 SCM_API void scm_set_smob_print (scm_t_bits tc,
 203                                  int (*print) (SCM, SCM, scm_print_state*));
 204 SCM_API void scm_set_smob_equalp (scm_t_bits tc, SCM (*equalp) (SCM, SCM));
 205 SCM_API void scm_set_smob_apply (scm_t_bits tc,
 206                                  scm_t_subr apply,
 207                                  unsigned int req,
 208                                  unsigned int opt,
 209                                  unsigned int rst);
 210
 211 SCM_API void scm_assert_smob_type (scm_t_bits tag, SCM val);
 212
 213 /* Function for creating smobs */
 214
 215 SCM_API SCM scm_make_smob (scm_t_bits tc);
 216
 217 SCM_INTERNAL SCM scm_i_smob_apply_trampoline (SCM smob);
 218
 219 SCM_API void scm_smob_prehistory (void);
 220
 221 #endif  /* SCM_SMOB_H */
 222
 223 /*
 224   Local Variables:
 225   c-file-style: "gnu"
 226   End:
 227 */