-/* Copyright (C) 1996 Free Software Foundation, Inc.
+/* Copyright (C) 1996, 1997 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
#include "_scm.h"
#include "chars.h"
#include "genio.h"
+#include "eval.h"
#include "struct.h"
case 'p':
if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
- *mem = SCM_EOL;
+ *mem = SCM_BOOL_F;
else
{
*mem = SCM_CAR (inits);
SCM_ASSERT (SCM_INUMP (tail_array_size), tail_array_size, SCM_ARG2,
s_make_struct);
- layout = SCM_STRUCT_DATA (vtable)[scm_struct_i_layout];
+ layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout];
basic_size = SCM_LENGTH (layout) / 2;
tail_elts = SCM_INUM (tail_array_size);
SCM_NEWCELL (handle);
SCM port;
scm_print_state *pstate;
{
-#if 0 /* XXX - too verbose */
- SCM * data;
- SCM layout;
- int p;
- int n_fields;
- unsigned char * fields_desc;
- unsigned char field_type;
-
- layout = SCM_STRUCT_LAYOUT (exp);
- data = SCM_STRUCT_DATA (exp);
-
- fields_desc = (unsigned char *)SCM_CHARS (layout);
- n_fields = data[scm_struct_i_n_words] - scm_struct_n_extra_words;
-
- scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1, port);
- for (p = 0; p < n_fields; p++)
+ if (SCM_NFALSEP (scm_procedure_p (SCM_STRUCT_PRINTER (exp))))
+ scm_printer_apply (SCM_STRUCT_PRINTER (exp), exp, port, pstate);
+ else
{
- if (fields_desc[2*p] == 'p')
- scm_iprin1 (data[p], port, pstate);
- if (p < n_fields-1)
- scm_gen_putc (' ', port);
+ scm_lfwrite ("#<struct ", sizeof ("#<struct ") - 1, port);
+ scm_intprint (SCM_STRUCT_VTABLE (exp), 16, port);
+ scm_putc (':', port);
+ scm_intprint (exp, 16, port);
+ scm_putc ('>', port);
}
- scm_gen_putc ('>', port);
-#else
- scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1, port);
- scm_intprint (exp, 16, port);
- scm_gen_putc ('>', port);
-#endif
}
void
scm_init_struct ()
{
- required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosr", sizeof ("pruosr") - 1, SCM_BOOL_F));
+ required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosrpw", sizeof ("pruosrpw") - 1, SCM_BOOL_F));
scm_permanent_object (required_vtable_fields);
- scm_sysintern ("struct-vtable-offset", SCM_MAKINUM (scm_struct_i_vtable_offset));
+ scm_sysintern ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
+ scm_sysintern ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
+ scm_sysintern ("vtable-index-printer", SCM_MAKINUM (scm_vtable_index_printer));
+ scm_sysintern ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
#include "struct.x"
}
-