Commit | Line | Data |
---|---|---|
0f2d19dd JB |
1 | /* classes: h_files */ |
2 | ||
729dbac3 DH |
3 | #ifndef SCM_STRUCT_H |
4 | #define SCM_STRUCT_H | |
b29058ff | 5 | |
d587c9e8 | 6 | /* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
b29058ff | 7 | * |
73be1d9e | 8 | * This library is free software; you can redistribute it and/or |
53befeb7 NJ |
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. | |
b29058ff | 12 | * |
53befeb7 NJ |
13 | * This library is distributed in the hope that it will be useful, but |
14 | * WITHOUT ANY WARRANTY; without even the implied warranty of | |
73be1d9e MV |
15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 | * Lesser General Public License for more details. | |
b29058ff | 17 | * |
73be1d9e MV |
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 | |
53befeb7 NJ |
20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
21 | * 02110-1301 USA | |
73be1d9e | 22 | */ |
d3a6bc94 | 23 | |
0f2d19dd JB |
24 | \f |
25 | ||
b4309c3c | 26 | #include "libguile/__scm.h" |
bafcafb2 | 27 | #include "libguile/print.h" |
0f2d19dd JB |
28 | |
29 | \f | |
30 | ||
b6cf4d02 AW |
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 | I would like to write this all up here, but for now: | |
37 | ||
ea68d342 | 38 | http://wingolog.org/archives/2009/11/09/class-redefinition-in-guile |
b6cf4d02 AW |
39 | */ |
40 | ||
41 | /* All vtables have the following fields. */ | |
2858deaf AW |
42 | #define SCM_VTABLE_BASE_LAYOUT \ |
43 | "pr" /* layout */ \ | |
44 | "uh" /* flags */ \ | |
45 | "sr" /* self */ \ | |
46 | "uh" /* finalizer */ \ | |
47 | "pw" /* printer */ \ | |
48 | "ph" /* name (hidden from make-struct for back-compat reasons) */ \ | |
49 | "uh" /* reserved */ \ | |
b6cf4d02 AW |
50 | "uh" /* reserved */ |
51 | ||
52 | #define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */ | |
53 | #define scm_vtable_index_flags 1 /* Class flags */ | |
54 | #define scm_vtable_index_self 2 /* A pointer to the vtable itself */ | |
55 | #define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */ | |
56 | #define scm_vtable_index_instance_printer 4 /* A printer for this struct type. */ | |
57 | #define scm_vtable_index_name 5 /* Name of this vtable. */ | |
58 | #define scm_vtable_index_reserved_6 6 | |
59 | #define scm_vtable_index_reserved_7 7 | |
60 | #define scm_vtable_offset_user 8 /* Where do user fields start in the vtable? */ | |
61 | ||
62 | /* All applicable structs have the following fields. */ | |
2858deaf | 63 | #define SCM_APPLICABLE_BASE_LAYOUT \ |
b6cf4d02 | 64 | "pw" /* procedure */ |
2858deaf AW |
65 | #define SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT \ |
66 | "pw" /* procedure */ \ | |
b6cf4d02 AW |
67 | "pw" /* setter */ |
68 | #define scm_applicable_struct_index_procedure 0 /* The procedure of an applicable | |
69 | struct. Only valid if the | |
70 | struct's vtable has the | |
71 | applicable flag set. */ | |
72 | #define scm_applicable_struct_index_setter 1 /* The setter of an applicable | |
73 | struct. Only valid if the | |
74 | struct's vtable has the | |
75 | setter flag set. */ | |
76 | ||
77 | #define SCM_VTABLE_FLAG_VTABLE (1L << 0) /* instances of this vtable are themselves vtables? */ | |
78 | #define SCM_VTABLE_FLAG_APPLICABLE_VTABLE (1L << 1) /* instances of this vtable are applicable vtables? */ | |
79 | #define SCM_VTABLE_FLAG_APPLICABLE (1L << 2) /* instances of this vtable are applicable? */ | |
80 | #define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 3) /* instances of this vtable are applicable-with-setter vtables? */ | |
81 | #define SCM_VTABLE_FLAG_SETTER (1L << 4) /* instances of this vtable are applicable-with-setters? */ | |
82 | #define SCM_VTABLE_FLAG_RESERVED_0 (1L << 5) | |
83 | #define SCM_VTABLE_FLAG_RESERVED_1 (1L << 6) | |
84 | #define SCM_VTABLE_FLAG_RESERVED_2 (1L << 7) | |
85 | #define SCM_VTABLE_FLAG_GOOPS_0 (1L << 8) | |
86 | #define SCM_VTABLE_FLAG_GOOPS_1 (1L << 9) | |
87 | #define SCM_VTABLE_FLAG_GOOPS_2 (1L << 10) | |
88 | #define SCM_VTABLE_FLAG_GOOPS_3 (1L << 11) | |
89 | #define SCM_VTABLE_FLAG_GOOPS_4 (1L << 12) | |
90 | #define SCM_VTABLE_FLAG_GOOPS_5 (1L << 13) | |
91 | #define SCM_VTABLE_FLAG_GOOPS_6 (1L << 14) | |
92 | #define SCM_VTABLE_FLAG_GOOPS_7 (1L << 15) | |
93 | #define SCM_VTABLE_USER_FLAG_SHIFT 16 | |
94 | ||
95 | typedef void (*scm_t_struct_finalize) (SCM obj); | |
0f2d19dd | 96 | |
b29058ff | 97 | #define SCM_STRUCTP(X) (!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct)) |
b6cf4d02 AW |
98 | #define SCM_STRUCT_SLOTS(X) ((SCM*)SCM_CELL_WORD_1 ((X))) |
99 | #define SCM_STRUCT_SLOT_REF(X,I) (SCM_STRUCT_SLOTS (X)[(I)]) | |
100 | #define SCM_STRUCT_SLOT_SET(X,I,V) SCM_STRUCT_SLOTS (X)[(I)]=(V) | |
101 | #define SCM_STRUCT_DATA(X) ((scm_t_bits*)SCM_CELL_WORD_1 (X)) | |
102 | #define SCM_STRUCT_DATA_REF(X,I) (SCM_STRUCT_DATA (X)[(I)]) | |
103 | #define SCM_STRUCT_DATA_SET(X,I,V) SCM_STRUCT_DATA (X)[(I)]=(V) | |
104 | ||
105 | /* The SCM_VTABLE_* macros assume that you're passing them a struct which is a | |
106 | valid vtable. */ | |
107 | #define SCM_VTABLE_LAYOUT(X) (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout)) | |
108 | #define SCM_SET_VTABLE_LAYOUT(X,L) (SCM_STRUCT_SLOT_SET ((X), scm_vtable_index_layout, L)) | |
109 | #define SCM_VTABLE_FLAGS(X) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags)) | |
110 | #define SCM_SET_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) |= (F)) | |
111 | #define SCM_CLEAR_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) &= (~(F))) | |
112 | #define SCM_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) & (F)) | |
113 | #define SCM_VTABLE_INSTANCE_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_SLOT_REF (X, scm_vtable_index_instance_finalize)) | |
114 | #define SCM_VTABLE_INSTANCE_PRINTER(X) (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_instance_printer)) | |
115 | #define SCM_VTABLE_NAME(X) (SCM_STRUCT_SLOT_REF (X, scm_vtable_index_name)) | |
116 | #define SCM_SET_VTABLE_NAME(X,V) (SCM_STRUCT_SLOT_SET (X, scm_vtable_index_name, V)) | |
117 | ||
118 | /* Structs hold a pointer to their vtable's data, not the vtable itself. To get | |
119 | the vtable we have to do an indirection through the self slot. */ | |
120 | #define SCM_STRUCT_VTABLE_DATA(X) ((scm_t_bits*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct)) | |
121 | #define SCM_STRUCT_VTABLE_SLOTS(X) ((SCM*)(SCM_CELL_WORD_0 (X) - scm_tc3_struct)) | |
122 | #define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_SLOTS(X)[scm_vtable_index_self]) | |
123 | /* But often we just need to access the vtable's data; we can do that without | |
124 | the data->self->data indirection. */ | |
125 | #define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_layout]) | |
126 | #define SCM_STRUCT_PRINTER(X) (SCM_STRUCT_VTABLE_SLOTS (X)[scm_vtable_index_instance_printer]) | |
127 | #define SCM_STRUCT_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_instance_finalize]) | |
128 | #define SCM_STRUCT_VTABLE_FLAGS(X) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags]) | |
129 | #define SCM_STRUCT_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_VTABLE_DATA (X)[scm_vtable_index_flags]&(F)) | |
130 | ||
131 | #define SCM_STRUCT_APPLICABLE_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_APPLICABLE)) | |
132 | #define SCM_STRUCT_SETTER_P(X) (SCM_STRUCT_VTABLE_FLAG_IS_SET ((X), SCM_VTABLE_FLAG_SETTER)) | |
133 | #define SCM_STRUCT_PROCEDURE(X) (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_procedure)) | |
134 | #define SCM_SET_STRUCT_PROCEDURE(X,P) (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_procedure, P)) | |
135 | #define SCM_STRUCT_SETTER(X) (SCM_STRUCT_SLOT_REF (X, scm_applicable_struct_index_setter)) | |
136 | #define SCM_SET_STRUCT_SETTER(X,P) (SCM_STRUCT_SLOT_SET (X, scm_applicable_struct_index_setter, P)) | |
0f2d19dd | 137 | |
6decd505 MD |
138 | #define SCM_STRUCT_TABLE_NAME(X) SCM_CAR (X) |
139 | #define SCM_SET_STRUCT_TABLE_NAME(X, NAME) SCM_SETCAR (X, NAME) | |
140 | #define SCM_STRUCT_TABLE_CLASS(X) SCM_CDR (X) | |
141 | #define SCM_SET_STRUCT_TABLE_CLASS(X, CLASS) SCM_SETCDR (X, CLASS) | |
33b001fd | 142 | SCM_API SCM scm_struct_table; |
0f2d19dd | 143 | |
db5ed685 AW |
144 | SCM_API SCM scm_standard_vtable_vtable; |
145 | SCM_API SCM scm_applicable_struct_vtable_vtable; | |
146 | SCM_API SCM scm_applicable_struct_with_setter_vtable_vtable; | |
147 | ||
0f2d19dd | 148 | \f |
0f2d19dd | 149 | |
33b001fd MV |
150 | SCM_API SCM scm_make_struct_layout (SCM fields); |
151 | SCM_API SCM scm_struct_p (SCM x); | |
152 | SCM_API SCM scm_struct_vtable_p (SCM x); | |
153 | SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init); | |
66e78727 AW |
154 | SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits, |
155 | scm_t_bits init, ...); | |
156 | SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits, | |
157 | scm_t_bits init[]); | |
651f2cd2 | 158 | SCM_API SCM scm_make_vtable (SCM fields, SCM printer); |
33b001fd MV |
159 | SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); |
160 | SCM_API SCM scm_struct_ref (SCM handle, SCM pos); | |
161 | SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val); | |
162 | SCM_API SCM scm_struct_vtable (SCM handle); | |
163 | SCM_API SCM scm_struct_vtable_tag (SCM handle); | |
33b001fd MV |
164 | SCM_API SCM scm_struct_create_handle (SCM obj); |
165 | SCM_API SCM scm_struct_vtable_name (SCM vtable); | |
166 | SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name); | |
167 | SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *); | |
51f66c91 AW |
168 | |
169 | SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2); | |
170 | SCM_INTERNAL unsigned long scm_struct_ihashq (SCM, unsigned long, void *); | |
171 | SCM_INTERNAL SCM scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words, const char *what); | |
172 | SCM_INTERNAL void scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj); | |
102dbb6f | 173 | SCM_INTERNAL void scm_init_struct (void); |
0f2d19dd | 174 | |
729dbac3 | 175 | #endif /* SCM_STRUCT_H */ |
89e00824 ML |
176 | |
177 | /* | |
178 | Local Variables: | |
179 | c-file-style: "gnu" | |
180 | End: | |
181 | */ |