mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

* strings.h, strings.c: (scm_i_string_chars, scm_i_string_length,

Browse source 
scm_i_string_writable_chars, scm_i_string_stop_writing): New, to
replace SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH.  Updated all
uses.
(scm_i_make_string, scm_c_make_string): New, to replace
scm_allocate_string.  Updated all uses.
(SCM_STRINGP, SCM_STRING_CHARS, SCM_STRING_UCHARS,
SCM_STRING_LENGTH): Deprecated.
(scm_allocate_string, scm_take_str, scm_take0str, scm_mem2string,
scm_str2string, scm_makfrom0str, scm_makfrom0str_opt):
Discouraged.  Replaced all uses with scm_from_locale_string or
similar, as appropriate.
(scm_c_string_length, scm_c_string_ref, scm_c_string_set_x,
scm_c_substring, scm_c_substring_shared, scm_c_substring_copy,
scm_substring_shared, scm_substring_copy): New.

* symbols.c, symbols.h (SCM_SYMBOLP, SCM_SYMBOL_FUNC,
SCM_SET_SYMBOL_FUNC, SCM_SYMBOL_PROPS, SCM_SET_SYMBOL_PROPS,
SCM_SYMBOL_HASH, SCM_SYMBOL_INTERNED_P, scm_mem2symbol,
scm_str2symbol, scm_mem2uninterned_symbol): Discouraged.
(SCM_SYMBOL_LENGTH, SCM_SYMBOL_CHARS, scm_c_symbol2str):
Deprecated.
(SCM_MAKE_SYMBOL_TAG, SCM_SET_SYMBOL_LENGTH, SCM_SET_SYMBOL_CHARS,
SCM_PROP_SLOTS, SCM_SET_PROP_SLOTS): Removed.
(scm_is_symbol, scm_from_locale_symbol, scm_from_locale_symboln):
New, to replace scm_str2symbol and scm_mem2symbol, respectively.
Updated all uses.
(scm_gensym): Generate only the number suffix in the buffer, just
string-append the prefix.
This commit is contained in:
Marius Vollmer 2004-08-19 17:19:44 +00:00
parent f76c6bb234
commit cc95e00ac6
45 changed files with 623 additions and 494 deletions
Download patch file Download diff file Expand all files Collapse all files

34
libguile/backtrace.c
View file

@ -177,7 +177,7 @@ display_expression (SCM frame, SCM pname, SCM source, SCM port)
pstate->fancyp = 1;
pstate->level = DISPLAY_EXPRESSION_MAX_LEVEL;
pstate->length = DISPLAY_EXPRESSION_MAX_LENGTH;
if (SCM_SYMBOLP (pname) || scm_is_string (pname))
if (scm_is_symbol (pname) || scm_is_string (pname))
{
if (SCM_FRAMEP (frame)
&& SCM_FRAME_EVAL_ARGS_P (frame))
@ -228,13 +228,13 @@ display_error_body (struct display_error_args *a)
prev_frame = SCM_FRAME_PREV (current_frame);
if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame);
if (!SCM_SYMBOLP (pname)
if (!scm_is_symbol (pname)
&& !scm_is_string (pname)
&& SCM_FRAME_PROC_P (current_frame)
&& scm_is_true (scm_procedure_p (SCM_FRAME_PROC (current_frame))))
pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
}
if (SCM_SYMBOLP (pname) || scm_is_string (pname) || SCM_MEMOIZEDP (source))
if (scm_is_symbol (pname) || scm_is_string (pname) || SCM_MEMOIZEDP (source))
{
display_header (source, a->port);
display_expression (current_frame, pname, source, a->port);
@ -401,18 +401,24 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
string = scm_strport_to_string (sport);
assert (scm_is_string (string));
/* Remove control characters */
for (i = 0; i < n; ++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_I_STRING_UCHARS (string)[n - 1] = '$';
}
{
char *data = scm_i_string_writable_chars (string);
/* Remove control characters */
for (i = 0; i < n; ++i)
if (iscntrl (data[i]))
data[i] = ' ';
/* Truncate */
if (indentation + n > SCM_BACKTRACE_WIDTH)
{
n = SCM_BACKTRACE_WIDTH - indentation;
data[n-1] = '$';
}
scm_i_string_stop_writing ();
}
scm_lfwrite (SCM_I_STRING_CHARS (string), n, port);
scm_lfwrite (scm_i_string_chars (string), n, port);
scm_remember_upto_here_1 (string);
}

4
libguile/convert.i.c
View file

@ -163,11 +163,11 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#if SIZEOF_CTYPE == 1
case scm_tc7_string:
n = SCM_I_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_I_STRING_CHARS (obj), n * sizeof (CTYPE));
memcpy (data, scm_i_string_chars (obj), n * sizeof (CTYPE));
break;
#endif

2
libguile/deprecation.c
View file

@ -103,7 +103,7 @@ SCM_DEFINE(scm_issue_deprecation_warning,
mode = summary_print;
else
{
SCM nl = scm_str2string ("\n");
SCM nl = scm_from_locale_string ("\n");
SCM msgs_nl = SCM_EOL;
char *c_msgs;
while (SCM_CONSP (msgs))

4
libguile/dynl.c
View file

@ -75,8 +75,8 @@ sysdep_dynl_link (const char *fname, const char *subr)
SCM fn;
SCM msg;
fn = scm_makfrom0str (fname);
msg = scm_makfrom0str (scm_lt_dlerror ());
fn = scm_from_locale_string (fname);
msg = scm_from_locale_string (scm_lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;

31
libguile/environments.c
View file

@ -118,7 +118,7 @@ SCM_DEFINE (scm_environment_bound_p, "environment-bound?", 2, 0, 0,
#define FUNC_NAME s_scm_environment_bound_p
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
return scm_from_bool (SCM_ENVIRONMENT_BOUND_P (env, sym));
}
@ -135,7 +135,7 @@ SCM_DEFINE (scm_environment_ref, "environment-ref", 2, 0, 0,
SCM val;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
val = SCM_ENVIRONMENT_REF (env, sym);
@ -155,7 +155,7 @@ SCM
scm_c_environment_ref (SCM env, SCM sym)
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, "scm_c_environment_ref");
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, "scm_c_environment_ref");
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, "scm_c_environment_ref");
return SCM_ENVIRONMENT_REF (env, sym);
}
@ -240,7 +240,7 @@ SCM_DEFINE (scm_environment_define, "environment-define", 3, 0, 0,
SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_DEFINE (env, sym, val);
@ -266,7 +266,7 @@ SCM_DEFINE (scm_environment_undefine, "environment-undefine", 2, 0, 0,
SCM status;
SCM_ASSERT(SCM_ENVIRONMENT_P(env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT(SCM_SYMBOLP(sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT(scm_is_symbol(sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_UNDEFINE (env, sym);
@ -294,7 +294,7 @@ SCM_DEFINE (scm_environment_set_x, "environment-set!", 3, 0, 0,
SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_SET (env, sym, val);
@ -329,7 +329,7 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0,
SCM location;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_bool (for_write), for_write, SCM_ARG3, FUNC_NAME);
location = SCM_ENVIRONMENT_CELL (env, sym, scm_is_true (for_write));
@ -355,7 +355,7 @@ SCM
scm_c_environment_cell(SCM env, SCM sym, int for_write)
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, "scm_c_environment_cell");
SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, "scm_c_environment_cell");
SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, "scm_c_environment_cell");
return SCM_ENVIRONMENT_CELL (env, sym, for_write);
}
@ -507,7 +507,7 @@ observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
static SCM
obarray_enter (SCM obarray, SCM symbol, SCM data)
{
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]);
SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
@ -525,7 +525,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_replace (SCM obarray, SCM symbol, SCM data)
{
size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM new_entry = scm_cons (symbol, data);
SCM lsym;
SCM slot;
@ -557,7 +557,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_retrieve (SCM obarray, SCM sym)
{
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM lsym;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
@ -580,7 +580,7 @@ obarray_retrieve (SCM obarray, SCM sym)
static SCM
obarray_remove (SCM obarray, SCM sym)
{
size_t hash = SCM_SYMBOL_HASH (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash];
SCM handle = scm_sloppy_assq (sym, table_entry);
@ -787,7 +787,8 @@ update_catch_handler (void *ptr, SCM tag, SCM args)
{
struct update_data *data = (struct update_data *) ptr;
SCM observer = data->observer;
SCM message = scm_makfrom0str ("Observer `~A' signals `~A' error: ~S");
SCM message =
scm_from_locale_string ("Observer `~A' signals `~A' error: ~S");
return scm_cons (message, scm_list_3 (observer, tag, args));
}
@ -2238,7 +2239,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
{
SCM entry = SCM_CAR (l);
if (SCM_SYMBOLP (entry))
if (scm_is_symbol (entry))
{
SCM new_entry = scm_cons2 (entry, symbol_immutable_location, SCM_EOL);
result = scm_cons (new_entry, result);
@ -2253,7 +2254,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
SCM l2;
SCM_ASSERT (SCM_CONSP (entry), entry, SCM_ARGn, caller);
SCM_ASSERT (SCM_SYMBOLP (SCM_CAR (entry)), entry, SCM_ARGn, caller);
SCM_ASSERT (scm_is_symbol (SCM_CAR (entry)), entry, SCM_ARGn, caller);
sym = SCM_CAR (entry);

63
libguile/eval.c
View file

@ -254,7 +254,7 @@ syntax_error (const char* const, const SCM, const SCM) SCM_NORETURN;
static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
const SCM msg_string = scm_makfrom0str (msg);
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
@ -524,7 +524,7 @@ is_self_quoting_p (const SCM expr)
{
if (SCM_CONSP (expr))
return 0;
else if (SCM_SYMBOLP (expr))
else if (scm_is_symbol (expr))
return 0;
else if (SCM_NULLP (expr))
return 0;
@ -651,7 +651,7 @@ m_body (SCM op, SCM exprs)
static SCM
try_macro_lookup (const SCM expr, const SCM env)
{
if (SCM_SYMBOLP (expr))
if (scm_is_symbol (expr))
{
const SCM variable = lookup_symbol (expr, env);
if (SCM_VARIABLEP (variable))
@ -848,7 +848,7 @@ macroexp (SCM x, SCM env)
macro_tail:
orig_sym = SCM_CAR (x);
if (!SCM_SYMBOLP (orig_sym))
if (!scm_is_symbol (orig_sym))
return x;
{
@ -1178,7 +1178,7 @@ canonicalize_define (const SCM expr)
body = scm_list_1 (lambda);
variable = SCM_CAR (variable);
}
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
SCM_SETCAR (cdr_expr, variable);
@ -1313,7 +1313,7 @@ scm_m_do (SCM expr, SCM env SCM_UNUSED)
const SCM name = SCM_CAR (binding);
const SCM init = SCM_CADR (binding);
const SCM step = (length == 2) ? name : SCM_CADDR (binding);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)),
s_duplicate_binding, name, expr);
@ -1455,7 +1455,7 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
}
else
{
ASSERT_SYNTAX_2 (SCM_SYMBOLP (formals) || SCM_NULLP (formals),
ASSERT_SYNTAX_2 (scm_is_symbol (formals) || SCM_NULLP (formals),
s_bad_formals, formals, expr);
}
@ -1466,12 +1466,12 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
{
const SCM formal = SCM_CAR (formals_idx);
const SCM next_idx = SCM_CDR (formals_idx);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (formal), s_bad_formal, formal, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (formal), s_bad_formal, formal, expr);
ASSERT_SYNTAX_2 (!c_improper_memq (formal, next_idx),
s_duplicate_formal, formal, expr);
formals_idx = next_idx;
}
ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || SCM_SYMBOLP (formals_idx),
ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || scm_is_symbol (formals_idx),
s_bad_formal, formals_idx, expr);
/* Memoize the body. Keep a potential documentation string. */
@ -1525,7 +1525,7 @@ check_bindings (const SCM bindings, const SCM expr)
s_bad_binding, binding, expr);
name = SCM_CAR (binding);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
}
}
@ -1611,7 +1611,7 @@ scm_m_let (SCM expr, SCM env)
ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
bindings = SCM_CAR (cdr_expr);
if (SCM_SYMBOLP (bindings))
if (scm_is_symbol (bindings))
{
ASSERT_SYNTAX (length >= 3, s_missing_expression, expr);
return memoize_named_let (expr, env);
@ -1944,7 +1944,7 @@ scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
variable = SCM_CAR (cdr_expr);
/* Memoize the variable form. */
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
new_variable = lookup_symbol (variable, env);
/* Leave the memoization of unbound symbols to lazy memoization: */
if (SCM_UNBNDP (new_variable))
@ -2140,7 +2140,7 @@ scm_m_generalized_set_x (SCM expr, SCM env)
&& SCM_NULLP (SCM_CDDR (exp_target)))
{
exp_target= SCM_CADR (exp_target);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (exp_target)
ASSERT_SYNTAX_2 (scm_is_symbol (exp_target)
|| SCM_VARIABLEP (exp_target),
s_bad_variable, exp_target, expr);
return scm_cons (SCM_IM_SET_X, scm_cons (exp_target,
@ -2276,7 +2276,7 @@ scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr);
symbol = SCM_CAR (cdr_expr);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (symbol), s_bad_variable, symbol, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (symbol), s_bad_variable, symbol, expr);
location = scm_symbol_fref (symbol);
ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
@ -2284,7 +2284,7 @@ scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
/* The elisp function `defalias' allows to define aliases for symbols. To
* look up such definitions, the chain of symbol definitions has to be
* followed up to the terminal symbol. */
while (SCM_SYMBOLP (SCM_VARIABLE_REF (location)))
while (scm_is_symbol (SCM_VARIABLE_REF (location)))
{
const SCM alias = SCM_VARIABLE_REF (location);
location = scm_symbol_fref (alias);
@ -2460,7 +2460,7 @@ scm_m_undefine (SCM expr, SCM env)
("`undefine' is deprecated.\n");
variable = SCM_CAR (cdr_expr);
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
ASSERT_SYNTAX_2 (scm_is_true (location)
&& !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
@ -2622,7 +2622,7 @@ static SCM deval (SCM x, SCM env);
? (scm_debug_mode_p \
? deval (SCM_CAR (x), (env)) \
: ceval (SCM_CAR (x), (env))) \
: (!SCM_SYMBOLP (SCM_CAR (x)) \
: (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
@ -2642,7 +2642,7 @@ static SCM deval (SCM x, SCM env);
? SCM_VARIABLE_REF (SCM_CAR (x)) \
: (SCM_CONSP (SCM_CAR (x)) \
? CEVAL (SCM_CAR (x), (env)) \
: (!SCM_SYMBOLP (SCM_CAR (x)) \
: (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
@ -3345,7 +3345,7 @@ dispatch:
RETURN (SCM_I_EVALIM (last_form, env));
else if (SCM_VARIABLEP (last_form))
RETURN (SCM_VARIABLE_REF (last_form));
else if (SCM_SYMBOLP (last_form))
else if (scm_is_symbol (last_form))
RETURN (*scm_lookupcar (x, env, 1));
else
RETURN (last_form);
@ -3603,7 +3603,7 @@ dispatch:
location = SCM_VARIABLE_LOC (variable);
else
{
/* (SCM_SYMBOLP (variable)) is known to be true */
/* (scm_is_symbol (variable)) is known to be true */
variable = lazy_memoize_variable (variable, env);
SCM_SETCAR (x, variable);
location = SCM_VARIABLE_LOC (variable);
@ -3945,7 +3945,7 @@ dispatch:
proc = *scm_ilookup (SCM_CAR (x), env);
else if (SCM_CONSP (SCM_CAR (x)))
proc = CEVAL (SCM_CAR (x), env);
else if (SCM_SYMBOLP (SCM_CAR (x)))
else if (scm_is_symbol (SCM_CAR (x)))
{
SCM orig_sym = SCM_CAR (x);
{
@ -4160,14 +4160,15 @@ dispatch:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
SCM_ARG1,
scm_i_symbol_chars (SCM_SNAME (proc)));
case scm_tc7_cxr:
{
unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@ -4847,7 +4848,7 @@ tail:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
case scm_tc7_cxr:
if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
scm_wrong_num_args (proc);
@ -4856,7 +4857,7 @@ tail:
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@ -5199,7 +5200,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
}
static SCM
@ -5209,7 +5210,7 @@ call_cxr_1 (SCM proc, SCM arg1)
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@ -5854,7 +5855,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
SCM
scm_i_eval_x (SCM exp, SCM env)
{
if (SCM_SYMBOLP (exp))
if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env);
@ -5864,7 +5865,7 @@ SCM
scm_i_eval (SCM exp, SCM env)
{
exp = scm_copy_tree (exp);
if (SCM_SYMBOLP (exp))
if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env);
@ -5980,7 +5981,7 @@ SCM scm_ceval (SCM x, SCM env)
{
if (SCM_CONSP (x))
return ceval (x, env);
else if (SCM_SYMBOLP (x))
else if (scm_is_symbol (x))
return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (x, env);
@ -5991,7 +5992,7 @@ SCM scm_deval (SCM x, SCM env)
{
if (SCM_CONSP (x))
return deval (x, env);
else if (SCM_SYMBOLP (x))
else if (scm_is_symbol (x))
return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (x, env);

6
libguile/feature.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -41,7 +41,7 @@ void
scm_add_feature (const char *str)
{
SCM old = SCM_VARIABLE_REF (features_var);
SCM new = scm_cons (scm_str2symbol (str), old);
SCM new = scm_cons (scm_from_locale_symbol (str), old);
SCM_VARIABLE_SET (features_var, new);
}
@ -71,7 +71,7 @@ scm_set_program_arguments (int argc, char **argv, char *first)
{
scm_progargs = scm_makfromstrs (argc, argv);
if (first)
scm_progargs = scm_cons (scm_makfrom0str (first), scm_progargs);
scm_progargs = scm_cons (scm_from_locale_string (first), scm_progargs);
}

30
libguile/filesys.c
View file

@ -863,7 +863,7 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
if (errno != 0)
SCM_SYSERROR;
return (rdent ? scm_mem2string (rdent->d_name, NAMLEN (rdent))
return (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
: SCM_EOF_VAL);
}
}
@ -977,7 +977,7 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
errno = save_errno;
SCM_SYSERROR;
}
result = scm_mem2string (wd, strlen (wd));
result = scm_from_locale_stringn (wd, strlen (wd));
free (wd);
return result;
}
@ -1501,14 +1501,14 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
"component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname
{
char *s;
const char *s;
long int i;
unsigned long int len;
SCM_VALIDATE_STRING (1, filename);
s = SCM_I_STRING_CHARS (filename);
len = SCM_I_STRING_LENGTH (filename);
s = scm_i_string_chars (filename);
len = scm_i_string_length (filename);
i = len - 1;
#ifdef __MINGW32__
@ -1527,12 +1527,12 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
#else
if (len > 0 && s[0] == '/')
#endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, scm_from_int (1));
return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
}
else
return scm_substring (filename, SCM_INUM0, scm_from_int (i + 1));
return scm_c_substring (filename, 0, i + 1);
}
#undef FUNC_NAME
@ -1544,20 +1544,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
"@var{basename}, it is removed also.")
#define FUNC_NAME s_scm_basename
{
char *f, *s = 0;
const char *f, *s = 0;
int i, j, len, end;
SCM_VALIDATE_STRING (1, filename);
f = SCM_I_STRING_CHARS (filename);
len = SCM_I_STRING_LENGTH (filename);
f = scm_i_string_chars (filename);
len = scm_i_string_length (filename);
if (SCM_UNBNDP (suffix))
j = -1;
else
{
SCM_VALIDATE_STRING (2, suffix);
s = SCM_I_STRING_CHARS (suffix);
j = SCM_I_STRING_LENGTH (suffix) - 1;
s = scm_i_string_chars (suffix);
j = scm_i_string_length (suffix) - 1;
}
i = len - 1;
#ifdef __MINGW32__
@ -1581,12 +1581,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
#else
if (len > 0 && f[0] == '/')
#endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, scm_from_int (1));
return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
}
else
return scm_substring (filename, scm_from_int (i+1), scm_from_int (end+1));
return scm_c_substring (filename, i+1, end+1);
}
#undef FUNC_NAME
@ -1601,7 +1601,7 @@ scm_init_filesys ()
scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print);
scm_dot_string = scm_permanent_object (scm_makfrom0str ("."));
scm_dot_string = scm_permanent_object (scm_from_locale_string ("."));
#ifdef O_RDONLY
scm_c_define ("O_RDONLY", scm_from_long (O_RDONLY));

2
libguile/fports.c
View file

@ -501,7 +501,7 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
int fdes;
SCM name = SCM_FILENAME (exp);
if (scm_is_string (name) || SCM_SYMBOLP (name))
if (scm_is_string (name) || scm_is_symbol (name))
scm_display (name, port);
else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);

6
libguile/gdbint.c
View file

@ -285,18 +285,18 @@ scm_init_gdbint ()
scm_print_carefully_p = 0;
port = scm_mkstrport (SCM_INUM0,
scm_make_string (scm_from_int (0), SCM_UNDEFINED),
scm_c_make_string (0, SCM_UNDEFINED),
SCM_OPN | SCM_WRTNG,
s);
gdb_output_port = scm_permanent_object (port);
port = scm_mkstrport (SCM_INUM0,
scm_make_string (scm_from_int (0), SCM_UNDEFINED),
scm_c_make_string (0, SCM_UNDEFINED),
SCM_OPN | SCM_RDNG | SCM_WRTNG,
s);
gdb_input_port = scm_permanent_object (port);
tok_buf = scm_permanent_object (scm_allocate_string (30));
tok_buf = scm_permanent_object (scm_c_make_string (30, SCM_UNDEFINED));
}
/*

86
libguile/goops.c
View file

@ -61,13 +61,14 @@
(v), SCM_BOOL_F)))
/* Fixme: Should use already interned symbols */
#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \
#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_from_locale_symbol (name)), \
a))
#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \
#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_from_locale_symbol (name)), \
a, b))
#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \
#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_from_locale_symbol (name)), \
a, b, c))
#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \
#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_from_locale_symbol (name)), \
a, b, c, d))
/* Class redefinition protocol:
@ -218,7 +219,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
return res;
tmp = SCM_CAAR (l);
if (!SCM_SYMBOLP (tmp))
if (!scm_is_symbol (tmp))
scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp));
if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) {
@ -479,6 +480,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
SCM slots, getters_n_setters, nfields;
unsigned long int n, i;
char *s;
SCM layout;
SCM_VALIDATE_INSTANCE (1, class);
slots = SCM_SLOT (class, scm_si_slots);
@ -493,7 +495,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S",
scm_list_1 (nfields));
s = n > 0 ? scm_malloc (n) : 0;
layout = scm_i_make_string (n, &s);
i = 0;
while (SCM_CONSP (getters_n_setters))
{
@ -519,11 +521,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
else
{
if (!SCM_CLASSP (type))
{
if (s)
free (s);
SCM_MISC_ERROR ("bad slot class", SCM_EOL);
}
SCM_MISC_ERROR ("bad slot class", SCM_EOL);
else if (SCM_SUBCLASSP (type, scm_class_foreign_slot))
{
if (SCM_SUBCLASSP (type, scm_class_self))
@ -564,13 +562,9 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
if (!SCM_NULLP (slots))
{
inconsistent:
if (s)
free (s);
SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL);
}
SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n));
if (s)
free (s);
SCM_SET_SLOT (class, scm_si_layout, scm_string_to_symbol (layout));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -763,9 +757,9 @@ create_basic_classes (void)
/* SCM slots_of_class = build_class_class_slots (); */
/**** <scm_class_class> ****/
SCM cs = scm_makfrom0str (SCM_CLASS_CLASS_LAYOUT
+ 2 * scm_vtable_offset_user);
SCM name = scm_str2symbol ("<class>");
SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT
+ 2 * scm_vtable_offset_user);
SCM name = scm_from_locale_symbol ("<class>");
scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs,
SCM_INUM0,
SCM_EOL));
@ -791,7 +785,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_class);
/**** <scm_class_top> ****/
name = scm_str2symbol ("<top>");
name = scm_from_locale_symbol ("<top>");
scm_class_top = scm_permanent_object (scm_basic_make_class (scm_class_class,
name,
SCM_EOL,
@ -800,7 +794,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_top);
/**** <scm_class_object> ****/
name = scm_str2symbol ("<object>");
name = scm_from_locale_symbol ("<object>");
scm_class_object = scm_permanent_object (scm_basic_make_class (scm_class_class,
name,
scm_list_1 (scm_class_top),
@ -977,7 +971,7 @@ SCM_DEFINE (scm_method_generic_function, "method-generic-function", 1, 0, 0,
#define FUNC_NAME s_scm_method_generic_function
{
SCM_VALIDATE_METHOD (1, obj);
return scm_slot_ref (obj, scm_str2symbol ("generic-function"));
return scm_slot_ref (obj, scm_from_locale_symbol ("generic-function"));
}
#undef FUNC_NAME
@ -987,7 +981,7 @@ SCM_DEFINE (scm_method_specializers, "method-specializers", 1, 0, 0,
#define FUNC_NAME s_scm_method_specializers
{
SCM_VALIDATE_METHOD (1, obj);
return scm_slot_ref (obj, scm_str2symbol ("specializers"));
return scm_slot_ref (obj, scm_from_locale_symbol ("specializers"));
}
#undef FUNC_NAME
@ -1007,7 +1001,7 @@ SCM_DEFINE (scm_accessor_method_slot_definition, "accessor-method-slot-definitio
#define FUNC_NAME s_scm_accessor_method_slot_definition
{
SCM_VALIDATE_ACCESSOR (1, obj);
return scm_slot_ref (obj, scm_str2symbol ("slot-definition"));
return scm_slot_ref (obj, scm_from_locale_symbol ("slot-definition"));
}
#undef FUNC_NAME
@ -2139,7 +2133,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
scm_i_get_keyword (k_name,
args,
len - 1,
scm_str2symbol ("???"),
scm_from_locale_symbol ("???"),
FUNC_NAME));
SCM_SET_SLOT (z, scm_si_direct_supers,
scm_i_get_keyword (k_dsupers,
@ -2234,7 +2228,7 @@ fix_cpl (SCM c, SCM before, SCM after)
static void
make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots)
{
SCM tmp = scm_str2symbol (name);
SCM tmp = scm_from_locale_symbol (name);
*var = scm_permanent_object (scm_basic_make_class (meta,
tmp,
@ -2252,32 +2246,32 @@ static void
create_standard_classes (void)
{
SCM slots;
SCM method_slots = scm_list_4 (scm_str2symbol ("generic-function"),
scm_str2symbol ("specializers"),
SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"),
scm_from_locale_symbol ("specializers"),
sym_procedure,
scm_str2symbol ("code-table"));
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"),
scm_from_locale_symbol ("code-table"));
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
k_init_keyword,
k_slot_definition));
SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
SCM mutex_slot = scm_list_1 (scm_from_locale_symbol ("make-mutex"));
SCM mutex_closure = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
SCM_EOL,
mutex_slot),
SCM_EOL);
SCM gf_slots = scm_list_5 (scm_str2symbol ("methods"),
scm_list_3 (scm_str2symbol ("n-specialized"),
SCM gf_slots = scm_list_5 (scm_from_locale_symbol ("methods"),
scm_list_3 (scm_from_locale_symbol ("n-specialized"),
k_init_value,
SCM_INUM0),
scm_list_3 (scm_str2symbol ("used-by"),
scm_list_3 (scm_from_locale_symbol ("used-by"),
k_init_value,
SCM_BOOL_F),
scm_list_3 (scm_str2symbol ("cache-mutex"),
scm_list_3 (scm_from_locale_symbol ("cache-mutex"),
k_init_thunk,
mutex_closure),
scm_list_3 (scm_str2symbol ("extended-by"),
scm_list_3 (scm_from_locale_symbol ("extended-by"),
k_init_value,
SCM_EOL));
SCM egf_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("extends"),
SCM egf_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("extends"),
k_init_value,
SCM_EOL));
/* Foreign class slot classes */
@ -2320,10 +2314,10 @@ create_standard_classes (void)
make_stdcls (&scm_class_foreign_class, "<foreign-class>",
scm_class_class, scm_class_class,
scm_list_2 (scm_list_3 (scm_str2symbol ("constructor"),
scm_list_2 (scm_list_3 (scm_from_locale_symbol ("constructor"),
k_class,
scm_class_opaque),
scm_list_3 (scm_str2symbol ("destructor"),
scm_list_3 (scm_from_locale_symbol ("destructor"),
k_class,
scm_class_opaque)));
make_stdcls (&scm_class_foreign_object, "<foreign-object>",
@ -2450,7 +2444,7 @@ make_class_from_template (char const *template, char const *type_name, SCM super
{
char buffer[100];
sprintf (buffer, template, type_name);
name = scm_str2symbol (buffer);
name = scm_from_locale_symbol (buffer);
}
else
name = SCM_GOOPS_UNBOUND;
@ -2580,7 +2574,7 @@ make_struct_class (void *closure SCM_UNUSED,
if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
SCM_SET_STRUCT_TABLE_CLASS (data,
scm_make_extended_class
(SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)),
(scm_i_symbol_chars (SCM_STRUCT_TABLE_NAME (data)),
SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR));
return SCM_UNSPECIFIED;
}
@ -2632,7 +2626,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
size_t (*destructor) (void *))
{
SCM name, class;
name = scm_str2symbol (s_name);
name = scm_from_locale_symbol (s_name);
if (SCM_NULLP (supers))
supers = scm_list_1 (scm_class_foreign_object);
class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL);
@ -2649,7 +2643,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
SCM_SET_CLASS_INSTANCE_SIZE (class, size);
}
SCM_SET_SLOT (class, scm_si_layout, scm_str2symbol (""));
SCM_SET_SLOT (class, scm_si_layout, scm_from_locale_symbol (""));
SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor);
return class;
@ -2692,8 +2686,8 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
SCM_EOL);
{
SCM name = scm_str2symbol (slot_name);
SCM aname = scm_str2symbol (accessor_name);
SCM name = scm_from_locale_symbol (slot_name);
SCM aname = scm_from_locale_symbol (accessor_name);
SCM gf = scm_ensure_accessor (aname);
SCM slot = scm_list_5 (name,
k_class,
@ -2840,7 +2834,7 @@ scm_init_goops_builtins (void)
create_port_classes ();
{
SCM name = scm_str2symbol ("no-applicable-method");
SCM name = scm_from_locale_symbol ("no-applicable-method");
scm_no_applicable_method
= scm_permanent_object (scm_make (scm_list_3 (scm_class_generic,
k_name,

6
libguile/hash.c
View file

@ -110,13 +110,13 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
/* Fall through */
case scm_tc7_string:
{
unsigned long hash = scm_string_hash (SCM_I_STRING_UCHARS (obj),
SCM_I_STRING_LENGTH (obj)) % n;
unsigned long hash = scm_string_hash (scm_i_string_chars (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;
return scm_i_symbol_hash (obj) % n;
case scm_tc7_wvect:
case scm_tc7_vector:
{

7
libguile/init.c
View file

@ -224,7 +224,7 @@ stream_body (void *data)
{
stream_body_data *body_data = (stream_body_data *) data;
SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode,
scm_makfrom0str (body_data->name));
scm_from_locale_string (body_data->name));
SCM_REVEALED (port) = 1;
return port;
@ -309,12 +309,13 @@ scm_load_startup_files ()
/* We want a path only containing directories from GUILE_LOAD_PATH,
SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
file, so we do this before loading Ice-9. */
SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
SCM init_path =
scm_sys_search_load_path (scm_from_locale_string ("init.scm"));
/* Load Ice-9. */
if (!scm_ice_9_already_loaded)
{
scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9.scm"));
/* Load the init.scm file. */
if (scm_is_true (init_path))

23
libguile/keywords.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -28,6 +28,8 @@
#include "libguile/validate.h"
#include "libguile/keywords.h"
#include "libguile/strings.h"
scm_t_bits scm_tc16_keyword;
@ -38,8 +40,8 @@ keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
SCM symbol = SCM_KEYWORDSYM (exp);
scm_puts ("#:", port);
scm_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1,
SCM_SYMBOL_LENGTH (symbol) - 1,
scm_print_symbol_name (scm_i_symbol_chars (symbol) + 1,
scm_i_symbol_length (symbol) - 1,
port);
scm_remember_upto_here_1 (symbol);
return 1;
@ -52,8 +54,8 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
{
SCM keyword;
SCM_ASSERT (SCM_SYMBOLP (symbol)
&& ('-' == SCM_SYMBOL_CHARS(symbol)[0]),
SCM_ASSERT (scm_is_symbol (symbol)
&& ('-' == scm_i_symbol_chars(symbol)[0]),
symbol, SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS;
@ -71,14 +73,15 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
SCM
scm_c_make_keyword (char *s)
{
char *buf = scm_malloc (strlen (s) + 2);
SCM symbol;
char *buf;
size_t len;
SCM string, symbol;
len = strlen (s) + 1;
string = scm_i_make_string (len, &buf);
buf[0] = '-';
strcpy (buf + 1, s);
symbol = scm_str2symbol (buf);
free (buf);
symbol = scm_string_to_symbol (string);
return scm_make_keyword_from_dash_symbol (symbol);
}

33
libguile/load.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -105,7 +105,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{ /* scope */
SCM port, save_port;
port = scm_open_file (filename, scm_mem2string ("r", sizeof (char)));
port = scm_open_file (filename, scm_from_locale_string ("r"));
save_port = port;
scm_internal_dynamic_wind (swap_port,
load,
@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
SCM
scm_c_primitive_load (const char *filename)
{
return scm_primitive_load (scm_makfrom0str (filename));
return scm_primitive_load (scm_from_locale_string (filename));
}
@ -134,7 +134,7 @@ SCM_DEFINE (scm_sys_package_data_dir, "%package-data-dir", 0, 0, 0,
"@samp{/usr/local/share/guile}.")
#define FUNC_NAME s_scm_sys_package_data_dir
{
return scm_makfrom0str (SCM_PKGDATA_DIR);
return scm_from_locale_string (SCM_PKGDATA_DIR);
}
#undef FUNC_NAME
#endif /* SCM_PKGDATA_DIR */
@ -146,7 +146,7 @@ SCM_DEFINE (scm_sys_library_dir, "%library-dir", 0,0,0,
"E.g., may return \"/usr/share/guile/1.3.5\".")
#define FUNC_NAME s_scm_sys_library_dir
{
return scm_makfrom0str(SCM_LIBRARY_DIR);
return scm_from_locale_string (SCM_LIBRARY_DIR);
}
#undef FUNC_NAME
#endif /* SCM_LIBRARY_DIR */
@ -158,7 +158,7 @@ SCM_DEFINE (scm_sys_site_dir, "%site-dir", 0,0,0,
"E.g., may return \"/usr/share/guile/site\".")
#define FUNC_NAME s_scm_sys_site_dir
{
return scm_makfrom0str(SCM_SITE_DIR);
return scm_from_locale_string (SCM_SITE_DIR);
}
#undef FUNC_NAME
#endif /* SCM_SITE_DIR */
@ -208,9 +208,9 @@ scm_init_load_path ()
SCM path = SCM_EOL;
#ifdef SCM_LIBRARY_DIR
path = scm_list_3 (scm_makfrom0str (SCM_SITE_DIR),
scm_makfrom0str (SCM_LIBRARY_DIR),
scm_makfrom0str (SCM_PKGDATA_DIR));
path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
scm_from_locale_string (SCM_LIBRARY_DIR),
scm_from_locale_string (SCM_PKGDATA_DIR));
#endif /* SCM_LIBRARY_DIR */
env = getenv ("GUILE_LOAD_PATH");
@ -483,7 +483,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
SCM
scm_c_primitive_load_path (const char *filename)
{
return scm_primitive_load_path (scm_makfrom0str (filename));
return scm_primitive_load_path (scm_from_locale_string (filename));
}
@ -499,12 +499,13 @@ init_build_info ()
unsigned long i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
*loc = scm_acons (scm_str2symbol (info[i].name),
scm_makfrom0str (info[i].value),
*loc);
{
SCM key = scm_from_locale_symbol (info[i].name);
SCM val = scm_from_locale_string (info[i].value);
*loc = scm_acons (key, val, *loc);
}
}
void
scm_init_load ()
@ -513,8 +514,8 @@ scm_init_load ()
scm_loc_load_path = SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL));
scm_loc_load_extensions
= SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
scm_list_2 (scm_makfrom0str (".scm"),
scm_nullstr)));
scm_list_2 (scm_from_locale_string (".scm"),
scm_nullstr)));
scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
init_build_info ();

17
libguile/modules.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1998,2000,2001,2002, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1998,2000,2001,2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -111,7 +111,8 @@ convert_module_name (const char *name)
ptr++;
if (ptr > name)
{
*tail = scm_cons (scm_mem2symbol (name, ptr-name), SCM_EOL);
SCM sym = scm_from_locale_symboln (name, ptr-name);
*tail = scm_cons (sym, SCM_EOL);
tail = SCM_CDRLOC (*tail);
}
name = ptr;
@ -185,7 +186,7 @@ scm_c_export (const char *name, ...)
if (name)
{
va_list ap;
SCM names = scm_cons (scm_str2symbol (name), SCM_EOL);
SCM names = scm_cons (scm_from_locale_symbol (name), SCM_EOL);
SCM *tail = SCM_CDRLOC (names);
va_start (ap, name);
while (1)
@ -193,7 +194,7 @@ scm_c_export (const char *name, ...)
const char *n = va_arg (ap, const char *);
if (n == NULL)
break;
*tail = scm_cons (scm_str2symbol (n), SCM_EOL);
*tail = scm_cons (scm_from_locale_symbol (n), SCM_EOL);
tail = SCM_CDRLOC (*tail);
}
va_end (ap);
@ -485,7 +486,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
SCM
scm_c_module_lookup (SCM module, const char *name)
{
return scm_module_lookup (module, scm_str2symbol (name));
return scm_module_lookup (module, scm_from_locale_symbol (name));
}
SCM
@ -505,7 +506,7 @@ scm_module_lookup (SCM module, SCM sym)
SCM
scm_c_lookup (const char *name)
{
return scm_lookup (scm_str2symbol (name));
return scm_lookup (scm_from_locale_symbol (name));
}
SCM
@ -521,7 +522,7 @@ scm_lookup (SCM sym)
SCM
scm_c_module_define (SCM module, const char *name, SCM value)
{
return scm_module_define (module, scm_str2symbol (name), value);
return scm_module_define (module, scm_from_locale_symbol (name), value);
}
SCM
@ -540,7 +541,7 @@ scm_module_define (SCM module, SCM sym, SCM value)
SCM
scm_c_define (const char *name, SCM value)
{
return scm_define (scm_str2symbol (name), value);
return scm_define (scm_from_locale_symbol (name), value);
}
SCM

10
libguile/net_db.c
View file

@ -174,7 +174,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry)
scm_resolv_error (FUNC_NAME, host);
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
@ -248,7 +248,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno);
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
@ -300,7 +300,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno);
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
return result;
@ -314,10 +314,10 @@ scm_return_entry (struct servent *entry)
{
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
SCM_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
return result;
}

16
libguile/numbers.c
View file

@ -2286,25 +2286,25 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0,
{
char num_buf [SCM_INTBUFLEN];
size_t length = scm_iint2str (SCM_I_INUM (n), base, num_buf);
return scm_mem2string (num_buf, length);
return scm_from_locale_stringn (num_buf, length);
}
else if (SCM_BIGP (n))
{
char *str = mpz_get_str (NULL, base, SCM_I_BIG_MPZ (n));
scm_remember_upto_here_1 (n);
return scm_take0str (str);
return scm_take_locale_string (str);
}
else if (SCM_FRACTIONP (n))
{
scm_i_fraction_reduce (n);
return scm_string_append (scm_list_3 (scm_number_to_string (SCM_FRACTION_NUMERATOR (n), radix),
scm_mem2string ("/", 1),
scm_from_locale_string ("/"),
scm_number_to_string (SCM_FRACTION_DENOMINATOR (n), radix)));
}
else if (SCM_INEXACTP (n))
{
char num_buf [FLOBUFLEN];
return scm_mem2string (num_buf, iflo2str (n, num_buf, base));
return scm_from_locale_stringn (num_buf, iflo2str (n, num_buf, base));
}
else
SCM_WRONG_TYPE_ARG (1, n);
@ -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_I_STRING_CHARS (str), SCM_I_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;
}
@ -2596,7 +2596,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
if (exponent > SCM_MAXEXP)
{
size_t exp_len = idx - start;
SCM exp_string = scm_mem2string (&mem[start], exp_len);
SCM exp_string = scm_from_locale_stringn (&mem[start], exp_len);
SCM exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
scm_out_of_range ("string->number", exp_num);
}
@ -2967,8 +2967,8 @@ 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_I_STRING_CHARS (string),
SCM_I_STRING_LENGTH (string),
answer = scm_i_mem2number (scm_i_string_chars (string),
scm_i_string_length (string),
base);
scm_remember_upto_here_1 (string);
return answer;

13
libguile/objects.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1999,2000,2001, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -170,7 +170,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
SCM class = scm_make_extended_class (scm_is_true (name)
? SCM_SYMBOL_CHARS (name)
? scm_i_symbol_chars (name)
: 0,
SCM_I_OPERATORP (x));
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
@ -468,8 +468,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
SCM_VALIDATE_STRUCT (1, class);
SCM_VALIDATE_STRING (2, layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */
pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
pl = scm_symbol_to_string (pl);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (scm_list_2 (pl, layout)),
SCM_CLASS_FLAGS (class));
@ -479,15 +478,15 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
void
scm_init_objects ()
{
SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
SCM ms = scm_from_locale_string (SCM_METACLASS_STANDARD_LAYOUT);
SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
SCM os = scm_from_locale_string (SCM_METACLASS_OPERATOR_LAYOUT);
SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
SCM es = scm_from_locale_string (SCM_ENTITY_LAYOUT);
SCM el = scm_make_struct_layout (es);
SCM et = scm_make_struct (mt, SCM_INUM0,
scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));

4
libguile/options.c
View file

@ -130,7 +130,7 @@ get_documented_option_setting (const scm_t_option options[], unsigned int n)
for (i = 0; i != n; ++i)
{
SCM ls = scm_cons (scm_str2string (options[i].doc), SCM_EOL);
SCM ls = scm_cons (scm_from_locale_string (options[i].doc), SCM_EOL);
switch (options[i].type)
{
case SCM_OPTION_BOOLEAN:
@ -252,7 +252,7 @@ scm_init_opts (SCM (*func) (SCM), scm_t_option options[], unsigned int n)
for (i = 0; i != n; ++i)
{
SCM name = scm_str2symbol (options[i].name);
SCM name = scm_from_locale_symbol (options[i].name);
options[i].name = (char *) SCM_UNPACK (name);
scm_permanent_object (name);
}

48
libguile/posix.c
View file

@ -355,19 +355,19 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL);
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid));
SCM_VECTOR_SET(result, 4, scm_makfrom0str (entry->pw_gecos));
SCM_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos));
if (!entry->pw_dir)
SCM_VECTOR_SET(result, 5, scm_makfrom0str (""));
SCM_VECTOR_SET(result, 5, scm_from_locale_string (""));
else
SCM_VECTOR_SET(result, 5, scm_makfrom0str (entry->pw_dir));
SCM_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir));
if (!entry->pw_shell)
SCM_VECTOR_SET(result, 6, scm_makfrom0str (""));
SCM_VECTOR_SET(result, 6, scm_from_locale_string (""));
else
SCM_VECTOR_SET(result, 6, scm_makfrom0str (entry->pw_shell));
SCM_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell));
return result;
}
#undef FUNC_NAME
@ -420,8 +420,8 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry)
SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid));
SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
return result;
@ -820,7 +820,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
scm_mutex_lock (&scm_i_misc_mutex);
SCM_SYSCALL (result = ttyname (fd));
err = errno;
ret = scm_makfrom0str (result);
ret = scm_from_locale_string (result);
scm_mutex_unlock (&scm_i_misc_mutex);
if (!result)
@ -850,7 +850,7 @@ SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
char *result = ctermid (buf);
if (*result == '\0')
SCM_SYSERROR;
return scm_makfrom0str (result);
return scm_from_locale_string (result);
}
#undef FUNC_NAME
#endif /* HAVE_CTERMID */
@ -1051,14 +1051,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0)
SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename));
SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release));
SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version));
SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine));
SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
SCM_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));
/*
a linux special?
SCM_VECTOR_SET(result, 5, scm_makfrom0str (buf.domainname));
SCM_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname));
*/
return result;
}
@ -1116,7 +1116,7 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
if (rv == NULL)
/* not SCM_SYSERROR since errno probably not set. */
SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);
return scm_makfrom0str (name);
return scm_from_locale_string (name);
}
#undef FUNC_NAME
@ -1369,13 +1369,13 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
#define FUNC_NAME s_scm_mknod
{
int val;
char *p;
const char *p;
int ctype = 0;
SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_SYMBOL (2, type);
p = SCM_SYMBOL_CHARS (type);
p = scm_i_symbol_chars (type);
if (strcmp (p, "regular") == 0)
ctype = S_IFREG;
else if (strcmp (p, "directory") == 0)
@ -1530,7 +1530,7 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
p = getlogin ();
if (!p || !*p)
return SCM_BOOL_F;
return scm_makfrom0str (p);
return scm_from_locale_string (p);
}
#undef FUNC_NAME
#endif /* HAVE_GETLOGIN */
@ -1549,7 +1549,7 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
p = cuserid (buf);
if (!p || !*p)
return SCM_BOOL_F;
return scm_makfrom0str (p);
return scm_from_locale_string (p);
}
#undef FUNC_NAME
#endif /* HAVE_CUSERID */
@ -1839,8 +1839,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
}
else
{
/* scm_makfrom0str may throw an exception. */
const SCM name = scm_makfrom0str (p);
/* scm_from_locale_string may throw an exception. */
const SCM name = scm_from_locale_string (p);
// No guile exceptions can occur before we have freed p's memory.
scm_frame_end ();

43
libguile/print.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995-1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -484,12 +484,15 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
size_t i;
size_t i, len;
const char *data;
scm_putc ('"', port);
for (i = 0; i < SCM_I_STRING_LENGTH (exp); ++i)
len = scm_i_string_length (exp);
data = scm_i_string_chars (exp);
for (i = 0; i < len; ++i)
{
unsigned char ch = SCM_I_STRING_CHARS (exp)[i];
unsigned char ch = data[i];
if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
{
static char const hex[]="0123456789abcdef";
@ -506,25 +509,26 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
}
}
scm_putc ('"', port);
scm_remember_upto_here_1 (exp);
}
else
scm_lfwrite (SCM_I_STRING_CHARS (exp), SCM_I_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))
if (scm_i_symbol_is_interned (exp))
{
scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
SCM_SYMBOL_LENGTH (exp),
scm_print_symbol_name (scm_i_symbol_chars (exp),
scm_i_symbol_length (exp),
port);
scm_remember_upto_here_1 (exp);
}
else
{
scm_puts ("#<uninterned-symbol ", port);
scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
SCM_SYMBOL_LENGTH (exp),
scm_print_symbol_name (scm_i_symbol_chars (exp),
scm_i_symbol_length (exp),
port);
scm_putc (' ', port);
scm_intprint ((long)exp, 16, port);
@ -592,7 +596,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
? "#<primitive-generic "
: "#<primitive-procedure ",
port);
scm_puts (SCM_SYMBOL_CHARS (SCM_SNAME (exp)), port);
scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
#ifdef CCLO
@ -607,7 +611,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
if (scm_is_true (name))
{
scm_putc (' ', port);
scm_puts (SCM_SYMBOL_CHARS (name), port);
scm_puts (scm_i_symbol_chars (name), port);
}
}
else
@ -913,9 +917,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM port, answer = SCM_UNSPECIFIED;
int fReturnString = 0;
int writingp;
char *start;
char *end;
char *p;
const char *start;
const char *end;
const char *p;
if (scm_is_eq (destination, SCM_BOOL_T))
{
@ -938,8 +942,8 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM_VALIDATE_STRING (2, message);
SCM_VALIDATE_REST_ARGUMENT (args);
start = SCM_I_STRING_CHARS (message);
end = start + SCM_I_STRING_LENGTH (message);
start = scm_i_string_chars (message);
end = start + scm_i_string_length (message);
for (p = start; p != end; ++p)
if (*p == '~')
{
@ -1102,9 +1106,10 @@ scm_init_print ()
scm_gc_register_root (&print_state_pool);
scm_gc_register_root (&scm_print_state_vtable);
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
layout =
scm_make_struct_layout (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT));
type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout));
scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state"));
scm_set_struct_vtable_name_x (type, scm_from_locale_symbol ("print-state"));
scm_print_state_vtable = type;
/* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */

2
libguile/procs.c
View file

@ -63,7 +63,7 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
entry = scm_subr_table_size;
z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
scm_subr_table[entry].handle = z;
scm_subr_table[entry].name = scm_str2symbol (name);
scm_subr_table[entry].name = scm_from_locale_symbol (name);
scm_subr_table[entry].generic = 0;
scm_subr_table[entry].properties = SCM_EOL;
scm_subr_table_size++;

23
libguile/ramap.c
View file

@ -468,8 +468,12 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
break;
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2);
for (i = base; n--; i += inc)
SCM_I_STRING_CHARS (ra)[i] = SCM_CHAR (fill);
{
char *data = scm_i_string_writable_chars (ra);
for (i = base; n--; i += inc)
data[i] = SCM_CHAR (fill);
scm_i_string_stop_writing ();
}
break;
case scm_tc7_byvect:
if (SCM_CHARP (fill))
@ -630,8 +634,13 @@ racp (SCM src, SCM dst)
case scm_tc7_string:
if (SCM_TYP7 (src) != scm_tc7_string)
goto gencase;
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
SCM_I_STRING_CHARS (dst)[i_d] = SCM_I_STRING_CHARS (src)[i_s];
{
char *dst_data = scm_i_string_writable_chars (dst);
const char *src_data = scm_i_string_chars (src);
for (; n-- > 0; i_s += inc_s, i_d += inc_d)
dst_data[i_d] = src_data[i_s];
scm_i_string_stop_writing ();
}
break;
case scm_tc7_byvect:
if (SCM_TYP7 (src) != scm_tc7_byvect)
@ -1791,8 +1800,8 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
return 1;
case scm_tc7_string:
{
char *v0 = SCM_I_STRING_CHARS (ra0) + i0;
char *v1 = SCM_I_STRING_CHARS (ra1) + i1;
const char *v0 = scm_i_string_chars (ra0) + i0;
const char *v1 = scm_i_string_chars (ra1) + i1;
for (; n--; v0 += inc0, v1 += inc1)
if (*v0 != *v1)
return 0;
@ -2015,7 +2024,7 @@ init_raprocs (ra_iproc *subra)
{
for (; subra->name; subra++)
{
SCM sym = scm_str2symbol (subra->name);
SCM sym = scm_from_locale_symbol (subra->name);
SCM var =
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
if (var != SCM_BOOL_F)

10
libguile/random.c
View file

@ -119,7 +119,7 @@ scm_i_uniform32 (scm_t_i_rstate *state)
#endif
void
scm_i_init_rstate (scm_t_i_rstate *state, char *seed, int n)
scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
{
scm_t_int32 w = 0L;
scm_t_int32 c = 0L;
@ -153,7 +153,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
*/
scm_t_rstate *
scm_c_make_rstate (char *seed, int n)
scm_c_make_rstate (const char *seed, int n)
{
scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
if (state == 0)
@ -328,7 +328,7 @@ rstate_free (SCM rstate)
* Scheme level interface.
*/
SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_random_state (scm_makfrom0str ("URL:http://stat.fsu.edu/~geo/diehard.html")));
SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_random_state (scm_from_locale_string ("URL:http://stat.fsu.edu/~geo/diehard.html")));
SCM_DEFINE (scm_random, "random", 1, 1, 0,
(SCM n, SCM state),
@ -387,8 +387,8 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0,
if (SCM_NUMBERP (seed))
seed = scm_number_to_string (seed, SCM_UNDEFINED);
SCM_VALIDATE_STRING (1, seed);
res = make_rstate (scm_c_make_rstate (SCM_I_STRING_CHARS (seed),
SCM_I_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;

6
libguile/random.h
View file

@ -46,7 +46,7 @@ typedef struct scm_t_rstate {
typedef struct scm_t_rng {
size_t rstate_size; /* size of random state */
unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
void (*init_rstate) (scm_t_rstate *state, char *seed, int n);
void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
} scm_t_rng;
@ -63,14 +63,14 @@ typedef struct scm_t_i_rstate {
} scm_t_i_rstate;
SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
SCM_API void scm_i_init_rstate (scm_t_i_rstate *, char *seed, int n);
SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
/*
* Random number library functions
*/
SCM_API scm_t_rstate *scm_c_make_rstate (char *, int);
SCM_API scm_t_rstate *scm_c_make_rstate (const char *, int);
SCM_API scm_t_rstate *scm_c_default_rstate (void);
#define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
SCM_API double scm_c_uniform01 (scm_t_rstate *);

16
libguile/rdelim.c
View file

@ -56,20 +56,18 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
#define FUNC_NAME s_scm_read_delimited_x
{
size_t j;
char *buf;
size_t cstart;
size_t cend;
int c;
char *cdelims;
const char *cdelims;
size_t num_delims;
SCM_VALIDATE_STRING (1, delims);
cdelims = SCM_I_STRING_CHARS (delims);
num_delims = SCM_I_STRING_LENGTH (delims);
cdelims = scm_i_string_chars (delims);
num_delims = scm_i_string_length (delims);
SCM_VALIDATE_STRING (2, str);
buf = SCM_I_STRING_CHARS (str);
scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
scm_i_get_substring_spec (scm_i_string_length (str),
start, &cstart, end, &cend);
if (SCM_UNBNDP (port))
@ -97,7 +95,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
return scm_cons (SCM_EOF_VAL,
scm_from_size_t (j - cstart));
buf[j] = c;
scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c));
}
return scm_cons (SCM_BOOL_F, scm_from_size_t (j - cstart));
}
@ -227,14 +225,14 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
{
term = SCM_MAKE_CHAR ('\n');
s[slen-1] = '\0';
line = scm_take_str (s, slen-1);
line = scm_take_locale_stringn (s, slen-1);
SCM_INCLINE (port);
}
else
{
/* Fix: we should check for eof on the port before assuming this. */
term = SCM_EOF_VAL;
line = scm_take_str (s, slen);
line = scm_take_locale_stringn (s, slen);
SCM_COL (port) += slen;
}
}

58
libguile/regex-posix.c
View file

@ -82,32 +82,21 @@ regex_free (SCM obj)
SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
static char *
static SCM
scm_regexp_error_msg (int regerrno, regex_t *rx)
{
SCM errmsg;
char *errmsg;
int l;
/* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
Or are these only necessary when a SCM object may be left in an
undetermined state (half-formed)? If the latter then I believe we
may do without the critical section code. -twp */
/* We could simply make errmsg a char pointer, and allocate space with
malloc. But since we are about to pass the pointer to scm_error, which
never returns, we would never have the opportunity to free it. Creating
it as a SCM object means that the system will GC it at some point. */
errmsg = scm_make_string (scm_from_int (80), SCM_UNDEFINED);
SCM_DEFER_INTS;
l = regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), 80);
errmsg = scm_malloc (80);
l = regerror (regerrno, rx, errmsg, 80);
if (l > 80)
{
errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED);
regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), l);
free (errmsg);
errmsg = scm_malloc (l);
regerror (regerrno, rx, errmsg, l);
}
SCM_ALLOW_INTS;
return SCM_I_STRING_CHARS (errmsg);
return scm_take_locale_string (errmsg);
}
SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
@ -164,6 +153,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
SCM flag;
regex_t *rx;
int status, cflags;
char *c_pat;
SCM_VALIDATE_STRING (1, pat);
SCM_VALIDATE_REST_ARGUMENT (flags);
@ -182,19 +172,21 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
}
rx = scm_gc_malloc (sizeof(regex_t), "regex");
status = regcomp (rx, SCM_I_STRING_CHARS (pat),
c_pat = scm_to_locale_string (pat);
status = regcomp (rx, c_pat,
/* Make sure they're not passing REG_NOSUB;
regexp-exec assumes we're getting match data. */
cflags & ~REG_NOSUB);
free (c_pat);
if (status != 0)
{
char *errmsg = scm_regexp_error_msg (status, rx);
SCM errmsg = scm_regexp_error_msg (status, rx);
scm_gc_free (rx, sizeof(regex_t), "regex");
scm_error (scm_regexp_error_key,
FUNC_NAME,
errmsg,
SCM_BOOL_F,
SCM_BOOL_F);
scm_error_scm (scm_regexp_error_key,
scm_from_locale_string (FUNC_NAME),
errmsg,
SCM_BOOL_F,
SCM_BOOL_F);
/* never returns */
}
SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
@ -234,7 +226,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_I_STRING_LENGTH (str));
offset = scm_to_signed_integer (start, 0, scm_i_string_length (str));
if (SCM_UNBNDP (flags))
flags = SCM_INUM0;
@ -245,7 +237,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_I_STRING_CHARS (str) + offset,
status = regexec (SCM_RGX (rx), scm_i_string_chars (str) + offset,
nmatches, matches,
scm_to_int (flags));
if (!status)
@ -268,11 +260,11 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
SCM_ALLOW_INTS;
if (status != 0 && status != REG_NOMATCH)
scm_error (scm_regexp_error_key,
FUNC_NAME,
scm_regexp_error_msg (status, SCM_RGX (rx)),
SCM_BOOL_F,
SCM_BOOL_F);
scm_error_scm (scm_regexp_error_key,
scm_from_locale_string (FUNC_NAME),
scm_regexp_error_msg (status, SCM_RGX (rx)),
SCM_BOOL_F,
SCM_BOOL_F);
return mvec;
}
#undef FUNC_NAME

13
libguile/rw.c
View file

@ -111,8 +111,7 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
size_t last;
SCM_VALIDATE_STRING (1, str);
dest = SCM_I_STRING_CHARS (str);
scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
scm_i_get_substring_spec (scm_i_string_length (str),
start, &offset, end, &last);
dest += offset;
read_len = last - offset;
@ -131,14 +130,18 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
don't touch the file descriptor. otherwise the
"return immediately if something is available" rule may
be violated. */
dest = scm_i_string_writable_chars (str);
chars_read = scm_take_from_input_buffers (port, dest, read_len);
scm_i_string_stop_writing ();
fdes = SCM_FPORT_FDES (port);
}
if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
EOF. */
{
dest = scm_i_string_writable_chars (str);
SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
scm_i_string_stop_writing ();
if (chars_read == -1)
{
if (SCM_EBLOCK (errno))
@ -202,7 +205,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
"@end itemize")
#define FUNC_NAME s_scm_write_string_partial
{
char *src;
const char *src;
long write_len;
int fdes;
@ -211,8 +214,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
size_t last;
SCM_VALIDATE_STRING (1, str);
src = SCM_I_STRING_CHARS (str);
scm_i_get_substring_spec (SCM_I_STRING_LENGTH (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;

8
libguile/script.c
View file

@ -451,13 +451,13 @@ scm_compile_shell_switches (int argc, char **argv)
(i.e., the #f) with the script name. */
if (!SCM_NULLP (do_script))
{
SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
do_script = SCM_EOL;
}
else
/* Construct an application of LOAD to the script name. */
tail = scm_cons (scm_cons2 (sym_load,
scm_makfrom0str (argv[i]),
scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
argv0 = argv[i];
@ -471,7 +471,7 @@ scm_compile_shell_switches (int argc, char **argv)
if (++i >= argc)
scm_shell_usage (1, "missing argument to `-c' switch");
tail = scm_cons (scm_cons2 (sym_eval_string,
scm_makfrom0str (argv[i]),
scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
i++;
@ -489,7 +489,7 @@ scm_compile_shell_switches (int argc, char **argv)
{
if (++i < argc)
tail = scm_cons (scm_cons2 (sym_load,
scm_makfrom0str (argv[i]),
scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
else

6
libguile/snarf.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SNARF_H
#define SCM_SNARF_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -175,11 +175,11 @@ SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
#define SCM_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
#define SCM_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \

38
libguile/socket.c
View file

@ -163,7 +163,7 @@ SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
SCM answer;
addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
s = inet_ntoa (addr);
answer = scm_mem2string (s, strlen (s));
answer = scm_from_locale_string (s);
return answer;
}
#undef FUNC_NAME
@ -453,7 +453,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
scm_to_ipv6 (addr6, address);
if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL)
SCM_SYSERROR;
return scm_makfrom0str (dst);
return scm_from_locale_string (dst);
}
#undef FUNC_NAME
#endif
@ -1000,8 +1000,7 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
if (addr_size <= offsetof (struct sockaddr_un, sun_path))
SCM_VECTOR_SET(result, 1, SCM_BOOL_F);
else
SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path,
strlen (nad->sun_path)));
SCM_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
}
break;
#endif
@ -1134,6 +1133,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
int rv;
int fd;
int flg;
char *dest;
size_t len;
SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_STRING (2, buf);
@ -1143,9 +1144,11 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = recv (fd,
SCM_I_STRING_CHARS (buf), SCM_I_STRING_LENGTH (buf),
flg));
len = scm_i_string_length (buf);
dest = scm_i_string_writable_chars (buf);
SCM_SYSCALL (rv = recv (fd, dest, len, flg));
scm_i_string_stop_writing ();
if (rv == -1)
SCM_SYSERROR;
@ -1173,6 +1176,8 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
int rv;
int fd;
int flg;
const char *src;
size_t len;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
@ -1183,10 +1188,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = send (fd,
SCM_I_STRING_CHARS (message),
SCM_I_STRING_LENGTH (message),
flg));
len = scm_i_string_length (message);
src = scm_i_string_writable_chars (message);
SCM_SYSCALL (rv = send (fd, src, len, flg));
scm_i_string_stop_writing ();
if (rv == -1)
SCM_SYSERROR;
@ -1233,8 +1239,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
fd = SCM_FPORT_FDES (sock);
SCM_VALIDATE_STRING (2, str);
buf = SCM_I_STRING_CHARS (str);
scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
scm_i_get_substring_spec (scm_i_string_length (str),
start, &offset, end, &cend);
if (SCM_UNBNDP (flags))
@ -1244,10 +1249,13 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
/* recvfrom will not necessarily return an address. usually nothing
is returned for stream sockets. */
buf = scm_i_string_writable_chars (str);
addr->sa_family = AF_UNSPEC;
SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
cend - offset, flg,
addr, &addr_size));
scm_i_string_stop_writing ();
if (rv == -1)
SCM_SYSERROR;
if (addr->sa_family != AF_UNSPEC)
@ -1301,8 +1309,8 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
}
SCM_SYSCALL (rv = sendto (fd,
SCM_I_STRING_CHARS (message),
SCM_I_STRING_LENGTH (message),
scm_i_string_chars (message),
scm_i_string_length (message),
flg, soka, size));
if (rv == -1)
{

5
libguile/stacks.c
View file

@ -744,13 +744,14 @@ scm_init_stacks ()
{
SCM vtable;
SCM stack_layout
= scm_make_struct_layout (scm_makfrom0str (SCM_STACK_LAYOUT));
= scm_make_struct_layout (scm_from_locale_string (SCM_STACK_LAYOUT));
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_stack_type
= scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
scm_cons (stack_layout,
SCM_EOL)));
scm_set_struct_vtable_name_x (scm_stack_type, scm_str2symbol ("stack"));
scm_set_struct_vtable_name_x (scm_stack_type,
scm_from_locale_symbol ("stack"));
#include "libguile/stacks.x"
}

27
libguile/stime.c
View file

@ -32,6 +32,7 @@
#include "libguile/feature.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/dynwind.h"
#include "libguile/validate.h"
#include "libguile/stime.h"
@ -274,7 +275,9 @@ filltime (struct tm *bd_time, int zoff, const char *zname)
SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
SCM_VECTOR_SET (result,9, scm_from_int (zoff));
SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F);
SCM_VECTOR_SET (result,10, (zname
? scm_from_locale_string (zname)
: SCM_BOOL_F));
return result;
}
@ -480,7 +483,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
if (scm_is_false (velts[10]))
lt->tm_zone = NULL;
else
lt->tm_zone = SCM_STRING_CHARS (velts[10]);
lt->tm_zone = scm_to_locale_string (velts[10]);
#endif
}
@ -503,7 +506,10 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
char **oldenv;
int err;
scm_frame_begin (0);
bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
scm_frame_free ((char *)lt.tm_zone);
SCM_DEFER_INTS;
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
@ -560,6 +566,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
SCM_ALLOW_INTS;
if (zname)
free (zname);
scm_frame_end ();
return result;
}
#undef FUNC_NAME
@ -594,15 +602,16 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
char *tbuf;
int size = 50;
char *fmt, *myfmt;
const char *fmt;
char *myfmt;
int len;
SCM result;
SCM_VALIDATE_STRING (1, format);
bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
fmt = SCM_STRING_CHARS (format);
len = SCM_STRING_LENGTH (format);
fmt = scm_i_string_chars (format);
len = scm_i_string_length (format);
/* Ugly hack: strftime can return 0 if its buffer is too small,
but some valid time strings (e.g. "%p") can sometimes produce
@ -665,7 +674,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
#endif
}
result = scm_mem2string (tbuf + 1, len - 1);
result = scm_from_locale_stringn (tbuf + 1, len - 1);
free (tbuf);
free (myfmt);
return result;
@ -688,13 +697,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
#define FUNC_NAME s_scm_strptime
{
struct tm t;
char *fmt, *str, *rest;
const char *fmt, *str, *rest;
SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_STRING (2, string);
fmt = SCM_STRING_CHARS (format);
str = SCM_STRING_CHARS (string);
fmt = scm_i_string_chars (format);
str = scm_i_string_chars (string);
/* initialize the struct tm */
#define tm_init(field) t.field = 0

123
libguile/strop.c
View file

@ -57,24 +57,24 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
long upper;
int ch;
SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, why);
SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, why);
SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
if (scm_is_false (sub_start))
lower = 0;
else
lower = scm_to_signed_integer (sub_start, 0, SCM_I_STRING_LENGTH(str));
lower = scm_to_signed_integer (sub_start, 0, scm_i_string_length(str));
if (scm_is_false (sub_end))
upper = SCM_I_STRING_LENGTH (str);
upper = scm_i_string_length (str);
else
upper = scm_to_signed_integer (sub_end, lower, SCM_I_STRING_LENGTH(str));
upper = scm_to_signed_integer (sub_end, lower, scm_i_string_length(str));
x = -1;
if (direction > 0)
{
p = SCM_I_STRING_UCHARS (str) + lower;
p = (unsigned char *) scm_i_string_chars (str) + lower;
ch = SCM_CHAR (chr);
for (x = lower; x < upper; ++x, ++p)
@ -83,7 +83,7 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
}
else
{
p = upper - 1 + SCM_I_STRING_UCHARS (str);
p = upper - 1 + (unsigned char *)scm_i_string_chars (str);
ch = SCM_CHAR (chr);
for (x = upper - 1; x >= lower; --x, --p)
if (*p == ch)
@ -164,17 +164,20 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
#define FUNC_NAME s_scm_substring_move_x
{
unsigned long s1, s2, e, len;
const char *src;
char *dst;
SCM_VALIDATE_STRING (1, str1);
SCM_VALIDATE_STRING (4, str2);
s1 = scm_to_unsigned_integer (start1, 0, SCM_I_STRING_LENGTH(str1));
e = scm_to_unsigned_integer (end1, s1, SCM_I_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_I_STRING_LENGTH(str2)-len);
s2 = scm_to_unsigned_integer (start2, 0, scm_i_string_length(str2)-len);
SCM_SYSCALL(memmove((void *)(&(SCM_I_STRING_CHARS(str2)[s2])),
(void *)(&(SCM_I_STRING_CHARS(str1)[s1])),
len));
src = scm_i_string_chars (str2);
dst = scm_i_string_writable_chars (str1);
SCM_SYSCALL (memmove (dst+s2, src+s1, len));
scm_i_string_stop_writing ();
scm_remember_upto_here_2 (str1, str2);
return SCM_UNSPECIFIED;
@ -197,12 +200,17 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
{
size_t i, e;
char c;
char *dst;
SCM_VALIDATE_STRING (1, 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));
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);
dst = scm_i_string_writable_chars (str);
while (i<e)
SCM_I_STRING_CHARS (str)[i++] = c;
dst[i++] = c;
scm_i_string_stop_writing ();
scm_remember_upto_here (str);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@ -220,7 +228,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_I_STRING_LENGTH (str) == 0);
return scm_from_bool (scm_i_string_length (str) == 0);
}
#undef FUNC_NAME
@ -235,10 +243,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
{
long i;
SCM res = SCM_EOL;
unsigned char *src;
const unsigned char *src;
SCM_VALIDATE_STRING (1, str);
src = SCM_I_STRING_UCHARS (str);
for (i = SCM_I_STRING_LENGTH (str)-1;i >= 0;i--)
src = scm_i_string_chars (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;
@ -251,10 +259,11 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
static SCM
string_copy (SCM str)
{
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);
const char* chars = scm_i_string_chars (str);
size_t length = scm_i_string_length (str);
char *dst;
SCM new_string = scm_i_make_string (length, &dst);
memcpy (dst, chars, length);
scm_remember_upto_here_1 (str);
return new_string;
}
@ -282,9 +291,10 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
long k;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR_COPY (2, chr, c);
dst = SCM_I_STRING_CHARS (str);
for (k = SCM_I_STRING_LENGTH (str)-1;k >= 0;k--)
dst = scm_i_string_writable_chars (str);
for (k = scm_i_string_length (str)-1;k >= 0;k--)
dst[k] = c;
scm_i_string_stop_writing ();
scm_remember_upto_here_1 (str);
return SCM_UNSPECIFIED;
}
@ -296,11 +306,14 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
static SCM
string_upcase_x (SCM v)
{
unsigned long 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]);
size_t k, len;
char *dst;
len = scm_i_string_length (v);
dst = scm_i_string_writable_chars (v);
for (k = 0; k < len; ++k)
dst[k] = scm_c_upcase (dst[k]);
scm_i_string_stop_writing ();
return v;
}
@ -341,10 +354,14 @@ SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0,
static SCM
string_downcase_x (SCM v)
{
unsigned long k;
size_t k, len;
char *dst;
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]);
len = scm_i_string_length (v);
dst = scm_i_string_writable_chars (v);
for (k = 0; k < len; ++k)
dst[k] = scm_c_downcase (dst[k]);
scm_i_string_stop_writing ();
return v;
}
@ -387,22 +404,29 @@ static SCM
string_capitalize_x (SCM str)
{
unsigned char *sz;
long i, len;
size_t i, len;
int in_word=0;
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) {
sz[i] = scm_c_upcase(sz[i]);
in_word = 1;
} else {
sz[i] = scm_c_downcase(sz[i]);
}
len = scm_i_string_length (str);
sz = scm_i_string_writable_chars (str);
for (i = 0; i < len; i++)
{
if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
{
if (!in_word)
{
sz[i] = scm_c_upcase (sz[i]);
in_word = 1;
}
else
{
sz[i] = scm_c_downcase (sz[i]);
}
}
else
in_word = 0;
}
else in_word = 0;
}
scm_i_string_stop_writing ();
return str;
}
@ -463,15 +487,15 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
#define FUNC_NAME s_scm_string_split
{
long idx, last_idx;
char * p;
const char * p;
int ch;
SCM res = SCM_EOL;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR (2, chr);
idx = SCM_I_STRING_LENGTH (str);
p = SCM_I_STRING_CHARS (str);
idx = scm_i_string_length (str);
p = scm_i_string_chars (str);
ch = SCM_CHAR (chr);
while (idx >= 0)
{
@ -480,7 +504,8 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
idx--;
if (idx >= 0)
{
res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res);
res = scm_cons (scm_c_substring (str, idx, last_idx), res);
p = scm_i_string_chars (str);
idx--;
}
}

36
libguile/strorder.c
View file

@ -43,11 +43,11 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
length = SCM_I_STRING_LENGTH (s2);
if (SCM_I_STRING_LENGTH (s1) == length)
length = scm_i_string_length (s2);
if (scm_i_string_length (s1) == length)
{
unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i;
/* comparing from back to front typically finds mismatches faster */
@ -82,11 +82,11 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
length = SCM_I_STRING_LENGTH (s2);
if (SCM_I_STRING_LENGTH (s1) == length)
length = scm_i_string_length (s2);
if (scm_i_string_length (s1) == length)
{
unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i;
/* comparing from back to front typically finds mismatches faster */
@ -114,13 +114,13 @@ static SCM
string_less_p (SCM s1, SCM s2)
{
size_t i, length1, length2, lengthm;
unsigned char *c1, *c2;
const unsigned char *c1, *c2;
length1 = SCM_I_STRING_LENGTH (s1);
length2 = SCM_I_STRING_LENGTH (s2);
length1 = scm_i_string_length (s1);
length2 = scm_i_string_length (s2);
lengthm = min (length1, length2);
c1 = SCM_I_STRING_UCHARS (s1);
c2 = SCM_I_STRING_UCHARS (s2);
c1 = scm_i_string_chars (s1);
c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = *c1 - *c2;
@ -196,13 +196,13 @@ static SCM
string_ci_less_p (SCM s1, SCM s2)
{
size_t i, length1, length2, lengthm;
unsigned char *c1, *c2;
const unsigned char *c1, *c2;
length1 = SCM_I_STRING_LENGTH (s1);
length2 = SCM_I_STRING_LENGTH (s2);
length1 = scm_i_string_length (s1);
length2 = scm_i_string_length (s2);
lengthm = min (length1, length2);
c1 = SCM_I_STRING_UCHARS (s1);
c2 = SCM_I_STRING_UCHARS (s2);
c1 = scm_i_string_chars (s1);
c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = scm_c_upcase (*c1) - scm_c_upcase (*c2);

56
libguile/strports.c
View file

@ -52,6 +52,14 @@
*/
/* NOTES:
We break the rules set forth by strings.h about accessing the
internals of strings here. We can do this since we can guarantee
that the string used as pt->stream is not in use by anyone else.
Thus, it's representation will not change asynchronously.
(Ports aren't thread-safe yet anyway...)
write_buf/write_end point to the ends of the allocated string.
read_buf/read_end in principle point to the part of the string which
has been written to, but this is only updated after a flush.
@ -79,8 +87,10 @@ static void
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_I_STRING_LENGTH (old_stream);
const char *src = scm_i_string_chars (old_stream);
char *dst;
SCM new_stream = scm_i_make_string (new_size, &dst);
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,14 +99,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_I_STRING_CHARS (new_stream) [i] = SCM_I_STRING_CHARS (old_stream) [i];
dst[i] = src[i];
scm_remember_upto_here_1 (old_stream);
/* reset buffer. */
{
pt->stream = SCM_UNPACK (new_stream);
pt->read_buf = pt->write_buf = SCM_I_STRING_UCHARS (new_stream);
pt->read_buf = pt->write_buf = dst;
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;
@ -254,19 +264,37 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
scm_t_port *pt;
size_t str_len, c_pos;
SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, caller);
str_len = SCM_I_STRING_LENGTH (str);
SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
str_len = scm_i_string_length (str);
c_pos = scm_to_unsigned_integer (pos, 0, str_len);
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
/* XXX
Make a new string to isolate us from changes to the original.
This is done so that we can rely on scm_i_string_chars to stay in
place even across SCM_TICKs.
Additionally, when we are going to write to the string, we make a
copy so that we can write to it without having to use
scm_i_string_writable_chars.
*/
if (modes & SCM_WRTNG)
str = scm_c_substring_copy (str, 0, str_len);
else
str = scm_c_substring (str, 0, str_len);
scm_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc16_strport);
pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str));
SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
pt->write_buf = pt->read_buf = SCM_I_STRING_UCHARS (str);
/* see above why we can use scm_i_string_chars here. */
pt->write_buf = pt->read_buf = (char *)scm_i_string_chars (str);
pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
pt->write_buf_size = pt->read_buf_size = str_len;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
@ -286,11 +314,13 @@ SCM scm_strport_to_string (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str;
char *dst;
if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port);
str = scm_mem2string ((char *) pt->read_buf, pt->read_buf_size);
str = scm_i_make_string (pt->read_buf_size, &dst);
memcpy (dst, (char *) pt->read_buf, pt->read_buf_size);
scm_remember_upto_here_1 (port);
return str;
}
@ -307,7 +337,7 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
if (!SCM_UNBNDP (printer))
SCM_VALIDATE_PROC (2, printer);
str = scm_allocate_string (0);
str = scm_c_make_string (0, SCM_UNDEFINED);
port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG, FUNC_NAME);
if (SCM_UNBNDP (printer))
@ -401,7 +431,7 @@ SCM
scm_c_read_string (const char *expr)
{
SCM port = scm_mkstrport (SCM_INUM0,
scm_makfrom0str (expr),
scm_from_locale_string (expr),
SCM_OPN | SCM_RDNG,
"scm_c_read_string");
SCM form;
@ -418,13 +448,13 @@ scm_c_read_string (const char *expr)
SCM
scm_c_eval_string (const char *expr)
{
return scm_eval_string (scm_makfrom0str (expr));
return scm_eval_string (scm_from_locale_string (expr));
}
SCM
scm_c_eval_string_in_module (const char *expr, SCM module)
{
return scm_eval_string_in_module (scm_makfrom0str (expr), module);
return scm_eval_string_in_module (scm_from_locale_string (expr), module);
}

57
libguile/struct.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -59,16 +59,16 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
SCM_VALIDATE_STRING (1, fields);
{ /* scope */
char * field_desc;
const char * field_desc;
size_t len;
int x;
len = SCM_I_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_I_STRING_CHARS (fields);
field_desc = scm_i_string_chars (fields);
for (x = 0; x < len; x += 2)
{
@ -120,7 +120,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
}
#endif
}
new_sym = scm_mem2symbol (field_desc, len);
new_sym = scm_string_to_symbol (fields);
}
scm_remember_upto_here_1 (fields);
return new_sym;
@ -134,9 +134,10 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void
scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits)
{
unsigned char * fields_desc = (unsigned char *) SCM_SYMBOL_CHARS (layout) - 2;
unsigned const char *fields_desc =
(unsigned const char *) scm_i_symbol_chars (layout) - 2;
unsigned char prot = 0;
int n_fields = SCM_SYMBOL_LENGTH (layout) / 2;
int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0;
while (n_fields)
@ -239,20 +240,20 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
layout = SCM_STRUCT_LAYOUT (x);
if (SCM_SYMBOL_LENGTH (layout)
< SCM_I_STRING_LENGTH (required_vtable_fields))
if (scm_i_symbol_length (layout)
< scm_i_string_length (required_vtable_fields))
return SCM_BOOL_F;
tmp = strncmp (SCM_SYMBOL_CHARS (layout),
SCM_I_STRING_CHARS (required_vtable_fields),
SCM_I_STRING_LENGTH (required_vtable_fields));
tmp = strncmp (scm_i_symbol_chars (layout),
scm_i_string_chars (required_vtable_fields),
scm_i_string_length (required_vtable_fields));
scm_remember_upto_here_1 (required_vtable_fields);
if (tmp)
return SCM_BOOL_F;
mem = SCM_STRUCT_DATA (x);
return scm_from_bool (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout])));
return scm_from_bool (scm_is_symbol (SCM_PACK (mem[scm_vtable_index_layout])));
}
#undef FUNC_NAME
@ -426,7 +427,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
basic_size = scm_i_symbol_length (layout) / 2;
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
@ -513,7 +514,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
fields = scm_string_append (scm_list_2 (required_vtable_fields,
user_fields));
layout = scm_make_struct_layout (fields);
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
basic_size = scm_i_symbol_length (layout) / 2;
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
data = scm_alloc_struct (basic_size + tail_elts,
@ -543,9 +544,10 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM answer = SCM_UNDEFINED;
scm_t_bits * data;
SCM layout;
size_t layout_len;
size_t p;
scm_t_bits n_fields;
char * fields_desc;
const char *fields_desc;
char field_type = 0;
@ -555,12 +557,13 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
fields_desc = SCM_SYMBOL_CHARS (layout);
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1, pos, p < n_fields);
if (p * 2 < SCM_SYMBOL_LENGTH (layout))
if (p * 2 < layout_len)
{
char ref;
field_type = fields_desc[p * 2];
@ -573,8 +576,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else if (fields_desc[layout_len - 1] != 'O')
field_type = fields_desc[layout_len - 2];
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
@ -619,9 +622,10 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
{
scm_t_bits * data;
SCM layout;
size_t layout_len;
size_t p;
int n_fields;
char * fields_desc;
const char *fields_desc;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
@ -630,12 +634,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
fields_desc = SCM_SYMBOL_CHARS (layout);
fields_desc = scm_i_symbol_chars (layout);
layout_len = scm_i_symbol_length (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1, pos, p < n_fields);
if (p * 2 < SCM_SYMBOL_LENGTH (layout))
if (p * 2 < layout_len)
{
char set_x;
field_type = fields_desc[p * 2];
@ -643,8 +648,8 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
if (set_x != 'w')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else if (fields_desc[layout_len - 1] == 'W')
field_type = fields_desc[layout_len - 2];
else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
@ -794,7 +799,7 @@ scm_init_struct ()
{
scm_struct_table
= scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31)));
required_vtable_fields = scm_makfrom0str ("prsrpw");
required_vtable_fields = scm_from_locale_string ("prsrpw");
scm_permanent_object (required_vtable_fields);
scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout));
scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable));

6
libguile/throw.c
View file

@ -444,7 +444,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
SCM
scm_handle_by_message (void *handler_data, SCM tag, SCM args)
{
if (scm_is_true (scm_eq_p (tag, scm_str2symbol ("quit"))))
if (scm_is_true (scm_eq_p (tag, scm_from_locale_symbol ("quit"))))
{
exit (scm_exit_status (args));
}
@ -502,7 +502,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T),
SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
key, SCM_ARG1, FUNC_NAME);
c.tag = key;
@ -530,7 +530,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T),
SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
key, SCM_ARG1, FUNC_NAME);
c.tag = key;

113
libguile/unif.c
View file

@ -169,7 +169,7 @@ scm_make_uve (long k, SCM prot)
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
return make_uve (scm_tc7_byvect, k, sizeof (char));
else if (SCM_CHARP (prot))
return scm_allocate_string (sizeof (char) * k);
return scm_c_make_string (sizeof (char) * k, SCM_UNDEFINED);
else if (SCM_I_INUMP (prot))
return make_uve (SCM_I_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect,
k,
@ -179,11 +179,11 @@ scm_make_uve (long k, SCM prot)
if (scm_num_eq_p (exactly_one_third, prot))
goto dvect;
}
else if (SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot)))
else if (scm_is_symbol (prot) && (1 == scm_i_symbol_length (prot)))
{
char s;
s = SCM_SYMBOL_CHARS (prot)[0];
s = scm_i_symbol_chars (prot)[0];
if (s == 's')
return make_uve (scm_tc7_svect, k, sizeof (short));
#if SCM_SIZEOF_LONG_LONG != 0
@ -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_I_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:
@ -286,15 +286,15 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)<=0;
break;
case scm_tc7_svect:
protp = SCM_SYMBOLP (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot))
&& ('s' == SCM_SYMBOL_CHARS (prot)[0]);
protp = scm_is_symbol (prot)
&& (1 == scm_i_symbol_length (prot))
&& ('s' == scm_i_symbol_chars (prot)[0]);
break;
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
protp = SCM_SYMBOLP (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot))
&& ('l' == SCM_SYMBOL_CHARS (prot)[0]);
protp = scm_is_symbol (prot)
&& (1 == scm_i_symbol_length (prot))
&& ('l' == scm_i_symbol_chars (prot)[0]);
break;
#endif
case scm_tc7_fvect:
@ -564,7 +564,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
SCM answer = scm_make_uve (scm_to_long (dims), prot);
if (!SCM_UNBNDP (fill))
scm_array_fill_x (answer, fill);
else if (SCM_SYMBOLP (prot))
else if (scm_is_symbol (prot))
scm_array_fill_x (answer, scm_from_int (0));
else
scm_array_fill_x (answer, prot);
@ -589,7 +589,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
if (!SCM_UNBNDP (fill))
scm_array_fill_x (ra, fill);
else if (SCM_SYMBOLP (prot))
else if (scm_is_symbol (prot))
scm_array_fill_x (ra, scm_from_int (0));
else
scm_array_fill_x (ra, prot);
@ -880,6 +880,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
#define FUNC_NAME s_scm_enclose_array
{
SCM axv, res, ra_inr;
const char *c_axv;
scm_t_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
@ -939,16 +940,18 @@ 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_I_STRING_CHARS (axv)[j] = 1;
scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
}
c_axv = scm_i_string_chars (axv);
for (j = 0, k = 0; k < noutr; k++, j++)
{
while (SCM_I_STRING_CHARS (axv)[j])
while (c_axv[j])
j++;
SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
}
scm_remember_upto_here_1 (axv);
scm_ra_set_contp (ra_inr);
scm_ra_set_contp (res);
return res;
@ -1109,7 +1112,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_I_STRING_UCHARS (v)[pos]);
return scm_c_string_ref (v, pos);
case scm_tc7_byvect:
return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
@ -1155,7 +1158,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
else
return SCM_BOOL_F;
case scm_tc7_string:
return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]);
return scm_c_string_ref (v, pos);
case scm_tc7_byvect:
return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
@ -1269,7 +1272,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break;
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (obj), badobj);
SCM_I_STRING_UCHARS (v)[pos] = SCM_CHAR (obj);
scm_c_string_set_x (v, pos, obj);
break;
case scm_tc7_byvect:
if (SCM_CHARP (obj))
@ -1478,7 +1481,7 @@ loop:
v = SCM_ARRAY_V (cra);
goto loop;
case scm_tc7_string:
base = SCM_I_STRING_CHARS (v);
base = NULL; /* writing to strings is special, see below. */
sz = sizeof (char);
break;
case scm_tc7_bvect:
@ -1544,7 +1547,7 @@ loop:
{
scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
char *dest = base + (cstart + offset) * sz;
size_t off = (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE)
scm_flush (port_or_fd);
@ -1557,10 +1560,18 @@ loop:
int to_copy = min (pt->read_end - pt->read_pos,
remaining);
memcpy (dest, pt->read_pos, to_copy);
if (base == NULL)
{
/* strings */
char *b = scm_i_string_writable_chars (v);
memcpy (b + off, pt->read_pos, to_copy);
scm_i_string_stop_writing ();
}
else
memcpy (base + off, pt->read_pos, to_copy);
pt->read_pos += to_copy;
remaining -= to_copy;
dest += to_copy;
off += to_copy;
}
else
{
@ -1581,9 +1592,19 @@ loop:
}
else /* file descriptor. */
{
SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
base + (cstart + offset) * sz,
(sz * (cend - offset))));
if (base == NULL)
{
/* strings */
char *b = scm_i_string_writable_chars (v);
SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
b + (cstart + offset) * sz,
(sz * (cend - offset))));
scm_i_string_stop_writing ();
}
else
SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
base + (cstart + offset) * sz,
(sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
}
@ -1615,7 +1636,7 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
long offset = 0;
long cstart = 0;
long cend;
char *base;
const char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
@ -1644,7 +1665,7 @@ loop:
v = SCM_ARRAY_V (v);
goto loop;
case scm_tc7_string:
base = SCM_I_STRING_CHARS (v);
base = scm_i_string_chars (v);
sz = sizeof (char);
break;
case scm_tc7_bvect:
@ -1708,7 +1729,7 @@ loop:
if (SCM_NIMP (port_or_fd))
{
char *source = base + (cstart + offset) * sz;
const char *source = base + (cstart + offset) * sz;
ans = cend - offset;
scm_lfwrite (source, ans * sz, port_or_fd);
@ -2014,13 +2035,16 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
SCM
scm_istr2bve (char *str, long len)
scm_istr2bve (SCM str)
{
size_t len = scm_i_string_length (str);
SCM v = scm_make_uve (len, SCM_BOOL_T);
long *data = (long *) SCM_VELTS (v);
register unsigned long mask;
register long k;
register long j;
const char *c_str = scm_i_string_chars (str);
for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
{
data[k] = 0L;
@ -2028,7 +2052,7 @@ scm_istr2bve (char *str, long len)
if (j > SCM_LONG_BIT)
j = SCM_LONG_BIT;
for (mask = 1L; j--; mask <<= 1)
switch (*str++)
switch (*c_str++)
{
case '0':
break;
@ -2320,17 +2344,22 @@ tail:
}
break;
case scm_tc7_string:
if (n-- > 0)
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_I_STRING_UCHARS (ra)[j]), port, pstate);
}
else
for (j += inc; n-- > 0; j += inc)
scm_putc (SCM_I_STRING_CHARS (ra)[j], port);
{
const char *src;
src = scm_i_string_chars (ra);
if (n-- > 0)
scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
if (SCM_WRITINGP (pstate))
for (j += inc; n-- > 0; j += inc)
{
scm_putc (' ', port);
scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
}
else
for (j += inc; n-- > 0; j += inc)
scm_putc (src[j], port);
scm_remember_upto_here_1 (ra);
}
break;
case scm_tc7_byvect:
if (n-- > 0)
@ -2560,10 +2589,10 @@ loop:
case scm_tc7_ivect:
return scm_from_int (-1);
case scm_tc7_svect:
return scm_str2symbol ("s");
return scm_from_locale_symbol ("s");
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
return scm_str2symbol ("l");
return scm_from_locale_symbol ("l");
#endif
case scm_tc7_fvect:
return scm_from_double (1.0);

2
libguile/unif.h
View file

@ -115,7 +115,7 @@ SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
SCM_API SCM scm_bit_invert_x (SCM v);
SCM_API SCM scm_istr2bve (char *str, long len);
SCM_API SCM scm_istr2bve (SCM str);
SCM_API SCM scm_array_to_list (SCM v);
SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);

12
libguile/validate.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_VALIDATE_H
#define SCM_VALIDATE_H
/* Copyright (C) 1999,2000,2001, 2002 Free Software Foundation, Inc.
/* Copyright (C) 1999,2000,2001, 2002, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@ -152,7 +152,10 @@
cvar = SCM_CHAR (scm); \
} while (0)
#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE_MSG (pos, str, I_STRINGP, "string")
#define SCM_VALIDATE_STRING(pos, str) \
do { \
SCM_ASSERT_TYPE (scm_is_string (str), str, pos, FUNC_NAME, "string"); \
} while (0)
#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real")
@ -270,7 +273,10 @@
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
} while (0)
#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol")
#define SCM_VALIDATE_SYMBOL(pos, str) \
do { \
SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
} while (0)
#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")

6
libguile/values.c
View file

@ -76,8 +76,10 @@ scm_init_values (void)
print_values);
scm_values_vtable
= scm_permanent_object (scm_make_vtable_vtable (scm_makfrom0str ("pr"),
SCM_INUM0, SCM_EOL));
= scm_permanent_object (
scm_make_vtable_vtable (scm_from_locale_string ("pr"),
SCM_INUM0, SCM_EOL));
SCM_SET_STRUCT_PRINTER (scm_values_vtable, print);
scm_add_feature ("values");

4
libguile/version.c
View file

@ -95,7 +95,7 @@ SCM_DEFINE (scm_version, "version", 0, 0, 0,
SCM_MAJOR_VERSION,
SCM_MINOR_VERSION,
SCM_MICRO_VERSION);
return scm_makfrom0str (version_str);
return scm_from_locale_string (version_str);
}
#undef FUNC_NAME
@ -120,7 +120,7 @@ SCM_DEFINE (scm_effective_version, "effective-version", 0, 0, 0,
# error version string may overflow buffer
#endif
sprintf (version_str, "%d.%d", SCM_MAJOR_VERSION, SCM_MINOR_VERSION);
return scm_makfrom0str (version_str);
return scm_from_locale_string (version_str);
}
#undef FUNC_NAME

2
libguile/vports.c
View file

@ -76,7 +76,7 @@ sf_write (SCM port, const void *data, size_t size)
{
SCM p = SCM_PACK (SCM_STREAM (port));
scm_call_1 (SCM_VELTS (p)[1], scm_mem2string ((char *) data, size));
scm_call_1 (SCM_VELTS (p)[1], scm_from_locale_stringn ((char *) data, size));
}
/* calling the flush proc (element 2) is in case old code needs it,