1 /* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library 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 GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23 #include "libguile/_scm.h"
24 #include "libguile/chars.h"
25 #include "libguile/eval.h"
26 #include "libguile/alist.h"
27 #include "libguile/weaks.h"
28 #include "libguile/hashtab.h"
29 #include "libguile/ports.h"
30 #include "libguile/strings.h"
32 #include "libguile/validate.h"
33 #include "libguile/struct.h"
41 static SCM required_vtable_fields
= SCM_BOOL_F
;
45 SCM_DEFINE (scm_make_struct_layout
, "make-struct-layout", 1, 0, 0,
47 "Return a new structure layout object.\n\n"
48 "@var{fields} must be a string made up of pairs of characters\n"
49 "strung together. The first character of each pair describes a field\n"
50 "type, the second a field protection. Allowed types are 'p' for\n"
51 "GC-protected Scheme data, 'u' for unprotected binary data, and 's' for\n"
52 "a field that points to the structure itself. Allowed protections\n"
53 "are 'w' for mutable fields, 'r' for read-only fields, and 'o' for opaque\n"
54 "fields. The last field protection specification may be capitalized to\n"
55 "indicate that the field is a tail-array.")
56 #define FUNC_NAME s_scm_make_struct_layout
59 SCM_VALIDATE_STRING (1, fields
);
62 const char * field_desc
;
66 len
= scm_i_string_length (fields
);
68 SCM_MISC_ERROR ("odd length field specification: ~S",
71 field_desc
= scm_i_string_chars (fields
);
73 for (x
= 0; x
< len
; x
+= 2)
75 switch (field_desc
[x
])
86 SCM_MISC_ERROR ("unrecognized field type: ~S",
87 scm_list_1 (SCM_MAKE_CHAR (field_desc
[x
])));
90 switch (field_desc
[x
+ 1])
93 if (field_desc
[x
] == 's')
94 SCM_MISC_ERROR ("self fields not writable", SCM_EOL
);
101 if (field_desc
[x
] == 's')
102 SCM_MISC_ERROR ("self fields not allowed in tail array",
105 SCM_MISC_ERROR ("tail array field must be last field in layout",
109 SCM_MISC_ERROR ("unrecognized ref specification: ~S",
110 scm_list_1 (SCM_MAKE_CHAR (field_desc
[x
+ 1])));
113 if (field_desc
[x
] == 'd')
115 if (field_desc
[x
+ 2] != '-')
116 SCM_MISC_ERROR ("missing dash field at position ~A",
117 scm_list_1 (scm_from_int (x
/ 2)));
123 new_sym
= scm_string_to_symbol (fields
);
125 scm_remember_upto_here_1 (fields
);
135 scm_struct_init (SCM handle
, SCM layout
, scm_t_bits
* mem
, int tail_elts
, SCM inits
)
137 unsigned const char *fields_desc
=
138 (unsigned const char *) scm_i_symbol_chars (layout
) - 2;
139 unsigned char prot
= 0;
140 int n_fields
= scm_i_symbol_length (layout
) / 2;
148 prot
= fields_desc
[1];
149 if (SCM_LAYOUT_TAILP (prot
))
152 prot
= prot
== 'R' ? 'r' : prot
== 'W' ? 'w' : 'o';
154 n_fields
+= tail_elts
- 1;
160 switch (*fields_desc
)
164 if ((prot
!= 'r' && prot
!= 'w') || inits
== SCM_EOL
)
168 *mem
= scm_to_long (SCM_CAR (inits
));
169 inits
= SCM_CDR (inits
);
175 if ((prot
!= 'r' && prot
!= 'w') || scm_is_null (inits
))
179 *mem
= scm_to_ulong (SCM_CAR (inits
));
180 inits
= SCM_CDR (inits
);
185 if ((prot
!= 'r' && prot
!= 'w') || scm_is_null (inits
))
186 *mem
= SCM_UNPACK (SCM_BOOL_F
);
189 *mem
= SCM_UNPACK (SCM_CAR (inits
));
190 inits
= SCM_CDR (inits
);
197 if ((prot
!= 'r' && prot
!= 'w') || inits
== SCM_EOL
)
198 *((double *)mem
) = 0.0;
201 *mem
= scm_num2dbl (SCM_CAR (inits
), "scm_struct_init");
202 inits
= SCM_CDR (inits
);
209 *mem
= SCM_UNPACK (handle
);
219 SCM_DEFINE (scm_struct_p
, "struct?", 1, 0, 0,
221 "Return @code{#t} iff @var{x} is a structure object, else\n"
223 #define FUNC_NAME s_scm_struct_p
225 return scm_from_bool(SCM_STRUCTP (x
));
229 SCM_DEFINE (scm_struct_vtable_p
, "struct-vtable?", 1, 0, 0,
231 "Return @code{#t} iff @var{x} is a vtable structure.")
232 #define FUNC_NAME s_scm_struct_vtable_p
238 if (!SCM_STRUCTP (x
))
241 layout
= SCM_STRUCT_LAYOUT (x
);
243 if (scm_i_symbol_length (layout
)
244 < scm_i_string_length (required_vtable_fields
))
247 tmp
= strncmp (scm_i_symbol_chars (layout
),
248 scm_i_string_chars (required_vtable_fields
),
249 scm_i_string_length (required_vtable_fields
));
250 scm_remember_upto_here_1 (required_vtable_fields
);
254 mem
= SCM_STRUCT_DATA (x
);
256 return scm_from_bool (scm_is_symbol (SCM_PACK (mem
[scm_vtable_index_layout
])));
261 /* All struct data must be allocated at an address whose bottom three
262 bits are zero. This is because the tag for a struct lives in the
263 bottom three bits of the struct's car, and the upper bits point to
264 the data of its vtable, which is a struct itself. Thus, if the
265 address of that data doesn't end in three zeros, tagging it will
268 This function allocates a block of memory, and returns a pointer at
269 least scm_struct_n_extra_words words into the block. Furthermore,
270 it guarantees that that pointer's least three significant bits are
273 The argument n_words should be the number of words that should
274 appear after the returned address. (That is, it shouldn't include
275 scm_struct_n_extra_words.)
277 This function initializes the following fields of the struct:
279 scm_struct_i_ptr --- the actual start of the block of memory; the
280 address you should pass to 'free' to dispose of the block.
281 This field allows us to both guarantee that the returned
282 address is divisible by eight, and allow the GC to free the
285 scm_struct_i_n_words --- the number of words allocated to the
286 block, including the extra fields. This is used by the GC.
292 scm_alloc_struct (int n_words
, int n_extra
, const char *what
)
294 int size
= sizeof (scm_t_bits
) * (n_words
+ n_extra
) + 7;
295 void * block
= scm_gc_malloc (size
, what
);
297 /* Adjust the pointer to hide the extra words. */
298 scm_t_bits
* p
= (scm_t_bits
*) block
+ n_extra
;
300 /* Adjust it even further so it's aligned on an eight-byte boundary. */
301 p
= (scm_t_bits
*) (((scm_t_bits
) p
+ 7) & ~7);
303 /* Initialize a few fields as described above. */
304 p
[scm_struct_i_free
] = (scm_t_bits
) scm_struct_free_standard
;
305 p
[scm_struct_i_ptr
] = (scm_t_bits
) block
;
306 p
[scm_struct_i_n_words
] = n_words
;
307 p
[scm_struct_i_flags
] = 0;
313 scm_struct_free_0 (scm_t_bits
* vtable SCM_UNUSED
,
314 scm_t_bits
* data SCM_UNUSED
)
319 scm_struct_free_light (scm_t_bits
* vtable
, scm_t_bits
* data
)
321 size_t n
= vtable
[scm_struct_i_size
] & ~SCM_STRUCTF_MASK
;
322 scm_gc_free (data
, n
, "struct");
326 scm_struct_free_standard (scm_t_bits
* vtable SCM_UNUSED
, scm_t_bits
* data
)
328 size_t n
= (data
[scm_struct_i_n_words
] + scm_struct_n_extra_words
)
329 * sizeof (scm_t_bits
) + 7;
330 scm_gc_free ((void *) data
[scm_struct_i_ptr
], n
, "heavy struct");
334 scm_struct_free_entity (scm_t_bits
* vtable SCM_UNUSED
, scm_t_bits
* data
)
336 size_t n
= (data
[scm_struct_i_n_words
] + scm_struct_entity_n_extra_words
)
337 * sizeof (scm_t_bits
) + 7;
338 scm_gc_free ((void *) data
[scm_struct_i_ptr
], n
, "entity struct");
342 scm_struct_gc_init (void *dummy1 SCM_UNUSED
,
343 void *dummy2 SCM_UNUSED
,
344 void *dummy3 SCM_UNUSED
)
346 scm_i_structs_to_free
= SCM_EOL
;
351 scm_free_structs (void *dummy1 SCM_UNUSED
,
352 void *dummy2 SCM_UNUSED
,
353 void *dummy3 SCM_UNUSED
)
355 SCM newchain
= scm_i_structs_to_free
;
358 /* Mark vtables in GC chain. GC mark set means delay freeing. */
359 SCM chain
= newchain
;
360 while (!scm_is_null (chain
))
362 SCM vtable
= SCM_STRUCT_VTABLE (chain
);
363 if (SCM_STRUCT_GC_CHAIN (vtable
) != 0 && vtable
!= chain
)
364 SCM_SET_GC_MARK (vtable
);
365 chain
= SCM_STRUCT_GC_CHAIN (chain
);
367 /* Free unmarked structs. */
370 while (!scm_is_null (chain
))
373 chain
= SCM_STRUCT_GC_CHAIN (chain
);
374 if (SCM_GC_MARK_P (obj
))
376 SCM_CLEAR_GC_MARK (obj
);
377 SCM_SET_STRUCT_GC_CHAIN (obj
, newchain
);
382 /* XXX - use less explicit code. */
383 scm_t_bits word0
= SCM_CELL_WORD_0 (obj
) - scm_tc3_struct
;
384 scm_t_bits
* vtable_data
= (scm_t_bits
*) word0
;
385 scm_t_bits
* data
= SCM_STRUCT_DATA (obj
);
386 scm_t_struct_free free_struct_data
387 = ((scm_t_struct_free
) vtable_data
[scm_struct_i_free
]);
388 SCM_SET_CELL_TYPE (obj
, scm_tc_free_cell
);
389 free_struct_data (vtable_data
, data
);
393 while (!scm_is_null (newchain
));
397 SCM_DEFINE (scm_make_struct
, "make-struct", 2, 0, 1,
398 (SCM vtable
, SCM tail_array_size
, SCM init
),
399 "Create a new structure.\n\n"
400 "@var{type} must be a vtable structure (@pxref{Vtables}).\n\n"
401 "@var{tail-elts} must be a non-negative integer. If the layout\n"
402 "specification indicated by @var{type} includes a tail-array,\n"
403 "this is the number of elements allocated to that array.\n\n"
404 "The @var{init1}, @dots{} are optional arguments describing how\n"
405 "successive fields of the structure should be initialized. Only fields\n"
406 "with protection 'r' or 'w' can be initialized, except for fields of\n"
407 "type 's', which are automatically initialized to point to the new\n"
408 "structure itself; fields with protection 'o' can not be initialized by\n"
409 "Scheme programs.\n\n"
410 "If fewer optional arguments than initializable fields are supplied,\n"
411 "fields of type 'p' get default value #f while fields of type 'u' are\n"
412 "initialized to 0.\n\n"
413 "Structs are currently the basic representation for record-like data\n"
414 "structures in Guile. The plan is to eventually replace them with a\n"
415 "new representation which will at the same time be easier to use and\n"
417 "For more information, see the documentation for @code{make-vtable-vtable}.")
418 #define FUNC_NAME s_scm_make_struct
426 SCM_VALIDATE_VTABLE (1, vtable
);
427 SCM_VALIDATE_REST_ARGUMENT (init
);
429 layout
= SCM_PACK (SCM_STRUCT_DATA (vtable
) [scm_vtable_index_layout
]);
430 basic_size
= scm_i_symbol_length (layout
) / 2;
431 tail_elts
= scm_to_size_t (tail_array_size
);
433 if (SCM_STRUCT_DATA (vtable
)[scm_struct_i_flags
] & SCM_STRUCTF_ENTITY
)
435 data
= scm_alloc_struct (basic_size
+ tail_elts
,
436 scm_struct_entity_n_extra_words
,
438 data
[scm_struct_i_procedure
] = SCM_UNPACK (SCM_BOOL_F
);
439 data
[scm_struct_i_setter
] = SCM_UNPACK (SCM_BOOL_F
);
442 data
= scm_alloc_struct (basic_size
+ tail_elts
,
443 scm_struct_n_extra_words
,
445 handle
= scm_double_cell ((((scm_t_bits
) SCM_STRUCT_DATA (vtable
))
447 (scm_t_bits
) data
, 0, 0);
448 scm_struct_init (handle
, layout
, data
, tail_elts
, init
);
456 SCM_DEFINE (scm_make_vtable_vtable
, "make-vtable-vtable", 2, 0, 1,
457 (SCM user_fields
, SCM tail_array_size
, SCM init
),
458 "Return a new, self-describing vtable structure.\n\n"
459 "@var{user-fields} is a string describing user defined fields of the\n"
460 "vtable beginning at index @code{vtable-offset-user}\n"
461 "(see @code{make-struct-layout}).\n\n"
462 "@var{tail-size} specifies the size of the tail-array (if any) of\n"
464 "@var{init1}, @dots{} are the optional initializers for the fields of\n"
466 "Vtables have one initializable system field---the struct printer.\n"
467 "This field comes before the user fields in the initializers passed\n"
468 "to @code{make-vtable-vtable} and @code{make-struct}, and thus works as\n"
469 "a third optional argument to @code{make-vtable-vtable} and a fourth to\n"
470 "@code{make-struct} when creating vtables:\n\n"
471 "If the value is a procedure, it will be called instead of the standard\n"
472 "printer whenever a struct described by this vtable is printed.\n"
473 "The procedure will be called with arguments STRUCT and PORT.\n\n"
474 "The structure of a struct is described by a vtable, so the vtable is\n"
475 "in essence the type of the struct. The vtable is itself a struct with\n"
476 "a vtable. This could go on forever if it weren't for the\n"
477 "vtable-vtables which are self-describing vtables, and thus terminate\n"
479 "There are several potential ways of using structs, but the standard\n"
480 "one is to use three kinds of structs, together building up a type\n"
481 "sub-system: one vtable-vtable working as the root and one or several\n"
482 "\"types\", each with a set of \"instances\". (The vtable-vtable should be\n"
483 "compared to the class <class> which is the class of itself.)\n\n"
485 "(define ball-root (make-vtable-vtable \"pr\" 0))\n\n"
486 "(define (make-ball-type ball-color)\n"
487 " (make-struct ball-root 0\n"
488 " (make-struct-layout \"pw\")\n"
489 " (lambda (ball port)\n"
490 " (format port \"#<a ~A ball owned by ~A>\"\n"
494 "(define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))\n"
495 "(define (owner ball) (struct-ref ball 0))\n\n"
496 "(define red (make-ball-type 'red))\n"
497 "(define green (make-ball-type 'green))\n\n"
498 "(define (make-ball type owner) (make-struct type 0 owner))\n\n"
499 "(define ball (make-ball green 'Nisse))\n"
500 "ball @result{} #<a green ball owned by Nisse>\n"
502 #define FUNC_NAME s_scm_make_vtable_vtable
511 SCM_VALIDATE_STRING (1, user_fields
);
512 SCM_VALIDATE_REST_ARGUMENT (init
);
514 fields
= scm_string_append (scm_list_2 (required_vtable_fields
,
516 layout
= scm_make_struct_layout (fields
);
517 basic_size
= scm_i_symbol_length (layout
) / 2;
518 tail_elts
= scm_to_size_t (tail_array_size
);
520 data
= scm_alloc_struct (basic_size
+ tail_elts
,
521 scm_struct_n_extra_words
,
523 handle
= scm_double_cell ((scm_t_bits
) data
+ scm_tc3_struct
,
524 (scm_t_bits
) data
, 0, 0);
525 data
[scm_vtable_index_layout
] = SCM_UNPACK (layout
);
526 scm_struct_init (handle
, layout
, data
, tail_elts
, scm_cons (layout
, init
));
535 SCM_DEFINE (scm_struct_ref
, "struct-ref", 2, 0, 0,
536 (SCM handle
, SCM pos
),
537 "@deffnx {Scheme Procedure} struct-set! struct n value\n"
538 "Access (or modify) the @var{n}th field of @var{struct}.\n\n"
539 "If the field is of type 'p', then it can be set to an arbitrary value.\n\n"
540 "If the field is of type 'u', then it can only be set to a non-negative\n"
541 "integer value small enough to fit in one machine word.")
542 #define FUNC_NAME s_scm_struct_ref
544 SCM answer
= SCM_UNDEFINED
;
550 const char *fields_desc
;
554 SCM_VALIDATE_STRUCT (1, handle
);
556 layout
= SCM_STRUCT_LAYOUT (handle
);
557 data
= SCM_STRUCT_DATA (handle
);
558 p
= scm_to_size_t (pos
);
560 fields_desc
= scm_i_symbol_chars (layout
);
561 layout_len
= scm_i_symbol_length (layout
);
562 n_fields
= data
[scm_struct_i_n_words
];
564 SCM_ASSERT_RANGE(1, pos
, p
< n_fields
);
566 if (p
* 2 < layout_len
)
569 field_type
= fields_desc
[p
* 2];
570 ref
= fields_desc
[p
* 2 + 1];
571 if ((ref
!= 'r') && (ref
!= 'w'))
573 if ((ref
== 'R') || (ref
== 'W'))
576 SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos
));
579 else if (fields_desc
[layout_len
- 1] != 'O')
580 field_type
= fields_desc
[layout_len
- 2];
582 SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos
));
587 answer
= scm_from_ulong (data
[p
]);
592 answer
= scm_from_long (data
[p
]);
596 answer
= scm_make_real (*((double *)&(data
[p
])));
602 answer
= SCM_PACK (data
[p
]);
607 SCM_MISC_ERROR ("unrecognized field type: ~S",
608 scm_list_1 (SCM_MAKE_CHAR (field_type
)));
616 SCM_DEFINE (scm_struct_set_x
, "struct-set!", 3, 0, 0,
617 (SCM handle
, SCM pos
, SCM val
),
618 "Set the slot of the structure @var{handle} with index @var{pos}\n"
619 "to @var{val}. Signal an error if the slot can not be written\n"
621 #define FUNC_NAME s_scm_struct_set_x
628 const char *fields_desc
;
631 SCM_VALIDATE_STRUCT (1, handle
);
633 layout
= SCM_STRUCT_LAYOUT (handle
);
634 data
= SCM_STRUCT_DATA (handle
);
635 p
= scm_to_size_t (pos
);
637 fields_desc
= scm_i_symbol_chars (layout
);
638 layout_len
= scm_i_symbol_length (layout
);
639 n_fields
= data
[scm_struct_i_n_words
];
641 SCM_ASSERT_RANGE (1, pos
, p
< n_fields
);
643 if (p
* 2 < layout_len
)
646 field_type
= fields_desc
[p
* 2];
647 set_x
= fields_desc
[p
* 2 + 1];
649 SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos
));
651 else if (fields_desc
[layout_len
- 1] == 'W')
652 field_type
= fields_desc
[layout_len
- 2];
654 SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos
));
659 data
[p
] = SCM_NUM2ULONG (3, val
);
664 data
[p
] = SCM_NUM2LONG (3, val
);
668 *((double *)&(data
[p
])) = scm_num2dbl (val
, (char *)SCM_ARG3
);
673 data
[p
] = SCM_UNPACK (val
);
677 SCM_MISC_ERROR ("self fields immutable", SCM_EOL
);
680 SCM_MISC_ERROR ("unrecognized field type: ~S",
681 scm_list_1 (SCM_MAKE_CHAR (field_type
)));
689 SCM_DEFINE (scm_struct_vtable
, "struct-vtable", 1, 0, 0,
691 "Return the vtable structure that describes the type of @var{struct}.")
692 #define FUNC_NAME s_scm_struct_vtable
694 SCM_VALIDATE_STRUCT (1, handle
);
695 return SCM_STRUCT_VTABLE (handle
);
700 SCM_DEFINE (scm_struct_vtable_tag
, "struct-vtable-tag", 1, 0, 0,
702 "Return the vtable tag of the structure @var{handle}.")
703 #define FUNC_NAME s_scm_struct_vtable_tag
705 SCM_VALIDATE_VTABLE (1, handle
);
706 return scm_from_ulong (((unsigned long)SCM_STRUCT_DATA (handle
)) >> 3);
710 /* {Associating names and classes with vtables}
712 * The name of a vtable should probably be stored as a slot. This is
713 * a backward compatible solution until agreement has been achieved on
714 * how to associate names with vtables.
718 scm_struct_ihashq (SCM obj
, unsigned long n
)
720 /* The length of the hash table should be a relative prime it's not
721 necessary to shift down the address. */
722 return SCM_UNPACK (obj
) % n
;
726 scm_struct_create_handle (SCM obj
)
728 SCM handle
= scm_hash_fn_create_handle_x (scm_struct_table
,
734 if (scm_is_false (SCM_CDR (handle
)))
735 SCM_SETCDR (handle
, scm_cons (SCM_BOOL_F
, SCM_BOOL_F
));
739 SCM_DEFINE (scm_struct_vtable_name
, "struct-vtable-name", 1, 0, 0,
741 "Return the name of the vtable @var{vtable}.")
742 #define FUNC_NAME s_scm_struct_vtable_name
744 SCM_VALIDATE_VTABLE (1, vtable
);
745 return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable
)));
749 SCM_DEFINE (scm_set_struct_vtable_name_x
, "set-struct-vtable-name!", 2, 0, 0,
750 (SCM vtable
, SCM name
),
751 "Set the name of the vtable @var{vtable} to @var{name}.")
752 #define FUNC_NAME s_scm_set_struct_vtable_name_x
754 SCM_VALIDATE_VTABLE (1, vtable
);
755 SCM_VALIDATE_SYMBOL (2, name
);
756 SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable
)),
758 return SCM_UNSPECIFIED
;
766 scm_print_struct (SCM exp
, SCM port
, scm_print_state
*pstate
)
768 if (scm_is_true (scm_procedure_p (SCM_STRUCT_PRINTER (exp
))))
769 scm_printer_apply (SCM_STRUCT_PRINTER (exp
), exp
, port
, pstate
);
772 SCM vtable
= SCM_STRUCT_VTABLE (exp
);
773 SCM name
= scm_struct_vtable_name (vtable
);
774 scm_puts ("#<", port
);
775 if (scm_is_true (name
))
776 scm_display (name
, port
);
778 scm_puts ("struct", port
);
779 scm_putc (' ', port
);
780 scm_intprint (SCM_UNPACK (vtable
), 16, port
);
781 scm_putc (':', port
);
782 scm_intprint (SCM_UNPACK (exp
), 16, port
);
783 scm_putc ('>', port
);
788 scm_struct_prehistory ()
790 scm_i_structs_to_free
= SCM_EOL
;
791 scm_c_hook_add (&scm_before_sweep_c_hook
, scm_struct_gc_init
, 0, 0);
792 /* With the new lazy sweep GC, the point at which the entire heap is
793 swept is just before the mark phase. */
794 scm_c_hook_add (&scm_before_mark_c_hook
, scm_free_structs
, 0, 0);
801 = scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31)));
802 required_vtable_fields
= scm_from_locale_string ("prsrpw");
803 scm_permanent_object (required_vtable_fields
);
804 scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout
));
805 scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable
));
806 scm_c_define ("vtable-index-printer",
807 scm_from_int (scm_vtable_index_printer
));
808 scm_c_define ("vtable-offset-user", scm_from_int (scm_vtable_offset_user
));
809 #include "libguile/struct.x"