diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-03-14 16:52:32 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-03-14 16:52:32 +0000 |
commit | 98d5f6018aaaff6a76081ea8712568bb3336455e (patch) | |
tree | 38d8a8cb0ecfca4cb7eb74de1a45295e55d83212 /libguile/struct.c | |
parent | da61c37a083928f8de0d4fc549718f9c95552926 (diff) | |
download | guile-98d5f6018aaaff6a76081ea8712568bb3336455e.tar.gz |
* struct.c: #include "alist.h", "weaks.h", "hashtab.h";
(scm_struct_table): Weak key table with auxilliary information for
struct types. Currently used for names and wrapper classes.
(scm_struct_ihashq): Hash function for structs.
(scm_struct_create_handle): Get/create entry in scm_struct_table.
(scm_struct_vtable_name, scm_set_struct_vtable_name_x): Procedures
for accessing names of vtables. The record implementation in
boot-9.scm currently uses the setter to record the name of record
types. When the object system is initialized, it can use this
information to create wrapper classes with suitable names.
(scm_init_struct): Allocate scm_struct_table.
(scm_alloc_struct): Don't initialize scm_struct_i_tag here.
(struct tags are a finite resource and we might want to restrict
the use of tags to vtables only. E.g., Goops only uses tags for
classes.)
(scm_make_struct): Use scm_struct_entity_n_extra_words instead of
magic number 5.
(scm_struct_vtable_tag): Use scm_struct_i_tag instead of magic
number -1.
Diffstat (limited to 'libguile/struct.c')
-rw-r--r-- | libguile/struct.c | 69 |
1 files changed, 64 insertions, 5 deletions
diff --git a/libguile/struct.c b/libguile/struct.c index 4caadcfd7..b5cd7f4a9 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -45,6 +45,9 @@ #include "chars.h" #include "genio.h" #include "eval.h" +#include "alist.h" +#include "weaks.h" +#include "hashtab.h" #include "struct.h" @@ -56,6 +59,7 @@ static SCM required_vtable_fields = SCM_BOOL_F; static int struct_num = 0; +SCM scm_struct_table; SCM_PROC (s_struct_make_layout, "make-struct-layout", 1, 0, 0, scm_make_struct_layout); @@ -322,10 +326,9 @@ scm_alloc_struct (int n_words, int n_extra, char *who) /* Adjust it even further so it's aligned on an eight-byte boundary. */ p = (SCM *) (((SCM) p + 7) & ~7); - /* Initialize a few fields as described above. */ + /* Initialize a few fields as described above, except for the tag. */ p[scm_struct_i_ptr] = (SCM) block; p[scm_struct_i_n_words] = (SCM) (n_words + n_extra); - p[scm_struct_i_tag] = struct_num++; return p; } @@ -358,7 +361,7 @@ scm_make_struct (vtable, tail_array_size, init) if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) { data = scm_alloc_struct (basic_size + tail_elts, - scm_struct_n_extra_words + 5, + scm_struct_entity_n_extra_words, "make-struct"); data[scm_struct_i_proc + 0] = SCM_BOOL_F; data[scm_struct_i_proc + 1] = SCM_BOOL_F; @@ -370,6 +373,7 @@ scm_make_struct (vtable, tail_array_size, init) data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, "make-struct"); + data[scm_struct_i_tag] = struct_num++; SCM_SETCDR (handle, data); SCM_SETCAR (handle, ((SCM)SCM_STRUCT_DATA (vtable)) + scm_tc3_cons_gloc); scm_struct_init (handle, tail_elts, init); @@ -410,6 +414,7 @@ scm_make_vtable_vtable (extra_fields, tail_array_size, init) data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, "make-vtable-vtable"); + data[scm_struct_i_tag] = struct_num++; SCM_SETCDR (handle, data); SCM_SETCAR (handle, ((SCM)data) + scm_tc3_cons_gloc); SCM_STRUCT_LAYOUT (handle) = layout; @@ -599,9 +604,61 @@ SCM scm_struct_vtable_tag (handle) SCM handle; { - SCM_ASSERT (SCM_NIMP (handle) && (SCM_BOOL_F != scm_struct_vtable_p (handle)), + SCM_ASSERT (SCM_NFALSEP (scm_struct_vtable_p (handle)), handle, SCM_ARG1, s_struct_vtable_tag); - return scm_long2num (SCM_STRUCT_DATA (handle)[-1]); + return scm_long2num (SCM_STRUCT_DATA (handle)[scm_struct_i_tag]); +} + +/* {Associating names and classes with vtables} + * + * The name of a vtable should probably be stored as a slot. This is + * a backward compatible solution until agreement has been achieved on + * how to associate names with vtables. + */ + +unsigned int +scm_struct_ihashq (SCM obj, unsigned int n) +{ + return (SCM_STRUCT_DATA (obj)[scm_struct_i_tag] & ~SCM_STRUCTF_MASK) % n; +} + +SCM +scm_struct_create_handle (SCM obj) +{ + SCM handle = scm_hash_fn_create_handle_x (scm_struct_table, + obj, + SCM_BOOL_F, + scm_struct_ihashq, + scm_sloppy_assq, + 0); + if (SCM_FALSEP (SCM_CDR (handle))) + SCM_SETCDR (handle, scm_cons (SCM_BOOL_F, SCM_BOOL_F)); + return handle; +} + +SCM_PROC (s_struct_vtable_name, "struct-vtable-name", 1, 0, 0, scm_struct_vtable_name); + +SCM +scm_struct_vtable_name (SCM vtable) +{ + SCM_ASSERT (SCM_NFALSEP (scm_struct_vtable_p (vtable)), + vtable, SCM_ARG1, s_struct_vtable_name); + + return SCM_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable))); +} + +SCM_PROC (s_set_struct_vtable_name_x, "set-struct-vtable-name!", 2, 0, 0, scm_set_struct_vtable_name_x); + +SCM +scm_set_struct_vtable_name_x (SCM vtable, SCM name) +{ + SCM_ASSERT (SCM_NIMP (vtable) && SCM_NFALSEP (scm_struct_vtable_p (vtable)), + vtable, SCM_ARG1, s_set_struct_vtable_name_x); + SCM_ASSERT (SCM_NIMP (name) && SCM_SYMBOLP (name), + name, SCM_ARG2, s_set_struct_vtable_name_x); + SCM_SET_STRUCT_TABLE_NAME (SCM_CDR (scm_struct_create_handle (vtable)), + name); + return SCM_UNSPECIFIED; } @@ -628,6 +685,8 @@ scm_print_struct (exp, port, pstate) void scm_init_struct () { + scm_struct_table + = scm_permanent_object (scm_make_weak_key_hash_table (SCM_MAKINUM (31))); required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosrpw", sizeof ("pruosrpw") - 1, SCM_BOOL_F)); scm_permanent_object (required_vtable_fields); scm_sysintern ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout)); |