mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 16:50:21 +02:00
* 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.
This commit is contained in:
Marius Vollmer
parent
70f7ee4188
commit
8824ac88f0
18 changed files with 189 additions and 135 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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),
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 == '~')
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
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;
|
||||
}
|
||||
|
|
@ -247,6 +256,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
|
|||
SCM_SYSERROR;
|
||||
}
|
||||
|
||||
scm_remember_upto_here_1 (str);
|
||||
return scm_from_long (rv);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
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))
|
||||
{
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue