Commit | Line | Data |
---|---|---|
78a0461a | 1 | /* Copyright (C) 1995, 1996, 1999 Free Software Foundation, Inc. |
1d9ee7c7 MD |
2 | * |
3 | * This program is free software; you can redistribute it and/or modify | |
4 | * it under the terms of the GNU General Public License as published by | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program is distributed in the hope that it will be useful, | |
9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * You should have received a copy of the GNU General Public License | |
14 | * along with this software; see the file COPYING. If not, write to | |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
16 | * Boston, MA 02111-1307 USA | |
17 | * | |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
40 | * If you do not wish that, delete this exception notice. */ | |
1bbd0b84 GB |
41 | |
42 | /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999, | |
43 | gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */ | |
44 | ||
1d9ee7c7 MD |
45 | \f |
46 | ||
da7f71d7 MD |
47 | /* This file and objects.h contains those minimal pieces of the Guile |
48 | * Object Oriented Programming System which need to be included in | |
49 | * libguile. See the comments in objects.h. | |
1d9ee7c7 MD |
50 | */ |
51 | ||
52 | #include "_scm.h" | |
53 | ||
54 | #include "struct.h" | |
47b21050 | 55 | #include "procprop.h" |
ab7288bc | 56 | #include "chars.h" |
547e65b5 | 57 | #include "keywords.h" |
ed6e0c83 | 58 | #include "smob.h" |
9de33deb MD |
59 | #include "eval.h" |
60 | #include "alist.h" | |
1d9ee7c7 | 61 | |
1bbd0b84 | 62 | #include "scm_validate.h" |
1d9ee7c7 MD |
63 | #include "objects.h" |
64 | \f | |
65 | ||
66 | SCM scm_metaclass_standard; | |
da7f71d7 | 67 | SCM scm_metaclass_operator; |
1d9ee7c7 | 68 | |
ab7288bc MD |
69 | /* These variables are filled in by the object system when loaded. */ |
70 | SCM scm_class_boolean, scm_class_char, scm_class_pair; | |
71 | SCM scm_class_procedure, scm_class_string, scm_class_symbol; | |
9de33deb | 72 | SCM scm_class_procedure_with_setter, scm_class_primitive_generic; |
ab7288bc | 73 | SCM scm_class_vector, scm_class_null; |
ed6e0c83 MD |
74 | SCM scm_class_integer, scm_class_real, scm_class_complex; |
75 | SCM scm_class_unknown; | |
ab7288bc | 76 | |
d0efbe61 | 77 | SCM *scm_port_class = 0; |
ed6e0c83 MD |
78 | SCM *scm_smob_class = 0; |
79 | ||
9de33deb MD |
80 | SCM scm_no_applicable_method; |
81 | ||
ed6e0c83 | 82 | SCM (*scm_make_extended_class) (char *type_name); |
c1636627 | 83 | void (*scm_make_port_classes) (int ptobnum, char *type_name); |
ab7288bc MD |
84 | void (*scm_change_object_class) (SCM, SCM, SCM); |
85 | ||
86 | /* This function is used for efficient type dispatch. */ | |
87 | SCM | |
88 | scm_class_of (SCM x) | |
89 | { | |
90 | switch (SCM_ITAG3 (x)) | |
91 | { | |
92 | case scm_tc3_int_1: | |
93 | case scm_tc3_int_2: | |
94 | return scm_class_integer; | |
95 | ||
96 | case scm_tc3_imm24: | |
97 | if (SCM_ICHRP (x)) | |
98 | return scm_class_char; | |
99 | else | |
100 | { | |
101 | switch (SCM_ISYMNUM (x)) | |
102 | { | |
103 | case SCM_ISYMNUM (SCM_BOOL_F): | |
104 | case SCM_ISYMNUM (SCM_BOOL_T): | |
105 | return scm_class_boolean; | |
106 | case SCM_ISYMNUM (SCM_EOL): | |
107 | return scm_class_null; | |
108 | default: | |
109 | return scm_class_unknown; | |
110 | } | |
111 | } | |
112 | ||
113 | case scm_tc3_cons: | |
114 | switch (SCM_TYP7 (x)) | |
115 | { | |
116 | case scm_tcs_cons_nimcar: | |
117 | return scm_class_pair; | |
118 | case scm_tcs_closures: | |
119 | return scm_class_procedure; | |
120 | case scm_tcs_symbols: | |
121 | return scm_class_symbol; | |
122 | case scm_tc7_vector: | |
123 | case scm_tc7_wvect: | |
afe5177e | 124 | #ifdef HAVE_ARRAYS |
ab7288bc MD |
125 | case scm_tc7_bvect: |
126 | case scm_tc7_byvect: | |
127 | case scm_tc7_svect: | |
128 | case scm_tc7_ivect: | |
129 | case scm_tc7_uvect: | |
130 | case scm_tc7_fvect: | |
131 | case scm_tc7_dvect: | |
132 | case scm_tc7_cvect: | |
afe5177e | 133 | #endif |
ab7288bc MD |
134 | return scm_class_vector; |
135 | case scm_tc7_string: | |
136 | case scm_tc7_substring: | |
137 | return scm_class_string; | |
138 | case scm_tc7_asubr: | |
139 | case scm_tc7_subr_0: | |
140 | case scm_tc7_subr_1: | |
141 | case scm_tc7_cxr: | |
142 | case scm_tc7_subr_3: | |
143 | case scm_tc7_subr_2: | |
144 | case scm_tc7_rpsubr: | |
145 | case scm_tc7_subr_1o: | |
146 | case scm_tc7_subr_2o: | |
147 | case scm_tc7_lsubr_2: | |
148 | case scm_tc7_lsubr: | |
9de33deb MD |
149 | if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x)) |
150 | return scm_class_primitive_generic; | |
151 | else | |
152 | return scm_class_procedure; | |
ed6e0c83 | 153 | case scm_tc7_cclo: |
ab7288bc MD |
154 | return scm_class_procedure; |
155 | case scm_tc7_pws: | |
156 | return scm_class_procedure_with_setter; | |
157 | ||
ab7288bc MD |
158 | case scm_tc7_smob: |
159 | { | |
160 | SCM type = SCM_TYP16 (x); | |
161 | if (type == scm_tc16_flo) | |
162 | { | |
163 | if (SCM_CAR (x) & SCM_IMAG_PART) | |
164 | return scm_class_complex; | |
165 | else | |
166 | return scm_class_real; | |
167 | } | |
55d54750 | 168 | else if (type != scm_tc16_port_with_ps) |
ed6e0c83 | 169 | return scm_smob_class[SCM_TC2SMOBNUM (type)]; |
55d54750 MD |
170 | x = SCM_PORT_WITH_PS_PORT (x); |
171 | /* fall through to ports */ | |
ab7288bc | 172 | } |
55d54750 MD |
173 | case scm_tc7_port: |
174 | return scm_port_class[(SCM_WRTNG & SCM_CAR (x) | |
175 | ? (SCM_RDNG & SCM_CAR (x) | |
176 | ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x) | |
177 | : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x)) | |
178 | : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))]; | |
ab7288bc MD |
179 | case scm_tcs_cons_gloc: |
180 | /* must be a struct */ | |
7151229d MD |
181 | if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID) |
182 | return SCM_CLASS_OF (x); | |
183 | else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS) | |
ed6e0c83 MD |
184 | { |
185 | /* Goops object */ | |
186 | if (SCM_OBJ_CLASS_REDEF (x) != SCM_BOOL_F) | |
187 | scm_change_object_class (x, | |
188 | SCM_CLASS_OF (x), /* old */ | |
189 | SCM_OBJ_CLASS_REDEF (x)); /* new */ | |
190 | return SCM_CLASS_OF (x); | |
191 | } | |
192 | else | |
193 | { | |
194 | /* ordinary struct */ | |
195 | SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x)); | |
196 | if (SCM_NFALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)))) | |
197 | return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle)); | |
198 | else | |
199 | { | |
200 | SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle)); | |
201 | SCM class = scm_make_extended_class (SCM_NFALSEP (name) | |
202 | ? SCM_ROCHARS (name) | |
203 | : 0); | |
204 | SCM_SET_STRUCT_TABLE_CLASS (handle, class); | |
205 | return class; | |
206 | } | |
207 | } | |
ab7288bc MD |
208 | default: |
209 | if (SCM_CONSP (x)) | |
210 | return scm_class_pair; | |
211 | else | |
212 | return scm_class_unknown; | |
213 | } | |
214 | ||
215 | case scm_tc3_cons_gloc: | |
216 | case scm_tc3_tc7_1: | |
217 | case scm_tc3_tc7_2: | |
218 | case scm_tc3_closure: | |
219 | /* Never reached */ | |
220 | break; | |
221 | } | |
222 | return scm_class_unknown; | |
223 | } | |
224 | ||
a12be546 MD |
225 | /* (SCM_IM_DISPATCH ARGS N-SPECIALIZED |
226 | * #((TYPE1 ... ENV FORMALS FORM ...) ...) | |
227 | * GF) | |
228 | * | |
229 | * (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK | |
230 | * #((TYPE1 ... ENV FORMALS FORM ...) ...) | |
231 | * GF) | |
232 | * | |
233 | * ARGS is either a list of expressions, in which case they | |
234 | * are interpreted as the arguments of an application, or | |
235 | * a non-pair, which is interpreted as a single expression | |
236 | * yielding all arguments. | |
237 | * | |
238 | * SCM_IM_DISPATCH expressions in generic functions always | |
239 | * have ARGS = the symbol `args' or the iloc #@0-0. | |
240 | * | |
241 | * Need FORMALS in order to support varying arity. This | |
242 | * also avoids the need for renaming of bindings. | |
243 | * | |
244 | * We should probably not complicate this mechanism by | |
245 | * introducing "optimizations" for getters and setters or | |
246 | * primitive methods. Getters and setter will normally be | |
247 | * compiled into @slot-[ref|set!] or a procedure call. | |
248 | * They rely on the dispatch performed before executing | |
249 | * the code which contains them. | |
250 | * | |
251 | * We might want to use a more efficient representation of | |
252 | * this form in the future, perhaps after we have introduced | |
253 | * low-level support for syntax-case macros. | |
254 | */ | |
255 | ||
9de33deb MD |
256 | SCM |
257 | scm_mcache_lookup_cmethod (SCM cache, SCM args) | |
258 | { | |
259 | int i, n, end, mask; | |
260 | SCM ls, methods, z = SCM_CDDR (cache); | |
261 | n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */ | |
262 | methods = SCM_CADR (z); | |
263 | ||
264 | if (SCM_NIMP (methods)) | |
265 | { | |
266 | /* Prepare for linear search */ | |
267 | mask = -1; | |
268 | i = 0; | |
269 | end = SCM_LENGTH (methods); | |
270 | } | |
271 | else | |
272 | { | |
273 | /* Compute a hash value */ | |
274 | int hashset = SCM_INUM (methods); | |
275 | int j = n; | |
276 | mask = SCM_INUM (SCM_CAR (z = SCM_CDDR (z))); | |
277 | methods = SCM_CADR (z); | |
278 | i = 0; | |
279 | ls = args; | |
a12be546 MD |
280 | if (SCM_NIMP (ls)) |
281 | do | |
282 | { | |
283 | i += (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls))) | |
284 | [scm_si_hashsets + hashset]); | |
285 | ls = SCM_CDR (ls); | |
286 | } | |
287 | while (--j && SCM_NIMP (ls)); | |
9de33deb MD |
288 | i &= mask; |
289 | end = i; | |
290 | } | |
291 | ||
292 | /* Search for match */ | |
293 | do | |
294 | { | |
295 | int j = n; | |
296 | z = SCM_VELTS (methods)[i]; | |
297 | ls = args; /* list of arguments */ | |
a12be546 MD |
298 | if (SCM_NIMP (ls)) |
299 | do | |
300 | { | |
301 | /* More arguments than specifiers => CLASS != ENV */ | |
302 | if (scm_class_of (SCM_CAR (ls)) != SCM_CAR (z)) | |
303 | goto next_method; | |
304 | ls = SCM_CDR (ls); | |
305 | z = SCM_CDR (z); | |
306 | } | |
307 | while (--j && SCM_NIMP (ls)); | |
9de33deb | 308 | /* Fewer arguments than specifiers => CAR != ENV */ |
0824bbb3 | 309 | if (!(SCM_IMP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z)))) |
9de33deb MD |
310 | goto next_method; |
311 | return z; | |
312 | next_method: | |
313 | i = (i + 1) & mask; | |
314 | } while (i != end); | |
315 | return SCM_BOOL_F; | |
316 | } | |
317 | ||
318 | SCM | |
a12be546 | 319 | scm_mcache_compute_cmethod (SCM cache, SCM args) |
9de33deb MD |
320 | { |
321 | SCM cmethod = scm_mcache_lookup_cmethod (cache, args); | |
322 | if (SCM_IMP (cmethod)) | |
323 | /* No match - memoize */ | |
324 | return scm_memoize_method (cache, args); | |
325 | return cmethod; | |
326 | } | |
327 | ||
328 | SCM | |
a12be546 | 329 | scm_apply_generic (SCM gf, SCM args) |
9de33deb | 330 | { |
a12be546 | 331 | SCM cmethod = scm_mcache_compute_cmethod (SCM_ENTITY_PROCEDURE (gf), args); |
9de33deb MD |
332 | return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)), |
333 | SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)), | |
334 | args, | |
335 | SCM_CMETHOD_ENV (cmethod))); | |
336 | } | |
337 | ||
338 | SCM | |
a12be546 | 339 | scm_call_generic_0 (SCM gf) |
9de33deb | 340 | { |
a12be546 | 341 | return scm_apply_generic (gf, SCM_EOL); |
9de33deb MD |
342 | } |
343 | ||
344 | SCM | |
a12be546 | 345 | scm_call_generic_1 (SCM gf, SCM a1) |
9de33deb | 346 | { |
a12be546 | 347 | return scm_apply_generic (gf, SCM_LIST1 (a1)); |
9de33deb MD |
348 | } |
349 | ||
350 | SCM | |
a12be546 MD |
351 | scm_call_generic_2 (SCM gf, SCM a1, SCM a2) |
352 | { | |
353 | return scm_apply_generic (gf, SCM_LIST2 (a1, a2)); | |
354 | } | |
355 | ||
356 | SCM | |
357 | scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3) | |
9de33deb | 358 | { |
a12be546 | 359 | return scm_apply_generic (gf, SCM_LIST3 (a1, a2, a3)); |
9de33deb MD |
360 | } |
361 | ||
1bbd0b84 GB |
362 | GUILE_PROC (scm_entity_p, "entity?", 1, 0, 0, |
363 | (SCM obj), | |
717050c8 | 364 | "") |
1bbd0b84 | 365 | #define FUNC_NAME s_scm_entity_p |
19c0dec2 | 366 | { |
0c95b57d | 367 | return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj)); |
19c0dec2 | 368 | } |
1bbd0b84 | 369 | #undef FUNC_NAME |
19c0dec2 | 370 | |
1bbd0b84 GB |
371 | GUILE_PROC (scm_operator_p, "operator?", 1, 0, 0, |
372 | (SCM obj), | |
717050c8 | 373 | "") |
1bbd0b84 | 374 | #define FUNC_NAME s_scm_operator_p |
a43a8375 | 375 | { |
1bbd0b84 GB |
376 | return SCM_BOOL(SCM_NIMP (obj) |
377 | && SCM_STRUCTP (obj) | |
378 | && SCM_I_OPERATORP (obj) | |
379 | && !SCM_I_ENTITYP (obj)); | |
a43a8375 | 380 | } |
1bbd0b84 | 381 | #undef FUNC_NAME |
a43a8375 | 382 | |
1bbd0b84 GB |
383 | GUILE_PROC (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0, |
384 | (SCM obj, SCM proc), | |
717050c8 | 385 | "") |
1bbd0b84 | 386 | #define FUNC_NAME s_scm_set_object_procedure_x |
47b21050 | 387 | { |
0c95b57d | 388 | SCM_ASSERT (SCM_STRUCTP (obj) |
c1a6fd8f MD |
389 | && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) |
390 | || (SCM_I_ENTITYP (obj) | |
391 | && !(SCM_OBJ_CLASS_FLAGS (obj) | |
392 | & SCM_CLASSF_PURE_GENERIC))), | |
47b21050 MD |
393 | obj, |
394 | SCM_ARG1, | |
1bbd0b84 GB |
395 | FUNC_NAME); |
396 | SCM_VALIDATE_PROC(2,proc); | |
a12be546 MD |
397 | if (SCM_I_ENTITYP (obj)) |
398 | SCM_ENTITY_PROCEDURE (obj) = proc; | |
399 | else | |
400 | SCM_OPERATOR_CLASS (obj)->procedure = proc; | |
47b21050 MD |
401 | return SCM_UNSPECIFIED; |
402 | } | |
1bbd0b84 | 403 | #undef FUNC_NAME |
47b21050 | 404 | |
a43a8375 | 405 | #ifdef GUILE_DEBUG |
1bbd0b84 GB |
406 | GUILE_PROC (scm_object_procedure, "object-procedure", 1, 0, 0, |
407 | (SCM obj), | |
717050c8 | 408 | "") |
1bbd0b84 | 409 | #define FUNC_NAME s_scm_object_procedure |
a43a8375 | 410 | { |
0c95b57d | 411 | SCM_ASSERT (SCM_STRUCTP (obj) |
a12be546 MD |
412 | && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR) |
413 | || SCM_I_ENTITYP (obj)), | |
1bbd0b84 | 414 | obj, SCM_ARG1, FUNC_NAME); |
a43a8375 | 415 | return (SCM_I_ENTITYP (obj) |
a12be546 MD |
416 | ? SCM_ENTITY_PROCEDURE (obj) |
417 | : SCM_OPERATOR_CLASS (obj)->procedure); | |
a43a8375 | 418 | } |
1bbd0b84 | 419 | #undef FUNC_NAME |
a43a8375 MD |
420 | #endif /* GUILE_DEBUG */ |
421 | ||
ed6e0c83 MD |
422 | /* The following procedures are not a part of Goops but a minimal |
423 | * object system built upon structs. They are here for those who | |
424 | * want to implement their own object system. | |
425 | */ | |
426 | ||
036737fc MD |
427 | SCM |
428 | scm_i_make_class_object (SCM meta, | |
429 | SCM layout_string, | |
430 | unsigned long flags) | |
47b21050 MD |
431 | { |
432 | SCM c; | |
036737fc | 433 | SCM layout = scm_make_struct_layout (layout_string); |
47b21050 MD |
434 | c = scm_make_struct (meta, |
435 | SCM_INUM0, | |
436 | SCM_LIST4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL)); | |
437 | SCM_SET_CLASS_FLAGS (c, flags); | |
438 | return c; | |
439 | } | |
440 | ||
1bbd0b84 GB |
441 | GUILE_PROC (scm_make_class_object, "make-class-object", 2, 0, 0, |
442 | (SCM metaclass, SCM layout), | |
717050c8 | 443 | "") |
1bbd0b84 | 444 | #define FUNC_NAME s_scm_make_class_object |
47b21050 MD |
445 | { |
446 | unsigned long flags = 0; | |
1bbd0b84 GB |
447 | SCM_VALIDATE_STRUCT(1,metaclass); |
448 | SCM_VALIDATE_STRING(2,layout); | |
47b21050 MD |
449 | if (metaclass == scm_metaclass_operator) |
450 | flags = SCM_CLASSF_OPERATOR; | |
036737fc | 451 | return scm_i_make_class_object (metaclass, layout, flags); |
47b21050 | 452 | } |
1bbd0b84 | 453 | #undef FUNC_NAME |
47b21050 | 454 | |
1bbd0b84 GB |
455 | GUILE_PROC (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, |
456 | (SCM class, SCM layout), | |
717050c8 | 457 | "") |
1bbd0b84 | 458 | #define FUNC_NAME s_scm_make_subclass_object |
47b21050 MD |
459 | { |
460 | SCM pl; | |
1bbd0b84 GB |
461 | SCM_VALIDATE_STRUCT(1,class); |
462 | SCM_VALIDATE_STRING(2,layout); | |
47b21050 | 463 | pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout]; |
036737fc | 464 | /* Convert symbol->string */ |
47b21050 | 465 | pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0); |
036737fc MD |
466 | return scm_i_make_class_object (SCM_STRUCT_VTABLE (class), |
467 | scm_string_append (SCM_LIST2 (pl, layout)), | |
468 | SCM_CLASS_FLAGS (class)); | |
47b21050 | 469 | } |
1bbd0b84 | 470 | #undef FUNC_NAME |
47b21050 | 471 | |
1d9ee7c7 MD |
472 | void |
473 | scm_init_objects () | |
474 | { | |
475 | SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT); | |
476 | SCM ml = scm_make_struct_layout (ms); | |
477 | SCM mt = scm_make_vtable_vtable (ml, SCM_INUM0, | |
478 | SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL)); | |
479 | ||
da7f71d7 MD |
480 | SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT); |
481 | SCM ol = scm_make_struct_layout (os); | |
482 | SCM ot = scm_make_vtable_vtable (ol, SCM_INUM0, | |
483 | SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL)); | |
484 | ||
1d9ee7c7 MD |
485 | SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT); |
486 | SCM el = scm_make_struct_layout (es); | |
487 | SCM et = scm_make_struct (mt, SCM_INUM0, | |
488 | SCM_LIST4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL)); | |
489 | ||
19c0dec2 | 490 | scm_sysintern ("<class>", mt); |
1d9ee7c7 | 491 | scm_metaclass_standard = mt; |
af3645c5 | 492 | scm_sysintern ("<operator-class>", ot); |
da7f71d7 MD |
493 | scm_metaclass_operator = ot; |
494 | SCM_SET_CLASS_FLAGS (et, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY); | |
135e76f8 | 495 | SCM_SET_CLASS_DESTRUCTOR (et, scm_struct_free_entity); |
af3645c5 | 496 | scm_sysintern ("<entity>", et); |
47b21050 MD |
497 | |
498 | #include "objects.x" | |
1d9ee7c7 | 499 | } |