fixes to goops + light structs + 'u' slots

[Andy Wingo <wingo@pobox.com>]

[-- Attachment #1: Type: text/plain, Size: 356 bytes --]

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.


[-- Attachment #2: 0001-respect-slot-allocation-e.g.-for-read-only-slot.patch --]
[-- Type: text/x-patch, Size: 3220 bytes --]

From fdaf1acd1af034ae6ac3f3dbeeb58bf4d8cca0ce Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@unquote.local>
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  <wingo@pobox.com>
+
+	* 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  <ludo@gnu.org>
 
 	* 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-initialize-u-slots-to-0-not-SCM_UNPACK-SCM_GOOPS_.patch --]
[-- Type: text/x-patch, Size: 1714 bytes --]

From 687f8ab3f54170f04d31a5b18397238a92eea0b6 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@unquote.local>
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  <wingo@pobox.com>
 
-	* 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-fix-struct-ref-and-struct-set-on-light-structs.patch --]
[-- Type: text/x-patch, Size: 2239 bytes --]

From dde5041ecc1ba5b7f3e1bf182b3f98107d5efbd5 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@unquote.local>
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  <wingo@pobox.com>
 
+	* 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