mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-13 09:10:26 +02:00
Code Activity

Use string and symbol accessors in struct, throw, and array funcs

Browse source 
* libguile/struct.c (scm_make_struct_layout, scm_struct_init)
  (scm_struct_vtable_p, scm_struct_ref, scm_struct_set_x): use string
  and symbol accessors and avoid unpacking strings and symbols

* libguile/throw.c (scm_ithrow): allow wide symbols in the error message

* libguile/unif.c (scm_enclose_array, scm_istr2bve): use string
  accessors and avoid unpacking strings
This commit is contained in:
Michael Gran 2009-08-22 10:15:53 -07:00
parent 806f1ded95
commit 27646f414e
3 changed files with 48 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

76
libguile/struct.c
View file

@ -30,6 +30,7 @@
#include "libguile/hashtab.h" #include "libguile/hashtab.h"
#include "libguile/ports.h" #include "libguile/ports.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/srfi-13.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/struct.h" #include "libguile/struct.h"
@ -61,9 +62,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
{ {
SCM new_sym; SCM new_sym;
SCM_VALIDATE_STRING (1, fields); SCM_VALIDATE_STRING (1, fields);
scm_t_wchar c;
{ /* scope */ { /* scope */
const char * field_desc;
size_t len; size_t len;
int x; int x;
@ -72,11 +73,9 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
SCM_MISC_ERROR ("odd length field specification: ~S", SCM_MISC_ERROR ("odd length field specification: ~S",
scm_list_1 (fields)); scm_list_1 (fields));
field_desc = scm_i_string_chars (fields);
for (x = 0; x < len; x += 2) for (x = 0; x < len; x += 2)
{ {
switch (field_desc[x]) switch (c = scm_i_string_ref (fields, x))
{ {
case 'u': case 'u':
case 'p': case 'p':
@ -88,13 +87,13 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
break; break;
default: default:
SCM_MISC_ERROR ("unrecognized field type: ~S", 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': case 'w':
if (field_desc[x] == 's') if (scm_i_string_ref (fields, x) == 's')
SCM_MISC_ERROR ("self fields not writable", SCM_EOL); SCM_MISC_ERROR ("self fields not writable", SCM_EOL);
case 'r': case 'r':
case 'o': case 'o':
@ -102,7 +101,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
case 'R': case 'R':
case 'W': case 'W':
case 'O': 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_MISC_ERROR ("self fields not allowed in tail array",
SCM_EOL); SCM_EOL);
if (x != len - 2) if (x != len - 2)
@ -111,12 +110,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
break; break;
default: default:
SCM_MISC_ERROR ("unrecognized ref specification: ~S", 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 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_MISC_ERROR ("missing dash field at position ~A",
scm_list_1 (scm_from_int (x / 2))); scm_list_1 (scm_from_int (x / 2)));
x += 2; x += 2;
@ -138,18 +137,18 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void static void
scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits) scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits)
{ {
unsigned const char *fields_desc = scm_t_wchar prot = 0;
(unsigned const char *) scm_i_symbol_chars (layout) - 2;
unsigned char prot = 0;
int n_fields = scm_i_symbol_length (layout) / 2; int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0; int tailp = 0;
int i;
i = -2;
while (n_fields) while (n_fields)
{ {
if (!tailp) if (!tailp)
{ {
fields_desc += 2; i += 2;
prot = fields_desc[1]; prot = scm_i_symbol_ref (layout, i+1);
if (SCM_LAYOUT_TAILP (prot)) if (SCM_LAYOUT_TAILP (prot))
{ {
tailp = 1; tailp = 1;
@ -160,8 +159,7 @@ scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM in
break; break;
} }
} }
switch (scm_i_symbol_ref (layout, i))
switch (*fields_desc)
{ {
#if 0 #if 0
case 'i': case 'i':
@ -237,7 +235,8 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
{ {
SCM layout; SCM layout;
scm_t_bits * mem; scm_t_bits * mem;
int tmp; SCM tmp;
size_t len;
if (!SCM_STRUCTP (x)) if (!SCM_STRUCTP (x))
return SCM_BOOL_F; return SCM_BOOL_F;
@ -248,11 +247,14 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
< scm_i_string_length (required_vtable_fields)) < scm_i_string_length (required_vtable_fields))
return SCM_BOOL_F; return SCM_BOOL_F;
tmp = strncmp (scm_i_symbol_chars (layout), len = scm_i_string_length (required_vtable_fields);
scm_i_string_chars (required_vtable_fields), tmp = scm_string_eq (scm_symbol_to_string (layout),
scm_i_string_length (required_vtable_fields)); required_vtable_fields,
scm_remember_upto_here_1 (required_vtable_fields); scm_from_size_t (0),
if (tmp) scm_from_size_t (len),
scm_from_size_t (0),
scm_from_size_t (len));
if (scm_is_false (tmp))
return SCM_BOOL_F; return SCM_BOOL_F;
mem = SCM_STRUCT_DATA (x); mem = SCM_STRUCT_DATA (x);
@ -646,8 +648,7 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
size_t layout_len; size_t layout_len;
size_t p; size_t p;
scm_t_bits n_fields; scm_t_bits n_fields;
const char *fields_desc; scm_t_wchar field_type = 0;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
@ -656,7 +657,6 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); p = scm_to_size_t (pos);
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout); layout_len = scm_i_symbol_length (layout);
if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
/* no extra words */ /* no extra words */
@ -668,9 +668,9 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
if (p * 2 < layout_len) if (p * 2 < layout_len)
{ {
char ref; scm_t_wchar ref;
field_type = fields_desc[p * 2]; field_type = scm_i_symbol_ref (layout, p * 2);
ref = fields_desc[p * 2 + 1]; ref = scm_i_symbol_ref (layout, p * 2 + 1);
if ((ref != 'r') && (ref != 'w')) if ((ref != 'r') && (ref != 'w'))
{ {
if ((ref == 'R') || (ref == 'W')) if ((ref == 'R') || (ref == 'W'))
@ -679,8 +679,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
} }
} }
else if (fields_desc[layout_len - 1] != 'O') else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
field_type = fields_desc[layout_len - 2]; field_type = scm_i_symbol_ref(layout, layout_len - 2);
else else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
@ -728,8 +728,7 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
size_t layout_len; size_t layout_len;
size_t p; size_t p;
int n_fields; int n_fields;
const char *fields_desc; scm_t_wchar field_type = 0;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
@ -737,7 +736,6 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); p = scm_to_size_t (pos);
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout); layout_len = scm_i_symbol_length (layout);
if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT) if (SCM_STRUCT_VTABLE_FLAGS (handle) & SCM_STRUCTF_LIGHT)
/* no extra words */ /* no extra words */
@ -750,13 +748,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
if (p * 2 < layout_len) if (p * 2 < layout_len)
{ {
char set_x; char set_x;
field_type = fields_desc[p * 2]; field_type = scm_i_symbol_ref (layout, p * 2);
set_x = fields_desc [p * 2 + 1]; set_x = scm_i_symbol_ref (layout, p * 2 + 1);
if (set_x != 'w') if (set_x != 'w')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
} }
else if (fields_desc[layout_len - 1] == 'W') else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
field_type = fields_desc[layout_len - 2]; field_type = scm_i_symbol_ref (layout, layout_len - 2);
else else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));

9
libguile/throw.c
View file

@ -23,6 +23,7 @@
#endif #endif
#include <stdio.h> #include <stdio.h>
#include <unistdio.h>
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/async.h" #include "libguile/async.h"
#include "libguile/smob.h" #include "libguile/smob.h"
@ -744,8 +745,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED)
*/ */
fprintf (stderr, "throw from within critical section.\n"); fprintf (stderr, "throw from within critical section.\n");
if (scm_is_symbol (key)) if (scm_is_symbol (key))
fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key)); {
if (scm_i_is_narrow_symbol (key))
fprintf (stderr, "error key: %s\n", scm_i_symbol_chars (key));
else
ulc_fprintf (stderr, "error key: %llU\n", scm_i_symbol_wide_chars (key));
}
for (; scm_is_pair (s); s = scm_cdr (s), i++) for (; scm_is_pair (s); s = scm_cdr (s), i++)
{ {

11
libguile/unif.c
View file

@ -1149,7 +1149,6 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
#define FUNC_NAME s_scm_enclose_array #define FUNC_NAME s_scm_enclose_array
{ {
SCM axv, res, ra_inr; SCM axv, res, ra_inr;
const char *c_axv;
scm_t_array_dim vdim, *s = &vdim; scm_t_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr; int ndim, j, k, ninr, noutr;
@ -1197,10 +1196,9 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; SCM_I_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1)); scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
} }
c_axv = scm_i_string_chars (axv);
for (j = 0, k = 0; k < noutr; k++, j++) for (j = 0, k = 0; k < noutr; k++, j++)
{ {
while (c_axv[j]) while (!scm_i_string_ref (axv, j) == '\0')
j++; j++;
SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
@ -2329,13 +2327,12 @@ scm_istr2bve (SCM str)
SCM res = vec; SCM res = vec;
scm_t_uint32 mask; scm_t_uint32 mask;
size_t k, j; size_t k, j, p;
const char *c_str;
scm_t_uint32 *data; scm_t_uint32 *data;
data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL); data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
c_str = scm_i_string_chars (str);
p = 0;
for (k = 0; k < (len + 31) / 32; k++) for (k = 0; k < (len + 31) / 32; k++)
{ {
data[k] = 0L; data[k] = 0L;
@ -2343,7 +2340,7 @@ scm_istr2bve (SCM str)
if (j > 32) if (j > 32)
j = 32; j = 32;
for (mask = 1L; j--; mask <<= 1) for (mask = 1L; j--; mask <<= 1)
switch (*c_str++) switch (scm_i_string_ref (str, p++))
{ {
case '0': case '0':
break; break;