summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/struct.c140
-rw-r--r--libguile/struct.h5
2 files changed, 99 insertions, 46 deletions
diff --git a/libguile/struct.c b/libguile/struct.c
index ca6b324d9..f5cf28342 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -98,12 +98,22 @@ scm_make_struct_layout (fields)
switch (field_desc[x + 1])
{
case 'w':
- SCM_ASSERT ((field_desc[x] != 's'), SCM_MAKICHR (field_desc[x + 1]),
+ SCM_ASSERT (field_desc[x] != 's', SCM_MAKICHR (field_desc[x + 1]),
"self fields not writable", s_struct_make_layout);
case 'r':
case 'o':
break;
+ case 'R':
+ case 'W':
+ case 'O':
+ SCM_ASSERT (field_desc[x] != 's', SCM_MAKICHR (field_desc[x + 1]),
+ "self fields not allowed in tail array",
+ s_struct_make_layout);
+ SCM_ASSERT (x == len - 2, SCM_MAKICHR (field_desc[x + 1]),
+ "tail array field must be last field in layout",
+ s_struct_make_layout);
+ break;
default:
SCM_ASSERT (0, SCM_MAKICHR (field_desc[x]) , "unrecognized ref specification", s_struct_make_layout);
}
@@ -126,34 +136,50 @@ scm_make_struct_layout (fields)
#ifdef __STDC__
static void
-init_struct (SCM handle, SCM tail_elts, SCM inits)
+init_struct (SCM handle, int tail_elts, SCM inits)
#else
static void
init_struct (handle, tail_elts, inits)
SCM handle;
- SCM tail_elts;
+ int tail_elts;
SCM inits;
#endif
{
SCM layout;
SCM * data;
unsigned char * fields_desc;
+ unsigned char prot;
int n_fields;
SCM * mem;
-
+ int tailp = 0;
+
layout = SCM_STRUCT_LAYOUT (handle);
data = SCM_STRUCT_DATA (handle);
- fields_desc = (unsigned char *)SCM_CHARS (layout);
+ fields_desc = (unsigned char *) SCM_CHARS (layout) - 2;
n_fields = SCM_LENGTH (layout) / 2;
mem = SCM_STRUCT_DATA (handle);
while (n_fields)
{
+ if (!tailp)
+ {
+ fields_desc += 2;
+ prot = fields_desc[1];
+ if (SCM_LAYOUT_TAILP (prot))
+ {
+ tailp = 1;
+ prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
+ *mem++ = tail_elts;
+ n_fields += tail_elts - 1;
+ if (n_fields == 0)
+ break;
+ }
+ }
+
switch (*fields_desc)
{
#if 0
case 'i':
- if ( ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
- || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+ if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
*mem = 0;
else
{
@@ -164,8 +190,7 @@ init_struct (handle, tail_elts, inits)
#endif
case 'u':
- if ( ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
- || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+ if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
*mem = 0;
else
{
@@ -175,8 +200,7 @@ init_struct (handle, tail_elts, inits)
break;
case 'p':
- if ( ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
- || (inits == SCM_EOL))
+ if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
*mem = SCM_EOL;
else
{
@@ -188,8 +212,7 @@ init_struct (handle, tail_elts, inits)
#if 0
case 'd':
- if ( ((fields_desc[1] != 'r') && (fields_desc[1] != 'w'))
- || ((inits == SCM_EOL) || !SCM_NUMBERP (SCM_CAR (inits))))
+ if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
*((double *)mem) = 0.0;
else
{
@@ -205,7 +228,6 @@ init_struct (handle, tail_elts, inits)
break;
}
- fields_desc += 2;
n_fields--;
mem++;
}
@@ -295,10 +317,15 @@ scm_make_struct (vtable, tail_array_size, init)
tail_elts = SCM_INUM (tail_array_size);
SCM_NEWCELL (handle);
SCM_DEFER_INTS;
- data = (SCM*)scm_must_malloc (sizeof (SCM) * (2 + basic_size + tail_elts), "structure");
- *data = (SCM)(2 + basic_size + tail_elts);
- data[1] = struct_num++;
- data += 2;
+ data = (SCM*)scm_must_malloc (sizeof (SCM) * (scm_struct_n_extra_words
+ + basic_size
+ + tail_elts),
+ "structure");
+ data += scm_struct_n_extra_words;
+ data[scm_struct_i_n_words] = (SCM) (scm_struct_n_extra_words
+ + basic_size
+ + tail_elts);
+ data[scm_struct_i_tag] = struct_num++;
SCM_SETCDR (handle, data);
SCM_SETCAR (handle, ((SCM)SCM_STRUCT_DATA (vtable)) + 1);
init_struct (handle, tail_elts, init);
@@ -340,10 +367,15 @@ scm_make_vtable_vtable (extra_fields, tail_array_size, init)
tail_elts = SCM_INUM (tail_array_size);
SCM_NEWCELL (handle);
SCM_DEFER_INTS;
- data = (SCM*)scm_must_malloc (sizeof (SCM) * (2 + basic_size + tail_elts), "structure");
- *data = (SCM)(2 + basic_size + tail_elts);
- data[1] = struct_num++;
- data += 2;
+ data = (SCM *) scm_must_malloc (sizeof (SCM) * (scm_struct_n_extra_words
+ + basic_size
+ + tail_elts),
+ "structure");
+ data += scm_struct_n_extra_words;
+ data[scm_struct_i_n_words] = (SCM) (scm_struct_n_extra_words
+ + basic_size
+ + tail_elts);
+ data[scm_struct_i_tag] = struct_num++;
SCM_SETCDR (handle, data);
SCM_SETCAR (handle, ((SCM)data) + 1);
SCM_STRUCT_LAYOUT (handle) = layout;
@@ -384,22 +416,30 @@ scm_struct_ref (handle, pos)
p = SCM_INUM (pos);
fields_desc = (unsigned char *)SCM_CHARS (layout);
- n_fields = SCM_LENGTH (layout) / 2;
-
- SCM_ASSERT (p <= n_fields, pos, SCM_OUTOFRANGE, s_struct_ref);
+ n_fields = data[- scm_struct_n_extra_words] - scm_struct_n_extra_words;
+
+ SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, s_struct_ref);
- field_type = fields_desc[p * 2];
- {
- unsigned char ref;
- ref = fields_desc [p * 2 + 1];
- if ((ref != 'r') && (ref != 'w'))
- {
- if ((ref == 'R') || (ref == 'W'))
- field_type = 'u';
- else
- SCM_ASSERT (0, pos, "ref denied", s_struct_ref);
- }
- }
+ if (p * 2 < SCM_LENGTH (layout))
+ {
+ unsigned char ref;
+ field_type = fields_desc[p * 2];
+ ref = fields_desc[p * 2 + 1];
+ if ((ref != 'r') && (ref != 'w'))
+ {
+ if ((ref == 'R') || (ref == 'W'))
+ field_type = 'u';
+ else
+ SCM_ASSERT (0, pos, "ref denied", s_struct_ref);
+ }
+ }
+ else if (fields_desc[SCM_LENGTH (layout) - 1] != 'O')
+ field_type = fields_desc[SCM_LENGTH (layout) - 2];
+ else
+ {
+ SCM_ASSERT (0, pos, "ref denied", s_struct_ref);
+ }
+
switch (field_type)
{
case 'u':
@@ -461,17 +501,25 @@ scm_struct_set_x (handle, pos, val)
p = SCM_INUM (pos);
fields_desc = (unsigned char *)SCM_CHARS (layout);
- n_fields = SCM_LENGTH (layout) / 2;
+ n_fields = data[- scm_struct_n_extra_words] - scm_struct_n_extra_words;
- SCM_ASSERT (p <= n_fields, pos, SCM_OUTOFRANGE, s_struct_set_x);
+ SCM_ASSERT (p < n_fields, pos, SCM_OUTOFRANGE, s_struct_set_x);
- field_type = fields_desc[p * 2];
- {
- unsigned char set_x;
- set_x = fields_desc [p * 2 + 1];
- if (set_x != 'w')
- SCM_ASSERT (0, pos, "set_x denied", s_struct_set_x);
- }
+ if (p * 2 < SCM_LENGTH (layout))
+ {
+ unsigned char set_x;
+ field_type = fields_desc[p * 2];
+ set_x = fields_desc [p * 2 + 1];
+ if (set_x != 'w')
+ SCM_ASSERT (0, pos, "set_x denied", s_struct_set_x);
+ }
+ else if (fields_desc[SCM_LENGTH (layout) - 1] == 'W')
+ field_type = fields_desc[SCM_LENGTH (layout) - 2];
+ else
+ {
+ SCM_ASSERT (0, pos, "set_x denied", s_struct_ref);
+ }
+
switch (field_type)
{
case 'u':
diff --git a/libguile/struct.h b/libguile/struct.h
index 19189aae0..a8bff944c 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -48,6 +48,9 @@
+/* Number of words with negative index */
+#define scm_struct_n_extra_words 2
+
/* These are how the initial words of a vtable are allocated. */
#define scm_struct_i_n_words -2 /* How many words allocated to this struct? */
#define scm_struct_i_tag -1 /* A unique tag for this type.. */
@@ -62,6 +65,8 @@
#define SCM_STRUCT_VTABLE_DATA(X) ((SCM *)(SCM_CAR(X) - 1))
#define SCM_STRUCT_LAYOUT(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_layout])
#define SCM_STRUCT_VTABLE(X) (SCM_STRUCT_VTABLE_DATA(X)[scm_struct_i_vtable])
+/* Efficiency is important in the following macro, since it's used in GC */
+#define SCM_LAYOUT_TAILP(X) (((X) & 32) == 0) /* R, W or O */