diff --git a/libguile/struct.c b/libguile/struct.c index 9cb165e2f..f78a812ab 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -30,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" @@ -61,9 +62,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; @@ -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_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': @@ -88,13 +87,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': @@ -102,7 +101,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) @@ -111,12 +110,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; @@ -138,18 +137,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; @@ -160,8 +159,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': @@ -237,7 +235,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; @@ -248,11 +247,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); @@ -646,8 +648,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); @@ -656,7 +657,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 */ @@ -668,9 +668,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')) @@ -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)); } } - 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)); @@ -728,8 +728,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); @@ -737,7 +736,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 */ @@ -750,13 +748,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)); diff --git a/libguile/throw.c b/libguile/throw.c index 4413efadf..cf6ea4a49 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -23,6 +23,7 @@ #endif #include +#include #include "libguile/_scm.h" #include "libguile/async.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"); 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++) { diff --git a/libguile/unif.c b/libguile/unif.c index 84b532347..cf39d055e 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1149,7 +1149,6 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, #define FUNC_NAME s_scm_enclose_array { SCM axv, res, ra_inr; - const char *c_axv; scm_t_array_dim vdim, *s = &vdim; 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_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++) { - while (c_axv[j]) + while (!scm_i_string_ref (axv, j) == '\0') j++; SCM_I_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_I_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; @@ -2329,13 +2327,12 @@ scm_istr2bve (SCM str) SCM res = vec; scm_t_uint32 mask; - size_t k, j; - const char *c_str; + size_t k, j, p; scm_t_uint32 *data; 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++) { data[k] = 0L; @@ -2343,7 +2340,7 @@ scm_istr2bve (SCM str) if (j > 32) j = 32; for (mask = 1L; j--; mask <<= 1) - switch (*c_str++) + switch (scm_i_string_ref (str, p++)) { case '0': break;