summaryrefslogtreecommitdiff
path: root/libguile/struct.c
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1999-03-14 16:52:32 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1999-03-14 16:52:32 +0000
commit98d5f6018aaaff6a76081ea8712568bb3336455e (patch)
tree38d8a8cb0ecfca4cb7eb74de1a45295e55d83212 /libguile/struct.c
parentda61c37a083928f8de0d4fc549718f9c95552926 (diff)
downloadguile-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.c69
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));