diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-08-12 17:45:03 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-08-12 17:45:03 +0000 |
commit | 8824ac88f08cffc954a907b85858ccd5b3c9843f (patch) | |
tree | c96fa1d142124eaf6f030adbc4ec2eb040b612b0 | |
parent | 70f7ee4188c0a752154d8cc63daf5a99ba89951f (diff) | |
download | guile-8824ac88f08cffc954a907b85858ccd5b3c9843f.tar.gz |
* socket.c, rw.c, deprecated.h, validate.h
(SCM_VALIDATE_STRING_COPY): Deprecated. Replaced all uses with
SCM_VALIDATE_STRING plus SCM_I_STRING_CHARS or
scm_to_locale_string, etc.
(SCM_VALIDATE_SUBSTRING_SPEC_COPY): Deprecated. Replaced as
above, plus scm_i_get_substring_spec.
* regex-posix.c, read.c, random.c, ramap.c, print.c, numbers.c,
hash.c, gc.c, gc-card.c, convert.i.c, backtrace.c, strop.c,
strorder.c, strports.c, struct.c, symbols.c, unif.c, ports.c: Use
SCM_I_STRING_CHARS, SCM_I_STRING_UCHARS, and SCM_I_STRING_LENGTH
instead of SCM_STRING_CHARS, SCM_STRING_UCHARS, and
SCM_STRING_LENGTH, respectively. Also, replaced scm_return_first
with more explicit scm_remember_upto_here_1, etc, or introduced
them in the first place.
-rw-r--r-- | libguile/backtrace.c | 12 | ||||
-rw-r--r-- | libguile/convert.i.c | 4 | ||||
-rw-r--r-- | libguile/gc-card.c | 4 | ||||
-rw-r--r-- | libguile/gc.c | 2 | ||||
-rw-r--r-- | libguile/hash.c | 7 | ||||
-rw-r--r-- | libguile/numbers.c | 9 | ||||
-rw-r--r-- | libguile/print.c | 11 | ||||
-rw-r--r-- | libguile/ramap.c | 8 | ||||
-rw-r--r-- | libguile/random.c | 8 | ||||
-rw-r--r-- | libguile/read.c | 38 | ||||
-rw-r--r-- | libguile/regex-posix.c | 12 | ||||
-rw-r--r-- | libguile/rw.c | 30 | ||||
-rw-r--r-- | libguile/strop.c | 62 | ||||
-rw-r--r-- | libguile/strorder.c | 56 | ||||
-rw-r--r-- | libguile/strports.c | 8 | ||||
-rw-r--r-- | libguile/struct.c | 18 | ||||
-rw-r--r-- | libguile/symbols.c | 13 | ||||
-rw-r--r-- | libguile/unif.c | 22 |
18 files changed, 189 insertions, 135 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 9dd278189..23e67e4da 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -22,6 +22,7 @@ #include <stdio.h> #include <ctype.h> +#include <assert.h> #include "libguile/_scm.h" @@ -398,18 +399,21 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S while (indentation + n > SCM_BACKTRACE_WIDTH && i < n_print_params); ptob->truncate (sport, n); string = scm_strport_to_string (sport); + assert (scm_is_string (string)); + /* Remove control characters */ for (i = 0; i < n; ++i) - if (iscntrl ((int) (unsigned char) SCM_STRING_CHARS (string)[i])) - SCM_STRING_CHARS (string)[i] = ' '; + if (iscntrl ((int) SCM_I_STRING_UCHARS (string)[i])) + SCM_I_STRING_UCHARS (string)[i] = ' '; /* Truncate */ if (indentation + n > SCM_BACKTRACE_WIDTH) { n = SCM_BACKTRACE_WIDTH - indentation; - SCM_STRING_CHARS (string)[n - 1] = '$'; + SCM_I_STRING_UCHARS (string)[n - 1] = '$'; } - scm_lfwrite (SCM_STRING_CHARS (string), n, port); + scm_lfwrite (SCM_I_STRING_CHARS (string), n, port); + scm_remember_upto_here_1 (string); } static void diff --git a/libguile/convert.i.c b/libguile/convert.i.c index f0ba6ae54..1fe928110 100644 --- a/libguile/convert.i.c +++ b/libguile/convert.i.c @@ -163,11 +163,11 @@ SCM2CTYPES (SCM obj, CTYPE *data) #if SIZEOF_CTYPE == 1 case scm_tc7_string: - n = SCM_STRING_LENGTH (obj); + n = SCM_I_STRING_LENGTH (obj); if (data == NULL) if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL) return NULL; - memcpy (data, SCM_STRING_CHARS (obj), n * sizeof (CTYPE)); + memcpy (data, SCM_I_STRING_CHARS (obj), n * sizeof (CTYPE)); break; #endif diff --git a/libguile/gc-card.c b/libguile/gc-card.c index a458cbaf0..2f57736b3 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -193,8 +193,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) } break; case scm_tc7_string: - scm_gc_free (SCM_STRING_CHARS (scmptr), - SCM_STRING_LENGTH (scmptr) + 1, "string"); + scm_gc_free (SCM_I_STRING_CHARS (scmptr), + SCM_I_STRING_LENGTH (scmptr) + 1, "string"); break; case scm_tc7_symbol: scm_gc_free (SCM_SYMBOL_CHARS (scmptr), diff --git a/libguile/gc.c b/libguile/gc.c index 4c0a633f7..2e163df83 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -642,7 +642,7 @@ scm_igc (const char *what) * the conservative gc we add the call to scm_remember_upto_here_1 _after_ the * call to 'some_function'. Note that this would not be necessary if str was * used anyway after the call to 'some_function'. - * char *chars = SCM_STRING_CHARS (str); + * char *chars = SCM_I_STRING_CHARS (str); * some_function (chars); * scm_remember_upto_here_1 (str); // str will be alive up to this point. */ diff --git a/libguile/hash.c b/libguile/hash.c index 4415bf82f..b2c7fa592 100644 --- a/libguile/hash.c +++ b/libguile/hash.c @@ -109,7 +109,12 @@ scm_hasher(SCM obj, unsigned long n, size_t d) } /* Fall through */ case scm_tc7_string: - return scm_string_hash (SCM_STRING_UCHARS (obj), SCM_STRING_LENGTH (obj)) % n; + { + unsigned long hash = scm_string_hash (SCM_I_STRING_UCHARS (obj), + SCM_I_STRING_LENGTH (obj)) % n; + scm_remember_upto_here_1 (obj); + return hash; + } case scm_tc7_symbol: return SCM_SYMBOL_HASH (obj) % n; case scm_tc7_wvect: diff --git a/libguile/numbers.c b/libguile/numbers.c index c0e7d58dc..a50ca8889 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -2338,7 +2338,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) SCM str; scm_i_fraction_reduce (sexp); str = scm_number_to_string (sexp, SCM_UNDEFINED); - scm_lfwrite (SCM_STRING_CHARS (str), SCM_STRING_LENGTH (str), port); + scm_lfwrite (SCM_I_STRING_CHARS (str), SCM_I_STRING_LENGTH (str), port); scm_remember_upto_here_1 (str); return !0; } @@ -2967,10 +2967,11 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0, else base = scm_to_unsigned_integer (radix, 2, INT_MAX); - answer = scm_i_mem2number (SCM_STRING_CHARS (string), - SCM_STRING_LENGTH (string), + answer = scm_i_mem2number (SCM_I_STRING_CHARS (string), + SCM_I_STRING_LENGTH (string), base); - return scm_return_first (answer, string); + scm_remember_upto_here_1 (string); + return answer; } #undef FUNC_NAME diff --git a/libguile/print.c b/libguile/print.c index a2fe9785f..0b69ebd0e 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -487,9 +487,9 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) size_t i; scm_putc ('"', port); - for (i = 0; i < SCM_STRING_LENGTH (exp); ++i) + for (i = 0; i < SCM_I_STRING_LENGTH (exp); ++i) { - unsigned char ch = SCM_STRING_CHARS (exp)[i]; + unsigned char ch = SCM_I_STRING_CHARS (exp)[i]; if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148)) { static char const hex[]="0123456789abcdef"; @@ -508,8 +508,9 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate) scm_putc ('"', port); } else - scm_lfwrite (SCM_STRING_CHARS (exp), SCM_STRING_LENGTH (exp), + scm_lfwrite (SCM_I_STRING_CHARS (exp), SCM_I_STRING_LENGTH (exp), port); + scm_remember_upto_here_1 (exp); break; case scm_tc7_symbol: if (SCM_SYMBOL_INTERNED_P (exp)) @@ -937,8 +938,8 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1, SCM_VALIDATE_STRING (2, message); SCM_VALIDATE_REST_ARGUMENT (args); - start = SCM_STRING_CHARS (message); - end = start + SCM_STRING_LENGTH (message); + start = SCM_I_STRING_CHARS (message); + end = start + SCM_I_STRING_LENGTH (message); for (p = start; p != end; ++p) if (*p == '~') { diff --git a/libguile/ramap.c b/libguile/ramap.c index 53d36294b..49ec40f11 100644 --- a/libguile/ramap.c +++ b/libguile/ramap.c @@ -469,7 +469,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED) case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (fill), badarg2); for (i = base; n--; i += inc) - SCM_STRING_CHARS (ra)[i] = SCM_CHAR (fill); + SCM_I_STRING_CHARS (ra)[i] = SCM_CHAR (fill); break; case scm_tc7_byvect: if (SCM_CHARP (fill)) @@ -631,7 +631,7 @@ racp (SCM src, SCM dst) if (SCM_TYP7 (src) != scm_tc7_string) goto gencase; for (; n-- > 0; i_s += inc_s, i_d += inc_d) - SCM_STRING_CHARS (dst)[i_d] = SCM_STRING_CHARS (src)[i_s]; + SCM_I_STRING_CHARS (dst)[i_d] = SCM_I_STRING_CHARS (src)[i_s]; break; case scm_tc7_byvect: if (SCM_TYP7 (src) != scm_tc7_byvect) @@ -1791,8 +1791,8 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1) return 1; case scm_tc7_string: { - char *v0 = SCM_STRING_CHARS (ra0) + i0; - char *v1 = SCM_STRING_CHARS (ra1) + i1; + char *v0 = SCM_I_STRING_CHARS (ra0) + i0; + char *v1 = SCM_I_STRING_CHARS (ra1) + i1; for (; n--; v0 += inc0, v1 += inc1) if (*v0 != *v1) return 0; diff --git a/libguile/random.c b/libguile/random.c index 991900af3..bb8d48355 100644 --- a/libguile/random.c +++ b/libguile/random.c @@ -383,11 +383,15 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0, "Return a new random state using @var{seed}.") #define FUNC_NAME s_scm_seed_to_random_state { + SCM res; if (SCM_NUMBERP (seed)) seed = scm_number_to_string (seed, SCM_UNDEFINED); SCM_VALIDATE_STRING (1, seed); - return make_rstate (scm_c_make_rstate (SCM_STRING_CHARS (seed), - SCM_STRING_LENGTH (seed))); + res = make_rstate (scm_c_make_rstate (SCM_I_STRING_CHARS (seed), + SCM_I_STRING_LENGTH (seed))); + scm_remember_upto_here_1 (seed); + return res; + } #undef FUNC_NAME diff --git a/libguile/read.c b/libguile/read.c index d3f448aac..fc973dcd2 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -151,15 +151,15 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0, char * scm_grow_tok_buf (SCM *tok_buf) { - size_t oldlen = SCM_STRING_LENGTH (*tok_buf); + size_t oldlen = SCM_I_STRING_LENGTH (*tok_buf); SCM newstr = scm_allocate_string (2 * oldlen); size_t i; for (i = 0; i != oldlen; ++i) - SCM_STRING_CHARS (newstr) [i] = SCM_STRING_CHARS (*tok_buf) [i]; + SCM_I_STRING_CHARS (newstr) [i] = SCM_I_STRING_CHARS (*tok_buf) [i]; *tok_buf = newstr; - return SCM_STRING_CHARS (newstr); + return SCM_I_STRING_CHARS (newstr); } @@ -437,7 +437,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) #if SCM_HAVE_ARRAYS case '*': j = scm_read_token (c, tok_buf, port, 0); - p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1)); + p = scm_istr2bve (SCM_I_STRING_CHARS (*tok_buf) + 1, (long) (j - 1)); if (scm_is_true (p)) return p; else @@ -446,7 +446,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) case '{': j = scm_read_token (c, tok_buf, port, 1); - return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j); + return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); case '\\': c = scm_getc (port); @@ -460,20 +460,20 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) * does only consist of octal digits. Finally, it should be * checked whether the resulting fixnum is in the range of * characters. */ - p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 8); + p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 8); if (SCM_I_INUMP (p)) return SCM_MAKE_CHAR (SCM_I_INUM (p)); } for (c = 0; c < scm_n_charnames; c++) if (scm_charnames[c] - && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf)))) + && (scm_casei_streq (scm_charnames[c], SCM_I_STRING_CHARS (*tok_buf)))) return SCM_MAKE_CHAR (scm_charnums[c]); scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); /* #:SYMBOL is a syntax for keywords supported in all contexts. */ case ':': j = scm_read_token ('-', tok_buf, port, 0); - p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j); + p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); return scm_make_keyword_from_dash_symbol (p); default: @@ -509,7 +509,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (c == EOF) str_eof: scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL); - while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) + while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) scm_grow_tok_buf (tok_buf); if (c == '\\') @@ -574,13 +574,13 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) "illegal character in escape sequence: ~S", scm_list_1 (SCM_MAKE_CHAR (c))); } - SCM_STRING_CHARS (*tok_buf)[j] = c; + SCM_I_STRING_CHARS (*tok_buf)[j] = c; ++j; } if (j == 0) return scm_nullstr; - SCM_STRING_CHARS (*tok_buf)[j] = 0; - return scm_mem2string (SCM_STRING_CHARS (*tok_buf), j); + SCM_I_STRING_CHARS (*tok_buf)[j] = 0; + return scm_mem2string (SCM_I_STRING_CHARS (*tok_buf), j); case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': @@ -593,7 +593,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* Shortcut: Detected symbol '+ or '- */ goto tok; - p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10); + p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 10); if (scm_is_true (p)) return p; if (c == '#') @@ -601,7 +601,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if ((j == 2) && (scm_getc (port) == '(')) { scm_ungetc ('(', port); - c = SCM_STRING_CHARS (*tok_buf)[1]; + c = SCM_I_STRING_CHARS (*tok_buf)[1]; goto callshrp; } scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL); @@ -612,7 +612,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix)) { j = scm_read_token ('-', tok_buf, port, 0); - p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j); + p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); return scm_make_keyword_from_dash_symbol (p); } /* fallthrough */ @@ -624,7 +624,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy) /* fallthrough */ tok: - return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j); + return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j); } } #undef FUNC_NAME @@ -642,14 +642,14 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) register char *p; c = (SCM_CASE_INSENSITIVE_P ? scm_c_downcase(ic) : ic); - p = SCM_STRING_CHARS (*tok_buf); + p = SCM_I_STRING_CHARS (*tok_buf); if (weird) j = 0; else { j = 0; - while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) + while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) p = scm_grow_tok_buf (tok_buf); p[j] = c; ++j; @@ -657,7 +657,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird) while (1) { - while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) + while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf)) p = scm_grow_tok_buf (tok_buf); c = scm_getc (port); switch (c) diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c index 7bc4dfa76..a79fde6c6 100644 --- a/libguile/regex-posix.c +++ b/libguile/regex-posix.c @@ -100,14 +100,14 @@ scm_regexp_error_msg (int regerrno, regex_t *rx) errmsg = scm_make_string (scm_from_int (80), SCM_UNDEFINED); SCM_DEFER_INTS; - l = regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), 80); + l = regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), 80); if (l > 80) { errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED); - regerror (regerrno, rx, SCM_STRING_CHARS (errmsg), l); + regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), l); } SCM_ALLOW_INTS; - return SCM_STRING_CHARS (errmsg); + return SCM_I_STRING_CHARS (errmsg); } SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0, @@ -182,7 +182,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1, } rx = scm_gc_malloc (sizeof(regex_t), "regex"); - status = regcomp (rx, SCM_STRING_CHARS (pat), + status = regcomp (rx, SCM_I_STRING_CHARS (pat), /* Make sure they're not passing REG_NOSUB; regexp-exec assumes we're getting match data. */ cflags & ~REG_NOSUB); @@ -234,7 +234,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, if (SCM_UNBNDP (start)) offset = 0; else - offset = scm_to_signed_integer (start, 0, SCM_STRING_LENGTH (str)); + offset = scm_to_signed_integer (start, 0, SCM_I_STRING_LENGTH (str)); if (SCM_UNBNDP (flags)) flags = SCM_INUM0; @@ -245,7 +245,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0, nmatches = SCM_RGX(rx)->re_nsub + 1; SCM_DEFER_INTS; matches = scm_malloc (sizeof (regmatch_t) * nmatches); - status = regexec (SCM_RGX (rx), SCM_STRING_CHARS (str) + offset, + status = regexec (SCM_RGX (rx), SCM_I_STRING_CHARS (str) + offset, nmatches, matches, scm_to_int (flags)); if (!status) diff --git a/libguile/rw.c b/libguile/rw.c index 94f813b90..23b562d8f 100644 --- a/libguile/rw.c +++ b/libguile/rw.c @@ -107,11 +107,13 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, int fdes; { - long offset; - long last; + size_t offset; + size_t last; - SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, dest, 3, start, offset, - 4, end, last); + SCM_VALIDATE_STRING (1, str); + dest = SCM_I_STRING_CHARS (str); + scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str), + start, &offset, end, &last); dest += offset; read_len = last - offset; } @@ -145,8 +147,13 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0, SCM_SYSERROR; } else if (chars_read == 0) - return SCM_BOOL_F; + { + scm_remember_upto_here_1 (str); + return SCM_BOOL_F; + } } + + scm_remember_upto_here_1 (str); return scm_from_long (chars_read); } #undef FUNC_NAME @@ -200,11 +207,13 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0, int fdes; { - long offset; - long last; + size_t offset; + size_t last; - SCM_VALIDATE_SUBSTRING_SPEC_COPY (1, str, src, 3, start, offset, - 4, end, last); + SCM_VALIDATE_STRING (1, str); + src = SCM_I_STRING_CHARS (str); + scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str), + start, &offset, end, &last); src += offset; write_len = last - offset; } @@ -246,7 +255,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0, else SCM_SYSERROR; } - + + scm_remember_upto_here_1 (str); return scm_from_long (rv); } } diff --git a/libguile/strop.c b/libguile/strop.c index 6f4b8cd88..1d7483d97 100644 --- a/libguile/strop.c +++ b/libguile/strop.c @@ -167,16 +167,17 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0, SCM_VALIDATE_STRING (1, str1); SCM_VALIDATE_STRING (4, str2); - s1 = scm_to_unsigned_integer (start1, 0, SCM_STRING_LENGTH(str1)); - e = scm_to_unsigned_integer (end1, s1, SCM_STRING_LENGTH(str1)); + s1 = scm_to_unsigned_integer (start1, 0, SCM_I_STRING_LENGTH(str1)); + e = scm_to_unsigned_integer (end1, s1, SCM_I_STRING_LENGTH(str1)); len = e - s1; - s2 = scm_to_unsigned_integer (start2, 0, SCM_STRING_LENGTH(str2)-len); + s2 = scm_to_unsigned_integer (start2, 0, SCM_I_STRING_LENGTH(str2)-len); - SCM_SYSCALL(memmove((void *)(&(SCM_STRING_CHARS(str2)[s2])), - (void *)(&(SCM_STRING_CHARS(str1)[s1])), + SCM_SYSCALL(memmove((void *)(&(SCM_I_STRING_CHARS(str2)[s2])), + (void *)(&(SCM_I_STRING_CHARS(str1)[s1])), len)); - return scm_return_first(SCM_UNSPECIFIED, str1, str2); + scm_remember_upto_here_2 (str1, str2); + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -197,10 +198,11 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0, size_t i, e; char c; SCM_VALIDATE_STRING (1, str); - i = scm_to_unsigned_integer (start, 0, SCM_STRING_LENGTH (str)); - e = scm_to_unsigned_integer (end, i, SCM_STRING_LENGTH (str)); + i = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH (str)); + e = scm_to_unsigned_integer (end, i, SCM_I_STRING_LENGTH (str)); SCM_VALIDATE_CHAR_COPY (4, fill, c); - while (i<e) SCM_STRING_CHARS (str)[i++] = c; + while (i<e) + SCM_I_STRING_CHARS (str)[i++] = c; return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -218,7 +220,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0, #define FUNC_NAME s_scm_string_null_p { SCM_VALIDATE_STRING (1, str); - return scm_from_bool (SCM_STRING_LENGTH (str) == 0); + return scm_from_bool (SCM_I_STRING_LENGTH (str) == 0); } #undef FUNC_NAME @@ -235,8 +237,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, SCM res = SCM_EOL; unsigned char *src; SCM_VALIDATE_STRING (1, str); - src = SCM_STRING_UCHARS (str); - for (i = SCM_STRING_LENGTH (str)-1;i >= 0;i--) res = scm_cons (SCM_MAKE_CHAR (src[i]), res); + src = SCM_I_STRING_UCHARS (str); + for (i = SCM_I_STRING_LENGTH (str)-1;i >= 0;i--) + res = scm_cons (SCM_MAKE_CHAR (src[i]), res); + scm_remember_upto_here_1 (src); return res; } #undef FUNC_NAME @@ -247,9 +251,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0, static SCM string_copy (SCM str) { - const char* chars = SCM_STRING_CHARS (str); - size_t length = SCM_STRING_LENGTH (str); - SCM new_string = scm_mem2string (chars, length); + const char* chars = SCM_I_STRING_CHARS (str); + size_t length = SCM_I_STRING_LENGTH (str); + SCM new_string = scm_allocate_string (length); + memcpy (SCM_I_STRING_CHARS (new_string), chars, length+1); scm_remember_upto_here_1 (str); return new_string; } @@ -273,11 +278,14 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0, "return an unspecified value.") #define FUNC_NAME s_scm_string_fill_x { - register char *dst, c; - register long k; - SCM_VALIDATE_STRING_COPY (1, str, dst); + char *dst, c; + long k; + SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_CHAR_COPY (2, chr, c); - for (k = SCM_STRING_LENGTH (str)-1;k >= 0;k--) dst[k] = c; + dst = SCM_I_STRING_CHARS (str); + for (k = SCM_I_STRING_LENGTH (str)-1;k >= 0;k--) + dst[k] = c; + scm_remember_upto_here_1 (str); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -290,8 +298,8 @@ string_upcase_x (SCM v) { unsigned long k; - for (k = 0; k < SCM_STRING_LENGTH (v); ++k) - SCM_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_STRING_UCHARS (v) [k]); + for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k) + SCM_I_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_I_STRING_UCHARS (v) [k]); return v; } @@ -335,8 +343,8 @@ string_downcase_x (SCM v) { unsigned long k; - for (k = 0; k < SCM_STRING_LENGTH (v); ++k) - SCM_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_STRING_UCHARS (v) [k]); + for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k) + SCM_I_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_I_STRING_UCHARS (v) [k]); return v; } @@ -382,8 +390,8 @@ string_capitalize_x (SCM str) long i, len; int in_word=0; - len = SCM_STRING_LENGTH(str); - sz = SCM_STRING_UCHARS (str); + len = SCM_I_STRING_LENGTH(str); + sz = SCM_I_STRING_UCHARS (str); for(i=0; i<len; i++) { if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) { if(!in_word) { @@ -462,8 +470,8 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0, SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_CHAR (2, chr); - idx = SCM_STRING_LENGTH (str); - p = SCM_STRING_CHARS (str); + idx = SCM_I_STRING_LENGTH (str); + p = SCM_I_STRING_CHARS (str); ch = SCM_CHAR (chr); while (idx >= 0) { diff --git a/libguile/strorder.c b/libguile/strorder.c index ac19d7370..6e8b647d3 100644 --- a/libguile/strorder.c +++ b/libguile/strorder.c @@ -43,18 +43,22 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - length = SCM_STRING_LENGTH (s2); - if (SCM_STRING_LENGTH (s1) == length) + length = SCM_I_STRING_LENGTH (s2); + if (SCM_I_STRING_LENGTH (s1) == length) { - unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1; - unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1; + unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1; + unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1; size_t i; /* comparing from back to front typically finds mismatches faster */ for (i = 0; i != length; ++i, --c1, --c2) if (*c1 != *c2) - return SCM_BOOL_F; + { + scm_remember_upto_here_2 (s1, s2); + return SCM_BOOL_F; + } + scm_remember_upto_here_2 (s1, s2); return SCM_BOOL_T; } else @@ -78,18 +82,22 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr, SCM_VALIDATE_STRING (1, s1); SCM_VALIDATE_STRING (2, s2); - length = SCM_STRING_LENGTH (s2); - if (SCM_STRING_LENGTH (s1) == length) + length = SCM_I_STRING_LENGTH (s2); + if (SCM_I_STRING_LENGTH (s1) == length) { - unsigned char *c1 = SCM_STRING_UCHARS (s1) + length - 1; - unsigned char *c2 = SCM_STRING_UCHARS (s2) + length - 1; + unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1; + unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1; size_t i; /* comparing from back to front typically finds mismatches faster */ for (i = 0; i != length; ++i, --c1, --c2) if (scm_c_upcase (*c1) != scm_c_upcase (*c2)) - return SCM_BOOL_F; + { + scm_remember_upto_here_2 (s1, s2); + return SCM_BOOL_F; + } + scm_remember_upto_here_2 (s1, s2); return SCM_BOOL_T; } else @@ -108,16 +116,18 @@ string_less_p (SCM s1, SCM s2) size_t i, length1, length2, lengthm; unsigned char *c1, *c2; - length1 = SCM_STRING_LENGTH (s1); - length2 = SCM_STRING_LENGTH (s2); + length1 = SCM_I_STRING_LENGTH (s1); + length2 = SCM_I_STRING_LENGTH (s2); lengthm = min (length1, length2); - c1 = SCM_STRING_UCHARS (s1); - c2 = SCM_STRING_UCHARS (s2); + c1 = SCM_I_STRING_UCHARS (s1); + c2 = SCM_I_STRING_UCHARS (s2); for (i = 0; i != lengthm; ++i, ++c1, ++c2) { int c = *c1 - *c2; - if (c < 0) return SCM_BOOL_T; - if (c > 0) return SCM_BOOL_F; + if (c == 0) + continue; + scm_remember_upto_here_2 (s1, s2); + return scm_from_bool (c < 0); } return scm_from_bool (length1 < length2); @@ -188,16 +198,18 @@ string_ci_less_p (SCM s1, SCM s2) size_t i, length1, length2, lengthm; unsigned char *c1, *c2; - length1 = SCM_STRING_LENGTH (s1); - length2 = SCM_STRING_LENGTH (s2); + length1 = SCM_I_STRING_LENGTH (s1); + length2 = SCM_I_STRING_LENGTH (s2); lengthm = min (length1, length2); - c1 = SCM_STRING_UCHARS (s1); - c2 = SCM_STRING_UCHARS (s2); + c1 = SCM_I_STRING_UCHARS (s1); + c2 = SCM_I_STRING_UCHARS (s2); for (i = 0; i != lengthm; ++i, ++c1, ++c2) { int c = scm_c_upcase (*c1) - scm_c_upcase (*c2); - if (c < 0) return SCM_BOOL_T; - if (c > 0) return SCM_BOOL_F; + if (c == 0) + continue; + scm_remember_upto_here_2 (s1, s2); + return scm_from_bool (c < 0); } return scm_from_bool (length1 < length2); diff --git a/libguile/strports.c b/libguile/strports.c index 70d8e66f0..aa9844bc7 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -80,7 +80,7 @@ st_resize_port (scm_t_port *pt, off_t new_size) { SCM old_stream = SCM_PACK (pt->stream); SCM new_stream = scm_allocate_string (new_size); - unsigned long int old_size = SCM_STRING_LENGTH (old_stream); + unsigned long int old_size = SCM_I_STRING_LENGTH (old_stream); unsigned long int min_size = min (old_size, new_size); unsigned long int i; @@ -89,12 +89,14 @@ st_resize_port (scm_t_port *pt, off_t new_size) pt->write_buf_size = new_size; for (i = 0; i != min_size; ++i) - SCM_STRING_CHARS (new_stream) [i] = SCM_STRING_CHARS (old_stream) [i]; + SCM_I_STRING_CHARS (new_stream) [i] = SCM_I_STRING_CHARS (old_stream) [i]; + + scm_remember_upto_here_1 (old_stream); /* reset buffer. */ { pt->stream = SCM_UNPACK (new_stream); - pt->read_buf = pt->write_buf = SCM_STRING_UCHARS (new_stream); + pt->read_buf = pt->write_buf = SCM_I_STRING_UCHARS (new_stream); pt->read_pos = pt->write_pos = pt->write_buf + index; pt->write_end = pt->write_buf + pt->write_buf_size; pt->read_end = pt->read_buf + pt->read_buf_size; diff --git a/libguile/struct.c b/libguile/struct.c index dac3ae5ab..efb17d3a4 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -63,12 +63,12 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, size_t len; int x; - len = SCM_STRING_LENGTH (fields); + len = SCM_I_STRING_LENGTH (fields); if (len % 2 == 1) SCM_MISC_ERROR ("odd length field specification: ~S", scm_list_1 (fields)); - field_desc = SCM_STRING_CHARS (fields); + field_desc = SCM_I_STRING_CHARS (fields); for (x = 0; x < len; x += 2) { @@ -122,7 +122,8 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0, } new_sym = scm_mem2symbol (field_desc, len); } - return scm_return_first (new_sym, fields); + scm_remember_upto_here_1 (fields); + return new_sym; } #undef FUNC_NAME @@ -231,17 +232,22 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0, { SCM layout; scm_t_bits * mem; + int tmp; if (!SCM_STRUCTP (x)) return SCM_BOOL_F; layout = SCM_STRUCT_LAYOUT (x); - if (SCM_SYMBOL_LENGTH (layout) < SCM_STRING_LENGTH (required_vtable_fields)) + if (SCM_SYMBOL_LENGTH (layout) + < SCM_I_STRING_LENGTH (required_vtable_fields)) return SCM_BOOL_F; - if (strncmp (SCM_SYMBOL_CHARS (layout), SCM_STRING_CHARS (required_vtable_fields), - SCM_STRING_LENGTH (required_vtable_fields))) + tmp = strncmp (SCM_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) return SCM_BOOL_F; mem = SCM_STRUCT_DATA (x); diff --git a/libguile/symbols.c b/libguile/symbols.c index f7fd68145..dc413c369 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -186,8 +186,8 @@ SCM_DEFINE (scm_make_symbol, "make-symbol", 1, 0, 0, { SCM sym; SCM_VALIDATE_STRING (1, name); - sym = scm_mem2uninterned_symbol (SCM_STRING_CHARS (name), - SCM_STRING_LENGTH (name)); + sym = scm_mem2uninterned_symbol (SCM_I_STRING_CHARS (name), + SCM_I_STRING_LENGTH (name)); scm_remember_upto_here_1 (name); return sym; } @@ -255,8 +255,8 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0, { SCM sym; SCM_VALIDATE_STRING (1, string); - sym = scm_mem2symbol (SCM_STRING_CHARS (string), - SCM_STRING_LENGTH (string)); + sym = scm_mem2symbol (SCM_I_STRING_CHARS (string), + SCM_I_STRING_LENGTH (string)); scm_remember_upto_here_1 (string); return sym; } @@ -287,10 +287,11 @@ SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0, else { SCM_VALIDATE_STRING (1, prefix); - len = SCM_STRING_LENGTH (prefix); + len = SCM_I_STRING_LENGTH (prefix); if (len > MAX_PREFIX_LENGTH) name = scm_malloc (len + SCM_INTBUFLEN); - memcpy (name, SCM_STRING_CHARS (prefix), len); + memcpy (name, SCM_I_STRING_CHARS (prefix), len); + scm_remember_upto_here_1 (prefix); } { int n, n_digits; diff --git a/libguile/unif.c b/libguile/unif.c index 78612621c..7936f2491 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -220,7 +220,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0, case scm_tc7_wvect: return scm_from_size_t (SCM_VECTOR_LENGTH (v)); case scm_tc7_string: - return scm_from_size_t (SCM_STRING_LENGTH (v)); + return scm_from_size_t (SCM_I_STRING_LENGTH (v)); case scm_tc7_bvect: return scm_from_size_t (SCM_BITVECTOR_LENGTH (v)); case scm_tc7_byvect: @@ -939,11 +939,11 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1, SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd; SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd; SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; - SCM_STRING_CHARS (axv)[j] = 1; + SCM_I_STRING_CHARS (axv)[j] = 1; } for (j = 0, k = 0; k < noutr; k++, j++) { - while (SCM_STRING_CHARS (axv)[j]) + while (SCM_I_STRING_CHARS (axv)[j]) j++; SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; @@ -1109,7 +1109,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0, else return SCM_BOOL_F; case scm_tc7_string: - return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); + return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: @@ -1155,7 +1155,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last) else return SCM_BOOL_F; case scm_tc7_string: - return SCM_MAKE_CHAR (SCM_STRING_UCHARS (v)[pos]); + return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]); case scm_tc7_byvect: return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]); case scm_tc7_uvect: @@ -1269,7 +1269,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1, break; case scm_tc7_string: SCM_ASRTGO (SCM_CHARP (obj), badobj); - SCM_STRING_UCHARS (v)[pos] = SCM_CHAR (obj); + SCM_I_STRING_UCHARS (v)[pos] = SCM_CHAR (obj); break; case scm_tc7_byvect: if (SCM_CHARP (obj)) @@ -1478,7 +1478,7 @@ loop: v = SCM_ARRAY_V (cra); goto loop; case scm_tc7_string: - base = SCM_STRING_CHARS (v); + base = SCM_I_STRING_CHARS (v); sz = sizeof (char); break; case scm_tc7_bvect: @@ -1644,7 +1644,7 @@ loop: v = SCM_ARRAY_V (v); goto loop; case scm_tc7_string: - base = SCM_STRING_CHARS (v); + base = SCM_I_STRING_CHARS (v); sz = sizeof (char); break; case scm_tc7_bvect: @@ -2321,16 +2321,16 @@ tail: break; case scm_tc7_string: if (n-- > 0) - scm_iprin1 (SCM_MAKE_CHAR (SCM_STRING_UCHARS (ra)[j]), port, pstate); + scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate); if (SCM_WRITINGP (pstate)) for (j += inc; n-- > 0; j += inc) { scm_putc (' ', port); - scm_iprin1 (SCM_MAKE_CHAR (SCM_STRING_UCHARS (ra)[j]), port, pstate); + scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate); } else for (j += inc; n-- > 0; j += inc) - scm_putc (SCM_STRING_CHARS (ra)[j], port); + scm_putc (SCM_I_STRING_CHARS (ra)[j], port); break; case scm_tc7_byvect: if (n-- > 0) |