summaryrefslogtreecommitdiff
path: root/libguile/struct.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/struct.c')
-rw-r--r--libguile/struct.c93
1 files changed, 46 insertions, 47 deletions
diff --git a/libguile/struct.c b/libguile/struct.c
index b536bea3b..b7e72a719 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,18 +1,19 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public
- * License as published by the Free Software Foundation; either
- * version 2.1 of the License, or (at your option) any later version.
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * This library is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
*/
@@ -29,6 +30,7 @@
#include "libguile/hashtab.h"
#include "libguile/ports.h"
#include "libguile/strings.h"
+#include "libguile/srfi-13.h"
#include "libguile/validate.h"
#include "libguile/struct.h"
@@ -62,9 +64,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
{
SCM new_sym;
SCM_VALIDATE_STRING (1, fields);
+ scm_t_wchar c;
{ /* scope */
- const char * field_desc;
size_t len;
int x;
@@ -73,11 +75,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
SCM_MISC_ERROR ("odd length field specification: ~S",
scm_list_1 (fields));
- field_desc = scm_i_string_chars (fields);
-
for (x = 0; x < len; x += 2)
{
- switch (field_desc[x])
+ switch (c = scm_i_string_ref (fields, x))
{
case 'u':
case 'p':
@@ -89,13 +89,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
break;
default:
SCM_MISC_ERROR ("unrecognized field type: ~S",
- scm_list_1 (SCM_MAKE_CHAR (field_desc[x])));
+ scm_list_1 (SCM_MAKE_CHAR (c)));
}
- switch (field_desc[x + 1])
+ switch (c = scm_i_string_ref (fields, x + 1))
{
case 'w':
- if (field_desc[x] == 's')
+ if (scm_i_string_ref (fields, x) == 's')
SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
case 'r':
case 'o':
@@ -103,7 +103,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
case 'R':
case 'W':
case 'O':
- if (field_desc[x] == 's')
+ if (scm_i_string_ref (fields, x) == 's')
SCM_MISC_ERROR ("self fields not allowed in tail array",
SCM_EOL);
if (x != len - 2)
@@ -112,12 +112,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
break;
default:
SCM_MISC_ERROR ("unrecognized ref specification: ~S",
- scm_list_1 (SCM_MAKE_CHAR (field_desc[x + 1])));
+ scm_list_1 (SCM_MAKE_CHAR (c)));
}
#if 0
- if (field_desc[x] == 'd')
+ if (scm_i_string_ref (fields, x, 'd'))
{
- if (field_desc[x + 2] != '-')
+ if (!scm_i_string_ref (fields, x+2, '-'))
SCM_MISC_ERROR ("missing dash field at position ~A",
scm_list_1 (scm_from_int (x / 2)));
x += 2;
@@ -139,18 +139,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void
scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits)
{
- unsigned const char *fields_desc =
- (unsigned const char *) scm_i_symbol_chars (layout) - 2;
- unsigned char prot = 0;
+ scm_t_wchar prot = 0;
int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0;
+ int i;
+ i = -2;
while (n_fields)
{
if (!tailp)
{
- fields_desc += 2;
- prot = fields_desc[1];
+ i += 2;
+ prot = scm_i_symbol_ref (layout, i+1);
if (SCM_LAYOUT_TAILP (prot))
{
tailp = 1;
@@ -161,8 +161,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
break;
}
}
-
- switch (*fields_desc)
+ switch (scm_i_symbol_ref (layout, i))
{
#if 0
case 'i':
@@ -238,7 +237,8 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
{
SCM layout;
scm_t_bits * mem;
- int tmp;
+ SCM tmp;
+ size_t len;
if (!SCM_STRUCTP (x))
return SCM_BOOL_F;
@@ -249,11 +249,14 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
< scm_i_string_length (required_vtable_fields))
return SCM_BOOL_F;
- tmp = strncmp (scm_i_symbol_chars (layout),
- scm_i_string_chars (required_vtable_fields),
- scm_i_string_length (required_vtable_fields));
- scm_remember_upto_here_1 (required_vtable_fields);
- if (tmp)
+ len = scm_i_string_length (required_vtable_fields);
+ tmp = scm_string_eq (scm_symbol_to_string (layout),
+ required_vtable_fields,
+ scm_from_size_t (0),
+ scm_from_size_t (len),
+ scm_from_size_t (0),
+ scm_from_size_t (len));
+ if (scm_is_false (tmp))
return SCM_BOOL_F;
mem = SCM_STRUCT_DATA (x);
@@ -337,7 +340,7 @@ struct_finalizer_trampoline (GC_PTR ptr, GC_PTR unused_data)
scm_t_struct_free free_struct_data
= ((scm_t_struct_free) vtable_data[scm_struct_i_free]);
- SCM_SET_CELL_TYPE (obj, scm_tc_free_cell);
+ SCM_SET_CELL_TYPE (obj, scm_tc3_struct);
#if 0
/* A sanity check. However, this check can fail if the free function
@@ -620,8 +623,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
size_t layout_len;
size_t p;
scm_t_bits n_fields;
- const char *fields_desc;
- char field_type = 0;
+ scm_t_wchar field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
@@ -630,7 +632,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
- fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
/* no extra words */
@@ -642,9 +643,9 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
if (p * 2 < layout_len)
{
- char ref;
- field_type = fields_desc[p * 2];
- ref = fields_desc[p * 2 + 1];
+ scm_t_wchar ref;
+ field_type = scm_i_symbol_ref (layout, p * 2);
+ ref = scm_i_symbol_ref (layout, p * 2 + 1);
if ((ref != 'r') && (ref != 'w'))
{
if ((ref == 'R') || (ref == 'W'))
@@ -653,8 +654,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
}
- else if (fields_desc[layout_len - 1] != 'O')
- field_type = fields_desc[layout_len - 2];
+ else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
+ field_type = scm_i_symbol_ref(layout, layout_len - 2);
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
@@ -702,8 +703,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
size_t layout_len;
size_t p;
int n_fields;
- const char *fields_desc;
- char field_type = 0;
+ scm_t_wchar field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
@@ -711,7 +711,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
- fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
/* no extra words */
@@ -724,13 +723,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
if (p * 2 < layout_len)
{
char set_x;
- field_type = fields_desc[p * 2];
- set_x = fields_desc [p * 2 + 1];
+ field_type = scm_i_symbol_ref (layout, p * 2);
+ set_x = scm_i_symbol_ref (layout, p * 2 + 1);
if (set_x != 'w')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
- else if (fields_desc[layout_len - 1] == 'W')
- field_type = fields_desc[layout_len - 2];
+ else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
+ field_type = scm_i_symbol_ref (layout, layout_len - 2);
else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
View Lorry Controller Status