summaryrefslogtreecommitdiff
path: root/libguile/struct.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/struct.c')
-rw-r--r--libguile/struct.c128
1 files changed, 10 insertions, 118 deletions
diff --git a/libguile/struct.c b/libguile/struct.c
index db1687ef8..1a30fefc5 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -31,7 +31,6 @@
#include "libguile/chars.h"
#include "libguile/eval.h"
#include "libguile/alist.h"
-#include "libguile/weaks.h"
#include "libguile/hashtab.h"
#include "libguile/ports.h"
#include "libguile/strings.h"
@@ -562,61 +561,6 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
}
#undef FUNC_NAME
-
-
-#if SCM_ENABLE_DEPRECATED == 1
-SCM
-scm_make_vtable_vtable (SCM user_fields, SCM tail_array_size, SCM init)
-#define FUNC_NAME "make-vtable-vtable"
-{
- SCM fields, layout, obj;
- size_t basic_size, n_tail, i, n_init;
- long ilen;
- scm_t_bits *v;
-
- SCM_VALIDATE_STRING (1, user_fields);
- ilen = scm_ilength (init);
- if (ilen < 0)
- SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL);
-
- n_init = (size_t)ilen + 1; /* + 1 for the layout */
-
- /* best to use alloca, but init could be big, so hack to avoid a possible
- stack overflow */
- if (n_init < 64)
- v = alloca (n_init * sizeof(scm_t_bits));
- else
- v = scm_gc_malloc (n_init * sizeof(scm_t_bits), "struct");
-
- fields = scm_string_append (scm_list_2 (required_vtable_fields,
- user_fields));
- layout = scm_make_struct_layout (fields);
- if (!scm_is_valid_vtable_layout (layout))
- SCM_MISC_ERROR ("invalid user fields", scm_list_1 (user_fields));
-
- basic_size = scm_i_symbol_length (layout) / 2;
- n_tail = scm_to_size_t (tail_array_size);
-
- i = 0;
- v[i++] = SCM_UNPACK (layout);
- for (; i < n_init; i++, init = SCM_CDR (init))
- v[i] = SCM_UNPACK (SCM_CAR (init));
-
- SCM_CRITICAL_SECTION_START;
- obj = scm_i_alloc_struct (NULL, basic_size + n_tail);
- /* Make it so that the vtable of OBJ is itself. */
- SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) | scm_tc3_struct);
- SCM_CRITICAL_SECTION_END;
-
- scm_struct_init (obj, layout, n_tail, n_init, v);
- SCM_SET_VTABLE_FLAGS (obj,
- SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
-
- return obj;
-}
-#undef FUNC_NAME
-#endif
-
SCM
scm_i_make_vtable_vtable (SCM user_fields)
#define FUNC_NAME "make-vtable-vtable"
@@ -922,55 +866,6 @@ scm_struct_ihashq (SCM obj, unsigned long n, void *closure)
return SCM_UNPACK (obj) % n;
}
-/* Return the hash of struct OBJ, modulo N. Traverse OBJ's fields to
- compute the result, unless DEPTH is zero. */
-unsigned long
-scm_i_struct_hash (SCM obj, unsigned long n, size_t depth)
-#define FUNC_NAME "hash"
-{
- SCM layout;
- scm_t_bits *data;
- size_t struct_size, field_num;
- unsigned long hash;
-
- SCM_VALIDATE_STRUCT (1, obj);
-
- layout = SCM_STRUCT_LAYOUT (obj);
- struct_size = scm_i_symbol_length (layout) / 2;
- data = SCM_STRUCT_DATA (obj);
-
- hash = SCM_UNPACK (SCM_STRUCT_VTABLE (obj)) % n;
- if (depth > 0)
- for (field_num = 0; field_num < struct_size; field_num++)
- {
- int protection;
-
- protection = scm_i_symbol_ref (layout, field_num * 2 + 1);
- if (protection != 'h' && protection != 'o')
- {
- int type;
- type = scm_i_symbol_ref (layout, field_num * 2);
- switch (type)
- {
- case 'p':
- hash ^= scm_hasher (SCM_PACK (data[field_num]), n,
- depth / 2);
- break;
- case 'u':
- hash ^= data[field_num] % n;
- break;
- default:
- /* Ignore 's' fields. */;
- }
- }
- }
-
- /* FIXME: Tail elements should be taken into account. */
-
- return hash % n;
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_struct_vtable_name, "struct-vtable-name", 1, 0, 0,
(SCM vtable),
"Return the name of the vtable @var{vtable}.")
@@ -1008,22 +903,22 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
{
SCM vtable = SCM_STRUCT_VTABLE (exp);
SCM name = scm_struct_vtable_name (vtable);
- scm_puts ("#<", port);
+ scm_puts_unlocked ("#<", port);
if (scm_is_true (name))
{
scm_display (name, port);
- scm_putc (' ', port);
+ scm_putc_unlocked (' ', port);
}
else
{
if (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_VTABLE))
- scm_puts ("vtable:", port);
+ scm_puts_unlocked ("vtable:", port);
else
- scm_puts ("struct:", port);
+ scm_puts_unlocked ("struct:", port);
scm_uintprint (SCM_UNPACK (vtable), 16, port);
- scm_putc (' ', port);
+ scm_putc_unlocked (' ', port);
scm_write (SCM_VTABLE_LAYOUT (vtable), port);
- scm_putc (' ', port);
+ scm_putc_unlocked (' ', port);
}
scm_uintprint (SCM_UNPACK (exp), 16, port);
/* hackety hack */
@@ -1031,19 +926,19 @@ scm_print_struct (SCM exp, SCM port, scm_print_state *pstate)
{
if (scm_is_true (SCM_STRUCT_PROCEDURE (exp)))
{
- scm_puts (" proc: ", port);
+ scm_puts_unlocked (" proc: ", port);
if (scm_is_true (scm_procedure_p (SCM_STRUCT_PROCEDURE (exp))))
scm_write (SCM_STRUCT_PROCEDURE (exp), port);
else
- scm_puts ("(not a procedure?)", port);
+ scm_puts_unlocked ("(not a procedure?)", port);
}
if (SCM_STRUCT_SETTER_P (exp))
{
- scm_puts (" setter: ", port);
+ scm_puts_unlocked (" setter: ", port);
scm_write (SCM_STRUCT_SETTER (exp), port);
}
}
- scm_putc ('>', port);
+ scm_putc_unlocked ('>', port);
}
}
@@ -1095,9 +990,6 @@ scm_init_struct ()
scm_from_int (scm_vtable_index_instance_printer));
scm_c_define ("vtable-offset-user", scm_from_int (scm_vtable_offset_user));
#include "libguile/struct.x"
-#if SCM_ENABLE_DEPRECATED
- scm_c_define_gsubr ("make-vtable-vtable", 2, 0, 1, scm_make_vtable_vtable);
-#endif
}
/*