diff options
Diffstat (limited to 'libguile/struct.c')
-rw-r--r-- | libguile/struct.c | 134 |
1 files changed, 13 insertions, 121 deletions
diff --git a/libguile/struct.c b/libguile/struct.c index 3906a42cf..c7f410b63 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -1,4 +1,5 @@ -/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, + * 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -31,7 +32,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" @@ -532,8 +532,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1, "Scheme programs.\n\n" "If fewer optional arguments than initializable fields are supplied,\n" "fields of type 'p' get default value #f while fields of type 'u' are\n" - "initialized to 0.\n\n" - "For more information, see the documentation for @code{make-vtable-vtable}.") + "initialized to 0.") #define FUNC_NAME s_scm_make_struct { size_t i, n_init; @@ -561,61 +560,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" @@ -921,55 +865,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}.") @@ -1007,22 +902,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 */ @@ -1030,19 +925,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); } } @@ -1094,9 +989,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 } /* |