summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-12 01:19:49 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-12 01:19:49 +0000
commitd8c40b9f49836a0d8c28b49ff5346033c50e113d (patch)
tree35920f5d7debfed249a1e01ba3eebf8d9dc1bbc3
parent1c3e63f06d87913b08ced09d0db6196a2fde8143 (diff)
downloadguile-d8c40b9f49836a0d8c28b49ff5346033c50e113d.tar.gz
The struct data is now an array of scm_bits_t variables.
-rw-r--r--libguile/ChangeLog17
-rw-r--r--libguile/eval.c10
-rw-r--r--libguile/objects.c8
-rw-r--r--libguile/objects.h12
-rw-r--r--libguile/struct.c60
-rw-r--r--libguile/struct.h2
6 files changed, 57 insertions, 52 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 1cd729fdb..57869d819 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,22 @@
2000-04-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
+ * eval.c (SCM_CEVAL), objects.c (scm_mcache_lookup_cmethod,
+ scm_make_subclass_object), objects.h (SCM_CLASS_FLAGS,
+ SCM_ENTITY_PROCEDURE, SCM_ENTITY_SETTER), struct.c
+ (scm_struct_init, scm_struct_vtable_p, scm_make_struct,
+ scm_struct_ref, scm_struct_set_x), struct.h (SCM_STRUCT_DATA):
+ The struct data is now an array of scm_bits_t variables.
+
+ * objects.h (SCM_SET_ENTITY_PROCEDURE): New macro.
+
+ * objects.c (scm_set_object_procedure_x): Use it.
+
+ * struct.c (scm_struct_init): Unused variable 'data' removed.
+
+ (scm_struct_vtable_p): Redundant SCM_IMP tests removed.
+
+2000-04-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
* objects.h (SCM_OBJ_CLASS_FLAGS, SCM_OBJ_CLASS_REDEF), struct.h
(SCM_STRUCT_VTABLE_DATA, SCM_STRUCT_LAYOUT, SCM_STRUCT_VTABLE,
SCM_STRUCT_PRINTER): The struct vtable data is now an array of
diff --git a/libguile/eval.c b/libguile/eval.c
index 68e30b4a1..c17e4787d 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -2299,8 +2299,8 @@ dispatch:
if (SCM_NIMP (t.arg1))
do
{
- i += SCM_UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1))))
- [scm_si_hashsets + hashset]);
+ i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))
+ [scm_si_hashsets + hashset];
t.arg1 = SCM_CDR (t.arg1);
}
while (--j && SCM_NIMP (t.arg1));
@@ -2344,15 +2344,15 @@ dispatch:
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
- RETURN (SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CADR (x))])
+ RETURN (SCM_PACK (SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CADR (x))]))
case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
x = SCM_CDR (x);
proc = SCM_CDR (x);
- SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))]
- = EVALCAR (proc, env);
+ SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CAR (x))]
+ = SCM_UNPACK (EVALCAR (proc, env));
RETURN (SCM_UNSPECIFIED)
case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
diff --git a/libguile/objects.c b/libguile/objects.c
index d1473d3bb..03330eb4f 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -276,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
if (SCM_NIMP (ls))
do
{
- i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
- [scm_si_hashsets + hashset]);
+ i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
+ [scm_si_hashsets + hashset];
ls = SCM_CDR (ls);
}
while (--j && SCM_NIMP (ls));
@@ -390,7 +390,7 @@ SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
FUNC_NAME);
SCM_VALIDATE_PROC (2,proc);
if (SCM_I_ENTITYP (obj))
- SCM_ENTITY_PROCEDURE (obj) = proc;
+ SCM_SET_ENTITY_PROCEDURE (obj, proc);
else
SCM_OPERATOR_CLASS (obj)->procedure = proc;
return SCM_UNSPECIFIED;
@@ -455,7 +455,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
SCM pl;
SCM_VALIDATE_STRUCT (1,class);
SCM_VALIDATE_STRING (2,layout);
- pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
+ pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */
pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
diff --git a/libguile/objects.h b/libguile/objects.h
index 03aa52b22..389552c2b 100644
--- a/libguile/objects.h
+++ b/libguile/objects.h
@@ -67,10 +67,8 @@
* certain class or its subclasses when traversal of the inheritance
* graph would be too costly.
*/
-#define SCM_CLASS_FLAGS(class)\
- SCM_UNPACK (SCM_STRUCT_DATA (class)[scm_struct_i_flags])
-#define SCM_OBJ_CLASS_FLAGS(obj)\
- (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
+#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
+#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
@@ -92,8 +90,10 @@
#define SCM_I_ENTITYP(obj)\
((SCM_OBJ_CLASS_FLAGS (obj) & SCM_CLASSF_ENTITY) != 0)
#define SCM_ENTITY_PROCEDURE(obj) \
- (SCM_STRUCT_DATA (obj)[scm_struct_i_procedure])
-#define SCM_ENTITY_SETTER(obj) (SCM_STRUCT_DATA (obj)[scm_struct_i_setter])
+ (SCM_PACK (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure]))
+#define SCM_SET_ENTITY_PROCEDURE(obj,v) \
+ (SCM_STRUCT_DATA (obj) [scm_struct_i_procedure] = SCM_UNPACK (v))
+#define SCM_ENTITY_SETTER(obj) (SCM_PACK (SCM_STRUCT_DATA (obj)[scm_struct_i_setter]))
#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
diff --git a/libguile/struct.c b/libguile/struct.c
index bbae48bb9..b4482719b 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -151,19 +151,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
void
scm_struct_init (SCM handle, int tail_elts, SCM inits)
{
- SCM layout;
- SCM * data;
- unsigned char * fields_desc;
+ SCM layout = SCM_STRUCT_LAYOUT (handle);
+ unsigned char * fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
unsigned char prot = 0;
- int n_fields;
- SCM * mem;
+ int n_fields = SCM_LENGTH (layout) / 2;
+ scm_bits_t * mem = SCM_STRUCT_DATA (handle);
int tailp = 0;
-
- layout = SCM_STRUCT_LAYOUT (handle);
- data = SCM_STRUCT_DATA (handle);
- fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
- n_fields = SCM_LENGTH (layout) / 2;
- mem = SCM_STRUCT_DATA (handle);
+
while (n_fields)
{
if (!tailp)
@@ -174,7 +168,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
{
tailp = 1;
prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
- *mem++ = SCM_PACK (tail_elts);
+ *mem++ = tail_elts;
n_fields += tail_elts - 1;
if (n_fields == 0)
break;
@@ -200,19 +194,19 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
*mem = 0;
else
{
- *mem = SCM_PACK (scm_num2ulong (SCM_CAR (inits),
- SCM_ARGn,
- "scm_struct_init"));
+ *mem = scm_num2ulong (SCM_CAR (inits),
+ SCM_ARGn,
+ "scm_struct_init");
inits = SCM_CDR (inits);
}
break;
case 'p':
if ((prot != 'r' && prot != 'w') || SCM_NULLP (inits))
- *mem = SCM_BOOL_F;
+ *mem = SCM_UNPACK (SCM_BOOL_F);
else
{
- *mem = SCM_CAR (inits);
+ *mem = SCM_UNPACK (SCM_CAR (inits));
inits = SCM_CDR (inits);
}
@@ -232,7 +226,7 @@ scm_struct_init (SCM handle, int tail_elts, SCM inits)
#endif
case 's':
- *mem = handle;
+ *mem = SCM_UNPACK (handle);
break;
}
@@ -257,10 +251,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
#define FUNC_NAME s_scm_struct_vtable_p
{
SCM layout;
- SCM * mem;
-
- if (SCM_IMP (x))
- return SCM_BOOL_F;
+ scm_bits_t * mem;
if (!SCM_STRUCTP (x))
return SCM_BOOL_F;
@@ -279,10 +270,7 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
if (mem[1] != 0)
return SCM_BOOL_F;
- if (SCM_IMP (mem[0]))
- return SCM_BOOL_F;
-
- return SCM_BOOL(SCM_SYMBOLP (mem[0]));
+ return SCM_BOOL (SCM_SYMBOLP (SCM_PACK (mem[0])));
}
#undef FUNC_NAME
@@ -392,12 +380,12 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_VTABLE (1,vtable);
SCM_VALIDATE_INUM (2,tail_array_size);
- layout = SCM_STRUCT_DATA (vtable)[scm_vtable_index_layout];
+ layout = SCM_PACK (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_DEFER_INTS;
- if (SCM_UNPACK (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags]) & SCM_STRUCTF_ENTITY)
+ if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
{
data = scm_alloc_struct (basic_size + tail_elts,
scm_struct_entity_n_extra_words,
@@ -520,7 +508,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
#define FUNC_NAME s_scm_struct_ref
{
SCM answer = SCM_UNDEFINED;
- SCM * data;
+ scm_bits_t * data;
SCM layout;
int p;
scm_bits_t n_fields;
@@ -536,7 +524,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
p = SCM_INUM (pos);
fields_desc = (unsigned char *) SCM_CHARS (layout);
- n_fields = SCM_UNPACK (data[scm_struct_i_n_words]);
+ n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1,pos, p < n_fields);
@@ -564,7 +552,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
switch (field_type)
{
case 'u':
- answer = scm_ulong2num (SCM_UNPACK (data[p]));
+ answer = scm_ulong2num (data[p]);
break;
#if 0
@@ -579,7 +567,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
case 's':
case 'p':
- answer = data[p];
+ answer = SCM_PACK (data[p]);
break;
@@ -598,7 +586,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
"")
#define FUNC_NAME s_scm_struct_set_x
{
- SCM * data;
+ scm_bits_t * data;
SCM layout;
int p;
int n_fields;
@@ -613,7 +601,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
p = SCM_INUM (pos);
fields_desc = (unsigned char *)SCM_CHARS (layout);
- n_fields = SCM_UNPACK (data[scm_struct_i_n_words]);
+ n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1,pos, p < n_fields);
@@ -636,7 +624,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
switch (field_type)
{
case 'u':
- data[p] = SCM_PACK (SCM_NUM2ULONG (3, val));
+ data[p] = SCM_NUM2ULONG (3, val);
break;
#if 0
@@ -650,7 +638,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
#endif
case 'p':
- data[p] = val;
+ data[p] = SCM_UNPACK (val);
break;
case 's':
diff --git a/libguile/struct.h b/libguile/struct.h
index d76b0f968..1e81acd29 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -78,7 +78,7 @@ typedef scm_sizet (*scm_struct_free_t) (SCM *vtable, SCM *data);
(no hidden words) */
#define SCM_STRUCTP(X) (SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc))
-#define SCM_STRUCT_DATA(X) ((SCM *) SCM_UNPACK (SCM_CDR (X)))
+#define SCM_STRUCT_DATA(X) ((scm_bits_t *) SCM_CELL_WORD_1 (X))
#define SCM_STRUCT_VTABLE_DATA(X) ((scm_bits_t *) (SCM_CELL_WORD_0 (X) - 1))
#define SCM_STRUCT_LAYOUT(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))