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