Hey folks,
Here are some patches that fix some goops <-> light structs <-> 'u'
slots interactions. See
http://article.gmane.org/gmane.lisp.guile.user/6371 for the basic idea
of where this goes. I'll write more later, but I think that these fixes
are obviously correct.
Let me know how this formatting comes out, or if there's a better way or
something.
>From fdaf1acd1af034ae6ac3f3dbeeb58bf4d8cca0ce Mon Sep 17 00:00:00 2001
From: Andy Wingo <[EMAIL PROTECTED]>
Date: Thu, 10 Apr 2008 01:23:06 +0200
Subject: [PATCH] respect slot allocation, e.g. for <read-only-slot>
* libguile/goops.c (get_slot_value, set_slot_value): In the struct
allocation case, don't poke the slots array directly -- we should
go through struct-ref/struct-set! code so that we get the
permissions and allocation ('u' versus 'p') correct.
---
libguile/ChangeLog | 7 +++++++
libguile/goops.c | 11 +++++++++--
2 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index e22c8f2..3e7b398 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,10 @@
+2008-04-10 Andy Wingo <[EMAIL PROTECTED]>
+
+ * libguile/goops.c (get_slot_value, set_slot_value): In the struct
+ allocation case, don't poke the slots array directly -- we should
+ go through struct-ref/struct-set! code so that we get the
+ permissions and allocation ('u' versus 'p') correct.
+
2008-04-03 Ludovic Courtès <[EMAIL PROTECTED]>
* inline.h (SCM_C_EXTERN_INLINE): New macro, addresses the
diff --git a/libguile/goops.c b/libguile/goops.c
index 8e398e3..a6769cd 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1260,6 +1260,7 @@ slot_definition_using_name (SCM class, SCM slot_name)
static SCM
get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
+#define FUNC_NAME "%get-slot-value"
{
SCM access = SCM_CDDR (slotdef);
/* Two cases here:
@@ -1270,7 +1271,9 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
* we can just assume fixnums here.
*/
if (SCM_I_INUMP (access))
- return SCM_SLOT (obj, SCM_I_INUM (access));
+ /* Don't poke at the slots directly, because scm_struct_ref handles the
+ access bits for us. */
+ return scm_struct_ref (obj, access);
else
{
/* We must evaluate (apply (car access) (list obj))
@@ -1287,6 +1290,7 @@ get_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef)
return scm_eval_body (SCM_CLOSURE_BODY (code), env);
}
}
+#undef FUNC_NAME
static SCM
get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
@@ -1300,6 +1304,7 @@ get_slot_value_using_name (SCM class, SCM obj, SCM slot_name)
static SCM
set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
+#define FUNC_NAME "%set-slot-value"
{
SCM access = SCM_CDDR (slotdef);
/* Two cases here:
@@ -1310,7 +1315,8 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
* we can just assume fixnums here.
*/
if (SCM_I_INUMP (access))
- SCM_SET_SLOT (obj, SCM_I_INUM (access), value);
+ /* obey permissions bits via going through struct-set! */
+ scm_struct_set_x (obj, access, value);
else
{
/* We must evaluate (apply (cadr l) (list obj value))
@@ -1331,6 +1337,7 @@ set_slot_value (SCM class SCM_UNUSED, SCM obj, SCM slotdef, SCM value)
}
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
static SCM
set_slot_value_using_name (SCM class, SCM obj, SCM slot_name, SCM value)
--
1.5.5-rc1.GIT
>From 687f8ab3f54170f04d31a5b18397238a92eea0b6 Mon Sep 17 00:00:00 2001
From: Andy Wingo <[EMAIL PROTECTED]>
Date: Thu, 10 Apr 2008 01:27:19 +0200
Subject: [PATCH] initialize 'u' slots to 0, not SCM_UNPACK(SCM_GOOPS_UNBOUND)
* goops.c (wrap_init): Initialize 'u' slots to 0, not some random
SCM value.
---
libguile/ChangeLog | 5 ++++-
libguile/goops.c | 9 +++++++--
2 files changed, 11 insertions(+), 3 deletions(-)
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 3e7b398..cce8dbb 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,6 +1,9 @@
2008-04-10 Andy Wingo <[EMAIL PROTECTED]>
- * libguile/goops.c (get_slot_value, set_slot_value): In the struct
+ * goops.c (wrap_init): Initialize 'u' slots to 0, not some random
+ SCM value.
+
+ * goops.c (get_slot_value, set_slot_value): In the struct
allocation case, don't poke the slots array directly -- we should
go through struct-ref/struct-set! code so that we get the
permissions and allocation ('u' versus 'p') correct.
diff --git a/libguile/goops.c b/libguile/goops.c
index a6769cd..abb96ab 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1507,10 +1507,15 @@ static SCM
wrap_init (SCM class, SCM *m, long n)
{
long i;
+ scm_t_bits slayout = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
+ const char *layout = scm_i_symbol_chars (SCM_PACK (slayout));
- /* Set all slots to unbound */
+ /* Set all SCM-holding slots to unbound */
for (i = 0; i < n; i++)
- m[i] = SCM_GOOPS_UNBOUND;
+ if (layout[i*2] == 'p')
+ m[i] = SCM_GOOPS_UNBOUND;
+ else
+ m[i] = 0;
return scm_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (class))
| scm_tc3_struct),
--
1.5.5-rc1.GIT
>From dde5041ecc1ba5b7f3e1bf182b3f98107d5efbd5 Mon Sep 17 00:00:00 2001
From: Andy Wingo <[EMAIL PROTECTED]>
Date: Thu, 10 Apr 2008 01:32:14 +0200
Subject: [PATCH] fix struct-ref and struct-set! on "light" structs
* libguile/struct.c (scm_struct_ref, scm_struct_set_x): "Light" structs
have no hidden words (members of the SCM_STRUCT_DATA(x) array accessed
with negative indices). In that case, determine the number of fields
from the length of the struct layout descriptor. (Most GOOPS instances
are light structs.)
---
libguile/ChangeLog | 6 ++++++
libguile/struct.c | 12 ++++++++++--
2 files changed, 16 insertions(+), 2 deletions(-)
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index cce8dbb..0d91c6b 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,5 +1,11 @@
2008-04-10 Andy Wingo <[EMAIL PROTECTED]>
+ * struct.c (scm_struct_ref, scm_struct_set_x): "Light" structs
+ have no hidden words (members of the SCM_STRUCT_DATA(x) array
+ accessed with negative indices). In that case, determine the
+ number of fields from the length of the struct layout
+ descriptor. (Most GOOPS instances are light structs.)
+
* goops.c (wrap_init): Initialize 'u' slots to 0, not some random
SCM value.
diff --git a/libguile/struct.c b/libguile/struct.c
index c8d34a4..2d36303 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -659,7 +659,11 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
- n_fields = data[scm_struct_i_n_words];
+ if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
+ /* no extra words */
+ n_fields = layout_len / 2;
+ else
+ n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1, pos, p < n_fields);
@@ -736,7 +740,11 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
- n_fields = data[scm_struct_i_n_words];
+ if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
+ /* no extra words */
+ n_fields = layout_len / 2;
+ else
+ n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1, pos, p < n_fields);
--
1.5.5-rc1.GIT
