libguile/struct.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM_STRUCT_H
   4 #define SCM_STRUCT_H
   5
   6 /* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2015 Free Software Foundation, Inc.
   7  *
   8  * This library is free software; you can redistribute it and/or
   9  * modify it under the terms of the GNU Lesser General Public License
  10  * as published by the Free Software Foundation; either version 3 of
  11  * the License, or (at your option) any later version.
  12  *
  13  * This library is distributed in the hope that it will be useful, but
  14  * WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16  * Lesser General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with this library; if not, write to the Free Software
  20  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  21  * 02110-1301 USA
  22  */
  23
  24 \f
  25
  26 #include "libguile/__scm.h"
  27 #include "libguile/print.h"
  28
  29 \f
  30
  31 /* The relationship between a struct and its vtable is a bit complicated,
  32    because we want structs to be used as GOOPS' native representation -- which
  33    in turn means we need support for changing the "class" (vtable) of an
  34    "instance" (struct). This necessitates some indirection and trickery.
  35
  36    To summarize, structs are laid out this way:
  37
  38                   .-------.
  39                   |       |
  40      .----------------+---v------------- -
  41      | vtable | data  | slot0 | slot1 |
  42      `----------------+----------------- -
  43          |        .-------.
  44          |        |       |
  45      .---v------------+---v------------- -
  46      | vtable | data  | slot0 | slot1 |
  47      `----------------+----------------- -
  48          |
  49          v
  50
  51         ...
  52                   .-------.
  53          |        |       |
  54      .---v------------+---v------------- -
  55    .-| vtable | data  | slot0 | slot1 |
  56    | `----------------+----------------- -
  57    |     ^
  58    `-----'
  59
  60    The DATA indirection (which corresponds to `SCM_STRUCT_DATA ()') is necessary
  61    to implement class redefinition.
  62
  63    For more details, see:
  64
  65      http://wingolog.org/archives/2009/11/09/class-redefinition-in-guile
  66
  67  */
  68
  69 /* All vtables have the following fields. */
  70 #define SCM_VTABLE_BASE_LAYOUT                                          \
  71   "pr" /* layout */                                                     \
  72   "uh" /* flags */                                                      \
  73   "sr" /* self */                                                       \
  74   "uh" /* finalizer */                                                  \
  75   "pw" /* printer */                                                    \
  76   "ph" /* name (hidden from make-struct for back-compat reasons) */     \
  77   "uh" /* size */                                                       \
  78   "uh" /* reserved */
  79
  80 #define scm_vtable_index_layout            0 /* A symbol describing the physical arrangement of this type. */
  81 #define scm_vtable_index_flags             1 /* Class flags */
  82 #define scm_vtable_index_self              2 /* A pointer to the vtable itself */
  83 #define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */
  84 #define scm_vtable_index_instance_printer  4 /* A printer for this struct type. */
  85 #define scm_vtable_index_name              5 /* Name of this vtable. */
  86 #define scm_vtable_index_size              6 /* Number of fields, for simple structs.  */
  87 #define scm_vtable_index_reserved_7        7
  88 #define scm_vtable_offset_user             8 /* Where do user fields start in the vtable? */
  89
  90 /* All applicable structs have the following fields. */
  91 #define SCM_APPLICABLE_BASE_LAYOUT              \
  92   "pw" /* procedure */
  93 #define SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT  \
  94   "pw" /* procedure */                          \
  95   "pw" /* setter */
  96 #define scm_applicable_struct_index_procedure 0 /* The procedure of an applicable
  97                                                    struct. Only valid if the
  98                                                    struct's vtable has the
  99                                                    applicable flag set. */
 100 #define scm_applicable_struct_index_setter    1 /* The setter of an applicable
 101                                                    struct. Only valid if the
 102                                                    struct's vtable has the
 103                                                    setter flag set. */
 104
 105 #define SCM_VTABLE_FLAG_VALIDATED (1L << 0) /* the layout of this vtable been validated? */
 106 #define SCM_VTABLE_FLAG_VTABLE (1L << 1) /* instances of this vtable are themselves vtables? */
 107 #define SCM_VTABLE_FLAG_APPLICABLE_VTABLE (1L << 2) /* instances of this vtable are applicable vtables? */
 108 #define SCM_VTABLE_FLAG_APPLICABLE (1L << 3) /* instances of this vtable are applicable? */
 109 #define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 4) /* instances of this vtable are applicable-with-setter vtables? */
 110 #define SCM_VTABLE_FLAG_SETTER (1L << 5) /* instances of this vtable are applicable-with-setters? */
 111 #define SCM_VTABLE_FLAG_SIMPLE (1L << 6) /* instances of this vtable have only "p" fields and no tail array*/
 112 #define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 7) /* instances of this vtable have only "pw" fields and no tail array */
 113 #define SCM_VTABLE_FLAG_RESERVED_0 (1L << 8)
 114 #define SCM_VTABLE_FLAG_RESERVED_1 (1L << 9)
 115 #define SCM_VTABLE_FLAG_RESERVED_2 (1L << 10)
 116 #define SCM_VTABLE_FLAG_SMOB_0 (1L << 11)
 117 #define SCM_VTABLE_FLAG_GOOPS_0 (1L << 12)
 118 #define SCM_VTABLE_FLAG_GOOPS_1 (1L << 13)
 119 #define SCM_VTABLE_FLAG_GOOPS_2 (1L << 14)
 120 #define SCM_VTABLE_FLAG_GOOPS_3 (1L << 15)
 121 #define SCM_VTABLE_USER_FLAG_SHIFT 16
 122
 123 typedef void (*scm_t_struct_finalize) (SCM obj);
 124
 125 #define SCM_STRUCTP(X)                  (!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct))
 126 #define SCM_STRUCT_SLOTS(X)             ((SCM*)SCM_CELL_WORD_1 ((X)))
 127 #define SCM_STRUCT_SLOT_REF(X,I)        (SCM_STRUCT_SLOTS (X)[(I)])
 128 #define SCM_STRUCT_SLOT_SET(X,I,V)      SCM_STRUCT_SLOTS (X)[(I)]=(V)
 129 #define SCM_STRUCT_DATA(X)              ((scm_t_bits*)SCM_CELL_WORD_1 (X))
 130 #define SCM_STRUCT_DATA_REF(X,I)        (SCM_STRUCT_DATA (X)[(I)])
 131 #define SCM_STRUCT_DATA_SET(X,I,V)      SCM_STRUCT_DATA (X)[(I)]=(V)
 132
 133 /* The SCM_VTABLE_* macros assume that you're passing them a struct which is a
 134    valid vtable. */
 135 #define SCM_VTABLE_LAYOUT(X)            (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout))
 136 #define SCM_SET_VTABLE_LAYOUT(X,L)      (SCM_STRUCT_SLOT_SET ((X), scm_vtable_index_layout, L))
 137 #define SCM_VTABLE_FLAGS(X)             (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags))
 138 #define SCM_SET_VTABLE_FLAGS(X,F)       (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) |= (F))
 139 #define SCM_CLEAR_VTABLE_FLAGS(X,F)     (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) &= (~(F)))
 140 #define SCM_VTABLE_FLAG_IS_SET(X,F)     (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) & (F))
 141 #define SCM_VTABLE_INSTANCE_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_DATA_REF (X, scm_vtable_index_instance_finalize))
 142 #define SCM_SET_VTABLE_INSTANCE_FINALIZER(X,P) (SCM_STRUCT_DATA_SET (X, scm_vtable_index_instance_finalize, (scm_t_bits)(P)))
 143 #define SCM_VTABLE_INSTANCE_PRINTER(X)  (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_instance_printer))
 144 #define SCM_SET_VTABLE_INSTANCE_PRINTER(X,P) (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_instance_printer, (P)))
 145 #define SCM_VTABLE_NAME(X)              (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_name))
 146 #define SCM_SET_VTABLE_NAME(X,V)        (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_name, V))
 147
 148 /* Structs hold a pointer to their vtable's data, not the vtable itself. To get
 149    the vtable we have to do an indirection through the self slot. */
 150 #define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
 151 #define SCM_STRUCT_VTABLE_SLOTS(X)      ((SCM*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct))
 152 #define SCM_STRUCT_VTABLE(X)            (SCM_STRUCT_VTABLE_SLOTS(X)[scm_vtable_index_self])
 153 /* But often we just need to access the vtable's data; we can do that without
 154    the data->self->data indirection. */
 155 #define SCM_STRUCT_LAYOUT(X)            (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_layout])
 156 #define SCM_STRUCT_PRINTER(X)           (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_instance_printer])
 157 #define SCM_STRUCT_FINALIZER(X)         ((scm_t_struct_finalize)SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_instance_finalize])
 158 #define SCM_STRUCT_VTABLE_FLAGS(X)      (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags])
 159 #define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags]&(F))
 160
 161 #define SCM_STRUCT_APPLICABLE_P(X)      (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_APPLICABLE))
 162 #define SCM_STRUCT_SETTER_P(X)          (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_SETTER))
 163 #define SCM_STRUCT_PROCEDURE(X)         (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_procedure))
 164 #define SCM_SET_STRUCT_PROCEDURE(X,P)   (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_procedure, P))
 165 #define SCM_STRUCT_SETTER(X)            (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_setter))
 166 #define SCM_SET_STRUCT_SETTER(X,P)      (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_setter, P))
 167
 168 SCM_API SCM scm_standard_vtable_vtable;
 169 SCM_API SCM scm_applicable_struct_vtable_vtable;
 170 SCM_API SCM scm_applicable_struct_with_setter_vtable_vtable;
 171
 172 \f
 173
 174 SCM_API SCM scm_make_struct_layout (SCM fields);
 175 SCM_API SCM scm_struct_p (SCM x);
 176 SCM_API SCM scm_struct_vtable_p (SCM x);
 177 SCM_INTERNAL SCM scm_allocate_struct (SCM vtable, SCM n_words);
 178 SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init);
 179 SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
 180                                scm_t_bits init, ...);
 181 SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits,
 182                                 scm_t_bits init[]);
 183 SCM_API SCM scm_make_vtable (SCM fields, SCM printer);
 184 SCM_INTERNAL SCM scm_i_make_vtable_vtable (SCM fields);
 185 SCM_API SCM scm_struct_ref (SCM handle, SCM pos);
 186 SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
 187 SCM_API SCM scm_struct_vtable (SCM handle);
 188 SCM_API SCM scm_struct_vtable_name (SCM vtable);
 189 SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name);
 190 SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *);
 191
 192 SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2);
 193 SCM_INTERNAL unsigned long scm_struct_ihashq (SCM, unsigned long, void *);
 194 SCM_INTERNAL SCM scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words);
 195 SCM_INTERNAL void scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj);
 196 SCM_INTERNAL void scm_init_struct (void);
 197
 198 #endif  /* SCM_STRUCT_H */
 199
 200 /*
 201   Local Variables:
 202   c-file-style: "gnu"
 203   End:
 204 */