fixes to goops + light structs + 'u' slots

[Andy Wingo]

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 <address@hidden>
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  <address@hidden>
+
+       * 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  <address@hidden>
 
        * 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 <address@hidden>
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  <address@hidden>
 
-       * 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 <address@hidden>
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  <address@hidden>
 
+       * 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