mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +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->fancyp = 1;
pstate->level = DISPLAY_EXPRESSION_MAX_LEVEL; pstate->level = DISPLAY_EXPRESSION_MAX_LEVEL;
pstate->length = DISPLAY_EXPRESSION_MAX_LENGTH; 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) if (SCM_FRAMEP (frame)
&& SCM_FRAME_EVAL_ARGS_P (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); prev_frame = SCM_FRAME_PREV (current_frame);
if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame)) if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame); source = SCM_FRAME_SOURCE (prev_frame);
if (!SCM_SYMBOLP (pname) if (!scm_is_symbol (pname)
&& !scm_is_string (pname) && !scm_is_string (pname)
&& SCM_FRAME_PROC_P (current_frame) && SCM_FRAME_PROC_P (current_frame)
&& scm_is_true (scm_procedure_p (SCM_FRAME_PROC (current_frame)))) && scm_is_true (scm_procedure_p (SCM_FRAME_PROC (current_frame))))
pname = scm_procedure_name (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_header (source, a->port);
display_expression (current_frame, pname, 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); string = scm_strport_to_string (sport);
assert (scm_is_string (string)); assert (scm_is_string (string));
/* Remove control characters */ {
for (i = 0; i < n; ++i) char *data = scm_i_string_writable_chars (string);
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] = '$';
}
scm_lfwrite (SCM_I_STRING_CHARS (string), n, port); /* 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_remember_upto_here_1 (string); 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 #if SIZEOF_CTYPE == 1
case scm_tc7_string: case scm_tc7_string:
n = SCM_I_STRING_LENGTH (obj); n = scm_i_string_length (obj);
if (data == NULL) if (data == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL) if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL; return NULL;
memcpy (data, SCM_I_STRING_CHARS (obj), n * sizeof (CTYPE)); memcpy (data, scm_i_string_chars (obj), n * sizeof (CTYPE));
break; break;
#endif #endif

2
libguile/deprecation.c
View file

@ -103,7 +103,7 @@ SCM_DEFINE(scm_issue_deprecation_warning,
mode = summary_print; mode = summary_print;
else else
{ {
SCM nl = scm_str2string ("\n"); SCM nl = scm_from_locale_string ("\n");
SCM msgs_nl = SCM_EOL; SCM msgs_nl = SCM_EOL;
char *c_msgs; char *c_msgs;
while (SCM_CONSP (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 fn;
SCM msg; SCM msg;
fn = scm_makfrom0str (fname); fn = scm_from_locale_string (fname);
msg = scm_makfrom0str (scm_lt_dlerror ()); msg = scm_from_locale_string (scm_lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg)); scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
} }
return (void *) handle; 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 #define FUNC_NAME s_scm_environment_bound_p
{ {
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); 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)); 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 val;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); 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); val = SCM_ENVIRONMENT_REF (env, sym);
@ -155,7 +155,7 @@ SCM
scm_c_environment_ref (SCM env, SCM sym) scm_c_environment_ref (SCM env, SCM sym)
{ {
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, "scm_c_environment_ref"); 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); return SCM_ENVIRONMENT_REF (env, sym);
} }
@ -240,7 +240,7 @@ SCM_DEFINE (scm_environment_define, "environment-define", 3, 0, 0,
SCM status; SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); 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); status = SCM_ENVIRONMENT_DEFINE (env, sym, val);
@ -266,7 +266,7 @@ SCM_DEFINE (scm_environment_undefine, "environment-undefine", 2, 0, 0,
SCM status; SCM status;
SCM_ASSERT(SCM_ENVIRONMENT_P(env), env, SCM_ARG1, FUNC_NAME); 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); status = SCM_ENVIRONMENT_UNDEFINE (env, sym);
@ -294,7 +294,7 @@ SCM_DEFINE (scm_environment_set_x, "environment-set!", 3, 0, 0,
SCM status; SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); 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); status = SCM_ENVIRONMENT_SET (env, sym, val);
@ -329,7 +329,7 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0,
SCM location; SCM location;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME); 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); SCM_ASSERT (scm_is_bool (for_write), for_write, SCM_ARG3, FUNC_NAME);
location = SCM_ENVIRONMENT_CELL (env, sym, scm_is_true (for_write)); 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_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_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); 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 static SCM
obarray_enter (SCM obarray, SCM symbol, SCM data) 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 entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]); SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]);
SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot); SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
@ -525,7 +525,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
static SCM static SCM
obarray_replace (SCM obarray, SCM symbol, SCM data) 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 new_entry = scm_cons (symbol, data);
SCM lsym; SCM lsym;
SCM slot; SCM slot;
@ -557,7 +557,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
static SCM static SCM
obarray_retrieve (SCM obarray, SCM sym) 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; SCM lsym;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash]; for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
@ -580,7 +580,7 @@ obarray_retrieve (SCM obarray, SCM sym)
static SCM static SCM
obarray_remove (SCM obarray, SCM sym) 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 table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash];
SCM handle = scm_sloppy_assq (sym, table_entry); 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; struct update_data *data = (struct update_data *) ptr;
SCM observer = data->observer; 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)); 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); 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); SCM new_entry = scm_cons2 (entry, symbol_immutable_location, SCM_EOL);
result = scm_cons (new_entry, result); result = scm_cons (new_entry, result);
@ -2253,7 +2254,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
SCM l2; SCM l2;
SCM_ASSERT (SCM_CONSP (entry), entry, SCM_ARGn, caller); 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); 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 static void
syntax_error (const char* const msg, const SCM form, const SCM expr) 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 filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F; SCM linenr = SCM_BOOL_F;
const char *format; const char *format;
@ -524,7 +524,7 @@ is_self_quoting_p (const SCM expr)
{ {
if (SCM_CONSP (expr)) if (SCM_CONSP (expr))
return 0; return 0;
else if (SCM_SYMBOLP (expr)) else if (scm_is_symbol (expr))
return 0; return 0;
else if (SCM_NULLP (expr)) else if (SCM_NULLP (expr))
return 0; return 0;
@ -651,7 +651,7 @@ m_body (SCM op, SCM exprs)
static SCM static SCM
try_macro_lookup (const SCM expr, const SCM env) 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); const SCM variable = lookup_symbol (expr, env);
if (SCM_VARIABLEP (variable)) if (SCM_VARIABLEP (variable))
@ -848,7 +848,7 @@ macroexp (SCM x, SCM env)
macro_tail: macro_tail:
orig_sym = SCM_CAR (x); orig_sym = SCM_CAR (x);
if (!SCM_SYMBOLP (orig_sym)) if (!scm_is_symbol (orig_sym))
return x; return x;
{ {
@ -1178,7 +1178,7 @@ canonicalize_define (const SCM expr)
body = scm_list_1 (lambda); body = scm_list_1 (lambda);
variable = SCM_CAR (variable); 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); ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
SCM_SETCAR (cdr_expr, variable); 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 name = SCM_CAR (binding);
const SCM init = SCM_CADR (binding); const SCM init = SCM_CADR (binding);
const SCM step = (length == 2) ? name : SCM_CADDR (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)), ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)),
s_duplicate_binding, name, expr); s_duplicate_binding, name, expr);
@ -1455,7 +1455,7 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
} }
else 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); 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 formal = SCM_CAR (formals_idx);
const SCM next_idx = SCM_CDR (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), ASSERT_SYNTAX_2 (!c_improper_memq (formal, next_idx),
s_duplicate_formal, formal, expr); s_duplicate_formal, formal, expr);
formals_idx = next_idx; 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); s_bad_formal, formals_idx, expr);
/* Memoize the body. Keep a potential documentation string. */ /* 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); s_bad_binding, binding, expr);
name = SCM_CAR (binding); 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); ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
bindings = SCM_CAR (cdr_expr); bindings = SCM_CAR (cdr_expr);
if (SCM_SYMBOLP (bindings)) if (scm_is_symbol (bindings))
{ {
ASSERT_SYNTAX (length >= 3, s_missing_expression, expr); ASSERT_SYNTAX (length >= 3, s_missing_expression, expr);
return memoize_named_let (expr, env); 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); variable = SCM_CAR (cdr_expr);
/* Memoize the variable form. */ /* 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); new_variable = lookup_symbol (variable, env);
/* Leave the memoization of unbound symbols to lazy memoization: */ /* Leave the memoization of unbound symbols to lazy memoization: */
if (SCM_UNBNDP (new_variable)) if (SCM_UNBNDP (new_variable))
@ -2140,7 +2140,7 @@ scm_m_generalized_set_x (SCM expr, SCM env)
&& SCM_NULLP (SCM_CDDR (exp_target))) && SCM_NULLP (SCM_CDDR (exp_target)))
{ {
exp_target= SCM_CADR (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), || SCM_VARIABLEP (exp_target),
s_bad_variable, exp_target, expr); s_bad_variable, exp_target, expr);
return scm_cons (SCM_IM_SET_X, scm_cons (exp_target, 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); ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr);
symbol = SCM_CAR (cdr_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); location = scm_symbol_fref (symbol);
ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr); 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 /* The elisp function `defalias' allows to define aliases for symbols. To
* look up such definitions, the chain of symbol definitions has to be * look up such definitions, the chain of symbol definitions has to be
* followed up to the terminal symbol. */ * 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); const SCM alias = SCM_VARIABLE_REF (location);
location = scm_symbol_fref (alias); location = scm_symbol_fref (alias);
@ -2460,7 +2460,7 @@ scm_m_undefine (SCM expr, SCM env)
("`undefine' is deprecated.\n"); ("`undefine' is deprecated.\n");
variable = SCM_CAR (cdr_expr); 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); location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
ASSERT_SYNTAX_2 (scm_is_true (location) ASSERT_SYNTAX_2 (scm_is_true (location)
&& !SCM_UNBNDP (SCM_VARIABLE_REF (location)), && !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
@ -2622,7 +2622,7 @@ static SCM deval (SCM x, SCM env);
? (scm_debug_mode_p \ ? (scm_debug_mode_p \
? deval (SCM_CAR (x), (env)) \ ? deval (SCM_CAR (x), (env)) \
: ceval (SCM_CAR (x), (env))) \ : ceval (SCM_CAR (x), (env))) \
: (!SCM_SYMBOLP (SCM_CAR (x)) \ : (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \ ? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1))))) : *scm_lookupcar ((x), (env), 1)))))
@ -2642,7 +2642,7 @@ static SCM deval (SCM x, SCM env);
? SCM_VARIABLE_REF (SCM_CAR (x)) \ ? SCM_VARIABLE_REF (SCM_CAR (x)) \
: (SCM_CONSP (SCM_CAR (x)) \ : (SCM_CONSP (SCM_CAR (x)) \
? CEVAL (SCM_CAR (x), (env)) \ ? CEVAL (SCM_CAR (x), (env)) \
: (!SCM_SYMBOLP (SCM_CAR (x)) \ : (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \ ? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1))))) : *scm_lookupcar ((x), (env), 1)))))
@ -3345,7 +3345,7 @@ dispatch:
RETURN (SCM_I_EVALIM (last_form, env)); RETURN (SCM_I_EVALIM (last_form, env));
else if (SCM_VARIABLEP (last_form)) else if (SCM_VARIABLEP (last_form))
RETURN (SCM_VARIABLE_REF (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)); RETURN (*scm_lookupcar (x, env, 1));
else else
RETURN (last_form); RETURN (last_form);
@ -3603,7 +3603,7 @@ dispatch:
location = SCM_VARIABLE_LOC (variable); location = SCM_VARIABLE_LOC (variable);
else else
{ {
/* (SCM_SYMBOLP (variable)) is known to be true */ /* (scm_is_symbol (variable)) is known to be true */
variable = lazy_memoize_variable (variable, env); variable = lazy_memoize_variable (variable, env);
SCM_SETCAR (x, variable); SCM_SETCAR (x, variable);
location = SCM_VARIABLE_LOC (variable); location = SCM_VARIABLE_LOC (variable);
@ -3945,7 +3945,7 @@ dispatch:
proc = *scm_ilookup (SCM_CAR (x), env); proc = *scm_ilookup (SCM_CAR (x), env);
else if (SCM_CONSP (SCM_CAR (x))) else if (SCM_CONSP (SCM_CAR (x)))
proc = CEVAL (SCM_CAR (x), env); 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); SCM orig_sym = SCM_CAR (x);
{ {
@ -4160,14 +4160,15 @@ dispatch:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1)))); RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
} }
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), 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: case scm_tc7_cxr:
{ {
unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc); unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
do do
{ {
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1, 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); arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2; pattern >>= 2;
} while (pattern); } while (pattern);
@ -4847,7 +4848,7 @@ tail:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1)))); RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
} }
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), 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: case scm_tc7_cxr:
if (SCM_UNBNDP (arg1) || !SCM_NULLP (args)) if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
scm_wrong_num_args (proc); scm_wrong_num_args (proc);
@ -4856,7 +4857,7 @@ tail:
do do
{ {
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1, 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); arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2; pattern >>= 2;
} while (pattern); } while (pattern);
@ -5199,7 +5200,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1)))); RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
} }
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), 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 static SCM
@ -5209,7 +5210,7 @@ call_cxr_1 (SCM proc, SCM arg1)
do do
{ {
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1, 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); arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2; pattern >>= 2;
} while (pattern); } while (pattern);
@ -5854,7 +5855,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
SCM SCM
scm_i_eval_x (SCM exp, SCM env) 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); return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else else
return SCM_I_XEVAL (exp, env); return SCM_I_XEVAL (exp, env);
@ -5864,7 +5865,7 @@ SCM
scm_i_eval (SCM exp, SCM env) scm_i_eval (SCM exp, SCM env)
{ {
exp = scm_copy_tree (exp); exp = scm_copy_tree (exp);
if (SCM_SYMBOLP (exp)) if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1); return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else else
return SCM_I_XEVAL (exp, env); return SCM_I_XEVAL (exp, env);
@ -5980,7 +5981,7 @@ SCM scm_ceval (SCM x, SCM env)
{ {
if (SCM_CONSP (x)) if (SCM_CONSP (x))
return ceval (x, env); 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); return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else else
return SCM_I_XEVAL (x, env); return SCM_I_XEVAL (x, env);
@ -5991,7 +5992,7 @@ SCM scm_deval (SCM x, SCM env)
{ {
if (SCM_CONSP (x)) if (SCM_CONSP (x))
return deval (x, env); 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); return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else else
return SCM_I_XEVAL (x, env); 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * modify it under the terms of the GNU Lesser General Public
@ -41,7 +41,7 @@ void
scm_add_feature (const char *str) scm_add_feature (const char *str)
{ {
SCM old = SCM_VARIABLE_REF (features_var); 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); 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); scm_progargs = scm_makfromstrs (argc, argv);
if (first) 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) if (errno != 0)
SCM_SYSERROR; 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); : SCM_EOF_VAL);
} }
} }
@ -977,7 +977,7 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
errno = save_errno; errno = save_errno;
SCM_SYSERROR; SCM_SYSERROR;
} }
result = scm_mem2string (wd, strlen (wd)); result = scm_from_locale_stringn (wd, strlen (wd));
free (wd); free (wd);
return result; return result;
} }
@ -1501,14 +1501,14 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
"component, @code{.} is returned.") "component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname #define FUNC_NAME s_scm_dirname
{ {
char *s; const char *s;
long int i; long int i;
unsigned long int len; unsigned long int len;
SCM_VALIDATE_STRING (1, filename); SCM_VALIDATE_STRING (1, filename);
s = SCM_I_STRING_CHARS (filename); s = scm_i_string_chars (filename);
len = SCM_I_STRING_LENGTH (filename); len = scm_i_string_length (filename);
i = len - 1; i = len - 1;
#ifdef __MINGW32__ #ifdef __MINGW32__
@ -1527,12 +1527,12 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
#else #else
if (len > 0 && s[0] == '/') if (len > 0 && s[0] == '/')
#endif /* ndef __MINGW32__ */ #endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, scm_from_int (1)); return scm_c_substring (filename, 0, 1);
else else
return scm_dot_string; return scm_dot_string;
} }
else else
return scm_substring (filename, SCM_INUM0, scm_from_int (i + 1)); return scm_c_substring (filename, 0, i + 1);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1544,20 +1544,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
"@var{basename}, it is removed also.") "@var{basename}, it is removed also.")
#define FUNC_NAME s_scm_basename #define FUNC_NAME s_scm_basename
{ {
char *f, *s = 0; const char *f, *s = 0;
int i, j, len, end; int i, j, len, end;
SCM_VALIDATE_STRING (1, filename); SCM_VALIDATE_STRING (1, filename);
f = SCM_I_STRING_CHARS (filename); f = scm_i_string_chars (filename);
len = SCM_I_STRING_LENGTH (filename); len = scm_i_string_length (filename);
if (SCM_UNBNDP (suffix)) if (SCM_UNBNDP (suffix))
j = -1; j = -1;
else else
{ {
SCM_VALIDATE_STRING (2, suffix); SCM_VALIDATE_STRING (2, suffix);
s = SCM_I_STRING_CHARS (suffix); s = scm_i_string_chars (suffix);
j = SCM_I_STRING_LENGTH (suffix) - 1; j = scm_i_string_length (suffix) - 1;
} }
i = len - 1; i = len - 1;
#ifdef __MINGW32__ #ifdef __MINGW32__
@ -1581,12 +1581,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
#else #else
if (len > 0 && f[0] == '/') if (len > 0 && f[0] == '/')
#endif /* ndef __MINGW32__ */ #endif /* ndef __MINGW32__ */
return scm_substring (filename, SCM_INUM0, scm_from_int (1)); return scm_c_substring (filename, 0, 1);
else else
return scm_dot_string; return scm_dot_string;
} }
else 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 #undef FUNC_NAME
@ -1601,7 +1601,7 @@ scm_init_filesys ()
scm_set_smob_free (scm_tc16_dir, scm_dir_free); scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print); 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 #ifdef O_RDONLY
scm_c_define ("O_RDONLY", scm_from_long (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; int fdes;
SCM name = SCM_FILENAME (exp); 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); scm_display (name, port);
else else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port); 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; scm_print_carefully_p = 0;
port = scm_mkstrport (SCM_INUM0, 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, SCM_OPN | SCM_WRTNG,
s); s);
gdb_output_port = scm_permanent_object (port); gdb_output_port = scm_permanent_object (port);
port = scm_mkstrport (SCM_INUM0, 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, SCM_OPN | SCM_RDNG | SCM_WRTNG,
s); s);
gdb_input_port = scm_permanent_object (port); 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))) (v), SCM_BOOL_F)))
/* Fixme: Should use already interned symbols */ /* 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)) 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)) 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)) 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)) a, b, c, d))
/* Class redefinition protocol: /* Class redefinition protocol:
@ -218,7 +219,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
return res; return res;
tmp = SCM_CAAR (l); 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)); scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp));
if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) { 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; SCM slots, getters_n_setters, nfields;
unsigned long int n, i; unsigned long int n, i;
char *s; char *s;
SCM layout;
SCM_VALIDATE_INSTANCE (1, class); SCM_VALIDATE_INSTANCE (1, class);
slots = SCM_SLOT (class, scm_si_slots); 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_MISC_ERROR ("class object doesn't have enough fields: ~S",
scm_list_1 (nfields)); scm_list_1 (nfields));
s = n > 0 ? scm_malloc (n) : 0; layout = scm_i_make_string (n, &s);
i = 0; i = 0;
while (SCM_CONSP (getters_n_setters)) while (SCM_CONSP (getters_n_setters))
{ {
@ -519,11 +521,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
else else
{ {
if (!SCM_CLASSP (type)) if (!SCM_CLASSP (type))
{ SCM_MISC_ERROR ("bad slot class", SCM_EOL);
if (s)
free (s);
SCM_MISC_ERROR ("bad slot class", SCM_EOL);
}
else if (SCM_SUBCLASSP (type, scm_class_foreign_slot)) else if (SCM_SUBCLASSP (type, scm_class_foreign_slot))
{ {
if (SCM_SUBCLASSP (type, scm_class_self)) 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)) if (!SCM_NULLP (slots))
{ {
inconsistent: inconsistent:
if (s)
free (s);
SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL); SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL);
} }
SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n)); SCM_SET_SLOT (class, scm_si_layout, scm_string_to_symbol (layout));
if (s)
free (s);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -763,9 +757,9 @@ create_basic_classes (void)
/* SCM slots_of_class = build_class_class_slots (); */ /* SCM slots_of_class = build_class_class_slots (); */
/**** <scm_class_class> ****/ /**** <scm_class_class> ****/
SCM cs = scm_makfrom0str (SCM_CLASS_CLASS_LAYOUT SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT
+ 2 * scm_vtable_offset_user); + 2 * scm_vtable_offset_user);
SCM name = scm_str2symbol ("<class>"); SCM name = scm_from_locale_symbol ("<class>");
scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs, scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs,
SCM_INUM0, SCM_INUM0,
SCM_EOL)); SCM_EOL));
@ -791,7 +785,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_class); DEFVAR(name, scm_class_class);
/**** <scm_class_top> ****/ /**** <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, scm_class_top = scm_permanent_object (scm_basic_make_class (scm_class_class,
name, name,
SCM_EOL, SCM_EOL,
@ -800,7 +794,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_top); DEFVAR(name, scm_class_top);
/**** <scm_class_object> ****/ /**** <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, scm_class_object = scm_permanent_object (scm_basic_make_class (scm_class_class,
name, name,
scm_list_1 (scm_class_top), 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 #define FUNC_NAME s_scm_method_generic_function
{ {
SCM_VALIDATE_METHOD (1, obj); 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 #undef FUNC_NAME
@ -987,7 +981,7 @@ SCM_DEFINE (scm_method_specializers, "method-specializers", 1, 0, 0,
#define FUNC_NAME s_scm_method_specializers #define FUNC_NAME s_scm_method_specializers
{ {
SCM_VALIDATE_METHOD (1, obj); 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 #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 #define FUNC_NAME s_scm_accessor_method_slot_definition
{ {
SCM_VALIDATE_ACCESSOR (1, obj); 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 #undef FUNC_NAME
@ -2139,7 +2133,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
scm_i_get_keyword (k_name, scm_i_get_keyword (k_name,
args, args,
len - 1, len - 1,
scm_str2symbol ("???"), scm_from_locale_symbol ("???"),
FUNC_NAME)); FUNC_NAME));
SCM_SET_SLOT (z, scm_si_direct_supers, SCM_SET_SLOT (z, scm_si_direct_supers,
scm_i_get_keyword (k_dsupers, scm_i_get_keyword (k_dsupers,
@ -2234,7 +2228,7 @@ fix_cpl (SCM c, SCM before, SCM after)
static void static void
make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots) 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, *var = scm_permanent_object (scm_basic_make_class (meta,
tmp, tmp,
@ -2252,32 +2246,32 @@ static void
create_standard_classes (void) create_standard_classes (void)
{ {
SCM slots; SCM slots;
SCM method_slots = scm_list_4 (scm_str2symbol ("generic-function"), SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"),
scm_str2symbol ("specializers"), scm_from_locale_symbol ("specializers"),
sym_procedure, sym_procedure,
scm_str2symbol ("code-table")); scm_from_locale_symbol ("code-table"));
SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"), SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
k_init_keyword, k_init_keyword,
k_slot_definition)); 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 mutex_closure = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
SCM_EOL, SCM_EOL,
mutex_slot), mutex_slot),
SCM_EOL); SCM_EOL);
SCM gf_slots = scm_list_5 (scm_str2symbol ("methods"), SCM gf_slots = scm_list_5 (scm_from_locale_symbol ("methods"),
scm_list_3 (scm_str2symbol ("n-specialized"), scm_list_3 (scm_from_locale_symbol ("n-specialized"),
k_init_value, k_init_value,
SCM_INUM0), SCM_INUM0),
scm_list_3 (scm_str2symbol ("used-by"), scm_list_3 (scm_from_locale_symbol ("used-by"),
k_init_value, k_init_value,
SCM_BOOL_F), SCM_BOOL_F),
scm_list_3 (scm_str2symbol ("cache-mutex"), scm_list_3 (scm_from_locale_symbol ("cache-mutex"),
k_init_thunk, k_init_thunk,
mutex_closure), mutex_closure),
scm_list_3 (scm_str2symbol ("extended-by"), scm_list_3 (scm_from_locale_symbol ("extended-by"),
k_init_value, k_init_value,
SCM_EOL)); 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, k_init_value,
SCM_EOL)); SCM_EOL));
/* Foreign class slot classes */ /* Foreign class slot classes */
@ -2320,10 +2314,10 @@ create_standard_classes (void)
make_stdcls (&scm_class_foreign_class, "<foreign-class>", make_stdcls (&scm_class_foreign_class, "<foreign-class>",
scm_class_class, scm_class_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, k_class,
scm_class_opaque), scm_class_opaque),
scm_list_3 (scm_str2symbol ("destructor"), scm_list_3 (scm_from_locale_symbol ("destructor"),
k_class, k_class,
scm_class_opaque))); scm_class_opaque)));
make_stdcls (&scm_class_foreign_object, "<foreign-object>", 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]; char buffer[100];
sprintf (buffer, template, type_name); sprintf (buffer, template, type_name);
name = scm_str2symbol (buffer); name = scm_from_locale_symbol (buffer);
} }
else else
name = SCM_GOOPS_UNBOUND; name = SCM_GOOPS_UNBOUND;
@ -2580,7 +2574,7 @@ make_struct_class (void *closure SCM_UNUSED,
if (scm_is_true (SCM_STRUCT_TABLE_NAME (data))) if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
SCM_SET_STRUCT_TABLE_CLASS (data, SCM_SET_STRUCT_TABLE_CLASS (data,
scm_make_extended_class 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)); SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -2632,7 +2626,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
size_t (*destructor) (void *)) size_t (*destructor) (void *))
{ {
SCM name, class; SCM name, class;
name = scm_str2symbol (s_name); name = scm_from_locale_symbol (s_name);
if (SCM_NULLP (supers)) if (SCM_NULLP (supers))
supers = scm_list_1 (scm_class_foreign_object); supers = scm_list_1 (scm_class_foreign_object);
class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL); 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_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); SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor);
return class; return class;
@ -2692,8 +2686,8 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
SCM_EOL); SCM_EOL);
{ {
SCM name = scm_str2symbol (slot_name); SCM name = scm_from_locale_symbol (slot_name);
SCM aname = scm_str2symbol (accessor_name); SCM aname = scm_from_locale_symbol (accessor_name);
SCM gf = scm_ensure_accessor (aname); SCM gf = scm_ensure_accessor (aname);
SCM slot = scm_list_5 (name, SCM slot = scm_list_5 (name,
k_class, k_class,
@ -2840,7 +2834,7 @@ scm_init_goops_builtins (void)
create_port_classes (); create_port_classes ();
{ {
SCM name = scm_str2symbol ("no-applicable-method"); SCM name = scm_from_locale_symbol ("no-applicable-method");
scm_no_applicable_method scm_no_applicable_method
= scm_permanent_object (scm_make (scm_list_3 (scm_class_generic, = scm_permanent_object (scm_make (scm_list_3 (scm_class_generic,
k_name, k_name,

6
libguile/hash.c
View file

@ -110,13 +110,13 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
/* Fall through */ /* Fall through */
case scm_tc7_string: case scm_tc7_string:
{ {
unsigned long hash = scm_string_hash (SCM_I_STRING_UCHARS (obj), unsigned long hash = scm_string_hash (scm_i_string_chars (obj),
SCM_I_STRING_LENGTH (obj)) % n; scm_i_string_length (obj)) % n;
scm_remember_upto_here_1 (obj); scm_remember_upto_here_1 (obj);
return hash; return hash;
} }
case scm_tc7_symbol: case scm_tc7_symbol:
return SCM_SYMBOL_HASH (obj) % n; return scm_i_symbol_hash (obj) % n;
case scm_tc7_wvect: case scm_tc7_wvect:
case scm_tc7_vector: 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; stream_body_data *body_data = (stream_body_data *) data;
SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode, 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; SCM_REVEALED (port) = 1;
return port; return port;
@ -309,12 +309,13 @@ scm_load_startup_files ()
/* We want a path only containing directories from GUILE_LOAD_PATH, /* We want a path only containing directories from GUILE_LOAD_PATH,
SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
file, so we do this before loading Ice-9. */ 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. */ /* Load Ice-9. */
if (!scm_ice_9_already_loaded) 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. */ /* Load the init.scm file. */
if (scm_is_true (init_path)) 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * modify it under the terms of the GNU Lesser General Public
@ -28,6 +28,8 @@
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/keywords.h" #include "libguile/keywords.h"
#include "libguile/strings.h"
scm_t_bits scm_tc16_keyword; 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 symbol = SCM_KEYWORDSYM (exp);
scm_puts ("#:", port); scm_puts ("#:", port);
scm_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1, scm_print_symbol_name (scm_i_symbol_chars (symbol) + 1,
SCM_SYMBOL_LENGTH (symbol) - 1, scm_i_symbol_length (symbol) - 1,
port); port);
scm_remember_upto_here_1 (symbol); scm_remember_upto_here_1 (symbol);
return 1; return 1;
@ -52,8 +54,8 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
{ {
SCM keyword; SCM keyword;
SCM_ASSERT (SCM_SYMBOLP (symbol) SCM_ASSERT (scm_is_symbol (symbol)
&& ('-' == SCM_SYMBOL_CHARS(symbol)[0]), && ('-' == scm_i_symbol_chars(symbol)[0]),
symbol, SCM_ARG1, FUNC_NAME); symbol, SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS; SCM_DEFER_INTS;
@ -71,14 +73,15 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
SCM SCM
scm_c_make_keyword (char *s) scm_c_make_keyword (char *s)
{ {
char *buf = scm_malloc (strlen (s) + 2); char *buf;
SCM symbol; size_t len;
SCM string, symbol;
len = strlen (s) + 1;
string = scm_i_make_string (len, &buf);
buf[0] = '-'; buf[0] = '-';
strcpy (buf + 1, s); strcpy (buf + 1, s);
symbol = scm_str2symbol (buf); symbol = scm_string_to_symbol (string);
free (buf);
return scm_make_keyword_from_dash_symbol (symbol); 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * 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 */ { /* scope */
SCM port, save_port; 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; save_port = port;
scm_internal_dynamic_wind (swap_port, scm_internal_dynamic_wind (swap_port,
load, load,
@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
SCM SCM
scm_c_primitive_load (const char *filename) 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}.") "@samp{/usr/local/share/guile}.")
#define FUNC_NAME s_scm_sys_package_data_dir #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 #undef FUNC_NAME
#endif /* SCM_PKGDATA_DIR */ #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\".") "E.g., may return \"/usr/share/guile/1.3.5\".")
#define FUNC_NAME s_scm_sys_library_dir #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 #undef FUNC_NAME
#endif /* SCM_LIBRARY_DIR */ #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\".") "E.g., may return \"/usr/share/guile/site\".")
#define FUNC_NAME s_scm_sys_site_dir #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 #undef FUNC_NAME
#endif /* SCM_SITE_DIR */ #endif /* SCM_SITE_DIR */
@ -208,9 +208,9 @@ scm_init_load_path ()
SCM path = SCM_EOL; SCM path = SCM_EOL;
#ifdef SCM_LIBRARY_DIR #ifdef SCM_LIBRARY_DIR
path = scm_list_3 (scm_makfrom0str (SCM_SITE_DIR), path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
scm_makfrom0str (SCM_LIBRARY_DIR), scm_from_locale_string (SCM_LIBRARY_DIR),
scm_makfrom0str (SCM_PKGDATA_DIR)); scm_from_locale_string (SCM_PKGDATA_DIR));
#endif /* SCM_LIBRARY_DIR */ #endif /* SCM_LIBRARY_DIR */
env = getenv ("GUILE_LOAD_PATH"); env = getenv ("GUILE_LOAD_PATH");
@ -483,7 +483,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
SCM SCM
scm_c_primitive_load_path (const char *filename) 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; unsigned long i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++) for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
*loc = scm_acons (scm_str2symbol (info[i].name), {
scm_makfrom0str (info[i].value), SCM key = scm_from_locale_symbol (info[i].name);
*loc); SCM val = scm_from_locale_string (info[i].value);
*loc = scm_acons (key, val, *loc);
}
} }
void void
scm_init_load () 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_path = SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL));
scm_loc_load_extensions scm_loc_load_extensions
= SCM_VARIABLE_LOC (scm_c_define ("%load-extensions", = SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
scm_list_2 (scm_makfrom0str (".scm"), scm_list_2 (scm_from_locale_string (".scm"),
scm_nullstr))); scm_nullstr)));
scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F)); scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
init_build_info (); 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * modify it under the terms of the GNU Lesser General Public
@ -111,7 +111,8 @@ convert_module_name (const char *name)
ptr++; ptr++;
if (ptr > name) 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); tail = SCM_CDRLOC (*tail);
} }
name = ptr; name = ptr;
@ -185,7 +186,7 @@ scm_c_export (const char *name, ...)
if (name) if (name)
{ {
va_list ap; 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); SCM *tail = SCM_CDRLOC (names);
va_start (ap, name); va_start (ap, name);
while (1) while (1)
@ -193,7 +194,7 @@ scm_c_export (const char *name, ...)
const char *n = va_arg (ap, const char *); const char *n = va_arg (ap, const char *);
if (n == NULL) if (n == NULL)
break; break;
*tail = scm_cons (scm_str2symbol (n), SCM_EOL); *tail = scm_cons (scm_from_locale_symbol (n), SCM_EOL);
tail = SCM_CDRLOC (*tail); tail = SCM_CDRLOC (*tail);
} }
va_end (ap); va_end (ap);
@ -485,7 +486,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
SCM SCM
scm_c_module_lookup (SCM module, const char *name) 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 SCM
@ -505,7 +506,7 @@ scm_module_lookup (SCM module, SCM sym)
SCM SCM
scm_c_lookup (const char *name) scm_c_lookup (const char *name)
{ {
return scm_lookup (scm_str2symbol (name)); return scm_lookup (scm_from_locale_symbol (name));
} }
SCM SCM
@ -521,7 +522,7 @@ scm_lookup (SCM sym)
SCM SCM
scm_c_module_define (SCM module, const char *name, SCM value) 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 SCM
@ -540,7 +541,7 @@ scm_module_define (SCM module, SCM sym, SCM value)
SCM SCM
scm_c_define (const char *name, SCM value) 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 SCM

10
libguile/net_db.c
View file

@ -174,7 +174,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry) if (!entry)
scm_resolv_error (FUNC_NAME, host); 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, 1, scm_makfromstrs (-1, entry->h_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype)); SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_int (entry->h_length)); 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) if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno); 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, 1, scm_makfromstrs (-1, entry->n_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype)); SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net)); 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) if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno); 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, 1, scm_makfromstrs (-1, entry->p_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto)); SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
return result; return result;
@ -314,10 +314,10 @@ scm_return_entry (struct servent *entry)
{ {
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED); 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, 1, scm_makfromstrs (-1, entry->s_aliases));
SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port))); 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; 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]; char num_buf [SCM_INTBUFLEN];
size_t length = scm_iint2str (SCM_I_INUM (n), base, num_buf); 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)) else if (SCM_BIGP (n))
{ {
char *str = mpz_get_str (NULL, base, SCM_I_BIG_MPZ (n)); char *str = mpz_get_str (NULL, base, SCM_I_BIG_MPZ (n));
scm_remember_upto_here_1 (n); scm_remember_upto_here_1 (n);
return scm_take0str (str); return scm_take_locale_string (str);
} }
else if (SCM_FRACTIONP (n)) else if (SCM_FRACTIONP (n))
{ {
scm_i_fraction_reduce (n); scm_i_fraction_reduce (n);
return scm_string_append (scm_list_3 (scm_number_to_string (SCM_FRACTION_NUMERATOR (n), radix), 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))); scm_number_to_string (SCM_FRACTION_DENOMINATOR (n), radix)));
} }
else if (SCM_INEXACTP (n)) else if (SCM_INEXACTP (n))
{ {
char num_buf [FLOBUFLEN]; 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 else
SCM_WRONG_TYPE_ARG (1, n); 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 str;
scm_i_fraction_reduce (sexp); scm_i_fraction_reduce (sexp);
str = scm_number_to_string (sexp, SCM_UNDEFINED); 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); scm_remember_upto_here_1 (str);
return !0; return !0;
} }
@ -2596,7 +2596,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
if (exponent > SCM_MAXEXP) if (exponent > SCM_MAXEXP)
{ {
size_t exp_len = idx - start; 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 exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
scm_out_of_range ("string->number", exp_num); scm_out_of_range ("string->number", exp_num);
} }
@ -2967,8 +2967,8 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
else else
base = scm_to_unsigned_integer (radix, 2, INT_MAX); base = scm_to_unsigned_integer (radix, 2, INT_MAX);
answer = scm_i_mem2number (SCM_I_STRING_CHARS (string), answer = scm_i_mem2number (scm_i_string_chars (string),
SCM_I_STRING_LENGTH (string), scm_i_string_length (string),
base); base);
scm_remember_upto_here_1 (string); scm_remember_upto_here_1 (string);
return answer; 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * 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 name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
SCM class = scm_make_extended_class (scm_is_true (name) SCM class = scm_make_extended_class (scm_is_true (name)
? SCM_SYMBOL_CHARS (name) ? scm_i_symbol_chars (name)
: 0, : 0,
SCM_I_OPERATORP (x)); SCM_I_OPERATORP (x));
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class); 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_STRUCT (1, class);
SCM_VALIDATE_STRING (2, layout); SCM_VALIDATE_STRING (2, layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]); pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
/* Convert symbol->string */ pl = scm_symbol_to_string (pl);
pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class), return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (scm_list_2 (pl, layout)), scm_string_append (scm_list_2 (pl, layout)),
SCM_CLASS_FLAGS (class)); SCM_CLASS_FLAGS (class));
@ -479,15 +478,15 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
void void
scm_init_objects () 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 mt = scm_make_vtable_vtable (ms, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL)); 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 ot = scm_make_vtable_vtable (os, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL)); 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 el = scm_make_struct_layout (es);
SCM et = scm_make_struct (mt, SCM_INUM0, SCM et = scm_make_struct (mt, SCM_INUM0,
scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL)); 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) 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) switch (options[i].type)
{ {
case SCM_OPTION_BOOLEAN: 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) 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); options[i].name = (char *) SCM_UNPACK (name);
scm_permanent_object (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) if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL); SCM_MISC_ERROR ("entry not found", SCM_EOL);
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name)); SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd)); 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, 2, scm_from_ulong (entry->pw_uid));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid)); 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) if (!entry->pw_dir)
SCM_VECTOR_SET(result, 5, scm_makfrom0str ("")); SCM_VECTOR_SET(result, 5, scm_from_locale_string (""));
else 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) if (!entry->pw_shell)
SCM_VECTOR_SET(result, 6, scm_makfrom0str ("")); SCM_VECTOR_SET(result, 6, scm_from_locale_string (""));
else 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; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -420,8 +420,8 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry) if (!entry)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name)); SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd)); 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, 2, scm_from_ulong (entry->gr_gid));
SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem)); SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
return result; return result;
@ -820,7 +820,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
scm_mutex_lock (&scm_i_misc_mutex); scm_mutex_lock (&scm_i_misc_mutex);
SCM_SYSCALL (result = ttyname (fd)); SCM_SYSCALL (result = ttyname (fd));
err = errno; err = errno;
ret = scm_makfrom0str (result); ret = scm_from_locale_string (result);
scm_mutex_unlock (&scm_i_misc_mutex); scm_mutex_unlock (&scm_i_misc_mutex);
if (!result) if (!result)
@ -850,7 +850,7 @@ SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
char *result = ctermid (buf); char *result = ctermid (buf);
if (*result == '\0') if (*result == '\0')
SCM_SYSERROR; SCM_SYSERROR;
return scm_makfrom0str (result); return scm_from_locale_string (result);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_CTERMID */ #endif /* HAVE_CTERMID */
@ -1051,14 +1051,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED); SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0) if (uname (&buf) < 0)
SCM_SYSERROR; SCM_SYSERROR;
SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname)); SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename)); SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release)); SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version)); SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine)); SCM_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));
/* /*
a linux special? 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; return result;
} }
@ -1116,7 +1116,7 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
if (rv == NULL) if (rv == NULL)
/* not SCM_SYSERROR since errno probably not set. */ /* not SCM_SYSERROR since errno probably not set. */
SCM_MISC_ERROR ("tmpnam failed", SCM_EOL); SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);
return scm_makfrom0str (name); return scm_from_locale_string (name);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -1369,13 +1369,13 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
#define FUNC_NAME s_scm_mknod #define FUNC_NAME s_scm_mknod
{ {
int val; int val;
char *p; const char *p;
int ctype = 0; int ctype = 0;
SCM_VALIDATE_STRING (1, path); SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_SYMBOL (2, type); SCM_VALIDATE_SYMBOL (2, type);
p = SCM_SYMBOL_CHARS (type); p = scm_i_symbol_chars (type);
if (strcmp (p, "regular") == 0) if (strcmp (p, "regular") == 0)
ctype = S_IFREG; ctype = S_IFREG;
else if (strcmp (p, "directory") == 0) else if (strcmp (p, "directory") == 0)
@ -1530,7 +1530,7 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
p = getlogin (); p = getlogin ();
if (!p || !*p) if (!p || !*p)
return SCM_BOOL_F; return SCM_BOOL_F;
return scm_makfrom0str (p); return scm_from_locale_string (p);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_GETLOGIN */ #endif /* HAVE_GETLOGIN */
@ -1549,7 +1549,7 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
p = cuserid (buf); p = cuserid (buf);
if (!p || !*p) if (!p || !*p)
return SCM_BOOL_F; return SCM_BOOL_F;
return scm_makfrom0str (p); return scm_from_locale_string (p);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_CUSERID */ #endif /* HAVE_CUSERID */
@ -1839,8 +1839,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
} }
else else
{ {
/* scm_makfrom0str may throw an exception. */ /* scm_from_locale_string may throw an exception. */
const SCM name = scm_makfrom0str (p); const SCM name = scm_from_locale_string (p);
// No guile exceptions can occur before we have freed p's memory. // No guile exceptions can occur before we have freed p's memory.
scm_frame_end (); 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * 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: case scm_tc7_string:
if (SCM_WRITINGP (pstate)) if (SCM_WRITINGP (pstate))
{ {
size_t i; size_t i, len;
const char *data;
scm_putc ('"', port); 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)) if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
{ {
static char const hex[]="0123456789abcdef"; static char const hex[]="0123456789abcdef";
@ -506,25 +509,26 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
} }
} }
scm_putc ('"', port); scm_putc ('"', port);
scm_remember_upto_here_1 (exp);
} }
else 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); port);
scm_remember_upto_here_1 (exp); scm_remember_upto_here_1 (exp);
break; break;
case scm_tc7_symbol: 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_print_symbol_name (scm_i_symbol_chars (exp),
SCM_SYMBOL_LENGTH (exp), scm_i_symbol_length (exp),
port); port);
scm_remember_upto_here_1 (exp); scm_remember_upto_here_1 (exp);
} }
else else
{ {
scm_puts ("#<uninterned-symbol ", port); scm_puts ("#<uninterned-symbol ", port);
scm_print_symbol_name (SCM_SYMBOL_CHARS (exp), scm_print_symbol_name (scm_i_symbol_chars (exp),
SCM_SYMBOL_LENGTH (exp), scm_i_symbol_length (exp),
port); port);
scm_putc (' ', port); scm_putc (' ', port);
scm_intprint ((long)exp, 16, port); scm_intprint ((long)exp, 16, port);
@ -592,7 +596,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
? "#<primitive-generic " ? "#<primitive-generic "
: "#<primitive-procedure ", : "#<primitive-procedure ",
port); port);
scm_puts (SCM_SYMBOL_CHARS (SCM_SNAME (exp)), port); scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_putc ('>', port); scm_putc ('>', port);
break; break;
#ifdef CCLO #ifdef CCLO
@ -607,7 +611,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
if (scm_is_true (name)) if (scm_is_true (name))
{ {
scm_putc (' ', port); scm_putc (' ', port);
scm_puts (SCM_SYMBOL_CHARS (name), port); scm_puts (scm_i_symbol_chars (name), port);
} }
} }
else else
@ -913,9 +917,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM port, answer = SCM_UNSPECIFIED; SCM port, answer = SCM_UNSPECIFIED;
int fReturnString = 0; int fReturnString = 0;
int writingp; int writingp;
char *start; const char *start;
char *end; const char *end;
char *p; const char *p;
if (scm_is_eq (destination, SCM_BOOL_T)) 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_STRING (2, message);
SCM_VALIDATE_REST_ARGUMENT (args); SCM_VALIDATE_REST_ARGUMENT (args);
start = SCM_I_STRING_CHARS (message); start = scm_i_string_chars (message);
end = start + SCM_I_STRING_LENGTH (message); end = start + scm_i_string_length (message);
for (p = start; p != end; ++p) for (p = start; p != end; ++p)
if (*p == '~') if (*p == '~')
{ {
@ -1102,9 +1106,10 @@ scm_init_print ()
scm_gc_register_root (&print_state_pool); scm_gc_register_root (&print_state_pool);
scm_gc_register_root (&scm_print_state_vtable); scm_gc_register_root (&scm_print_state_vtable);
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL); 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)); 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; scm_print_state_vtable = type;
/* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */ /* 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; entry = scm_subr_table_size;
z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn); z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
scm_subr_table[entry].handle = z; 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].generic = 0;
scm_subr_table[entry].properties = SCM_EOL; scm_subr_table[entry].properties = SCM_EOL;
scm_subr_table_size++; 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; break;
case scm_tc7_string: case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2); 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; break;
case scm_tc7_byvect: case scm_tc7_byvect:
if (SCM_CHARP (fill)) if (SCM_CHARP (fill))
@ -630,8 +634,13 @@ racp (SCM src, SCM dst)
case scm_tc7_string: case scm_tc7_string:
if (SCM_TYP7 (src) != scm_tc7_string) if (SCM_TYP7 (src) != scm_tc7_string)
goto gencase; 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; break;
case scm_tc7_byvect: case scm_tc7_byvect:
if (SCM_TYP7 (src) != 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; return 1;
case scm_tc7_string: case scm_tc7_string:
{ {
char *v0 = SCM_I_STRING_CHARS (ra0) + i0; const char *v0 = scm_i_string_chars (ra0) + i0;
char *v1 = SCM_I_STRING_CHARS (ra1) + i1; const char *v1 = scm_i_string_chars (ra1) + i1;
for (; n--; v0 += inc0, v1 += inc1) for (; n--; v0 += inc0, v1 += inc1)
if (*v0 != *v1) if (*v0 != *v1)
return 0; return 0;
@ -2015,7 +2024,7 @@ init_raprocs (ra_iproc *subra)
{ {
for (; subra->name; subra++) for (; subra->name; subra++)
{ {
SCM sym = scm_str2symbol (subra->name); SCM sym = scm_from_locale_symbol (subra->name);
SCM var = SCM var =
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F); scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
if (var != 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 #endif
void 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 w = 0L;
scm_t_int32 c = 0L; scm_t_int32 c = 0L;
@ -153,7 +153,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
*/ */
scm_t_rstate * 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); scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
if (state == 0) if (state == 0)
@ -328,7 +328,7 @@ rstate_free (SCM rstate)
* Scheme level interface. * 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_DEFINE (scm_random, "random", 1, 1, 0,
(SCM n, SCM state), (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)) if (SCM_NUMBERP (seed))
seed = scm_number_to_string (seed, SCM_UNDEFINED); seed = scm_number_to_string (seed, SCM_UNDEFINED);
SCM_VALIDATE_STRING (1, seed); SCM_VALIDATE_STRING (1, seed);
res = make_rstate (scm_c_make_rstate (SCM_I_STRING_CHARS (seed), res = make_rstate (scm_c_make_rstate (scm_i_string_chars (seed),
SCM_I_STRING_LENGTH (seed))); scm_i_string_length (seed)));
scm_remember_upto_here_1 (seed); scm_remember_upto_here_1 (seed);
return res; return res;

6
libguile/random.h
View file

@ -46,7 +46,7 @@ typedef struct scm_t_rstate {
typedef struct scm_t_rng { typedef struct scm_t_rng {
size_t rstate_size; /* size of random state */ size_t rstate_size; /* size of random state */
unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */ 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_rstate *(*copy_rstate) (scm_t_rstate *state);
} scm_t_rng; } scm_t_rng;
@ -63,14 +63,14 @@ typedef struct scm_t_i_rstate {
} scm_t_i_rstate; } scm_t_i_rstate;
SCM_API unsigned long scm_i_uniform32 (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 *); SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
/* /*
* Random number library functions * 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); SCM_API scm_t_rstate *scm_c_default_rstate (void);
#define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE) #define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
SCM_API double scm_c_uniform01 (scm_t_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 #define FUNC_NAME s_scm_read_delimited_x
{ {
size_t j; size_t j;
char *buf;
size_t cstart; size_t cstart;
size_t cend; size_t cend;
int c; int c;
char *cdelims; const char *cdelims;
size_t num_delims; size_t num_delims;
SCM_VALIDATE_STRING (1, delims); SCM_VALIDATE_STRING (1, delims);
cdelims = SCM_I_STRING_CHARS (delims); cdelims = scm_i_string_chars (delims);
num_delims = SCM_I_STRING_LENGTH (delims); num_delims = scm_i_string_length (delims);
SCM_VALIDATE_STRING (2, str); 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); start, &cstart, end, &cend);
if (SCM_UNBNDP (port)) 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, return scm_cons (SCM_EOF_VAL,
scm_from_size_t (j - cstart)); 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)); 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'); term = SCM_MAKE_CHAR ('\n');
s[slen-1] = '\0'; s[slen-1] = '\0';
line = scm_take_str (s, slen-1); line = scm_take_locale_stringn (s, slen-1);
SCM_INCLINE (port); SCM_INCLINE (port);
} }
else else
{ {
/* Fix: we should check for eof on the port before assuming this. */ /* Fix: we should check for eof on the port before assuming this. */
term = SCM_EOF_VAL; term = SCM_EOF_VAL;
line = scm_take_str (s, slen); line = scm_take_locale_stringn (s, slen);
SCM_COL (port) += 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"); SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
static char * static SCM
scm_regexp_error_msg (int regerrno, regex_t *rx) scm_regexp_error_msg (int regerrno, regex_t *rx)
{ {
SCM errmsg; char *errmsg;
int l; int l;
/* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS? errmsg = scm_malloc (80);
Or are these only necessary when a SCM object may be left in an l = regerror (regerrno, rx, errmsg, 80);
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);
if (l > 80) if (l > 80)
{ {
errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED); free (errmsg);
regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), l); errmsg = scm_malloc (l);
regerror (regerrno, rx, errmsg, l);
} }
SCM_ALLOW_INTS; return scm_take_locale_string (errmsg);
return SCM_I_STRING_CHARS (errmsg);
} }
SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0, 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; SCM flag;
regex_t *rx; regex_t *rx;
int status, cflags; int status, cflags;
char *c_pat;
SCM_VALIDATE_STRING (1, pat); SCM_VALIDATE_STRING (1, pat);
SCM_VALIDATE_REST_ARGUMENT (flags); 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"); 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; /* Make sure they're not passing REG_NOSUB;
regexp-exec assumes we're getting match data. */ regexp-exec assumes we're getting match data. */
cflags & ~REG_NOSUB); cflags & ~REG_NOSUB);
free (c_pat);
if (status != 0) 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_gc_free (rx, sizeof(regex_t), "regex");
scm_error (scm_regexp_error_key, scm_error_scm (scm_regexp_error_key,
FUNC_NAME, scm_from_locale_string (FUNC_NAME),
errmsg, errmsg,
SCM_BOOL_F, SCM_BOOL_F,
SCM_BOOL_F); SCM_BOOL_F);
/* never returns */ /* never returns */
} }
SCM_RETURN_NEWSMOB (scm_tc16_regex, rx); 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)) if (SCM_UNBNDP (start))
offset = 0; offset = 0;
else 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)) if (SCM_UNBNDP (flags))
flags = SCM_INUM0; flags = SCM_INUM0;
@ -245,7 +237,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
nmatches = SCM_RGX(rx)->re_nsub + 1; nmatches = SCM_RGX(rx)->re_nsub + 1;
SCM_DEFER_INTS; SCM_DEFER_INTS;
matches = scm_malloc (sizeof (regmatch_t) * nmatches); 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, nmatches, matches,
scm_to_int (flags)); scm_to_int (flags));
if (!status) if (!status)
@ -268,11 +260,11 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (status != 0 && status != REG_NOMATCH) if (status != 0 && status != REG_NOMATCH)
scm_error (scm_regexp_error_key, scm_error_scm (scm_regexp_error_key,
FUNC_NAME, scm_from_locale_string (FUNC_NAME),
scm_regexp_error_msg (status, SCM_RGX (rx)), scm_regexp_error_msg (status, SCM_RGX (rx)),
SCM_BOOL_F, SCM_BOOL_F,
SCM_BOOL_F); SCM_BOOL_F);
return mvec; return mvec;
} }
#undef FUNC_NAME #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; size_t last;
SCM_VALIDATE_STRING (1, str); 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); start, &offset, end, &last);
dest += offset; dest += offset;
read_len = last - 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 don't touch the file descriptor. otherwise the
"return immediately if something is available" rule may "return immediately if something is available" rule may
be violated. */ be violated. */
dest = scm_i_string_writable_chars (str);
chars_read = scm_take_from_input_buffers (port, dest, read_len); chars_read = scm_take_from_input_buffers (port, dest, read_len);
scm_i_string_stop_writing ();
fdes = SCM_FPORT_FDES (port); fdes = SCM_FPORT_FDES (port);
} }
if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
EOF. */ EOF. */
{ {
dest = scm_i_string_writable_chars (str);
SCM_SYSCALL (chars_read = read (fdes, dest, read_len)); SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
scm_i_string_stop_writing ();
if (chars_read == -1) if (chars_read == -1)
{ {
if (SCM_EBLOCK (errno)) if (SCM_EBLOCK (errno))
@ -202,7 +205,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
"@end itemize") "@end itemize")
#define FUNC_NAME s_scm_write_string_partial #define FUNC_NAME s_scm_write_string_partial
{ {
char *src; const char *src;
long write_len; long write_len;
int fdes; int fdes;
@ -211,8 +214,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
size_t last; size_t last;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
src = SCM_I_STRING_CHARS (str); src = 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); start, &offset, end, &last);
src += offset; src += offset;
write_len = last - 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. */ (i.e., the #f) with the script name. */
if (!SCM_NULLP (do_script)) 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; do_script = SCM_EOL;
} }
else else
/* Construct an application of LOAD to the script name. */ /* Construct an application of LOAD to the script name. */
tail = scm_cons (scm_cons2 (sym_load, tail = scm_cons (scm_cons2 (sym_load,
scm_makfrom0str (argv[i]), scm_from_locale_string (argv[i]),
SCM_EOL), SCM_EOL),
tail); tail);
argv0 = argv[i]; argv0 = argv[i];
@ -471,7 +471,7 @@ scm_compile_shell_switches (int argc, char **argv)
if (++i >= argc) if (++i >= argc)
scm_shell_usage (1, "missing argument to `-c' switch"); scm_shell_usage (1, "missing argument to `-c' switch");
tail = scm_cons (scm_cons2 (sym_eval_string, tail = scm_cons (scm_cons2 (sym_eval_string,
scm_makfrom0str (argv[i]), scm_from_locale_string (argv[i]),
SCM_EOL), SCM_EOL),
tail); tail);
i++; i++;
@ -489,7 +489,7 @@ scm_compile_shell_switches (int argc, char **argv)
{ {
if (++i < argc) if (++i < argc)
tail = scm_cons (scm_cons2 (sym_load, tail = scm_cons (scm_cons2 (sym_load,
scm_makfrom0str (argv[i]), scm_from_locale_string (argv[i]),
SCM_EOL), SCM_EOL),
tail); tail);
else else

6
libguile/snarf.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_SNARF_H #ifndef SCM_SNARF_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * 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) \ #define SCM_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_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) \ #define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_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) \ #define SCM_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_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; SCM answer;
addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid)); addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
s = inet_ntoa (addr); s = inet_ntoa (addr);
answer = scm_mem2string (s, strlen (s)); answer = scm_from_locale_string (s);
return answer; return answer;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -453,7 +453,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
scm_to_ipv6 (addr6, address); scm_to_ipv6 (addr6, address);
if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL) if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL)
SCM_SYSERROR; SCM_SYSERROR;
return scm_makfrom0str (dst); return scm_from_locale_string (dst);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif #endif
@ -1000,8 +1000,7 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
if (addr_size <= offsetof (struct sockaddr_un, sun_path)) if (addr_size <= offsetof (struct sockaddr_un, sun_path))
SCM_VECTOR_SET(result, 1, SCM_BOOL_F); SCM_VECTOR_SET(result, 1, SCM_BOOL_F);
else else
SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path, SCM_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
strlen (nad->sun_path)));
} }
break; break;
#endif #endif
@ -1134,6 +1133,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
int rv; int rv;
int fd; int fd;
int flg; int flg;
char *dest;
size_t len;
SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_STRING (2, buf); SCM_VALIDATE_STRING (2, buf);
@ -1143,9 +1144,11 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
flg = scm_to_int (flags); flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = recv (fd, len = scm_i_string_length (buf);
SCM_I_STRING_CHARS (buf), SCM_I_STRING_LENGTH (buf), dest = scm_i_string_writable_chars (buf);
flg)); SCM_SYSCALL (rv = recv (fd, dest, len, flg));
scm_i_string_stop_writing ();
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1173,6 +1176,8 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
int rv; int rv;
int fd; int fd;
int flg; int flg;
const char *src;
size_t len;
sock = SCM_COERCE_OUTPORT (sock); sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_OPFPORT (1, sock);
@ -1183,10 +1188,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
flg = scm_to_int (flags); flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
SCM_SYSCALL (rv = send (fd, len = scm_i_string_length (message);
SCM_I_STRING_CHARS (message), src = scm_i_string_writable_chars (message);
SCM_I_STRING_LENGTH (message), SCM_SYSCALL (rv = send (fd, src, len, flg));
flg)); scm_i_string_stop_writing ();
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
@ -1233,8 +1239,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
SCM_VALIDATE_STRING (2, str); 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); start, &offset, end, &cend);
if (SCM_UNBNDP (flags)) 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 /* recvfrom will not necessarily return an address. usually nothing
is returned for stream sockets. */ is returned for stream sockets. */
buf = scm_i_string_writable_chars (str);
addr->sa_family = AF_UNSPEC; addr->sa_family = AF_UNSPEC;
SCM_SYSCALL (rv = recvfrom (fd, buf + offset, SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
cend - offset, flg, cend - offset, flg,
addr, &addr_size)); addr, &addr_size));
scm_i_string_stop_writing ();
if (rv == -1) if (rv == -1)
SCM_SYSERROR; SCM_SYSERROR;
if (addr->sa_family != AF_UNSPEC) 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)); flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
} }
SCM_SYSCALL (rv = sendto (fd, SCM_SYSCALL (rv = sendto (fd,
SCM_I_STRING_CHARS (message), scm_i_string_chars (message),
SCM_I_STRING_LENGTH (message), scm_i_string_length (message),
flg, soka, size)); flg, soka, size));
if (rv == -1) if (rv == -1)
{ {

5
libguile/stacks.c
View file

@ -744,13 +744,14 @@ scm_init_stacks ()
{ {
SCM vtable; SCM vtable;
SCM stack_layout 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); vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_stack_type scm_stack_type
= scm_permanent_object (scm_make_struct (vtable, SCM_INUM0, = scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
scm_cons (stack_layout, scm_cons (stack_layout,
SCM_EOL))); 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" #include "libguile/stacks.x"
} }

27
libguile/stime.c
View file

@ -32,6 +32,7 @@
#include "libguile/feature.h" #include "libguile/feature.h"
#include "libguile/strings.h" #include "libguile/strings.h"
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/dynwind.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/stime.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,7, scm_from_int (bd_time->tm_yday));
SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst)); 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,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; return result;
} }
@ -480,7 +483,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
if (scm_is_false (velts[10])) if (scm_is_false (velts[10]))
lt->tm_zone = NULL; lt->tm_zone = NULL;
else else
lt->tm_zone = SCM_STRING_CHARS (velts[10]); lt->tm_zone = scm_to_locale_string (velts[10]);
#endif #endif
} }
@ -503,7 +506,10 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
char **oldenv; char **oldenv;
int err; int err;
scm_frame_begin (0);
bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME); bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
scm_frame_free ((char *)lt.tm_zone);
SCM_DEFER_INTS; SCM_DEFER_INTS;
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME); oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
@ -560,6 +566,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
if (zname) if (zname)
free (zname); free (zname);
scm_frame_end ();
return result; return result;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -594,15 +602,16 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
char *tbuf; char *tbuf;
int size = 50; int size = 50;
char *fmt, *myfmt; const char *fmt;
char *myfmt;
int len; int len;
SCM result; SCM result;
SCM_VALIDATE_STRING (1, format); SCM_VALIDATE_STRING (1, format);
bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME); bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
fmt = SCM_STRING_CHARS (format); fmt = scm_i_string_chars (format);
len = SCM_STRING_LENGTH (format); len = scm_i_string_length (format);
/* Ugly hack: strftime can return 0 if its buffer is too small, /* Ugly hack: strftime can return 0 if its buffer is too small,
but some valid time strings (e.g. "%p") can sometimes produce but some valid time strings (e.g. "%p") can sometimes produce
@ -665,7 +674,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
#endif #endif
} }
result = scm_mem2string (tbuf + 1, len - 1); result = scm_from_locale_stringn (tbuf + 1, len - 1);
free (tbuf); free (tbuf);
free (myfmt); free (myfmt);
return result; return result;
@ -688,13 +697,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
#define FUNC_NAME s_scm_strptime #define FUNC_NAME s_scm_strptime
{ {
struct tm t; struct tm t;
char *fmt, *str, *rest; const char *fmt, *str, *rest;
SCM_VALIDATE_STRING (1, format); SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_STRING (2, string); SCM_VALIDATE_STRING (2, string);
fmt = SCM_STRING_CHARS (format); fmt = scm_i_string_chars (format);
str = SCM_STRING_CHARS (string); str = scm_i_string_chars (string);
/* initialize the struct tm */ /* initialize the struct tm */
#define tm_init(field) t.field = 0 #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; long upper;
int ch; 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); SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
if (scm_is_false (sub_start)) if (scm_is_false (sub_start))
lower = 0; lower = 0;
else 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)) if (scm_is_false (sub_end))
upper = SCM_I_STRING_LENGTH (str); upper = scm_i_string_length (str);
else 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; x = -1;
if (direction > 0) if (direction > 0)
{ {
p = SCM_I_STRING_UCHARS (str) + lower; p = (unsigned char *) scm_i_string_chars (str) + lower;
ch = SCM_CHAR (chr); ch = SCM_CHAR (chr);
for (x = lower; x < upper; ++x, ++p) for (x = lower; x < upper; ++x, ++p)
@ -83,7 +83,7 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
} }
else else
{ {
p = upper - 1 + SCM_I_STRING_UCHARS (str); p = upper - 1 + (unsigned char *)scm_i_string_chars (str);
ch = SCM_CHAR (chr); ch = SCM_CHAR (chr);
for (x = upper - 1; x >= lower; --x, --p) for (x = upper - 1; x >= lower; --x, --p)
if (*p == ch) 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 #define FUNC_NAME s_scm_substring_move_x
{ {
unsigned long s1, s2, e, len; unsigned long s1, s2, e, len;
const char *src;
char *dst;
SCM_VALIDATE_STRING (1, str1); SCM_VALIDATE_STRING (1, str1);
SCM_VALIDATE_STRING (4, str2); SCM_VALIDATE_STRING (4, str2);
s1 = scm_to_unsigned_integer (start1, 0, 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)); e = scm_to_unsigned_integer (end1, s1, scm_i_string_length(str1));
len = e - s1; 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])), src = scm_i_string_chars (str2);
(void *)(&(SCM_I_STRING_CHARS(str1)[s1])), dst = scm_i_string_writable_chars (str1);
len)); SCM_SYSCALL (memmove (dst+s2, src+s1, len));
scm_i_string_stop_writing ();
scm_remember_upto_here_2 (str1, str2); scm_remember_upto_here_2 (str1, str2);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
@ -197,12 +200,17 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
{ {
size_t i, e; size_t i, e;
char c; char c;
char *dst;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
i = scm_to_unsigned_integer (start, 0, 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)); e = scm_to_unsigned_integer (end, i, scm_i_string_length (str));
SCM_VALIDATE_CHAR_COPY (4, fill, c); SCM_VALIDATE_CHAR_COPY (4, fill, c);
dst = scm_i_string_writable_chars (str);
while (i<e) 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; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #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 #define FUNC_NAME s_scm_string_null_p
{ {
SCM_VALIDATE_STRING (1, str); 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 #undef FUNC_NAME
@ -235,10 +243,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
{ {
long i; long i;
SCM res = SCM_EOL; SCM res = SCM_EOL;
unsigned char *src; const unsigned char *src;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
src = SCM_I_STRING_UCHARS (str); src = scm_i_string_chars (str);
for (i = SCM_I_STRING_LENGTH (str)-1;i >= 0;i--) for (i = scm_i_string_length (str)-1;i >= 0;i--)
res = scm_cons (SCM_MAKE_CHAR (src[i]), res); res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
scm_remember_upto_here_1 (src); scm_remember_upto_here_1 (src);
return res; return res;
@ -251,10 +259,11 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
static SCM static SCM
string_copy (SCM str) string_copy (SCM str)
{ {
const char* chars = SCM_I_STRING_CHARS (str); const char* chars = scm_i_string_chars (str);
size_t length = SCM_I_STRING_LENGTH (str); size_t length = scm_i_string_length (str);
SCM new_string = scm_allocate_string (length); char *dst;
memcpy (SCM_I_STRING_CHARS (new_string), chars, length+1); SCM new_string = scm_i_make_string (length, &dst);
memcpy (dst, chars, length);
scm_remember_upto_here_1 (str); scm_remember_upto_here_1 (str);
return new_string; return new_string;
} }
@ -282,9 +291,10 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
long k; long k;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR_COPY (2, chr, c); SCM_VALIDATE_CHAR_COPY (2, chr, c);
dst = SCM_I_STRING_CHARS (str); dst = scm_i_string_writable_chars (str);
for (k = SCM_I_STRING_LENGTH (str)-1;k >= 0;k--) for (k = scm_i_string_length (str)-1;k >= 0;k--)
dst[k] = c; dst[k] = c;
scm_i_string_stop_writing ();
scm_remember_upto_here_1 (str); scm_remember_upto_here_1 (str);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
@ -296,11 +306,14 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
static SCM static SCM
string_upcase_x (SCM v) string_upcase_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_upcase (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_upcase (dst[k]);
scm_i_string_stop_writing ();
return v; return v;
} }
@ -341,10 +354,14 @@ SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0,
static SCM static SCM
string_downcase_x (SCM v) string_downcase_x (SCM v)
{ {
unsigned long k; size_t k, len;
char *dst;
for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k) len = scm_i_string_length (v);
SCM_I_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_I_STRING_UCHARS (v) [k]); 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; return v;
} }
@ -387,22 +404,29 @@ static SCM
string_capitalize_x (SCM str) string_capitalize_x (SCM str)
{ {
unsigned char *sz; unsigned char *sz;
long i, len; size_t i, len;
int in_word=0; int in_word=0;
len = SCM_I_STRING_LENGTH(str); len = scm_i_string_length (str);
sz = SCM_I_STRING_UCHARS (str); sz = scm_i_string_writable_chars (str);
for(i=0; i<len; i++) { for (i = 0; i < len; i++)
if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) { {
if(!in_word) { if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
sz[i] = scm_c_upcase(sz[i]); {
in_word = 1; if (!in_word)
} else { {
sz[i] = scm_c_downcase(sz[i]); 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; return str;
} }
@ -463,15 +487,15 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
#define FUNC_NAME s_scm_string_split #define FUNC_NAME s_scm_string_split
{ {
long idx, last_idx; long idx, last_idx;
char * p; const char * p;
int ch; int ch;
SCM res = SCM_EOL; SCM res = SCM_EOL;
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR (2, chr); SCM_VALIDATE_CHAR (2, chr);
idx = SCM_I_STRING_LENGTH (str); idx = scm_i_string_length (str);
p = SCM_I_STRING_CHARS (str); p = scm_i_string_chars (str);
ch = SCM_CHAR (chr); ch = SCM_CHAR (chr);
while (idx >= 0) while (idx >= 0)
{ {
@ -480,7 +504,8 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
idx--; idx--;
if (idx >= 0) 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--; 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 (1, s1);
SCM_VALIDATE_STRING (2, s2); SCM_VALIDATE_STRING (2, s2);
length = SCM_I_STRING_LENGTH (s2); length = scm_i_string_length (s2);
if (SCM_I_STRING_LENGTH (s1) == length) if (scm_i_string_length (s1) == length)
{ {
unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1; const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1; const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i; size_t i;
/* comparing from back to front typically finds mismatches faster */ /* 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 (1, s1);
SCM_VALIDATE_STRING (2, s2); SCM_VALIDATE_STRING (2, s2);
length = SCM_I_STRING_LENGTH (s2); length = scm_i_string_length (s2);
if (SCM_I_STRING_LENGTH (s1) == length) if (scm_i_string_length (s1) == length)
{ {
unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1; const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1; const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i; size_t i;
/* comparing from back to front typically finds mismatches faster */ /* comparing from back to front typically finds mismatches faster */
@ -114,13 +114,13 @@ static SCM
string_less_p (SCM s1, SCM s2) string_less_p (SCM s1, SCM s2)
{ {
size_t i, length1, length2, lengthm; size_t i, length1, length2, lengthm;
unsigned char *c1, *c2; const unsigned char *c1, *c2;
length1 = SCM_I_STRING_LENGTH (s1); length1 = scm_i_string_length (s1);
length2 = SCM_I_STRING_LENGTH (s2); length2 = scm_i_string_length (s2);
lengthm = min (length1, length2); lengthm = min (length1, length2);
c1 = SCM_I_STRING_UCHARS (s1); c1 = scm_i_string_chars (s1);
c2 = SCM_I_STRING_UCHARS (s2); c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) { for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = *c1 - *c2; int c = *c1 - *c2;
@ -196,13 +196,13 @@ static SCM
string_ci_less_p (SCM s1, SCM s2) string_ci_less_p (SCM s1, SCM s2)
{ {
size_t i, length1, length2, lengthm; size_t i, length1, length2, lengthm;
unsigned char *c1, *c2; const unsigned char *c1, *c2;
length1 = SCM_I_STRING_LENGTH (s1); length1 = scm_i_string_length (s1);
length2 = SCM_I_STRING_LENGTH (s2); length2 = scm_i_string_length (s2);
lengthm = min (length1, length2); lengthm = min (length1, length2);
c1 = SCM_I_STRING_UCHARS (s1); c1 = scm_i_string_chars (s1);
c2 = SCM_I_STRING_UCHARS (s2); c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) { for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = scm_c_upcase (*c1) - scm_c_upcase (*c2); int c = scm_c_upcase (*c1) - scm_c_upcase (*c2);

54
libguile/strports.c
View file

@ -52,6 +52,14 @@
*/ */
/* NOTES: /* 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. 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 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. 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) st_resize_port (scm_t_port *pt, off_t new_size)
{ {
SCM old_stream = SCM_PACK (pt->stream); SCM old_stream = SCM_PACK (pt->stream);
SCM new_stream = scm_allocate_string (new_size); const char *src = scm_i_string_chars (old_stream);
unsigned long int old_size = SCM_I_STRING_LENGTH (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 min_size = min (old_size, new_size);
unsigned long int i; 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; pt->write_buf_size = new_size;
for (i = 0; i != min_size; ++i) 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); scm_remember_upto_here_1 (old_stream);
/* reset buffer. */ /* reset buffer. */
{ {
pt->stream = SCM_UNPACK (new_stream); 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->read_pos = pt->write_pos = pt->write_buf + index;
pt->write_end = pt->write_buf + pt->write_buf_size; pt->write_end = pt->write_buf + pt->write_buf_size;
pt->read_end = pt->read_buf + pt->read_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; scm_t_port *pt;
size_t str_len, c_pos; size_t str_len, c_pos;
SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, caller); SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
str_len = SCM_I_STRING_LENGTH (str);
str_len = scm_i_string_length (str);
c_pos = scm_to_unsigned_integer (pos, 0, str_len); c_pos = scm_to_unsigned_integer (pos, 0, str_len);
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL); 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); scm_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc16_strport); z = scm_new_port_table_entry (scm_tc16_strport);
pt = SCM_PTAB_ENTRY(z); pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str)); SCM_SETSTREAM (z, SCM_UNPACK (str));
SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes); 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->read_pos = pt->write_pos = pt->read_buf + c_pos;
pt->write_buf_size = pt->read_buf_size = str_len; pt->write_buf_size = pt->read_buf_size = str_len;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size; 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_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str; SCM str;
char *dst;
if (pt->rw_active == SCM_PORT_WRITE) if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port); 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); scm_remember_upto_here_1 (port);
return str; return str;
} }
@ -307,7 +337,7 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
if (!SCM_UNBNDP (printer)) if (!SCM_UNBNDP (printer))
SCM_VALIDATE_PROC (2, 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); port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG, FUNC_NAME);
if (SCM_UNBNDP (printer)) if (SCM_UNBNDP (printer))
@ -401,7 +431,7 @@ SCM
scm_c_read_string (const char *expr) scm_c_read_string (const char *expr)
{ {
SCM port = scm_mkstrport (SCM_INUM0, SCM port = scm_mkstrport (SCM_INUM0,
scm_makfrom0str (expr), scm_from_locale_string (expr),
SCM_OPN | SCM_RDNG, SCM_OPN | SCM_RDNG,
"scm_c_read_string"); "scm_c_read_string");
SCM form; SCM form;
@ -418,13 +448,13 @@ scm_c_read_string (const char *expr)
SCM SCM
scm_c_eval_string (const char *expr) 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
scm_c_eval_string_in_module (const char *expr, SCM module) 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * 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); SCM_VALIDATE_STRING (1, fields);
{ /* scope */ { /* scope */
char * field_desc; const char * field_desc;
size_t len; size_t len;
int x; int x;
len = SCM_I_STRING_LENGTH (fields); len = scm_i_string_length (fields);
if (len % 2 == 1) if (len % 2 == 1)
SCM_MISC_ERROR ("odd length field specification: ~S", SCM_MISC_ERROR ("odd length field specification: ~S",
scm_list_1 (fields)); 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) for (x = 0; x < len; x += 2)
{ {
@ -120,7 +120,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
} }
#endif #endif
} }
new_sym = scm_mem2symbol (field_desc, len); new_sym = scm_string_to_symbol (fields);
} }
scm_remember_upto_here_1 (fields); scm_remember_upto_here_1 (fields);
return new_sym; return new_sym;
@ -134,9 +134,10 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void static void
scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits) 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; unsigned char prot = 0;
int n_fields = SCM_SYMBOL_LENGTH (layout) / 2; int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0; int tailp = 0;
while (n_fields) while (n_fields)
@ -239,20 +240,20 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
layout = SCM_STRUCT_LAYOUT (x); layout = SCM_STRUCT_LAYOUT (x);
if (SCM_SYMBOL_LENGTH (layout) if (scm_i_symbol_length (layout)
< SCM_I_STRING_LENGTH (required_vtable_fields)) < scm_i_string_length (required_vtable_fields))
return SCM_BOOL_F; return SCM_BOOL_F;
tmp = strncmp (SCM_SYMBOL_CHARS (layout), tmp = strncmp (scm_i_symbol_chars (layout),
SCM_I_STRING_CHARS (required_vtable_fields), scm_i_string_chars (required_vtable_fields),
SCM_I_STRING_LENGTH (required_vtable_fields)); scm_i_string_length (required_vtable_fields));
scm_remember_upto_here_1 (required_vtable_fields); scm_remember_upto_here_1 (required_vtable_fields);
if (tmp) if (tmp)
return SCM_BOOL_F; return SCM_BOOL_F;
mem = SCM_STRUCT_DATA (x); 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 #undef FUNC_NAME
@ -426,7 +427,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (init); SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]); 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); tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS; SCM_DEFER_INTS;
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY) 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, fields = scm_string_append (scm_list_2 (required_vtable_fields,
user_fields)); user_fields));
layout = scm_make_struct_layout (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); tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS; SCM_DEFER_INTS;
data = scm_alloc_struct (basic_size + tail_elts, 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 answer = SCM_UNDEFINED;
scm_t_bits * data; scm_t_bits * data;
SCM layout; SCM layout;
size_t layout_len;
size_t p; size_t p;
scm_t_bits n_fields; scm_t_bits n_fields;
char * fields_desc; const char *fields_desc;
char field_type = 0; char field_type = 0;
@ -555,12 +557,13 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); 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]; n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1, pos, p < n_fields); SCM_ASSERT_RANGE(1, pos, p < n_fields);
if (p * 2 < SCM_SYMBOL_LENGTH (layout)) if (p * 2 < layout_len)
{ {
char ref; char ref;
field_type = fields_desc[p * 2]; 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)); SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
} }
} }
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O') else if (fields_desc[layout_len - 1] != 'O')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2]; field_type = fields_desc[layout_len - 2];
else else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos)); 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_t_bits * data;
SCM layout; SCM layout;
size_t layout_len;
size_t p; size_t p;
int n_fields; int n_fields;
char * fields_desc; const char *fields_desc;
char field_type = 0; char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle); 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); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); 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]; n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1, pos, p < n_fields); SCM_ASSERT_RANGE (1, pos, p < n_fields);
if (p * 2 < SCM_SYMBOL_LENGTH (layout)) if (p * 2 < layout_len)
{ {
char set_x; char set_x;
field_type = fields_desc[p * 2]; 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') if (set_x != 'w')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
} }
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W') else if (fields_desc[layout_len - 1] == 'W')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2]; field_type = fields_desc[layout_len - 2];
else else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos)); SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
@ -794,7 +799,7 @@ scm_init_struct ()
{ {
scm_struct_table scm_struct_table
= scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31))); = 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_permanent_object (required_vtable_fields);
scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout)); 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)); 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
scm_handle_by_message (void *handler_data, SCM tag, SCM args) 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)); exit (scm_exit_status (args));
} }
@ -502,7 +502,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; 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); key, SCM_ARG1, FUNC_NAME);
c.tag = key; c.tag = key;
@ -530,7 +530,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{ {
struct scm_body_thunk_data c; 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); key, SCM_ARG1, FUNC_NAME);
c.tag = key; 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')) else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
return make_uve (scm_tc7_byvect, k, sizeof (char)); return make_uve (scm_tc7_byvect, k, sizeof (char));
else if (SCM_CHARP (prot)) 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)) else if (SCM_I_INUMP (prot))
return make_uve (SCM_I_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect, return make_uve (SCM_I_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect,
k, k,
@ -179,11 +179,11 @@ scm_make_uve (long k, SCM prot)
if (scm_num_eq_p (exactly_one_third, prot)) if (scm_num_eq_p (exactly_one_third, prot))
goto dvect; 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; char s;
s = SCM_SYMBOL_CHARS (prot)[0]; s = scm_i_symbol_chars (prot)[0];
if (s == 's') if (s == 's')
return make_uve (scm_tc7_svect, k, sizeof (short)); return make_uve (scm_tc7_svect, k, sizeof (short));
#if SCM_SIZEOF_LONG_LONG != 0 #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: case scm_tc7_wvect:
return scm_from_size_t (SCM_VECTOR_LENGTH (v)); return scm_from_size_t (SCM_VECTOR_LENGTH (v));
case scm_tc7_string: 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: case scm_tc7_bvect:
return scm_from_size_t (SCM_BITVECTOR_LENGTH (v)); return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
case scm_tc7_byvect: 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; protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)<=0;
break; break;
case scm_tc7_svect: case scm_tc7_svect:
protp = SCM_SYMBOLP (prot) protp = scm_is_symbol (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot)) && (1 == scm_i_symbol_length (prot))
&& ('s' == SCM_SYMBOL_CHARS (prot)[0]); && ('s' == scm_i_symbol_chars (prot)[0]);
break; break;
#if SCM_SIZEOF_LONG_LONG != 0 #if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect: case scm_tc7_llvect:
protp = SCM_SYMBOLP (prot) protp = scm_is_symbol (prot)
&& (1 == SCM_SYMBOL_LENGTH (prot)) && (1 == scm_i_symbol_length (prot))
&& ('l' == SCM_SYMBOL_CHARS (prot)[0]); && ('l' == scm_i_symbol_chars (prot)[0]);
break; break;
#endif #endif
case scm_tc7_fvect: 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); SCM answer = scm_make_uve (scm_to_long (dims), prot);
if (!SCM_UNBNDP (fill)) if (!SCM_UNBNDP (fill))
scm_array_fill_x (answer, 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)); scm_array_fill_x (answer, scm_from_int (0));
else else
scm_array_fill_x (answer, prot); 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)) if (!SCM_UNBNDP (fill))
scm_array_fill_x (ra, 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)); scm_array_fill_x (ra, scm_from_int (0));
else else
scm_array_fill_x (ra, prot); 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 #define FUNC_NAME s_scm_enclose_array
{ {
SCM axv, res, ra_inr; SCM axv, res, ra_inr;
const char *c_axv;
scm_t_array_dim vdim, *s = &vdim; scm_t_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr; 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].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd; SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc; 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++) for (j = 0, k = 0; k < noutr; k++, j++)
{ {
while (SCM_I_STRING_CHARS (axv)[j]) while (c_axv[j])
j++; j++;
SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd; SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd; SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (res)[k].inc = s[j].inc; 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 (ra_inr);
scm_ra_set_contp (res); scm_ra_set_contp (res);
return res; return res;
@ -1109,7 +1112,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
else else
return SCM_BOOL_F; return SCM_BOOL_F;
case scm_tc7_string: 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: case scm_tc7_byvect:
return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]); return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect: case scm_tc7_uvect:
@ -1155,7 +1158,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
else else
return SCM_BOOL_F; return SCM_BOOL_F;
case scm_tc7_string: 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: case scm_tc7_byvect:
return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]); return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect: case scm_tc7_uvect:
@ -1269,7 +1272,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break; break;
case scm_tc7_string: case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (obj), badobj); SCM_ASRTGO (SCM_CHARP (obj), badobj);
SCM_I_STRING_UCHARS (v)[pos] = SCM_CHAR (obj); scm_c_string_set_x (v, pos, obj);
break; break;
case scm_tc7_byvect: case scm_tc7_byvect:
if (SCM_CHARP (obj)) if (SCM_CHARP (obj))
@ -1478,7 +1481,7 @@ loop:
v = SCM_ARRAY_V (cra); v = SCM_ARRAY_V (cra);
goto loop; goto loop;
case scm_tc7_string: case scm_tc7_string:
base = SCM_I_STRING_CHARS (v); base = NULL; /* writing to strings is special, see below. */
sz = sizeof (char); sz = sizeof (char);
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
@ -1544,7 +1547,7 @@ loop:
{ {
scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd); scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz; int remaining = (cend - offset) * sz;
char *dest = base + (cstart + offset) * sz; size_t off = (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE) if (pt->rw_active == SCM_PORT_WRITE)
scm_flush (port_or_fd); scm_flush (port_or_fd);
@ -1557,10 +1560,18 @@ loop:
int to_copy = min (pt->read_end - pt->read_pos, int to_copy = min (pt->read_end - pt->read_pos,
remaining); 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; pt->read_pos += to_copy;
remaining -= to_copy; remaining -= to_copy;
dest += to_copy; off += to_copy;
} }
else else
{ {
@ -1581,9 +1592,19 @@ loop:
} }
else /* file descriptor. */ else /* file descriptor. */
{ {
SCM_SYSCALL (ans = read (scm_to_int (port_or_fd), if (base == NULL)
base + (cstart + offset) * sz, {
(sz * (cend - offset)))); /* 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) if (ans == -1)
SCM_SYSERROR; SCM_SYSERROR;
} }
@ -1615,7 +1636,7 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
long offset = 0; long offset = 0;
long cstart = 0; long cstart = 0;
long cend; long cend;
char *base; const char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd); port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
@ -1644,7 +1665,7 @@ loop:
v = SCM_ARRAY_V (v); v = SCM_ARRAY_V (v);
goto loop; goto loop;
case scm_tc7_string: case scm_tc7_string:
base = SCM_I_STRING_CHARS (v); base = scm_i_string_chars (v);
sz = sizeof (char); sz = sizeof (char);
break; break;
case scm_tc7_bvect: case scm_tc7_bvect:
@ -1708,7 +1729,7 @@ loop:
if (SCM_NIMP (port_or_fd)) if (SCM_NIMP (port_or_fd))
{ {
char *source = base + (cstart + offset) * sz; const char *source = base + (cstart + offset) * sz;
ans = cend - offset; ans = cend - offset;
scm_lfwrite (source, ans * sz, port_or_fd); 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
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); SCM v = scm_make_uve (len, SCM_BOOL_T);
long *data = (long *) SCM_VELTS (v); long *data = (long *) SCM_VELTS (v);
register unsigned long mask; register unsigned long mask;
register long k; register long k;
register long j; 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++) for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
{ {
data[k] = 0L; data[k] = 0L;
@ -2028,7 +2052,7 @@ scm_istr2bve (char *str, long len)
if (j > SCM_LONG_BIT) if (j > SCM_LONG_BIT)
j = SCM_LONG_BIT; j = SCM_LONG_BIT;
for (mask = 1L; j--; mask <<= 1) for (mask = 1L; j--; mask <<= 1)
switch (*str++) switch (*c_str++)
{ {
case '0': case '0':
break; break;
@ -2320,17 +2344,22 @@ tail:
} }
break; break;
case scm_tc7_string: case scm_tc7_string:
if (n-- > 0) {
scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate); const char *src;
if (SCM_WRITINGP (pstate)) src = scm_i_string_chars (ra);
for (j += inc; n-- > 0; j += inc) if (n-- > 0)
{ scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
scm_putc (' ', port); if (SCM_WRITINGP (pstate))
scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate); for (j += inc; n-- > 0; j += inc)
} {
else scm_putc (' ', port);
for (j += inc; n-- > 0; j += inc) scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
scm_putc (SCM_I_STRING_CHARS (ra)[j], port); }
else
for (j += inc; n-- > 0; j += inc)
scm_putc (src[j], port);
scm_remember_upto_here_1 (ra);
}
break; break;
case scm_tc7_byvect: case scm_tc7_byvect:
if (n-- > 0) if (n-- > 0)
@ -2560,10 +2589,10 @@ loop:
case scm_tc7_ivect: case scm_tc7_ivect:
return scm_from_int (-1); return scm_from_int (-1);
case scm_tc7_svect: case scm_tc7_svect:
return scm_str2symbol ("s"); return scm_from_locale_symbol ("s");
#if SCM_SIZEOF_LONG_LONG != 0 #if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect: case scm_tc7_llvect:
return scm_str2symbol ("l"); return scm_from_locale_symbol ("l");
#endif #endif
case scm_tc7_fvect: case scm_tc7_fvect:
return scm_from_double (1.0); 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_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_count_star (SCM v, SCM kv, SCM obj);
SCM_API SCM scm_bit_invert_x (SCM v); 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_array_to_list (SCM v);
SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst); 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); 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 #ifndef SCM_VALIDATE_H
#define 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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public * modify it under the terms of the GNU Lesser General Public
@ -152,7 +152,10 @@
cvar = SCM_CHAR (scm); \ cvar = SCM_CHAR (scm); \
} while (0) } 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") #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); \ SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
} while (0) } 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") #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); print_values);
scm_values_vtable scm_values_vtable
= scm_permanent_object (scm_make_vtable_vtable (scm_makfrom0str ("pr"), = scm_permanent_object (
SCM_INUM0, SCM_EOL)); scm_make_vtable_vtable (scm_from_locale_string ("pr"),
SCM_INUM0, SCM_EOL));
SCM_SET_STRUCT_PRINTER (scm_values_vtable, print); SCM_SET_STRUCT_PRINTER (scm_values_vtable, print);
scm_add_feature ("values"); 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_MAJOR_VERSION,
SCM_MINOR_VERSION, SCM_MINOR_VERSION,
SCM_MICRO_VERSION); SCM_MICRO_VERSION);
return scm_makfrom0str (version_str); return scm_from_locale_string (version_str);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -120,7 +120,7 @@ SCM_DEFINE (scm_effective_version, "effective-version", 0, 0, 0,
# error version string may overflow buffer # error version string may overflow buffer
#endif #endif
sprintf (version_str, "%d.%d", SCM_MAJOR_VERSION, SCM_MINOR_VERSION); 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 #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 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, /* calling the flush proc (element 2) is in case old code needs it,