summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-08-12 17:45:03 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-08-12 17:45:03 +0000
commit8824ac88f08cffc954a907b85858ccd5b3c9843f (patch)
treec96fa1d142124eaf6f030adbc4ec2eb040b612b0
parent70f7ee4188c0a752154d8cc63daf5a99ba89951f (diff)
downloadguile-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.c12
-rw-r--r--libguile/convert.i.c4
-rw-r--r--libguile/gc-card.c4
-rw-r--r--libguile/gc.c2
-rw-r--r--libguile/hash.c7
-rw-r--r--libguile/numbers.c9
-rw-r--r--libguile/print.c11
-rw-r--r--libguile/ramap.c8
-rw-r--r--libguile/random.c8
-rw-r--r--libguile/read.c38
-rw-r--r--libguile/regex-posix.c12
-rw-r--r--libguile/rw.c30
-rw-r--r--libguile/strop.c62
-rw-r--r--libguile/strorder.c56
-rw-r--r--libguile/strports.c8
-rw-r--r--libguile/struct.c18
-rw-r--r--libguile/symbols.c13
-rw-r--r--libguile/unif.c22
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)