summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/backtrace.c34
-rw-r--r--libguile/convert.i.c4
-rw-r--r--libguile/deprecation.c2
-rw-r--r--libguile/dynl.c4
-rw-r--r--libguile/environments.c31
-rw-r--r--libguile/eval.c63
-rw-r--r--libguile/feature.c6
-rw-r--r--libguile/filesys.c30
-rw-r--r--libguile/fports.c2
-rw-r--r--libguile/gdbint.c6
-rw-r--r--libguile/goops.c86
-rw-r--r--libguile/hash.c6
-rw-r--r--libguile/init.c7
-rw-r--r--libguile/keywords.c23
-rw-r--r--libguile/load.c33
-rw-r--r--libguile/modules.c17
-rw-r--r--libguile/net_db.c10
-rw-r--r--libguile/numbers.c16
-rw-r--r--libguile/objects.c13
-rw-r--r--libguile/options.c4
-rw-r--r--libguile/posix.c48
-rw-r--r--libguile/print.c43
-rw-r--r--libguile/procs.c2
-rw-r--r--libguile/ramap.c23
-rw-r--r--libguile/random.c10
-rw-r--r--libguile/random.h6
-rw-r--r--libguile/rdelim.c16
-rw-r--r--libguile/regex-posix.c58
-rw-r--r--libguile/rw.c13
-rw-r--r--libguile/script.c8
-rw-r--r--libguile/snarf.h6
-rw-r--r--libguile/socket.c38
-rw-r--r--libguile/stacks.c5
-rw-r--r--libguile/stime.c27
-rw-r--r--libguile/strop.c125
-rw-r--r--libguile/strorder.c36
-rw-r--r--libguile/strports.c56
-rw-r--r--libguile/struct.c57
-rw-r--r--libguile/throw.c6
-rw-r--r--libguile/unif.c113
-rw-r--r--libguile/unif.h2
-rw-r--r--libguile/validate.h12
-rw-r--r--libguile/values.c6
-rw-r--r--libguile/version.c4
-rw-r--r--libguile/vports.c2
45 files changed, 624 insertions, 495 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 23e67e4da..09430f5cc 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -177,7 +177,7 @@ display_expression (SCM frame, SCM pname, SCM source, SCM port)
pstate->fancyp = 1;
pstate->level = DISPLAY_EXPRESSION_MAX_LEVEL;
pstate->length = DISPLAY_EXPRESSION_MAX_LENGTH;
- if (SCM_SYMBOLP (pname) || scm_is_string (pname))
+ if (scm_is_symbol (pname) || scm_is_string (pname))
{
if (SCM_FRAMEP (frame)
&& SCM_FRAME_EVAL_ARGS_P (frame))
@@ -228,13 +228,13 @@ display_error_body (struct display_error_args *a)
prev_frame = SCM_FRAME_PREV (current_frame);
if (!SCM_MEMOIZEDP (source) && scm_is_true (prev_frame))
source = SCM_FRAME_SOURCE (prev_frame);
- if (!SCM_SYMBOLP (pname)
+ if (!scm_is_symbol (pname)
&& !scm_is_string (pname)
&& SCM_FRAME_PROC_P (current_frame)
&& scm_is_true (scm_procedure_p (SCM_FRAME_PROC (current_frame))))
pname = scm_procedure_name (SCM_FRAME_PROC (current_frame));
}
- if (SCM_SYMBOLP (pname) || scm_is_string (pname) || SCM_MEMOIZEDP (source))
+ if (scm_is_symbol (pname) || scm_is_string (pname) || SCM_MEMOIZEDP (source))
{
display_header (source, a->port);
display_expression (current_frame, pname, source, a->port);
@@ -401,18 +401,24 @@ display_frame_expr (char *hdr, SCM exp, char *tlr, int indentation, SCM sport, S
string = scm_strport_to_string (sport);
assert (scm_is_string (string));
- /* Remove control characters */
- for (i = 0; i < n; ++i)
- if (iscntrl ((int) SCM_I_STRING_UCHARS (string)[i]))
- SCM_I_STRING_UCHARS (string)[i] = ' ';
- /* Truncate */
- if (indentation + n > SCM_BACKTRACE_WIDTH)
- {
- n = SCM_BACKTRACE_WIDTH - indentation;
- SCM_I_STRING_UCHARS (string)[n - 1] = '$';
- }
+ {
+ char *data = scm_i_string_writable_chars (string);
+
+ /* Remove control characters */
+ for (i = 0; i < n; ++i)
+ if (iscntrl (data[i]))
+ data[i] = ' ';
+ /* Truncate */
+ if (indentation + n > SCM_BACKTRACE_WIDTH)
+ {
+ n = SCM_BACKTRACE_WIDTH - indentation;
+ data[n-1] = '$';
+ }
+
+ scm_i_string_stop_writing ();
+ }
- scm_lfwrite (SCM_I_STRING_CHARS (string), n, port);
+ scm_lfwrite (scm_i_string_chars (string), n, port);
scm_remember_upto_here_1 (string);
}
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
index 1fe928110..230aa5192 100644
--- a/libguile/convert.i.c
+++ b/libguile/convert.i.c
@@ -163,11 +163,11 @@ SCM2CTYPES (SCM obj, CTYPE *data)
#if SIZEOF_CTYPE == 1
case scm_tc7_string:
- n = SCM_I_STRING_LENGTH (obj);
+ n = scm_i_string_length (obj);
if (data == NULL)
if ((data = (CTYPE *) malloc (n * sizeof (CTYPE))) == NULL)
return NULL;
- memcpy (data, SCM_I_STRING_CHARS (obj), n * sizeof (CTYPE));
+ memcpy (data, scm_i_string_chars (obj), n * sizeof (CTYPE));
break;
#endif
diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index 3d4852a2f..d33e6b5ae 100644
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -103,7 +103,7 @@ SCM_DEFINE(scm_issue_deprecation_warning,
mode = summary_print;
else
{
- SCM nl = scm_str2string ("\n");
+ SCM nl = scm_from_locale_string ("\n");
SCM msgs_nl = SCM_EOL;
char *c_msgs;
while (SCM_CONSP (msgs))
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 99c6dc837..ad2b3a32a 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -75,8 +75,8 @@ sysdep_dynl_link (const char *fname, const char *subr)
SCM fn;
SCM msg;
- fn = scm_makfrom0str (fname);
- msg = scm_makfrom0str (scm_lt_dlerror ());
+ fn = scm_from_locale_string (fname);
+ msg = scm_from_locale_string (scm_lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
diff --git a/libguile/environments.c b/libguile/environments.c
index 1b75bcd2d..bd90a43fe 100644
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -118,7 +118,7 @@ SCM_DEFINE (scm_environment_bound_p, "environment-bound?", 2, 0, 0,
#define FUNC_NAME s_scm_environment_bound_p
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
return scm_from_bool (SCM_ENVIRONMENT_BOUND_P (env, sym));
}
@@ -135,7 +135,7 @@ SCM_DEFINE (scm_environment_ref, "environment-ref", 2, 0, 0,
SCM val;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
val = SCM_ENVIRONMENT_REF (env, sym);
@@ -155,7 +155,7 @@ SCM
scm_c_environment_ref (SCM env, SCM sym)
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, "scm_c_environment_ref");
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, "scm_c_environment_ref");
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, "scm_c_environment_ref");
return SCM_ENVIRONMENT_REF (env, sym);
}
@@ -240,7 +240,7 @@ SCM_DEFINE (scm_environment_define, "environment-define", 3, 0, 0,
SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_DEFINE (env, sym, val);
@@ -266,7 +266,7 @@ SCM_DEFINE (scm_environment_undefine, "environment-undefine", 2, 0, 0,
SCM status;
SCM_ASSERT(SCM_ENVIRONMENT_P(env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT(SCM_SYMBOLP(sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT(scm_is_symbol(sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_UNDEFINE (env, sym);
@@ -294,7 +294,7 @@ SCM_DEFINE (scm_environment_set_x, "environment-set!", 3, 0, 0,
SCM status;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
status = SCM_ENVIRONMENT_SET (env, sym, val);
@@ -329,7 +329,7 @@ SCM_DEFINE (scm_environment_cell, "environment-cell", 3, 0, 0,
SCM location;
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, FUNC_NAME);
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, FUNC_NAME);
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, FUNC_NAME);
SCM_ASSERT (scm_is_bool (for_write), for_write, SCM_ARG3, FUNC_NAME);
location = SCM_ENVIRONMENT_CELL (env, sym, scm_is_true (for_write));
@@ -355,7 +355,7 @@ SCM
scm_c_environment_cell(SCM env, SCM sym, int for_write)
{
SCM_ASSERT (SCM_ENVIRONMENT_P (env), env, SCM_ARG1, "scm_c_environment_cell");
- SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG2, "scm_c_environment_cell");
+ SCM_ASSERT (scm_is_symbol (sym), sym, SCM_ARG2, "scm_c_environment_cell");
return SCM_ENVIRONMENT_CELL (env, sym, for_write);
}
@@ -507,7 +507,7 @@ observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
static SCM
obarray_enter (SCM obarray, SCM symbol, SCM data)
{
- size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
+ size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM entry = scm_cons (symbol, data);
SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKETS (obarray)[hash]);
SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
@@ -525,7 +525,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_replace (SCM obarray, SCM symbol, SCM data)
{
- size_t hash = SCM_SYMBOL_HASH (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
+ size_t hash = scm_i_symbol_hash (symbol) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM new_entry = scm_cons (symbol, data);
SCM lsym;
SCM slot;
@@ -557,7 +557,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
static SCM
obarray_retrieve (SCM obarray, SCM sym)
{
- size_t hash = SCM_SYMBOL_HASH (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
+ size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM lsym;
for (lsym = SCM_HASHTABLE_BUCKETS (obarray)[hash];
@@ -580,7 +580,7 @@ obarray_retrieve (SCM obarray, SCM sym)
static SCM
obarray_remove (SCM obarray, SCM sym)
{
- size_t hash = SCM_SYMBOL_HASH (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
+ size_t hash = scm_i_symbol_hash (sym) % SCM_HASHTABLE_N_BUCKETS (obarray);
SCM table_entry = SCM_HASHTABLE_BUCKETS (obarray)[hash];
SCM handle = scm_sloppy_assq (sym, table_entry);
@@ -787,7 +787,8 @@ update_catch_handler (void *ptr, SCM tag, SCM args)
{
struct update_data *data = (struct update_data *) ptr;
SCM observer = data->observer;
- SCM message = scm_makfrom0str ("Observer `~A' signals `~A' error: ~S");
+ SCM message =
+ scm_from_locale_string ("Observer `~A' signals `~A' error: ~S");
return scm_cons (message, scm_list_3 (observer, tag, args));
}
@@ -2238,7 +2239,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
{
SCM entry = SCM_CAR (l);
- if (SCM_SYMBOLP (entry))
+ if (scm_is_symbol (entry))
{
SCM new_entry = scm_cons2 (entry, symbol_immutable_location, SCM_EOL);
result = scm_cons (new_entry, result);
@@ -2253,7 +2254,7 @@ export_environment_parse_signature (SCM signature, const char* caller)
SCM l2;
SCM_ASSERT (SCM_CONSP (entry), entry, SCM_ARGn, caller);
- SCM_ASSERT (SCM_SYMBOLP (SCM_CAR (entry)), entry, SCM_ARGn, caller);
+ SCM_ASSERT (scm_is_symbol (SCM_CAR (entry)), entry, SCM_ARGn, caller);
sym = SCM_CAR (entry);
diff --git a/libguile/eval.c b/libguile/eval.c
index d8dfc9e70..a032cf8da 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -254,7 +254,7 @@ syntax_error (const char* const, const SCM, const SCM) SCM_NORETURN;
static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
- const SCM msg_string = scm_makfrom0str (msg);
+ SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
@@ -524,7 +524,7 @@ is_self_quoting_p (const SCM expr)
{
if (SCM_CONSP (expr))
return 0;
- else if (SCM_SYMBOLP (expr))
+ else if (scm_is_symbol (expr))
return 0;
else if (SCM_NULLP (expr))
return 0;
@@ -651,7 +651,7 @@ m_body (SCM op, SCM exprs)
static SCM
try_macro_lookup (const SCM expr, const SCM env)
{
- if (SCM_SYMBOLP (expr))
+ if (scm_is_symbol (expr))
{
const SCM variable = lookup_symbol (expr, env);
if (SCM_VARIABLEP (variable))
@@ -848,7 +848,7 @@ macroexp (SCM x, SCM env)
macro_tail:
orig_sym = SCM_CAR (x);
- if (!SCM_SYMBOLP (orig_sym))
+ if (!scm_is_symbol (orig_sym))
return x;
{
@@ -1178,7 +1178,7 @@ canonicalize_define (const SCM expr)
body = scm_list_1 (lambda);
variable = SCM_CAR (variable);
}
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
ASSERT_SYNTAX (scm_ilength (body) == 1, s_expression, expr);
SCM_SETCAR (cdr_expr, variable);
@@ -1313,7 +1313,7 @@ scm_m_do (SCM expr, SCM env SCM_UNUSED)
const SCM name = SCM_CAR (binding);
const SCM init = SCM_CADR (binding);
const SCM step = (length == 2) ? name : SCM_CADDR (binding);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
ASSERT_SYNTAX_2 (scm_is_false (scm_c_memq (name, variables)),
s_duplicate_binding, name, expr);
@@ -1455,7 +1455,7 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
}
else
{
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (formals) || SCM_NULLP (formals),
+ ASSERT_SYNTAX_2 (scm_is_symbol (formals) || SCM_NULLP (formals),
s_bad_formals, formals, expr);
}
@@ -1466,12 +1466,12 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED)
{
const SCM formal = SCM_CAR (formals_idx);
const SCM next_idx = SCM_CDR (formals_idx);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (formal), s_bad_formal, formal, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (formal), s_bad_formal, formal, expr);
ASSERT_SYNTAX_2 (!c_improper_memq (formal, next_idx),
s_duplicate_formal, formal, expr);
formals_idx = next_idx;
}
- ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || SCM_SYMBOLP (formals_idx),
+ ASSERT_SYNTAX_2 (SCM_NULLP (formals_idx) || scm_is_symbol (formals_idx),
s_bad_formal, formals_idx, expr);
/* Memoize the body. Keep a potential documentation string. */
@@ -1525,7 +1525,7 @@ check_bindings (const SCM bindings, const SCM expr)
s_bad_binding, binding, expr);
name = SCM_CAR (binding);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (name), s_bad_variable, name, expr);
}
}
@@ -1611,7 +1611,7 @@ scm_m_let (SCM expr, SCM env)
ASSERT_SYNTAX (length >= 2, s_missing_expression, expr);
bindings = SCM_CAR (cdr_expr);
- if (SCM_SYMBOLP (bindings))
+ if (scm_is_symbol (bindings))
{
ASSERT_SYNTAX (length >= 3, s_missing_expression, expr);
return memoize_named_let (expr, env);
@@ -1944,7 +1944,7 @@ scm_m_set_x (SCM expr, SCM env SCM_UNUSED)
variable = SCM_CAR (cdr_expr);
/* Memoize the variable form. */
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
new_variable = lookup_symbol (variable, env);
/* Leave the memoization of unbound symbols to lazy memoization: */
if (SCM_UNBNDP (new_variable))
@@ -2140,7 +2140,7 @@ scm_m_generalized_set_x (SCM expr, SCM env)
&& SCM_NULLP (SCM_CDDR (exp_target)))
{
exp_target= SCM_CADR (exp_target);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (exp_target)
+ ASSERT_SYNTAX_2 (scm_is_symbol (exp_target)
|| SCM_VARIABLEP (exp_target),
s_bad_variable, exp_target, expr);
return scm_cons (SCM_IM_SET_X, scm_cons (exp_target,
@@ -2276,7 +2276,7 @@ scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr);
symbol = SCM_CAR (cdr_expr);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (symbol), s_bad_variable, symbol, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (symbol), s_bad_variable, symbol, expr);
location = scm_symbol_fref (symbol);
ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr);
@@ -2284,7 +2284,7 @@ scm_m_atfop (SCM expr, SCM env SCM_UNUSED)
/* The elisp function `defalias' allows to define aliases for symbols. To
* look up such definitions, the chain of symbol definitions has to be
* followed up to the terminal symbol. */
- while (SCM_SYMBOLP (SCM_VARIABLE_REF (location)))
+ while (scm_is_symbol (SCM_VARIABLE_REF (location)))
{
const SCM alias = SCM_VARIABLE_REF (location);
location = scm_symbol_fref (alias);
@@ -2460,7 +2460,7 @@ scm_m_undefine (SCM expr, SCM env)
("`undefine' is deprecated.\n");
variable = SCM_CAR (cdr_expr);
- ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr);
+ ASSERT_SYNTAX_2 (scm_is_symbol (variable), s_bad_variable, variable, expr);
location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F);
ASSERT_SYNTAX_2 (scm_is_true (location)
&& !SCM_UNBNDP (SCM_VARIABLE_REF (location)),
@@ -2622,7 +2622,7 @@ static SCM deval (SCM x, SCM env);
? (scm_debug_mode_p \
? deval (SCM_CAR (x), (env)) \
: ceval (SCM_CAR (x), (env))) \
- : (!SCM_SYMBOLP (SCM_CAR (x)) \
+ : (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
@@ -2642,7 +2642,7 @@ static SCM deval (SCM x, SCM env);
? SCM_VARIABLE_REF (SCM_CAR (x)) \
: (SCM_CONSP (SCM_CAR (x)) \
? CEVAL (SCM_CAR (x), (env)) \
- : (!SCM_SYMBOLP (SCM_CAR (x)) \
+ : (!scm_is_symbol (SCM_CAR (x)) \
? SCM_CAR (x) \
: *scm_lookupcar ((x), (env), 1)))))
@@ -3345,7 +3345,7 @@ dispatch:
RETURN (SCM_I_EVALIM (last_form, env));
else if (SCM_VARIABLEP (last_form))
RETURN (SCM_VARIABLE_REF (last_form));
- else if (SCM_SYMBOLP (last_form))
+ else if (scm_is_symbol (last_form))
RETURN (*scm_lookupcar (x, env, 1));
else
RETURN (last_form);
@@ -3603,7 +3603,7 @@ dispatch:
location = SCM_VARIABLE_LOC (variable);
else
{
- /* (SCM_SYMBOLP (variable)) is known to be true */
+ /* (scm_is_symbol (variable)) is known to be true */
variable = lazy_memoize_variable (variable, env);
SCM_SETCAR (x, variable);
location = SCM_VARIABLE_LOC (variable);
@@ -3945,7 +3945,7 @@ dispatch:
proc = *scm_ilookup (SCM_CAR (x), env);
else if (SCM_CONSP (SCM_CAR (x)))
proc = CEVAL (SCM_CAR (x), env);
- else if (SCM_SYMBOLP (SCM_CAR (x)))
+ else if (scm_is_symbol (SCM_CAR (x)))
{
SCM orig_sym = SCM_CAR (x);
{
@@ -4160,14 +4160,15 @@ dispatch:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ SCM_ARG1,
+ scm_i_symbol_chars (SCM_SNAME (proc)));
case scm_tc7_cxr:
{
unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
- SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@@ -4847,7 +4848,7 @@ tail:
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
case scm_tc7_cxr:
if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
scm_wrong_num_args (proc);
@@ -4856,7 +4857,7 @@ tail:
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
- SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@@ -5199,7 +5200,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ SCM_ARG1, scm_i_symbol_chars (SCM_SNAME (proc)));
}
static SCM
@@ -5209,7 +5210,7 @@ call_cxr_1 (SCM proc, SCM arg1)
do
{
SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
- SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ scm_i_symbol_chars (SCM_SNAME (proc)));
arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
pattern >>= 2;
} while (pattern);
@@ -5854,7 +5855,7 @@ SCM_DEFINE (scm_copy_tree, "copy-tree", 1, 0, 0,
SCM
scm_i_eval_x (SCM exp, SCM env)
{
- if (SCM_SYMBOLP (exp))
+ if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env);
@@ -5864,7 +5865,7 @@ SCM
scm_i_eval (SCM exp, SCM env)
{
exp = scm_copy_tree (exp);
- if (SCM_SYMBOLP (exp))
+ if (scm_is_symbol (exp))
return *scm_lookupcar (scm_cons (exp, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (exp, env);
@@ -5980,7 +5981,7 @@ SCM scm_ceval (SCM x, SCM env)
{
if (SCM_CONSP (x))
return ceval (x, env);
- else if (SCM_SYMBOLP (x))
+ else if (scm_is_symbol (x))
return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (x, env);
@@ -5991,7 +5992,7 @@ SCM scm_deval (SCM x, SCM env)
{
if (SCM_CONSP (x))
return deval (x, env);
- else if (SCM_SYMBOLP (x))
+ else if (scm_is_symbol (x))
return *scm_lookupcar (scm_cons (x, SCM_UNDEFINED), env, 1);
else
return SCM_I_XEVAL (x, env);
diff --git a/libguile/feature.c b/libguile/feature.c
index e6b212351..ec51a07a9 100644
--- a/libguile/feature.c
+++ b/libguile/feature.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -41,7 +41,7 @@ void
scm_add_feature (const char *str)
{
SCM old = SCM_VARIABLE_REF (features_var);
- SCM new = scm_cons (scm_str2symbol (str), old);
+ SCM new = scm_cons (scm_from_locale_symbol (str), old);
SCM_VARIABLE_SET (features_var, new);
}
@@ -71,7 +71,7 @@ scm_set_program_arguments (int argc, char **argv, char *first)
{
scm_progargs = scm_makfromstrs (argc, argv);
if (first)
- scm_progargs = scm_cons (scm_makfrom0str (first), scm_progargs);
+ scm_progargs = scm_cons (scm_from_locale_string (first), scm_progargs);
}
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 403996d04..af3ddc514 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -863,7 +863,7 @@ SCM_DEFINE (scm_readdir, "readdir", 1, 0, 0,
if (errno != 0)
SCM_SYSERROR;
- return (rdent ? scm_mem2string (rdent->d_name, NAMLEN (rdent))
+ return (rdent ? scm_from_locale_stringn (rdent->d_name, NAMLEN (rdent))
: SCM_EOF_VAL);
}
}
@@ -977,7 +977,7 @@ SCM_DEFINE (scm_getcwd, "getcwd", 0, 0, 0,
errno = save_errno;
SCM_SYSERROR;
}
- result = scm_mem2string (wd, strlen (wd));
+ result = scm_from_locale_stringn (wd, strlen (wd));
free (wd);
return result;
}
@@ -1501,14 +1501,14 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
"component, @code{.} is returned.")
#define FUNC_NAME s_scm_dirname
{
- char *s;
+ const char *s;
long int i;
unsigned long int len;
SCM_VALIDATE_STRING (1, filename);
- s = SCM_I_STRING_CHARS (filename);
- len = SCM_I_STRING_LENGTH (filename);
+ s = scm_i_string_chars (filename);
+ len = scm_i_string_length (filename);
i = len - 1;
#ifdef __MINGW32__
@@ -1527,12 +1527,12 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
#else
if (len > 0 && s[0] == '/')
#endif /* ndef __MINGW32__ */
- return scm_substring (filename, SCM_INUM0, scm_from_int (1));
+ return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
}
else
- return scm_substring (filename, SCM_INUM0, scm_from_int (i + 1));
+ return scm_c_substring (filename, 0, i + 1);
}
#undef FUNC_NAME
@@ -1544,20 +1544,20 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
"@var{basename}, it is removed also.")
#define FUNC_NAME s_scm_basename
{
- char *f, *s = 0;
+ const char *f, *s = 0;
int i, j, len, end;
SCM_VALIDATE_STRING (1, filename);
- f = SCM_I_STRING_CHARS (filename);
- len = SCM_I_STRING_LENGTH (filename);
+ f = scm_i_string_chars (filename);
+ len = scm_i_string_length (filename);
if (SCM_UNBNDP (suffix))
j = -1;
else
{
SCM_VALIDATE_STRING (2, suffix);
- s = SCM_I_STRING_CHARS (suffix);
- j = SCM_I_STRING_LENGTH (suffix) - 1;
+ s = scm_i_string_chars (suffix);
+ j = scm_i_string_length (suffix) - 1;
}
i = len - 1;
#ifdef __MINGW32__
@@ -1581,12 +1581,12 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
#else
if (len > 0 && f[0] == '/')
#endif /* ndef __MINGW32__ */
- return scm_substring (filename, SCM_INUM0, scm_from_int (1));
+ return scm_c_substring (filename, 0, 1);
else
return scm_dot_string;
}
else
- return scm_substring (filename, scm_from_int (i+1), scm_from_int (end+1));
+ return scm_c_substring (filename, i+1, end+1);
}
#undef FUNC_NAME
@@ -1601,7 +1601,7 @@ scm_init_filesys ()
scm_set_smob_free (scm_tc16_dir, scm_dir_free);
scm_set_smob_print (scm_tc16_dir, scm_dir_print);
- scm_dot_string = scm_permanent_object (scm_makfrom0str ("."));
+ scm_dot_string = scm_permanent_object (scm_from_locale_string ("."));
#ifdef O_RDONLY
scm_c_define ("O_RDONLY", scm_from_long (O_RDONLY));
diff --git a/libguile/fports.c b/libguile/fports.c
index ad03ad913..35789ff6e 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -501,7 +501,7 @@ fport_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
int fdes;
SCM name = SCM_FILENAME (exp);
- if (scm_is_string (name) || SCM_SYMBOLP (name))
+ if (scm_is_string (name) || scm_is_symbol (name))
scm_display (name, port);
else
scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
diff --git a/libguile/gdbint.c b/libguile/gdbint.c
index fe7cd7c94..0a31bf34d 100644
--- a/libguile/gdbint.c
+++ b/libguile/gdbint.c
@@ -285,18 +285,18 @@ scm_init_gdbint ()
scm_print_carefully_p = 0;
port = scm_mkstrport (SCM_INUM0,
- scm_make_string (scm_from_int (0), SCM_UNDEFINED),
+ scm_c_make_string (0, SCM_UNDEFINED),
SCM_OPN | SCM_WRTNG,
s);
gdb_output_port = scm_permanent_object (port);
port = scm_mkstrport (SCM_INUM0,
- scm_make_string (scm_from_int (0), SCM_UNDEFINED),
+ scm_c_make_string (0, SCM_UNDEFINED),
SCM_OPN | SCM_RDNG | SCM_WRTNG,
s);
gdb_input_port = scm_permanent_object (port);
- tok_buf = scm_permanent_object (scm_allocate_string (30));
+ tok_buf = scm_permanent_object (scm_c_make_string (30, SCM_UNDEFINED));
}
/*
diff --git a/libguile/goops.c b/libguile/goops.c
index cc4c98e04..6a595f9d0 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -61,13 +61,14 @@
(v), SCM_BOOL_F)))
/* Fixme: Should use already interned symbols */
-#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \
+
+#define CALL_GF1(name, a) (scm_call_1 (GETVAR (scm_from_locale_symbol (name)), \
a))
-#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \
+#define CALL_GF2(name, a, b) (scm_call_2 (GETVAR (scm_from_locale_symbol (name)), \
a, b))
-#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \
+#define CALL_GF3(name, a, b, c) (scm_call_3 (GETVAR (scm_from_locale_symbol (name)), \
a, b, c))
-#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \
+#define CALL_GF4(name, a, b, c, d) (scm_call_4 (GETVAR (scm_from_locale_symbol (name)), \
a, b, c, d))
/* Class redefinition protocol:
@@ -218,7 +219,7 @@ remove_duplicate_slots (SCM l, SCM res, SCM slots_already_seen)
return res;
tmp = SCM_CAAR (l);
- if (!SCM_SYMBOLP (tmp))
+ if (!scm_is_symbol (tmp))
scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp));
if (scm_is_false (scm_c_memq (tmp, slots_already_seen))) {
@@ -479,6 +480,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
SCM slots, getters_n_setters, nfields;
unsigned long int n, i;
char *s;
+ SCM layout;
SCM_VALIDATE_INSTANCE (1, class);
slots = SCM_SLOT (class, scm_si_slots);
@@ -493,7 +495,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S",
scm_list_1 (nfields));
- s = n > 0 ? scm_malloc (n) : 0;
+ layout = scm_i_make_string (n, &s);
i = 0;
while (SCM_CONSP (getters_n_setters))
{
@@ -519,11 +521,7 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
else
{
if (!SCM_CLASSP (type))
- {
- if (s)
- free (s);
- SCM_MISC_ERROR ("bad slot class", SCM_EOL);
- }
+ SCM_MISC_ERROR ("bad slot class", SCM_EOL);
else if (SCM_SUBCLASSP (type, scm_class_foreign_slot))
{
if (SCM_SUBCLASSP (type, scm_class_self))
@@ -564,13 +562,9 @@ SCM_DEFINE (scm_sys_prep_layout_x, "%prep-layout!", 1, 0, 0,
if (!SCM_NULLP (slots))
{
inconsistent:
- if (s)
- free (s);
SCM_MISC_ERROR ("inconsistent getters-n-setters", SCM_EOL);
}
- SCM_SET_SLOT (class, scm_si_layout, scm_mem2symbol (s, n));
- if (s)
- free (s);
+ SCM_SET_SLOT (class, scm_si_layout, scm_string_to_symbol (layout));
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -763,9 +757,9 @@ create_basic_classes (void)
/* SCM slots_of_class = build_class_class_slots (); */
/**** <scm_class_class> ****/
- SCM cs = scm_makfrom0str (SCM_CLASS_CLASS_LAYOUT
- + 2 * scm_vtable_offset_user);
- SCM name = scm_str2symbol ("<class>");
+ SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT
+ + 2 * scm_vtable_offset_user);
+ SCM name = scm_from_locale_symbol ("<class>");
scm_class_class = scm_permanent_object (scm_make_vtable_vtable (cs,
SCM_INUM0,
SCM_EOL));
@@ -791,7 +785,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_class);
/**** <scm_class_top> ****/
- name = scm_str2symbol ("<top>");
+ name = scm_from_locale_symbol ("<top>");
scm_class_top = scm_permanent_object (scm_basic_make_class (scm_class_class,
name,
SCM_EOL,
@@ -800,7 +794,7 @@ create_basic_classes (void)
DEFVAR(name, scm_class_top);
/**** <scm_class_object> ****/
- name = scm_str2symbol ("<object>");
+ name = scm_from_locale_symbol ("<object>");
scm_class_object = scm_permanent_object (scm_basic_make_class (scm_class_class,
name,
scm_list_1 (scm_class_top),
@@ -977,7 +971,7 @@ SCM_DEFINE (scm_method_generic_function, "method-generic-function", 1, 0, 0,
#define FUNC_NAME s_scm_method_generic_function
{
SCM_VALIDATE_METHOD (1, obj);
- return scm_slot_ref (obj, scm_str2symbol ("generic-function"));
+ return scm_slot_ref (obj, scm_from_locale_symbol ("generic-function"));
}
#undef FUNC_NAME
@@ -987,7 +981,7 @@ SCM_DEFINE (scm_method_specializers, "method-specializers", 1, 0, 0,
#define FUNC_NAME s_scm_method_specializers
{
SCM_VALIDATE_METHOD (1, obj);
- return scm_slot_ref (obj, scm_str2symbol ("specializers"));
+ return scm_slot_ref (obj, scm_from_locale_symbol ("specializers"));
}
#undef FUNC_NAME
@@ -1007,7 +1001,7 @@ SCM_DEFINE (scm_accessor_method_slot_definition, "accessor-method-slot-definitio
#define FUNC_NAME s_scm_accessor_method_slot_definition
{
SCM_VALIDATE_ACCESSOR (1, obj);
- return scm_slot_ref (obj, scm_str2symbol ("slot-definition"));
+ return scm_slot_ref (obj, scm_from_locale_symbol ("slot-definition"));
}
#undef FUNC_NAME
@@ -2139,7 +2133,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
scm_i_get_keyword (k_name,
args,
len - 1,
- scm_str2symbol ("???"),
+ scm_from_locale_symbol ("???"),
FUNC_NAME));
SCM_SET_SLOT (z, scm_si_direct_supers,
scm_i_get_keyword (k_dsupers,
@@ -2234,7 +2228,7 @@ fix_cpl (SCM c, SCM before, SCM after)
static void
make_stdcls (SCM *var, char *name, SCM meta, SCM super, SCM slots)
{
- SCM tmp = scm_str2symbol (name);
+ SCM tmp = scm_from_locale_symbol (name);
*var = scm_permanent_object (scm_basic_make_class (meta,
tmp,
@@ -2252,32 +2246,32 @@ static void
create_standard_classes (void)
{
SCM slots;
- SCM method_slots = scm_list_4 (scm_str2symbol ("generic-function"),
- scm_str2symbol ("specializers"),
+ SCM method_slots = scm_list_4 (scm_from_locale_symbol ("generic-function"),
+ scm_from_locale_symbol ("specializers"),
sym_procedure,
- scm_str2symbol ("code-table"));
- SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("slot-definition"),
+ scm_from_locale_symbol ("code-table"));
+ SCM amethod_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("slot-definition"),
k_init_keyword,
k_slot_definition));
- SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
+ SCM mutex_slot = scm_list_1 (scm_from_locale_symbol ("make-mutex"));
SCM mutex_closure = scm_i_eval_x (scm_list_3 (scm_sym_lambda,
SCM_EOL,
mutex_slot),
SCM_EOL);
- SCM gf_slots = scm_list_5 (scm_str2symbol ("methods"),
- scm_list_3 (scm_str2symbol ("n-specialized"),
+ SCM gf_slots = scm_list_5 (scm_from_locale_symbol ("methods"),
+ scm_list_3 (scm_from_locale_symbol ("n-specialized"),
k_init_value,
SCM_INUM0),
- scm_list_3 (scm_str2symbol ("used-by"),
+ scm_list_3 (scm_from_locale_symbol ("used-by"),
k_init_value,
SCM_BOOL_F),
- scm_list_3 (scm_str2symbol ("cache-mutex"),
+ scm_list_3 (scm_from_locale_symbol ("cache-mutex"),
k_init_thunk,
mutex_closure),
- scm_list_3 (scm_str2symbol ("extended-by"),
+ scm_list_3 (scm_from_locale_symbol ("extended-by"),
k_init_value,
SCM_EOL));
- SCM egf_slots = scm_list_1 (scm_list_3 (scm_str2symbol ("extends"),
+ SCM egf_slots = scm_list_1 (scm_list_3 (scm_from_locale_symbol ("extends"),
k_init_value,
SCM_EOL));
/* Foreign class slot classes */
@@ -2320,10 +2314,10 @@ create_standard_classes (void)
make_stdcls (&scm_class_foreign_class, "<foreign-class>",
scm_class_class, scm_class_class,
- scm_list_2 (scm_list_3 (scm_str2symbol ("constructor"),
+ scm_list_2 (scm_list_3 (scm_from_locale_symbol ("constructor"),
k_class,
scm_class_opaque),
- scm_list_3 (scm_str2symbol ("destructor"),
+ scm_list_3 (scm_from_locale_symbol ("destructor"),
k_class,
scm_class_opaque)));
make_stdcls (&scm_class_foreign_object, "<foreign-object>",
@@ -2450,7 +2444,7 @@ make_class_from_template (char const *template, char const *type_name, SCM super
{
char buffer[100];
sprintf (buffer, template, type_name);
- name = scm_str2symbol (buffer);
+ name = scm_from_locale_symbol (buffer);
}
else
name = SCM_GOOPS_UNBOUND;
@@ -2580,7 +2574,7 @@ make_struct_class (void *closure SCM_UNUSED,
if (scm_is_true (SCM_STRUCT_TABLE_NAME (data)))
SCM_SET_STRUCT_TABLE_CLASS (data,
scm_make_extended_class
- (SCM_SYMBOL_CHARS (SCM_STRUCT_TABLE_NAME (data)),
+ (scm_i_symbol_chars (SCM_STRUCT_TABLE_NAME (data)),
SCM_CLASS_FLAGS (vtable) & SCM_CLASSF_OPERATOR));
return SCM_UNSPECIFIED;
}
@@ -2632,7 +2626,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
size_t (*destructor) (void *))
{
SCM name, class;
- name = scm_str2symbol (s_name);
+ name = scm_from_locale_symbol (s_name);
if (SCM_NULLP (supers))
supers = scm_list_1 (scm_class_foreign_object);
class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL);
@@ -2649,7 +2643,7 @@ scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
SCM_SET_CLASS_INSTANCE_SIZE (class, size);
}
- SCM_SET_SLOT (class, scm_si_layout, scm_str2symbol (""));
+ SCM_SET_SLOT (class, scm_si_layout, scm_from_locale_symbol (""));
SCM_SET_SLOT (class, scm_si_constructor, (SCM) constructor);
return class;
@@ -2692,8 +2686,8 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
SCM_EOL);
{
- SCM name = scm_str2symbol (slot_name);
- SCM aname = scm_str2symbol (accessor_name);
+ SCM name = scm_from_locale_symbol (slot_name);
+ SCM aname = scm_from_locale_symbol (accessor_name);
SCM gf = scm_ensure_accessor (aname);
SCM slot = scm_list_5 (name,
k_class,
@@ -2840,7 +2834,7 @@ scm_init_goops_builtins (void)
create_port_classes ();
{
- SCM name = scm_str2symbol ("no-applicable-method");
+ SCM name = scm_from_locale_symbol ("no-applicable-method");
scm_no_applicable_method
= scm_permanent_object (scm_make (scm_list_3 (scm_class_generic,
k_name,
diff --git a/libguile/hash.c b/libguile/hash.c
index b2c7fa592..5123c2c15 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -110,13 +110,13 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
/* Fall through */
case scm_tc7_string:
{
- unsigned long hash = scm_string_hash (SCM_I_STRING_UCHARS (obj),
- SCM_I_STRING_LENGTH (obj)) % n;
+ unsigned long hash = scm_string_hash (scm_i_string_chars (obj),
+ scm_i_string_length (obj)) % n;
scm_remember_upto_here_1 (obj);
return hash;
}
case scm_tc7_symbol:
- return SCM_SYMBOL_HASH (obj) % n;
+ return scm_i_symbol_hash (obj) % n;
case scm_tc7_wvect:
case scm_tc7_vector:
{
diff --git a/libguile/init.c b/libguile/init.c
index 9e09e2587..313f3ff04 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -224,7 +224,7 @@ stream_body (void *data)
{
stream_body_data *body_data = (stream_body_data *) data;
SCM port = scm_fdes_to_port (body_data->fdes, body_data->mode,
- scm_makfrom0str (body_data->name));
+ scm_from_locale_string (body_data->name));
SCM_REVEALED (port) = 1;
return port;
@@ -309,12 +309,13 @@ scm_load_startup_files ()
/* We want a path only containing directories from GUILE_LOAD_PATH,
SCM_SITE_DIR and SCM_LIBRARY_DIR when searching for the site init
file, so we do this before loading Ice-9. */
- SCM init_path = scm_sys_search_load_path (scm_makfrom0str ("init.scm"));
+ SCM init_path =
+ scm_sys_search_load_path (scm_from_locale_string ("init.scm"));
/* Load Ice-9. */
if (!scm_ice_9_already_loaded)
{
- scm_primitive_load_path (scm_makfrom0str ("ice-9/boot-9.scm"));
+ scm_primitive_load_path (scm_from_locale_string ("ice-9/boot-9.scm"));
/* Load the init.scm file. */
if (scm_is_true (init_path))
diff --git a/libguile/keywords.c b/libguile/keywords.c
index fb29bb081..fd75d7274 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -28,6 +28,8 @@
#include "libguile/validate.h"
#include "libguile/keywords.h"
+#include "libguile/strings.h"
+
scm_t_bits scm_tc16_keyword;
@@ -38,8 +40,8 @@ keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
SCM symbol = SCM_KEYWORDSYM (exp);
scm_puts ("#:", port);
- scm_print_symbol_name (SCM_SYMBOL_CHARS (symbol) + 1,
- SCM_SYMBOL_LENGTH (symbol) - 1,
+ scm_print_symbol_name (scm_i_symbol_chars (symbol) + 1,
+ scm_i_symbol_length (symbol) - 1,
port);
scm_remember_upto_here_1 (symbol);
return 1;
@@ -52,8 +54,8 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
{
SCM keyword;
- SCM_ASSERT (SCM_SYMBOLP (symbol)
- && ('-' == SCM_SYMBOL_CHARS(symbol)[0]),
+ SCM_ASSERT (scm_is_symbol (symbol)
+ && ('-' == scm_i_symbol_chars(symbol)[0]),
symbol, SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS;
@@ -71,14 +73,15 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
SCM
scm_c_make_keyword (char *s)
{
- char *buf = scm_malloc (strlen (s) + 2);
- SCM symbol;
+ char *buf;
+ size_t len;
+ SCM string, symbol;
+ len = strlen (s) + 1;
+ string = scm_i_make_string (len, &buf);
buf[0] = '-';
strcpy (buf + 1, s);
- symbol = scm_str2symbol (buf);
- free (buf);
-
+ symbol = scm_string_to_symbol (string);
return scm_make_keyword_from_dash_symbol (symbol);
}
diff --git a/libguile/load.c b/libguile/load.c
index d50211dcf..345f309c8 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -105,7 +105,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
{ /* scope */
SCM port, save_port;
- port = scm_open_file (filename, scm_mem2string ("r", sizeof (char)));
+ port = scm_open_file (filename, scm_from_locale_string ("r"));
save_port = port;
scm_internal_dynamic_wind (swap_port,
load,
@@ -121,7 +121,7 @@ SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
SCM
scm_c_primitive_load (const char *filename)
{
- return scm_primitive_load (scm_makfrom0str (filename));
+ return scm_primitive_load (scm_from_locale_string (filename));
}
@@ -134,7 +134,7 @@ SCM_DEFINE (scm_sys_package_data_dir, "%package-data-dir", 0, 0, 0,
"@samp{/usr/local/share/guile}.")
#define FUNC_NAME s_scm_sys_package_data_dir
{
- return scm_makfrom0str (SCM_PKGDATA_DIR);
+ return scm_from_locale_string (SCM_PKGDATA_DIR);
}
#undef FUNC_NAME
#endif /* SCM_PKGDATA_DIR */
@@ -146,7 +146,7 @@ SCM_DEFINE (scm_sys_library_dir, "%library-dir", 0,0,0,
"E.g., may return \"/usr/share/guile/1.3.5\".")
#define FUNC_NAME s_scm_sys_library_dir
{
- return scm_makfrom0str(SCM_LIBRARY_DIR);
+ return scm_from_locale_string (SCM_LIBRARY_DIR);
}
#undef FUNC_NAME
#endif /* SCM_LIBRARY_DIR */
@@ -158,7 +158,7 @@ SCM_DEFINE (scm_sys_site_dir, "%site-dir", 0,0,0,
"E.g., may return \"/usr/share/guile/site\".")
#define FUNC_NAME s_scm_sys_site_dir
{
- return scm_makfrom0str(SCM_SITE_DIR);
+ return scm_from_locale_string (SCM_SITE_DIR);
}
#undef FUNC_NAME
#endif /* SCM_SITE_DIR */
@@ -208,9 +208,9 @@ scm_init_load_path ()
SCM path = SCM_EOL;
#ifdef SCM_LIBRARY_DIR
- path = scm_list_3 (scm_makfrom0str (SCM_SITE_DIR),
- scm_makfrom0str (SCM_LIBRARY_DIR),
- scm_makfrom0str (SCM_PKGDATA_DIR));
+ path = scm_list_3 (scm_from_locale_string (SCM_SITE_DIR),
+ scm_from_locale_string (SCM_LIBRARY_DIR),
+ scm_from_locale_string (SCM_PKGDATA_DIR));
#endif /* SCM_LIBRARY_DIR */
env = getenv ("GUILE_LOAD_PATH");
@@ -483,7 +483,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
SCM
scm_c_primitive_load_path (const char *filename)
{
- return scm_primitive_load_path (scm_makfrom0str (filename));
+ return scm_primitive_load_path (scm_from_locale_string (filename));
}
@@ -499,12 +499,13 @@ init_build_info ()
unsigned long i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
- *loc = scm_acons (scm_str2symbol (info[i].name),
- scm_makfrom0str (info[i].value),
- *loc);
+ {
+ SCM key = scm_from_locale_symbol (info[i].name);
+ SCM val = scm_from_locale_string (info[i].value);
+ *loc = scm_acons (key, val, *loc);
+ }
}
-
void
scm_init_load ()
@@ -513,8 +514,8 @@ scm_init_load ()
scm_loc_load_path = SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL));
scm_loc_load_extensions
= SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
- scm_list_2 (scm_makfrom0str (".scm"),
- scm_nullstr)));
+ scm_list_2 (scm_from_locale_string (".scm"),
+ scm_nullstr)));
scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
init_build_info ();
diff --git a/libguile/modules.c b/libguile/modules.c
index 98f5b8ea6..5049a186c 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,2000,2001,2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1998,2000,2001,2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -111,7 +111,8 @@ convert_module_name (const char *name)
ptr++;
if (ptr > name)
{
- *tail = scm_cons (scm_mem2symbol (name, ptr-name), SCM_EOL);
+ SCM sym = scm_from_locale_symboln (name, ptr-name);
+ *tail = scm_cons (sym, SCM_EOL);
tail = SCM_CDRLOC (*tail);
}
name = ptr;
@@ -185,7 +186,7 @@ scm_c_export (const char *name, ...)
if (name)
{
va_list ap;
- SCM names = scm_cons (scm_str2symbol (name), SCM_EOL);
+ SCM names = scm_cons (scm_from_locale_symbol (name), SCM_EOL);
SCM *tail = SCM_CDRLOC (names);
va_start (ap, name);
while (1)
@@ -193,7 +194,7 @@ scm_c_export (const char *name, ...)
const char *n = va_arg (ap, const char *);
if (n == NULL)
break;
- *tail = scm_cons (scm_str2symbol (n), SCM_EOL);
+ *tail = scm_cons (scm_from_locale_symbol (n), SCM_EOL);
tail = SCM_CDRLOC (*tail);
}
va_end (ap);
@@ -485,7 +486,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
SCM
scm_c_module_lookup (SCM module, const char *name)
{
- return scm_module_lookup (module, scm_str2symbol (name));
+ return scm_module_lookup (module, scm_from_locale_symbol (name));
}
SCM
@@ -505,7 +506,7 @@ scm_module_lookup (SCM module, SCM sym)
SCM
scm_c_lookup (const char *name)
{
- return scm_lookup (scm_str2symbol (name));
+ return scm_lookup (scm_from_locale_symbol (name));
}
SCM
@@ -521,7 +522,7 @@ scm_lookup (SCM sym)
SCM
scm_c_module_define (SCM module, const char *name, SCM value)
{
- return scm_module_define (module, scm_str2symbol (name), value);
+ return scm_module_define (module, scm_from_locale_symbol (name), value);
}
SCM
@@ -540,7 +541,7 @@ scm_module_define (SCM module, SCM sym, SCM value)
SCM
scm_c_define (const char *name, SCM value)
{
- return scm_define (scm_str2symbol (name), value);
+ return scm_define (scm_from_locale_symbol (name), value);
}
SCM
diff --git a/libguile/net_db.c b/libguile/net_db.c
index 41f05a9d7..8b2562d4a 100644
--- a/libguile/net_db.c
+++ b/libguile/net_db.c
@@ -174,7 +174,7 @@ SCM_DEFINE (scm_gethost, "gethost", 0, 1, 0,
if (!entry)
scm_resolv_error (FUNC_NAME, host);
- SCM_VECTOR_SET(result, 0, scm_mem2string (entry->h_name, strlen (entry->h_name)));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->h_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->h_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->h_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_int (entry->h_length));
@@ -248,7 +248,7 @@ SCM_DEFINE (scm_getnet, "getnet", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), eno);
- SCM_VECTOR_SET(result, 0, scm_mem2string (entry->n_name, strlen (entry->n_name)));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->n_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->n_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->n_addrtype));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->n_net));
@@ -300,7 +300,7 @@ SCM_DEFINE (scm_getproto, "getproto", 0, 1, 0,
if (!entry)
SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), eno);
- SCM_VECTOR_SET(result, 0, scm_mem2string (entry->p_name, strlen (entry->p_name)));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->p_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->p_aliases));
SCM_VECTOR_SET(result, 2, scm_from_int (entry->p_proto));
return result;
@@ -314,10 +314,10 @@ scm_return_entry (struct servent *entry)
{
SCM result = scm_c_make_vector (4, SCM_UNSPECIFIED);
- SCM_VECTOR_SET(result, 0, scm_mem2string (entry->s_name, strlen (entry->s_name)));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->s_name));
SCM_VECTOR_SET(result, 1, scm_makfromstrs (-1, entry->s_aliases));
SCM_VECTOR_SET(result, 2, scm_from_uint16 (ntohs (entry->s_port)));
- SCM_VECTOR_SET(result, 3, scm_mem2string (entry->s_proto, strlen (entry->s_proto)));
+ SCM_VECTOR_SET(result, 3, scm_from_locale_string (entry->s_proto));
return result;
}
diff --git a/libguile/numbers.c b/libguile/numbers.c
index a50ca8889..966aa0d33 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -2286,25 +2286,25 @@ SCM_DEFINE (scm_number_to_string, "number->string", 1, 1, 0,
{
char num_buf [SCM_INTBUFLEN];
size_t length = scm_iint2str (SCM_I_INUM (n), base, num_buf);
- return scm_mem2string (num_buf, length);
+ return scm_from_locale_stringn (num_buf, length);
}
else if (SCM_BIGP (n))
{
char *str = mpz_get_str (NULL, base, SCM_I_BIG_MPZ (n));
scm_remember_upto_here_1 (n);
- return scm_take0str (str);
+ return scm_take_locale_string (str);
}
else if (SCM_FRACTIONP (n))
{
scm_i_fraction_reduce (n);
return scm_string_append (scm_list_3 (scm_number_to_string (SCM_FRACTION_NUMERATOR (n), radix),
- scm_mem2string ("/", 1),
+ scm_from_locale_string ("/"),
scm_number_to_string (SCM_FRACTION_DENOMINATOR (n), radix)));
}
else if (SCM_INEXACTP (n))
{
char num_buf [FLOBUFLEN];
- return scm_mem2string (num_buf, iflo2str (n, num_buf, base));
+ return scm_from_locale_stringn (num_buf, iflo2str (n, num_buf, base));
}
else
SCM_WRONG_TYPE_ARG (1, n);
@@ -2338,7 +2338,7 @@ scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED)
SCM str;
scm_i_fraction_reduce (sexp);
str = scm_number_to_string (sexp, SCM_UNDEFINED);
- scm_lfwrite (SCM_I_STRING_CHARS (str), SCM_I_STRING_LENGTH (str), port);
+ scm_lfwrite (scm_i_string_chars (str), scm_i_string_length (str), port);
scm_remember_upto_here_1 (str);
return !0;
}
@@ -2596,7 +2596,7 @@ mem2decimal_from_point (SCM result, const char* mem, size_t len,
if (exponent > SCM_MAXEXP)
{
size_t exp_len = idx - start;
- SCM exp_string = scm_mem2string (&mem[start], exp_len);
+ SCM exp_string = scm_from_locale_stringn (&mem[start], exp_len);
SCM exp_num = scm_string_to_number (exp_string, SCM_UNDEFINED);
scm_out_of_range ("string->number", exp_num);
}
@@ -2967,8 +2967,8 @@ SCM_DEFINE (scm_string_to_number, "string->number", 1, 1, 0,
else
base = scm_to_unsigned_integer (radix, 2, INT_MAX);
- answer = scm_i_mem2number (SCM_I_STRING_CHARS (string),
- SCM_I_STRING_LENGTH (string),
+ answer = scm_i_mem2number (scm_i_string_chars (string),
+ scm_i_string_length (string),
base);
scm_remember_upto_here_1 (string);
return answer;
diff --git a/libguile/objects.c b/libguile/objects.c
index 519a7ecf5..449976a1d 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -170,7 +170,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
SCM class = scm_make_extended_class (scm_is_true (name)
- ? SCM_SYMBOL_CHARS (name)
+ ? scm_i_symbol_chars (name)
: 0,
SCM_I_OPERATORP (x));
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
@@ -468,8 +468,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
SCM_VALIDATE_STRUCT (1, class);
SCM_VALIDATE_STRING (2, layout);
pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
- /* Convert symbol->string */
- pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
+ pl = scm_symbol_to_string (pl);
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
scm_string_append (scm_list_2 (pl, layout)),
SCM_CLASS_FLAGS (class));
@@ -479,15 +478,15 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
void
scm_init_objects ()
{
- SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
+ SCM ms = scm_from_locale_string (SCM_METACLASS_STANDARD_LAYOUT);
SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
- SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
+ SCM os = scm_from_locale_string (SCM_METACLASS_OPERATOR_LAYOUT);
SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
- SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
+ SCM es = scm_from_locale_string (SCM_ENTITY_LAYOUT);
SCM el = scm_make_struct_layout (es);
SCM et = scm_make_struct (mt, SCM_INUM0,
scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
diff --git a/libguile/options.c b/libguile/options.c
index 4c53611a3..34e0bef99 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -130,7 +130,7 @@ get_documented_option_setting (const scm_t_option options[], unsigned int n)
for (i = 0; i != n; ++i)
{
- SCM ls = scm_cons (scm_str2string (options[i].doc), SCM_EOL);
+ SCM ls = scm_cons (scm_from_locale_string (options[i].doc), SCM_EOL);
switch (options[i].type)
{
case SCM_OPTION_BOOLEAN:
@@ -252,7 +252,7 @@ scm_init_opts (SCM (*func) (SCM), scm_t_option options[], unsigned int n)
for (i = 0; i != n; ++i)
{
- SCM name = scm_str2symbol (options[i].name);
+ SCM name = scm_from_locale_symbol (options[i].name);
options[i].name = (char *) SCM_UNPACK (name);
scm_permanent_object (name);
}
diff --git a/libguile/posix.c b/libguile/posix.c
index 37b46bdaf..bb78a18ae 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -355,19 +355,19 @@ SCM_DEFINE (scm_getpwuid, "getpw", 0, 1, 0,
if (!entry)
SCM_MISC_ERROR ("entry not found", SCM_EOL);
- SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->pw_name));
- SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->pw_passwd));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->pw_name));
+ SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->pw_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->pw_uid));
SCM_VECTOR_SET(result, 3, scm_from_ulong (entry->pw_gid));
- SCM_VECTOR_SET(result, 4, scm_makfrom0str (entry->pw_gecos));
+ SCM_VECTOR_SET(result, 4, scm_from_locale_string (entry->pw_gecos));
if (!entry->pw_dir)
- SCM_VECTOR_SET(result, 5, scm_makfrom0str (""));
+ SCM_VECTOR_SET(result, 5, scm_from_locale_string (""));
else
- SCM_VECTOR_SET(result, 5, scm_makfrom0str (entry->pw_dir));
+ SCM_VECTOR_SET(result, 5, scm_from_locale_string (entry->pw_dir));
if (!entry->pw_shell)
- SCM_VECTOR_SET(result, 6, scm_makfrom0str (""));
+ SCM_VECTOR_SET(result, 6, scm_from_locale_string (""));
else
- SCM_VECTOR_SET(result, 6, scm_makfrom0str (entry->pw_shell));
+ SCM_VECTOR_SET(result, 6, scm_from_locale_string (entry->pw_shell));
return result;
}
#undef FUNC_NAME
@@ -420,8 +420,8 @@ SCM_DEFINE (scm_getgrgid, "getgr", 0, 1, 0,
if (!entry)
SCM_SYSERROR;
- SCM_VECTOR_SET(result, 0, scm_makfrom0str (entry->gr_name));
- SCM_VECTOR_SET(result, 1, scm_makfrom0str (entry->gr_passwd));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (entry->gr_name));
+ SCM_VECTOR_SET(result, 1, scm_from_locale_string (entry->gr_passwd));
SCM_VECTOR_SET(result, 2, scm_from_ulong (entry->gr_gid));
SCM_VECTOR_SET(result, 3, scm_makfromstrs (-1, entry->gr_mem));
return result;
@@ -820,7 +820,7 @@ SCM_DEFINE (scm_ttyname, "ttyname", 1, 0, 0,
scm_mutex_lock (&scm_i_misc_mutex);
SCM_SYSCALL (result = ttyname (fd));
err = errno;
- ret = scm_makfrom0str (result);
+ ret = scm_from_locale_string (result);
scm_mutex_unlock (&scm_i_misc_mutex);
if (!result)
@@ -850,7 +850,7 @@ SCM_DEFINE (scm_ctermid, "ctermid", 0, 0, 0,
char *result = ctermid (buf);
if (*result == '\0')
SCM_SYSERROR;
- return scm_makfrom0str (result);
+ return scm_from_locale_string (result);
}
#undef FUNC_NAME
#endif /* HAVE_CTERMID */
@@ -1051,14 +1051,14 @@ SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
SCM result = scm_c_make_vector (5, SCM_UNSPECIFIED);
if (uname (&buf) < 0)
SCM_SYSERROR;
- SCM_VECTOR_SET(result, 0, scm_makfrom0str (buf.sysname));
- SCM_VECTOR_SET(result, 1, scm_makfrom0str (buf.nodename));
- SCM_VECTOR_SET(result, 2, scm_makfrom0str (buf.release));
- SCM_VECTOR_SET(result, 3, scm_makfrom0str (buf.version));
- SCM_VECTOR_SET(result, 4, scm_makfrom0str (buf.machine));
+ SCM_VECTOR_SET(result, 0, scm_from_locale_string (buf.sysname));
+ SCM_VECTOR_SET(result, 1, scm_from_locale_string (buf.nodename));
+ SCM_VECTOR_SET(result, 2, scm_from_locale_string (buf.release));
+ SCM_VECTOR_SET(result, 3, scm_from_locale_string (buf.version));
+ SCM_VECTOR_SET(result, 4, scm_from_locale_string (buf.machine));
/*
a linux special?
- SCM_VECTOR_SET(result, 5, scm_makfrom0str (buf.domainname));
+ SCM_VECTOR_SET(result, 5, scm_from_locale_string (buf.domainname));
*/
return result;
}
@@ -1116,7 +1116,7 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
if (rv == NULL)
/* not SCM_SYSERROR since errno probably not set. */
SCM_MISC_ERROR ("tmpnam failed", SCM_EOL);
- return scm_makfrom0str (name);
+ return scm_from_locale_string (name);
}
#undef FUNC_NAME
@@ -1369,13 +1369,13 @@ SCM_DEFINE (scm_mknod, "mknod", 4, 0, 0,
#define FUNC_NAME s_scm_mknod
{
int val;
- char *p;
+ const char *p;
int ctype = 0;
SCM_VALIDATE_STRING (1, path);
SCM_VALIDATE_SYMBOL (2, type);
- p = SCM_SYMBOL_CHARS (type);
+ p = scm_i_symbol_chars (type);
if (strcmp (p, "regular") == 0)
ctype = S_IFREG;
else if (strcmp (p, "directory") == 0)
@@ -1530,7 +1530,7 @@ SCM_DEFINE (scm_getlogin, "getlogin", 0, 0, 0,
p = getlogin ();
if (!p || !*p)
return SCM_BOOL_F;
- return scm_makfrom0str (p);
+ return scm_from_locale_string (p);
}
#undef FUNC_NAME
#endif /* HAVE_GETLOGIN */
@@ -1549,7 +1549,7 @@ SCM_DEFINE (scm_cuserid, "cuserid", 0, 0, 0,
p = cuserid (buf);
if (!p || !*p)
return SCM_BOOL_F;
- return scm_makfrom0str (p);
+ return scm_from_locale_string (p);
}
#undef FUNC_NAME
#endif /* HAVE_CUSERID */
@@ -1839,8 +1839,8 @@ SCM_DEFINE (scm_gethostname, "gethostname", 0, 0, 0,
}
else
{
- /* scm_makfrom0str may throw an exception. */
- const SCM name = scm_makfrom0str (p);
+ /* scm_from_locale_string may throw an exception. */
+ const SCM name = scm_from_locale_string (p);
// No guile exceptions can occur before we have freed p's memory.
scm_frame_end ();
diff --git a/libguile/print.c b/libguile/print.c
index 0b69ebd0e..cfae921bd 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -484,12 +484,15 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_string:
if (SCM_WRITINGP (pstate))
{
- size_t i;
+ size_t i, len;
+ const char *data;
scm_putc ('"', port);
- for (i = 0; i < SCM_I_STRING_LENGTH (exp); ++i)
+ len = scm_i_string_length (exp);
+ data = scm_i_string_chars (exp);
+ for (i = 0; i < len; ++i)
{
- unsigned char ch = SCM_I_STRING_CHARS (exp)[i];
+ unsigned char ch = data[i];
if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
{
static char const hex[]="0123456789abcdef";
@@ -506,25 +509,26 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
}
}
scm_putc ('"', port);
+ scm_remember_upto_here_1 (exp);
}
else
- scm_lfwrite (SCM_I_STRING_CHARS (exp), SCM_I_STRING_LENGTH (exp),
+ scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
port);
scm_remember_upto_here_1 (exp);
break;
case scm_tc7_symbol:
- if (SCM_SYMBOL_INTERNED_P (exp))
+ if (scm_i_symbol_is_interned (exp))
{
- scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
- SCM_SYMBOL_LENGTH (exp),
+ scm_print_symbol_name (scm_i_symbol_chars (exp),
+ scm_i_symbol_length (exp),
port);
scm_remember_upto_here_1 (exp);
}
else
{
scm_puts ("#<uninterned-symbol ", port);
- scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
- SCM_SYMBOL_LENGTH (exp),
+ scm_print_symbol_name (scm_i_symbol_chars (exp),
+ scm_i_symbol_length (exp),
port);
scm_putc (' ', port);
scm_intprint ((long)exp, 16, port);
@@ -592,7 +596,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
? "#<primitive-generic "
: "#<primitive-procedure ",
port);
- scm_puts (SCM_SYMBOL_CHARS (SCM_SNAME (exp)), port);
+ scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
scm_putc ('>', port);
break;
#ifdef CCLO
@@ -607,7 +611,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
if (scm_is_true (name))
{
scm_putc (' ', port);
- scm_puts (SCM_SYMBOL_CHARS (name), port);
+ scm_puts (scm_i_symbol_chars (name), port);
}
}
else
@@ -913,9 +917,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM port, answer = SCM_UNSPECIFIED;
int fReturnString = 0;
int writingp;
- char *start;
- char *end;
- char *p;
+ const char *start;
+ const char *end;
+ const char *p;
if (scm_is_eq (destination, SCM_BOOL_T))
{
@@ -938,8 +942,8 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
SCM_VALIDATE_STRING (2, message);
SCM_VALIDATE_REST_ARGUMENT (args);
- start = SCM_I_STRING_CHARS (message);
- end = start + SCM_I_STRING_LENGTH (message);
+ start = scm_i_string_chars (message);
+ end = start + scm_i_string_length (message);
for (p = start; p != end; ++p)
if (*p == '~')
{
@@ -1102,9 +1106,10 @@ scm_init_print ()
scm_gc_register_root (&print_state_pool);
scm_gc_register_root (&scm_print_state_vtable);
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
- layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
+ layout =
+ scm_make_struct_layout (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT));
type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout));
- scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state"));
+ scm_set_struct_vtable_name_x (type, scm_from_locale_symbol ("print-state"));
scm_print_state_vtable = type;
/* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */
diff --git a/libguile/procs.c b/libguile/procs.c
index a625b6e30..4a233dde6 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -63,7 +63,7 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
entry = scm_subr_table_size;
z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
scm_subr_table[entry].handle = z;
- scm_subr_table[entry].name = scm_str2symbol (name);
+ scm_subr_table[entry].name = scm_from_locale_symbol (name);
scm_subr_table[entry].generic = 0;
scm_subr_table[entry].properties = SCM_EOL;
scm_subr_table_size++;
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 49ec40f11..fc88a824e 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -468,8 +468,12 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
break;
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (fill), badarg2);
- for (i = base; n--; i += inc)
- SCM_I_STRING_CHARS (ra)[i] = SCM_CHAR (fill);
+ {
+ char *data = scm_i_string_writable_chars (ra);
+ for (i = base; n--; i += inc)
+ data[i] = SCM_CHAR (fill);
+ scm_i_string_stop_writing ();
+ }
break;
case scm_tc7_byvect:
if (SCM_CHARP (fill))
@@ -630,8 +634,13 @@ racp (SCM src, SCM dst)
case scm_tc7_string:
if (SCM_TYP7 (src) != scm_tc7_string)
goto gencase;
- for (; n-- > 0; i_s += inc_s, i_d += inc_d)
- SCM_I_STRING_CHARS (dst)[i_d] = SCM_I_STRING_CHARS (src)[i_s];
+ {
+ char *dst_data = scm_i_string_writable_chars (dst);
+ const char *src_data = scm_i_string_chars (src);
+ for (; n-- > 0; i_s += inc_s, i_d += inc_d)
+ dst_data[i_d] = src_data[i_s];
+ scm_i_string_stop_writing ();
+ }
break;
case scm_tc7_byvect:
if (SCM_TYP7 (src) != scm_tc7_byvect)
@@ -1791,8 +1800,8 @@ raeql_1 (SCM ra0, SCM as_equal, SCM ra1)
return 1;
case scm_tc7_string:
{
- char *v0 = SCM_I_STRING_CHARS (ra0) + i0;
- char *v1 = SCM_I_STRING_CHARS (ra1) + i1;
+ const char *v0 = scm_i_string_chars (ra0) + i0;
+ const char *v1 = scm_i_string_chars (ra1) + i1;
for (; n--; v0 += inc0, v1 += inc1)
if (*v0 != *v1)
return 0;
@@ -2015,7 +2024,7 @@ init_raprocs (ra_iproc *subra)
{
for (; subra->name; subra++)
{
- SCM sym = scm_str2symbol (subra->name);
+ SCM sym = scm_from_locale_symbol (subra->name);
SCM var =
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
if (var != SCM_BOOL_F)
diff --git a/libguile/random.c b/libguile/random.c
index bb8d48355..6efde1be5 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -119,7 +119,7 @@ scm_i_uniform32 (scm_t_i_rstate *state)
#endif
void
-scm_i_init_rstate (scm_t_i_rstate *state, char *seed, int n)
+scm_i_init_rstate (scm_t_i_rstate *state, const char *seed, int n)
{
scm_t_int32 w = 0L;
scm_t_int32 c = 0L;
@@ -153,7 +153,7 @@ scm_i_copy_rstate (scm_t_i_rstate *state)
*/
scm_t_rstate *
-scm_c_make_rstate (char *seed, int n)
+scm_c_make_rstate (const char *seed, int n)
{
scm_t_rstate *state = scm_malloc (scm_the_rng.rstate_size);
if (state == 0)
@@ -328,7 +328,7 @@ rstate_free (SCM rstate)
* Scheme level interface.
*/
-SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_random_state (scm_makfrom0str ("URL:http://stat.fsu.edu/~geo/diehard.html")));
+SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*", scm_seed_to_random_state (scm_from_locale_string ("URL:http://stat.fsu.edu/~geo/diehard.html")));
SCM_DEFINE (scm_random, "random", 1, 1, 0,
(SCM n, SCM state),
@@ -387,8 +387,8 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0,
if (SCM_NUMBERP (seed))
seed = scm_number_to_string (seed, SCM_UNDEFINED);
SCM_VALIDATE_STRING (1, seed);
- res = make_rstate (scm_c_make_rstate (SCM_I_STRING_CHARS (seed),
- SCM_I_STRING_LENGTH (seed)));
+ res = make_rstate (scm_c_make_rstate (scm_i_string_chars (seed),
+ scm_i_string_length (seed)));
scm_remember_upto_here_1 (seed);
return res;
diff --git a/libguile/random.h b/libguile/random.h
index 8620c3738..ff0b08c6f 100644
--- a/libguile/random.h
+++ b/libguile/random.h
@@ -46,7 +46,7 @@ typedef struct scm_t_rstate {
typedef struct scm_t_rng {
size_t rstate_size; /* size of random state */
unsigned long (*random_bits) (scm_t_rstate *state); /* gives 32 random bits */
- void (*init_rstate) (scm_t_rstate *state, char *seed, int n);
+ void (*init_rstate) (scm_t_rstate *state, const char *seed, int n);
scm_t_rstate *(*copy_rstate) (scm_t_rstate *state);
} scm_t_rng;
@@ -63,14 +63,14 @@ typedef struct scm_t_i_rstate {
} scm_t_i_rstate;
SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *);
-SCM_API void scm_i_init_rstate (scm_t_i_rstate *, char *seed, int n);
+SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n);
SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *);
/*
* Random number library functions
*/
-SCM_API scm_t_rstate *scm_c_make_rstate (char *, int);
+SCM_API scm_t_rstate *scm_c_make_rstate (const char *, int);
SCM_API scm_t_rstate *scm_c_default_rstate (void);
#define scm_c_uniform32(RSTATE) scm_the_rng.random_bits (RSTATE)
SCM_API double scm_c_uniform01 (scm_t_rstate *);
diff --git a/libguile/rdelim.c b/libguile/rdelim.c
index 3967a1d72..98e88779e 100644
--- a/libguile/rdelim.c
+++ b/libguile/rdelim.c
@@ -56,20 +56,18 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
#define FUNC_NAME s_scm_read_delimited_x
{
size_t j;
- char *buf;
size_t cstart;
size_t cend;
int c;
- char *cdelims;
+ const char *cdelims;
size_t num_delims;
SCM_VALIDATE_STRING (1, delims);
- cdelims = SCM_I_STRING_CHARS (delims);
- num_delims = SCM_I_STRING_LENGTH (delims);
+ cdelims = scm_i_string_chars (delims);
+ num_delims = scm_i_string_length (delims);
SCM_VALIDATE_STRING (2, str);
- buf = SCM_I_STRING_CHARS (str);
- scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+ scm_i_get_substring_spec (scm_i_string_length (str),
start, &cstart, end, &cend);
if (SCM_UNBNDP (port))
@@ -97,7 +95,7 @@ SCM_DEFINE (scm_read_delimited_x, "%read-delimited!", 3, 3, 0,
return scm_cons (SCM_EOF_VAL,
scm_from_size_t (j - cstart));
- buf[j] = c;
+ scm_c_string_set_x (str, j, SCM_MAKE_CHAR (c));
}
return scm_cons (SCM_BOOL_F, scm_from_size_t (j - cstart));
}
@@ -227,14 +225,14 @@ SCM_DEFINE (scm_read_line, "%read-line", 0, 1, 0,
{
term = SCM_MAKE_CHAR ('\n');
s[slen-1] = '\0';
- line = scm_take_str (s, slen-1);
+ line = scm_take_locale_stringn (s, slen-1);
SCM_INCLINE (port);
}
else
{
/* Fix: we should check for eof on the port before assuming this. */
term = SCM_EOF_VAL;
- line = scm_take_str (s, slen);
+ line = scm_take_locale_stringn (s, slen);
SCM_COL (port) += slen;
}
}
diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
index a79fde6c6..9587dfa0e 100644
--- a/libguile/regex-posix.c
+++ b/libguile/regex-posix.c
@@ -82,32 +82,21 @@ regex_free (SCM obj)
SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
-static char *
+static SCM
scm_regexp_error_msg (int regerrno, regex_t *rx)
{
- SCM errmsg;
+ char *errmsg;
int l;
- /* FIXME: must we wrap any external calls in SCM_DEFER_INTS...SCM_ALLOW_INTS?
- Or are these only necessary when a SCM object may be left in an
- undetermined state (half-formed)? If the latter then I believe we
- may do without the critical section code. -twp */
-
- /* We could simply make errmsg a char pointer, and allocate space with
- malloc. But since we are about to pass the pointer to scm_error, which
- never returns, we would never have the opportunity to free it. Creating
- it as a SCM object means that the system will GC it at some point. */
-
- errmsg = scm_make_string (scm_from_int (80), SCM_UNDEFINED);
- SCM_DEFER_INTS;
- l = regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), 80);
+ errmsg = scm_malloc (80);
+ l = regerror (regerrno, rx, errmsg, 80);
if (l > 80)
{
- errmsg = scm_make_string (scm_from_int (l), SCM_UNDEFINED);
- regerror (regerrno, rx, SCM_I_STRING_CHARS (errmsg), l);
+ free (errmsg);
+ errmsg = scm_malloc (l);
+ regerror (regerrno, rx, errmsg, l);
}
- SCM_ALLOW_INTS;
- return SCM_I_STRING_CHARS (errmsg);
+ return scm_take_locale_string (errmsg);
}
SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
@@ -164,6 +153,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
SCM flag;
regex_t *rx;
int status, cflags;
+ char *c_pat;
SCM_VALIDATE_STRING (1, pat);
SCM_VALIDATE_REST_ARGUMENT (flags);
@@ -182,19 +172,21 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
}
rx = scm_gc_malloc (sizeof(regex_t), "regex");
- status = regcomp (rx, SCM_I_STRING_CHARS (pat),
+ c_pat = scm_to_locale_string (pat);
+ status = regcomp (rx, c_pat,
/* Make sure they're not passing REG_NOSUB;
regexp-exec assumes we're getting match data. */
cflags & ~REG_NOSUB);
+ free (c_pat);
if (status != 0)
{
- char *errmsg = scm_regexp_error_msg (status, rx);
+ SCM errmsg = scm_regexp_error_msg (status, rx);
scm_gc_free (rx, sizeof(regex_t), "regex");
- scm_error (scm_regexp_error_key,
- FUNC_NAME,
- errmsg,
- SCM_BOOL_F,
- SCM_BOOL_F);
+ scm_error_scm (scm_regexp_error_key,
+ scm_from_locale_string (FUNC_NAME),
+ errmsg,
+ SCM_BOOL_F,
+ SCM_BOOL_F);
/* never returns */
}
SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
@@ -234,7 +226,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
if (SCM_UNBNDP (start))
offset = 0;
else
- offset = scm_to_signed_integer (start, 0, SCM_I_STRING_LENGTH (str));
+ offset = scm_to_signed_integer (start, 0, scm_i_string_length (str));
if (SCM_UNBNDP (flags))
flags = SCM_INUM0;
@@ -245,7 +237,7 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
nmatches = SCM_RGX(rx)->re_nsub + 1;
SCM_DEFER_INTS;
matches = scm_malloc (sizeof (regmatch_t) * nmatches);
- status = regexec (SCM_RGX (rx), SCM_I_STRING_CHARS (str) + offset,
+ status = regexec (SCM_RGX (rx), scm_i_string_chars (str) + offset,
nmatches, matches,
scm_to_int (flags));
if (!status)
@@ -268,11 +260,11 @@ SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
SCM_ALLOW_INTS;
if (status != 0 && status != REG_NOMATCH)
- scm_error (scm_regexp_error_key,
- FUNC_NAME,
- scm_regexp_error_msg (status, SCM_RGX (rx)),
- SCM_BOOL_F,
- SCM_BOOL_F);
+ scm_error_scm (scm_regexp_error_key,
+ scm_from_locale_string (FUNC_NAME),
+ scm_regexp_error_msg (status, SCM_RGX (rx)),
+ SCM_BOOL_F,
+ SCM_BOOL_F);
return mvec;
}
#undef FUNC_NAME
diff --git a/libguile/rw.c b/libguile/rw.c
index 23b562d8f..06b683fd8 100644
--- a/libguile/rw.c
+++ b/libguile/rw.c
@@ -111,8 +111,7 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
size_t last;
SCM_VALIDATE_STRING (1, str);
- dest = SCM_I_STRING_CHARS (str);
- scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+ scm_i_get_substring_spec (scm_i_string_length (str),
start, &offset, end, &last);
dest += offset;
read_len = last - offset;
@@ -131,14 +130,18 @@ SCM_DEFINE (scm_read_string_x_partial, "read-string!/partial", 1, 3, 0,
don't touch the file descriptor. otherwise the
"return immediately if something is available" rule may
be violated. */
+ dest = scm_i_string_writable_chars (str);
chars_read = scm_take_from_input_buffers (port, dest, read_len);
+ scm_i_string_stop_writing ();
fdes = SCM_FPORT_FDES (port);
}
if (chars_read == 0 && read_len > 0) /* don't confuse read_len == 0 with
EOF. */
{
+ dest = scm_i_string_writable_chars (str);
SCM_SYSCALL (chars_read = read (fdes, dest, read_len));
+ scm_i_string_stop_writing ();
if (chars_read == -1)
{
if (SCM_EBLOCK (errno))
@@ -202,7 +205,7 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
"@end itemize")
#define FUNC_NAME s_scm_write_string_partial
{
- char *src;
+ const char *src;
long write_len;
int fdes;
@@ -211,8 +214,8 @@ SCM_DEFINE (scm_write_string_partial, "write-string/partial", 1, 3, 0,
size_t last;
SCM_VALIDATE_STRING (1, str);
- src = SCM_I_STRING_CHARS (str);
- scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+ src = scm_i_string_chars (str);
+ scm_i_get_substring_spec (scm_i_string_length (str),
start, &offset, end, &last);
src += offset;
write_len = last - offset;
diff --git a/libguile/script.c b/libguile/script.c
index a8a84185f..5b62d65ce 100644
--- a/libguile/script.c
+++ b/libguile/script.c
@@ -451,13 +451,13 @@ scm_compile_shell_switches (int argc, char **argv)
(i.e., the #f) with the script name. */
if (!SCM_NULLP (do_script))
{
- SCM_SETCAR (do_script, scm_makfrom0str (argv[i]));
+ SCM_SETCAR (do_script, scm_from_locale_string (argv[i]));
do_script = SCM_EOL;
}
else
/* Construct an application of LOAD to the script name. */
tail = scm_cons (scm_cons2 (sym_load,
- scm_makfrom0str (argv[i]),
+ scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
argv0 = argv[i];
@@ -471,7 +471,7 @@ scm_compile_shell_switches (int argc, char **argv)
if (++i >= argc)
scm_shell_usage (1, "missing argument to `-c' switch");
tail = scm_cons (scm_cons2 (sym_eval_string,
- scm_makfrom0str (argv[i]),
+ scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
i++;
@@ -489,7 +489,7 @@ scm_compile_shell_switches (int argc, char **argv)
{
if (++i < argc)
tail = scm_cons (scm_cons2 (sym_load,
- scm_makfrom0str (argv[i]),
+ scm_from_locale_string (argv[i]),
SCM_EOL),
tail);
else
diff --git a/libguile/snarf.h b/libguile/snarf.h
index b9cbb056c..4ec1c3342 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -3,7 +3,7 @@
#ifndef SCM_SNARF_H
#define SCM_SNARF_H
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -175,11 +175,11 @@ SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
#define SCM_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
SCM_SNARF_HERE(SCM c_name) \
-SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
#define SCM_KEYWORD(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
diff --git a/libguile/socket.c b/libguile/socket.c
index 374c162c7..a092962b1 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -163,7 +163,7 @@ SCM_DEFINE (scm_inet_ntoa, "inet-ntoa", 1, 0, 0,
SCM answer;
addr.s_addr = htonl (SCM_NUM2ULONG (1, inetid));
s = inet_ntoa (addr);
- answer = scm_mem2string (s, strlen (s));
+ answer = scm_from_locale_string (s);
return answer;
}
#undef FUNC_NAME
@@ -453,7 +453,7 @@ SCM_DEFINE (scm_inet_ntop, "inet-ntop", 2, 0, 0,
scm_to_ipv6 (addr6, address);
if (inet_ntop (af, &addr6, dst, sizeof dst) == NULL)
SCM_SYSERROR;
- return scm_makfrom0str (dst);
+ return scm_from_locale_string (dst);
}
#undef FUNC_NAME
#endif
@@ -1000,8 +1000,7 @@ scm_addr_vector (const struct sockaddr *address, int addr_size,
if (addr_size <= offsetof (struct sockaddr_un, sun_path))
SCM_VECTOR_SET(result, 1, SCM_BOOL_F);
else
- SCM_VECTOR_SET(result, 1, scm_mem2string (nad->sun_path,
- strlen (nad->sun_path)));
+ SCM_VECTOR_SET(result, 1, scm_from_locale_string (nad->sun_path));
}
break;
#endif
@@ -1134,6 +1133,8 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
int rv;
int fd;
int flg;
+ char *dest;
+ size_t len;
SCM_VALIDATE_OPFPORT (1, sock);
SCM_VALIDATE_STRING (2, buf);
@@ -1143,9 +1144,11 @@ SCM_DEFINE (scm_recv, "recv!", 2, 1, 0,
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
- SCM_SYSCALL (rv = recv (fd,
- SCM_I_STRING_CHARS (buf), SCM_I_STRING_LENGTH (buf),
- flg));
+ len = scm_i_string_length (buf);
+ dest = scm_i_string_writable_chars (buf);
+ SCM_SYSCALL (rv = recv (fd, dest, len, flg));
+ scm_i_string_stop_writing ();
+
if (rv == -1)
SCM_SYSERROR;
@@ -1173,6 +1176,8 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
int rv;
int fd;
int flg;
+ const char *src;
+ size_t len;
sock = SCM_COERCE_OUTPORT (sock);
SCM_VALIDATE_OPFPORT (1, sock);
@@ -1183,10 +1188,11 @@ SCM_DEFINE (scm_send, "send", 2, 1, 0,
flg = scm_to_int (flags);
fd = SCM_FPORT_FDES (sock);
- SCM_SYSCALL (rv = send (fd,
- SCM_I_STRING_CHARS (message),
- SCM_I_STRING_LENGTH (message),
- flg));
+ len = scm_i_string_length (message);
+ src = scm_i_string_writable_chars (message);
+ SCM_SYSCALL (rv = send (fd, src, len, flg));
+ scm_i_string_stop_writing ();
+
if (rv == -1)
SCM_SYSERROR;
@@ -1233,8 +1239,7 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
fd = SCM_FPORT_FDES (sock);
SCM_VALIDATE_STRING (2, str);
- buf = SCM_I_STRING_CHARS (str);
- scm_i_get_substring_spec (SCM_I_STRING_LENGTH (str),
+ scm_i_get_substring_spec (scm_i_string_length (str),
start, &offset, end, &cend);
if (SCM_UNBNDP (flags))
@@ -1244,10 +1249,13 @@ SCM_DEFINE (scm_recvfrom, "recvfrom!", 2, 3, 0,
/* recvfrom will not necessarily return an address. usually nothing
is returned for stream sockets. */
+ buf = scm_i_string_writable_chars (str);
addr->sa_family = AF_UNSPEC;
SCM_SYSCALL (rv = recvfrom (fd, buf + offset,
cend - offset, flg,
addr, &addr_size));
+ scm_i_string_stop_writing ();
+
if (rv == -1)
SCM_SYSERROR;
if (addr->sa_family != AF_UNSPEC)
@@ -1301,8 +1309,8 @@ SCM_DEFINE (scm_sendto, "sendto", 4, 0, 1,
flg = SCM_NUM2ULONG (5, SCM_CAR (args_and_flags));
}
SCM_SYSCALL (rv = sendto (fd,
- SCM_I_STRING_CHARS (message),
- SCM_I_STRING_LENGTH (message),
+ scm_i_string_chars (message),
+ scm_i_string_length (message),
flg, soka, size));
if (rv == -1)
{
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 387fc57fd..c6c316fad 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -744,13 +744,14 @@ scm_init_stacks ()
{
SCM vtable;
SCM stack_layout
- = scm_make_struct_layout (scm_makfrom0str (SCM_STACK_LAYOUT));
+ = scm_make_struct_layout (scm_from_locale_string (SCM_STACK_LAYOUT));
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_stack_type
= scm_permanent_object (scm_make_struct (vtable, SCM_INUM0,
scm_cons (stack_layout,
SCM_EOL)));
- scm_set_struct_vtable_name_x (scm_stack_type, scm_str2symbol ("stack"));
+ scm_set_struct_vtable_name_x (scm_stack_type,
+ scm_from_locale_symbol ("stack"));
#include "libguile/stacks.x"
}
diff --git a/libguile/stime.c b/libguile/stime.c
index f08ae28b5..b850dc2b1 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -32,6 +32,7 @@
#include "libguile/feature.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
+#include "libguile/dynwind.h"
#include "libguile/validate.h"
#include "libguile/stime.h"
@@ -274,7 +275,9 @@ filltime (struct tm *bd_time, int zoff, const char *zname)
SCM_VECTOR_SET (result,7, scm_from_int (bd_time->tm_yday));
SCM_VECTOR_SET (result,8, scm_from_int (bd_time->tm_isdst));
SCM_VECTOR_SET (result,9, scm_from_int (zoff));
- SCM_VECTOR_SET (result,10, zname ? scm_makfrom0str (zname) : SCM_BOOL_F);
+ SCM_VECTOR_SET (result,10, (zname
+ ? scm_from_locale_string (zname)
+ : SCM_BOOL_F));
return result;
}
@@ -480,7 +483,7 @@ bdtime2c (SCM sbd_time, struct tm *lt, int pos, const char *subr)
if (scm_is_false (velts[10]))
lt->tm_zone = NULL;
else
- lt->tm_zone = SCM_STRING_CHARS (velts[10]);
+ lt->tm_zone = scm_to_locale_string (velts[10]);
#endif
}
@@ -503,7 +506,10 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
char **oldenv;
int err;
+ scm_frame_begin (0);
+
bdtime2c (sbd_time, &lt, SCM_ARG1, FUNC_NAME);
+ scm_frame_free ((char *)lt.tm_zone);
SCM_DEFER_INTS;
oldenv = setzone (zone, SCM_ARG2, FUNC_NAME);
@@ -560,6 +566,8 @@ SCM_DEFINE (scm_mktime, "mktime", 1, 1, 0,
SCM_ALLOW_INTS;
if (zname)
free (zname);
+
+ scm_frame_end ();
return result;
}
#undef FUNC_NAME
@@ -594,15 +602,16 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
char *tbuf;
int size = 50;
- char *fmt, *myfmt;
+ const char *fmt;
+ char *myfmt;
int len;
SCM result;
SCM_VALIDATE_STRING (1, format);
bdtime2c (stime, &t, SCM_ARG2, FUNC_NAME);
- fmt = SCM_STRING_CHARS (format);
- len = SCM_STRING_LENGTH (format);
+ fmt = scm_i_string_chars (format);
+ len = scm_i_string_length (format);
/* Ugly hack: strftime can return 0 if its buffer is too small,
but some valid time strings (e.g. "%p") can sometimes produce
@@ -665,7 +674,7 @@ SCM_DEFINE (scm_strftime, "strftime", 2, 0, 0,
#endif
}
- result = scm_mem2string (tbuf + 1, len - 1);
+ result = scm_from_locale_stringn (tbuf + 1, len - 1);
free (tbuf);
free (myfmt);
return result;
@@ -688,13 +697,13 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
#define FUNC_NAME s_scm_strptime
{
struct tm t;
- char *fmt, *str, *rest;
+ const char *fmt, *str, *rest;
SCM_VALIDATE_STRING (1, format);
SCM_VALIDATE_STRING (2, string);
- fmt = SCM_STRING_CHARS (format);
- str = SCM_STRING_CHARS (string);
+ fmt = scm_i_string_chars (format);
+ str = scm_i_string_chars (string);
/* initialize the struct tm */
#define tm_init(field) t.field = 0
diff --git a/libguile/strop.c b/libguile/strop.c
index 1d7483d97..b4a7063cf 100644
--- a/libguile/strop.c
+++ b/libguile/strop.c
@@ -57,24 +57,24 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
long upper;
int ch;
- SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, why);
+ SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, why);
SCM_ASSERT (SCM_CHARP (chr), chr, SCM_ARG2, why);
if (scm_is_false (sub_start))
lower = 0;
else
- lower = scm_to_signed_integer (sub_start, 0, SCM_I_STRING_LENGTH(str));
+ lower = scm_to_signed_integer (sub_start, 0, scm_i_string_length(str));
if (scm_is_false (sub_end))
- upper = SCM_I_STRING_LENGTH (str);
+ upper = scm_i_string_length (str);
else
- upper = scm_to_signed_integer (sub_end, lower, SCM_I_STRING_LENGTH(str));
+ upper = scm_to_signed_integer (sub_end, lower, scm_i_string_length(str));
x = -1;
if (direction > 0)
{
- p = SCM_I_STRING_UCHARS (str) + lower;
+ p = (unsigned char *) scm_i_string_chars (str) + lower;
ch = SCM_CHAR (chr);
for (x = lower; x < upper; ++x, ++p)
@@ -83,7 +83,7 @@ scm_i_index (SCM str, SCM chr, int direction, SCM sub_start,
}
else
{
- p = upper - 1 + SCM_I_STRING_UCHARS (str);
+ p = upper - 1 + (unsigned char *)scm_i_string_chars (str);
ch = SCM_CHAR (chr);
for (x = upper - 1; x >= lower; --x, --p)
if (*p == ch)
@@ -164,17 +164,20 @@ SCM_DEFINE (scm_substring_move_x, "substring-move!", 5, 0, 0,
#define FUNC_NAME s_scm_substring_move_x
{
unsigned long s1, s2, e, len;
+ const char *src;
+ char *dst;
SCM_VALIDATE_STRING (1, str1);
SCM_VALIDATE_STRING (4, str2);
- s1 = scm_to_unsigned_integer (start1, 0, SCM_I_STRING_LENGTH(str1));
- e = scm_to_unsigned_integer (end1, s1, SCM_I_STRING_LENGTH(str1));
+ s1 = scm_to_unsigned_integer (start1, 0, scm_i_string_length(str1));
+ e = scm_to_unsigned_integer (end1, s1, scm_i_string_length(str1));
len = e - s1;
- s2 = scm_to_unsigned_integer (start2, 0, SCM_I_STRING_LENGTH(str2)-len);
+ s2 = scm_to_unsigned_integer (start2, 0, scm_i_string_length(str2)-len);
- SCM_SYSCALL(memmove((void *)(&(SCM_I_STRING_CHARS(str2)[s2])),
- (void *)(&(SCM_I_STRING_CHARS(str1)[s1])),
- len));
+ src = scm_i_string_chars (str2);
+ dst = scm_i_string_writable_chars (str1);
+ SCM_SYSCALL (memmove (dst+s2, src+s1, len));
+ scm_i_string_stop_writing ();
scm_remember_upto_here_2 (str1, str2);
return SCM_UNSPECIFIED;
@@ -197,12 +200,17 @@ SCM_DEFINE (scm_substring_fill_x, "substring-fill!", 4, 0, 0,
{
size_t i, e;
char c;
+ char *dst;
+
SCM_VALIDATE_STRING (1, str);
- i = scm_to_unsigned_integer (start, 0, SCM_I_STRING_LENGTH (str));
- e = scm_to_unsigned_integer (end, i, SCM_I_STRING_LENGTH (str));
+ i = scm_to_unsigned_integer (start, 0, scm_i_string_length (str));
+ e = scm_to_unsigned_integer (end, i, scm_i_string_length (str));
SCM_VALIDATE_CHAR_COPY (4, fill, c);
+ dst = scm_i_string_writable_chars (str);
while (i<e)
- SCM_I_STRING_CHARS (str)[i++] = c;
+ dst[i++] = c;
+ scm_i_string_stop_writing ();
+ scm_remember_upto_here (str);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -220,7 +228,7 @@ SCM_DEFINE (scm_string_null_p, "string-null?", 1, 0, 0,
#define FUNC_NAME s_scm_string_null_p
{
SCM_VALIDATE_STRING (1, str);
- return scm_from_bool (SCM_I_STRING_LENGTH (str) == 0);
+ return scm_from_bool (scm_i_string_length (str) == 0);
}
#undef FUNC_NAME
@@ -235,10 +243,10 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
{
long i;
SCM res = SCM_EOL;
- unsigned char *src;
+ const unsigned char *src;
SCM_VALIDATE_STRING (1, str);
- src = SCM_I_STRING_UCHARS (str);
- for (i = SCM_I_STRING_LENGTH (str)-1;i >= 0;i--)
+ src = scm_i_string_chars (str);
+ for (i = scm_i_string_length (str)-1;i >= 0;i--)
res = scm_cons (SCM_MAKE_CHAR (src[i]), res);
scm_remember_upto_here_1 (src);
return res;
@@ -251,10 +259,11 @@ SCM_DEFINE (scm_string_to_list, "string->list", 1, 0, 0,
static SCM
string_copy (SCM str)
{
- const char* chars = SCM_I_STRING_CHARS (str);
- size_t length = SCM_I_STRING_LENGTH (str);
- SCM new_string = scm_allocate_string (length);
- memcpy (SCM_I_STRING_CHARS (new_string), chars, length+1);
+ const char* chars = scm_i_string_chars (str);
+ size_t length = scm_i_string_length (str);
+ char *dst;
+ SCM new_string = scm_i_make_string (length, &dst);
+ memcpy (dst, chars, length);
scm_remember_upto_here_1 (str);
return new_string;
}
@@ -282,9 +291,10 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
long k;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR_COPY (2, chr, c);
- dst = SCM_I_STRING_CHARS (str);
- for (k = SCM_I_STRING_LENGTH (str)-1;k >= 0;k--)
+ dst = scm_i_string_writable_chars (str);
+ for (k = scm_i_string_length (str)-1;k >= 0;k--)
dst[k] = c;
+ scm_i_string_stop_writing ();
scm_remember_upto_here_1 (str);
return SCM_UNSPECIFIED;
}
@@ -296,11 +306,14 @@ SCM_DEFINE (scm_string_fill_x, "string-fill!", 2, 0, 0,
static SCM
string_upcase_x (SCM v)
{
- unsigned long k;
-
- for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k)
- SCM_I_STRING_UCHARS (v) [k] = scm_c_upcase (SCM_I_STRING_UCHARS (v) [k]);
-
+ size_t k, len;
+ char *dst;
+
+ len = scm_i_string_length (v);
+ dst = scm_i_string_writable_chars (v);
+ for (k = 0; k < len; ++k)
+ dst[k] = scm_c_upcase (dst[k]);
+ scm_i_string_stop_writing ();
return v;
}
@@ -341,10 +354,14 @@ SCM_DEFINE (scm_string_upcase, "string-upcase", 1, 0, 0,
static SCM
string_downcase_x (SCM v)
{
- unsigned long k;
+ size_t k, len;
+ char *dst;
- for (k = 0; k < SCM_I_STRING_LENGTH (v); ++k)
- SCM_I_STRING_UCHARS (v) [k] = scm_c_downcase (SCM_I_STRING_UCHARS (v) [k]);
+ len = scm_i_string_length (v);
+ dst = scm_i_string_writable_chars (v);
+ for (k = 0; k < len; ++k)
+ dst[k] = scm_c_downcase (dst[k]);
+ scm_i_string_stop_writing ();
return v;
}
@@ -387,22 +404,29 @@ static SCM
string_capitalize_x (SCM str)
{
unsigned char *sz;
- long i, len;
+ size_t i, len;
int in_word=0;
- len = SCM_I_STRING_LENGTH(str);
- sz = SCM_I_STRING_UCHARS (str);
- for(i=0; i<len; i++) {
- if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i])))) {
- if(!in_word) {
- sz[i] = scm_c_upcase(sz[i]);
- in_word = 1;
- } else {
- sz[i] = scm_c_downcase(sz[i]);
- }
+ len = scm_i_string_length (str);
+ sz = scm_i_string_writable_chars (str);
+ for (i = 0; i < len; i++)
+ {
+ if (scm_is_true (scm_char_alphabetic_p (SCM_MAKE_CHAR (sz[i]))))
+ {
+ if (!in_word)
+ {
+ sz[i] = scm_c_upcase (sz[i]);
+ in_word = 1;
+ }
+ else
+ {
+ sz[i] = scm_c_downcase (sz[i]);
+ }
+ }
+ else
+ in_word = 0;
}
- else in_word = 0;
- }
+ scm_i_string_stop_writing ();
return str;
}
@@ -463,15 +487,15 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
#define FUNC_NAME s_scm_string_split
{
long idx, last_idx;
- char * p;
+ const char * p;
int ch;
SCM res = SCM_EOL;
SCM_VALIDATE_STRING (1, str);
SCM_VALIDATE_CHAR (2, chr);
- idx = SCM_I_STRING_LENGTH (str);
- p = SCM_I_STRING_CHARS (str);
+ idx = scm_i_string_length (str);
+ p = scm_i_string_chars (str);
ch = SCM_CHAR (chr);
while (idx >= 0)
{
@@ -480,7 +504,8 @@ SCM_DEFINE (scm_string_split, "string-split", 2, 0, 0,
idx--;
if (idx >= 0)
{
- res = scm_cons (scm_mem2string (p + idx, last_idx - idx), res);
+ res = scm_cons (scm_c_substring (str, idx, last_idx), res);
+ p = scm_i_string_chars (str);
idx--;
}
}
diff --git a/libguile/strorder.c b/libguile/strorder.c
index 6e8b647d3..3601c90bc 100644
--- a/libguile/strorder.c
+++ b/libguile/strorder.c
@@ -43,11 +43,11 @@ SCM_DEFINE1 (scm_string_equal_p, "string=?", scm_tc7_rpsubr,
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
- length = SCM_I_STRING_LENGTH (s2);
- if (SCM_I_STRING_LENGTH (s1) == length)
+ length = scm_i_string_length (s2);
+ if (scm_i_string_length (s1) == length)
{
- unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
- unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
+ const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
+ const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i;
/* comparing from back to front typically finds mismatches faster */
@@ -82,11 +82,11 @@ SCM_DEFINE1 (scm_string_ci_equal_p, "string-ci=?", scm_tc7_rpsubr,
SCM_VALIDATE_STRING (1, s1);
SCM_VALIDATE_STRING (2, s2);
- length = SCM_I_STRING_LENGTH (s2);
- if (SCM_I_STRING_LENGTH (s1) == length)
+ length = scm_i_string_length (s2);
+ if (scm_i_string_length (s1) == length)
{
- unsigned char *c1 = SCM_I_STRING_UCHARS (s1) + length - 1;
- unsigned char *c2 = SCM_I_STRING_UCHARS (s2) + length - 1;
+ const unsigned char *c1 = scm_i_string_chars (s1) + length - 1;
+ const unsigned char *c2 = scm_i_string_chars (s2) + length - 1;
size_t i;
/* comparing from back to front typically finds mismatches faster */
@@ -114,13 +114,13 @@ static SCM
string_less_p (SCM s1, SCM s2)
{
size_t i, length1, length2, lengthm;
- unsigned char *c1, *c2;
+ const unsigned char *c1, *c2;
- length1 = SCM_I_STRING_LENGTH (s1);
- length2 = SCM_I_STRING_LENGTH (s2);
+ length1 = scm_i_string_length (s1);
+ length2 = scm_i_string_length (s2);
lengthm = min (length1, length2);
- c1 = SCM_I_STRING_UCHARS (s1);
- c2 = SCM_I_STRING_UCHARS (s2);
+ c1 = scm_i_string_chars (s1);
+ c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = *c1 - *c2;
@@ -196,13 +196,13 @@ static SCM
string_ci_less_p (SCM s1, SCM s2)
{
size_t i, length1, length2, lengthm;
- unsigned char *c1, *c2;
+ const unsigned char *c1, *c2;
- length1 = SCM_I_STRING_LENGTH (s1);
- length2 = SCM_I_STRING_LENGTH (s2);
+ length1 = scm_i_string_length (s1);
+ length2 = scm_i_string_length (s2);
lengthm = min (length1, length2);
- c1 = SCM_I_STRING_UCHARS (s1);
- c2 = SCM_I_STRING_UCHARS (s2);
+ c1 = scm_i_string_chars (s1);
+ c2 = scm_i_string_chars (s2);
for (i = 0; i != lengthm; ++i, ++c1, ++c2) {
int c = scm_c_upcase (*c1) - scm_c_upcase (*c2);
diff --git a/libguile/strports.c b/libguile/strports.c
index aa9844bc7..f7b4013b8 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -52,6 +52,14 @@
*/
/* NOTES:
+
+ We break the rules set forth by strings.h about accessing the
+ internals of strings here. We can do this since we can guarantee
+ that the string used as pt->stream is not in use by anyone else.
+ Thus, it's representation will not change asynchronously.
+
+ (Ports aren't thread-safe yet anyway...)
+
write_buf/write_end point to the ends of the allocated string.
read_buf/read_end in principle point to the part of the string which
has been written to, but this is only updated after a flush.
@@ -79,8 +87,10 @@ static void
st_resize_port (scm_t_port *pt, off_t new_size)
{
SCM old_stream = SCM_PACK (pt->stream);
- SCM new_stream = scm_allocate_string (new_size);
- unsigned long int old_size = SCM_I_STRING_LENGTH (old_stream);
+ const char *src = scm_i_string_chars (old_stream);
+ char *dst;
+ SCM new_stream = scm_i_make_string (new_size, &dst);
+ unsigned long int old_size = scm_i_string_length (old_stream);
unsigned long int min_size = min (old_size, new_size);
unsigned long int i;
@@ -89,14 +99,14 @@ st_resize_port (scm_t_port *pt, off_t new_size)
pt->write_buf_size = new_size;
for (i = 0; i != min_size; ++i)
- SCM_I_STRING_CHARS (new_stream) [i] = SCM_I_STRING_CHARS (old_stream) [i];
+ dst[i] = src[i];
scm_remember_upto_here_1 (old_stream);
/* reset buffer. */
{
pt->stream = SCM_UNPACK (new_stream);
- pt->read_buf = pt->write_buf = SCM_I_STRING_UCHARS (new_stream);
+ pt->read_buf = pt->write_buf = dst;
pt->read_pos = pt->write_pos = pt->write_buf + index;
pt->write_end = pt->write_buf + pt->write_buf_size;
pt->read_end = pt->read_buf + pt->read_buf_size;
@@ -254,19 +264,37 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
scm_t_port *pt;
size_t str_len, c_pos;
- SCM_ASSERT (SCM_I_STRINGP (str), str, SCM_ARG1, caller);
- str_len = SCM_I_STRING_LENGTH (str);
+ SCM_ASSERT (scm_is_string (str), str, SCM_ARG1, caller);
+
+ str_len = scm_i_string_length (str);
c_pos = scm_to_unsigned_integer (pos, 0, str_len);
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
+ /* XXX
+
+ Make a new string to isolate us from changes to the original.
+ This is done so that we can rely on scm_i_string_chars to stay in
+ place even across SCM_TICKs.
+
+ Additionally, when we are going to write to the string, we make a
+ copy so that we can write to it without having to use
+ scm_i_string_writable_chars.
+ */
+
+ if (modes & SCM_WRTNG)
+ str = scm_c_substring_copy (str, 0, str_len);
+ else
+ str = scm_c_substring (str, 0, str_len);
+
scm_mutex_lock (&scm_i_port_table_mutex);
z = scm_new_port_table_entry (scm_tc16_strport);
pt = SCM_PTAB_ENTRY(z);
SCM_SETSTREAM (z, SCM_UNPACK (str));
SCM_SET_CELL_TYPE(z, scm_tc16_strport|modes);
- pt->write_buf = pt->read_buf = SCM_I_STRING_UCHARS (str);
+ /* see above why we can use scm_i_string_chars here. */
+ pt->write_buf = pt->read_buf = (char *)scm_i_string_chars (str);
pt->read_pos = pt->write_pos = pt->read_buf + c_pos;
pt->write_buf_size = pt->read_buf_size = str_len;
pt->write_end = pt->read_end = pt->read_buf + pt->read_buf_size;
@@ -286,11 +314,13 @@ SCM scm_strport_to_string (SCM port)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str;
-
+ char *dst;
+
if (pt->rw_active == SCM_PORT_WRITE)
st_flush (port);
- str = scm_mem2string ((char *) pt->read_buf, pt->read_buf_size);
+ str = scm_i_make_string (pt->read_buf_size, &dst);
+ memcpy (dst, (char *) pt->read_buf, pt->read_buf_size);
scm_remember_upto_here_1 (port);
return str;
}
@@ -307,7 +337,7 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
if (!SCM_UNBNDP (printer))
SCM_VALIDATE_PROC (2, printer);
- str = scm_allocate_string (0);
+ str = scm_c_make_string (0, SCM_UNDEFINED);
port = scm_mkstrport (SCM_INUM0, str, SCM_OPN | SCM_WRTNG, FUNC_NAME);
if (SCM_UNBNDP (printer))
@@ -401,7 +431,7 @@ SCM
scm_c_read_string (const char *expr)
{
SCM port = scm_mkstrport (SCM_INUM0,
- scm_makfrom0str (expr),
+ scm_from_locale_string (expr),
SCM_OPN | SCM_RDNG,
"scm_c_read_string");
SCM form;
@@ -418,13 +448,13 @@ scm_c_read_string (const char *expr)
SCM
scm_c_eval_string (const char *expr)
{
- return scm_eval_string (scm_makfrom0str (expr));
+ return scm_eval_string (scm_from_locale_string (expr));
}
SCM
scm_c_eval_string_in_module (const char *expr, SCM module)
{
- return scm_eval_string_in_module (scm_makfrom0str (expr), module);
+ return scm_eval_string_in_module (scm_from_locale_string (expr), module);
}
diff --git a/libguile/struct.c b/libguile/struct.c
index efb17d3a4..8be254e73 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -59,16 +59,16 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
SCM_VALIDATE_STRING (1, fields);
{ /* scope */
- char * field_desc;
+ const char * field_desc;
size_t len;
int x;
- len = SCM_I_STRING_LENGTH (fields);
+ len = scm_i_string_length (fields);
if (len % 2 == 1)
SCM_MISC_ERROR ("odd length field specification: ~S",
scm_list_1 (fields));
- field_desc = SCM_I_STRING_CHARS (fields);
+ field_desc = scm_i_string_chars (fields);
for (x = 0; x < len; x += 2)
{
@@ -120,7 +120,7 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
}
#endif
}
- new_sym = scm_mem2symbol (field_desc, len);
+ new_sym = scm_string_to_symbol (fields);
}
scm_remember_upto_here_1 (fields);
return new_sym;
@@ -134,9 +134,10 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
static void
scm_struct_init (SCM handle, SCM layout, scm_t_bits * mem, int tail_elts, SCM inits)
{
- unsigned char * fields_desc = (unsigned char *) SCM_SYMBOL_CHARS (layout) - 2;
+ unsigned const char *fields_desc =
+ (unsigned const char *) scm_i_symbol_chars (layout) - 2;
unsigned char prot = 0;
- int n_fields = SCM_SYMBOL_LENGTH (layout) / 2;
+ int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0;
while (n_fields)
@@ -239,20 +240,20 @@ SCM_DEFINE (scm_struct_vtable_p, "struct-vtable?", 1, 0, 0,
layout = SCM_STRUCT_LAYOUT (x);
- if (SCM_SYMBOL_LENGTH (layout)
- < SCM_I_STRING_LENGTH (required_vtable_fields))
+ if (scm_i_symbol_length (layout)
+ < scm_i_string_length (required_vtable_fields))
return SCM_BOOL_F;
- tmp = strncmp (SCM_SYMBOL_CHARS (layout),
- SCM_I_STRING_CHARS (required_vtable_fields),
- SCM_I_STRING_LENGTH (required_vtable_fields));
+ tmp = strncmp (scm_i_symbol_chars (layout),
+ scm_i_string_chars (required_vtable_fields),
+ scm_i_string_length (required_vtable_fields));
scm_remember_upto_here_1 (required_vtable_fields);
if (tmp)
return SCM_BOOL_F;
mem = SCM_STRUCT_DATA (x);
- return scm_from_bool (SCM_SYMBOLP (SCM_PACK (mem[scm_vtable_index_layout])));
+ return scm_from_bool (scm_is_symbol (SCM_PACK (mem[scm_vtable_index_layout])));
}
#undef FUNC_NAME
@@ -426,7 +427,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
SCM_VALIDATE_REST_ARGUMENT (init);
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
- basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
+ basic_size = scm_i_symbol_length (layout) / 2;
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
@@ -513,7 +514,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
fields = scm_string_append (scm_list_2 (required_vtable_fields,
user_fields));
layout = scm_make_struct_layout (fields);
- basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
+ basic_size = scm_i_symbol_length (layout) / 2;
tail_elts = scm_to_size_t (tail_array_size);
SCM_DEFER_INTS;
data = scm_alloc_struct (basic_size + tail_elts,
@@ -543,9 +544,10 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM answer = SCM_UNDEFINED;
scm_t_bits * data;
SCM layout;
+ size_t layout_len;
size_t p;
scm_t_bits n_fields;
- char * fields_desc;
+ const char *fields_desc;
char field_type = 0;
@@ -555,12 +557,13 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
- fields_desc = SCM_SYMBOL_CHARS (layout);
+ fields_desc = scm_i_symbol_chars (layout);
+ layout_len = scm_i_symbol_length (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE(1, pos, p < n_fields);
- if (p * 2 < SCM_SYMBOL_LENGTH (layout))
+ if (p * 2 < layout_len)
{
char ref;
field_type = fields_desc[p * 2];
@@ -573,8 +576,8 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
}
- else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O')
- field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
+ else if (fields_desc[layout_len - 1] != 'O')
+ field_type = fields_desc[layout_len - 2];
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
@@ -619,9 +622,10 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
{
scm_t_bits * data;
SCM layout;
+ size_t layout_len;
size_t p;
int n_fields;
- char * fields_desc;
+ const char *fields_desc;
char field_type = 0;
SCM_VALIDATE_STRUCT (1, handle);
@@ -630,12 +634,13 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos);
- fields_desc = SCM_SYMBOL_CHARS (layout);
+ fields_desc = scm_i_symbol_chars (layout);
+ layout_len = scm_i_symbol_length (layout);
n_fields = data[scm_struct_i_n_words];
SCM_ASSERT_RANGE (1, pos, p < n_fields);
- if (p * 2 < SCM_SYMBOL_LENGTH (layout))
+ if (p * 2 < layout_len)
{
char set_x;
field_type = fields_desc[p * 2];
@@ -643,8 +648,8 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
if (set_x != 'w')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
- else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W')
- field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
+ else if (fields_desc[layout_len - 1] == 'W')
+ field_type = fields_desc[layout_len - 2];
else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
@@ -794,7 +799,7 @@ scm_init_struct ()
{
scm_struct_table
= scm_permanent_object (scm_make_weak_key_hash_table (scm_from_int (31)));
- required_vtable_fields = scm_makfrom0str ("prsrpw");
+ required_vtable_fields = scm_from_locale_string ("prsrpw");
scm_permanent_object (required_vtable_fields);
scm_c_define ("vtable-index-layout", scm_from_int (scm_vtable_index_layout));
scm_c_define ("vtable-index-vtable", scm_from_int (scm_vtable_index_vtable));
diff --git a/libguile/throw.c b/libguile/throw.c
index 94affdeb4..8c8380c3c 100644
--- a/libguile/throw.c
+++ b/libguile/throw.c
@@ -444,7 +444,7 @@ handler_message (void *handler_data, SCM tag, SCM args)
SCM
scm_handle_by_message (void *handler_data, SCM tag, SCM args)
{
- if (scm_is_true (scm_eq_p (tag, scm_str2symbol ("quit"))))
+ if (scm_is_true (scm_eq_p (tag, scm_from_locale_symbol ("quit"))))
{
exit (scm_exit_status (args));
}
@@ -502,7 +502,7 @@ SCM_DEFINE (scm_catch, "catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
- SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T),
+ SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
key, SCM_ARG1, FUNC_NAME);
c.tag = key;
@@ -530,7 +530,7 @@ SCM_DEFINE (scm_lazy_catch, "lazy-catch", 3, 0, 0,
{
struct scm_body_thunk_data c;
- SCM_ASSERT (SCM_SYMBOLP (key) || scm_is_eq (key, SCM_BOOL_T),
+ SCM_ASSERT (scm_is_symbol (key) || scm_is_eq (key, SCM_BOOL_T),
key, SCM_ARG1, FUNC_NAME);
c.tag = key;
diff --git a/libguile/unif.c b/libguile/unif.c
index 7936f2491..cc9e6ee04 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -169,7 +169,7 @@ scm_make_uve (long k, SCM prot)
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
return make_uve (scm_tc7_byvect, k, sizeof (char));
else if (SCM_CHARP (prot))
- return scm_allocate_string (sizeof (char) * k);
+ return scm_c_make_string (sizeof (char) * k, SCM_UNDEFINED);
else if (SCM_I_INUMP (prot))
return make_uve (SCM_I_INUM (prot) > 0 ? scm_tc7_uvect : scm_tc7_ivect,
k,
@@ -179,11 +179,11 @@ scm_make_uve (long k, SCM prot)
if (scm_num_eq_p (exactly_one_third, prot))
goto dvect;
}
- else if (SCM_SYMBOLP (prot) && (1 == SCM_SYMBOL_LENGTH (prot)))
+ else if (scm_is_symbol (prot) && (1 == scm_i_symbol_length (prot)))
{
char s;
- s = SCM_SYMBOL_CHARS (prot)[0];
+ s = scm_i_symbol_chars (prot)[0];
if (s == 's')
return make_uve (scm_tc7_svect, k, sizeof (short));
#if SCM_SIZEOF_LONG_LONG != 0
@@ -220,7 +220,7 @@ SCM_DEFINE (scm_uniform_vector_length, "uniform-vector-length", 1, 0, 0,
case scm_tc7_wvect:
return scm_from_size_t (SCM_VECTOR_LENGTH (v));
case scm_tc7_string:
- return scm_from_size_t (SCM_I_STRING_LENGTH (v));
+ return scm_from_size_t (scm_i_string_length (v));
case scm_tc7_bvect:
return scm_from_size_t (SCM_BITVECTOR_LENGTH (v));
case scm_tc7_byvect:
@@ -286,15 +286,15 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
protp = SCM_I_INUMP(prot) && SCM_I_INUM(prot)<=0;
break;
case scm_tc7_svect:
- protp = SCM_SYMBOLP (prot)
- && (1 == SCM_SYMBOL_LENGTH (prot))
- && ('s' == SCM_SYMBOL_CHARS (prot)[0]);
+ protp = scm_is_symbol (prot)
+ && (1 == scm_i_symbol_length (prot))
+ && ('s' == scm_i_symbol_chars (prot)[0]);
break;
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
- protp = SCM_SYMBOLP (prot)
- && (1 == SCM_SYMBOL_LENGTH (prot))
- && ('l' == SCM_SYMBOL_CHARS (prot)[0]);
+ protp = scm_is_symbol (prot)
+ && (1 == scm_i_symbol_length (prot))
+ && ('l' == scm_i_symbol_chars (prot)[0]);
break;
#endif
case scm_tc7_fvect:
@@ -564,7 +564,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
SCM answer = scm_make_uve (scm_to_long (dims), prot);
if (!SCM_UNBNDP (fill))
scm_array_fill_x (answer, fill);
- else if (SCM_SYMBOLP (prot))
+ else if (scm_is_symbol (prot))
scm_array_fill_x (answer, scm_from_int (0));
else
scm_array_fill_x (answer, prot);
@@ -589,7 +589,7 @@ SCM_DEFINE (scm_dimensions_to_uniform_array, "dimensions->uniform-array", 2, 1,
if (!SCM_UNBNDP (fill))
scm_array_fill_x (ra, fill);
- else if (SCM_SYMBOLP (prot))
+ else if (scm_is_symbol (prot))
scm_array_fill_x (ra, scm_from_int (0));
else
scm_array_fill_x (ra, prot);
@@ -880,6 +880,7 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
#define FUNC_NAME s_scm_enclose_array
{
SCM axv, res, ra_inr;
+ const char *c_axv;
scm_t_array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
@@ -939,16 +940,18 @@ SCM_DEFINE (scm_enclose_array, "enclose-array", 1, 0, 1,
SCM_ARRAY_DIMS (ra_inr)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (ra_inr)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (ra_inr)[k].inc = s[j].inc;
- SCM_I_STRING_CHARS (axv)[j] = 1;
+ scm_c_string_set_x (axv, j, SCM_MAKE_CHAR (1));
}
+ c_axv = scm_i_string_chars (axv);
for (j = 0, k = 0; k < noutr; k++, j++)
{
- while (SCM_I_STRING_CHARS (axv)[j])
+ while (c_axv[j])
j++;
SCM_ARRAY_DIMS (res)[k].lbnd = s[j].lbnd;
SCM_ARRAY_DIMS (res)[k].ubnd = s[j].ubnd;
SCM_ARRAY_DIMS (res)[k].inc = s[j].inc;
}
+ scm_remember_upto_here_1 (axv);
scm_ra_set_contp (ra_inr);
scm_ra_set_contp (res);
return res;
@@ -1109,7 +1112,7 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
else
return SCM_BOOL_F;
case scm_tc7_string:
- return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]);
+ return scm_c_string_ref (v, pos);
case scm_tc7_byvect:
return scm_from_schar (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
@@ -1155,7 +1158,7 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
else
return SCM_BOOL_F;
case scm_tc7_string:
- return SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (v)[pos]);
+ return scm_c_string_ref (v, pos);
case scm_tc7_byvect:
return scm_from_char (((char *) SCM_UVECTOR_BASE (v))[pos]);
case scm_tc7_uvect:
@@ -1269,7 +1272,7 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break;
case scm_tc7_string:
SCM_ASRTGO (SCM_CHARP (obj), badobj);
- SCM_I_STRING_UCHARS (v)[pos] = SCM_CHAR (obj);
+ scm_c_string_set_x (v, pos, obj);
break;
case scm_tc7_byvect:
if (SCM_CHARP (obj))
@@ -1478,7 +1481,7 @@ loop:
v = SCM_ARRAY_V (cra);
goto loop;
case scm_tc7_string:
- base = SCM_I_STRING_CHARS (v);
+ base = NULL; /* writing to strings is special, see below. */
sz = sizeof (char);
break;
case scm_tc7_bvect:
@@ -1544,7 +1547,7 @@ loop:
{
scm_t_port *pt = SCM_PTAB_ENTRY (port_or_fd);
int remaining = (cend - offset) * sz;
- char *dest = base + (cstart + offset) * sz;
+ size_t off = (cstart + offset) * sz;
if (pt->rw_active == SCM_PORT_WRITE)
scm_flush (port_or_fd);
@@ -1557,10 +1560,18 @@ loop:
int to_copy = min (pt->read_end - pt->read_pos,
remaining);
- memcpy (dest, pt->read_pos, to_copy);
+ if (base == NULL)
+ {
+ /* strings */
+ char *b = scm_i_string_writable_chars (v);
+ memcpy (b + off, pt->read_pos, to_copy);
+ scm_i_string_stop_writing ();
+ }
+ else
+ memcpy (base + off, pt->read_pos, to_copy);
pt->read_pos += to_copy;
remaining -= to_copy;
- dest += to_copy;
+ off += to_copy;
}
else
{
@@ -1581,9 +1592,19 @@ loop:
}
else /* file descriptor. */
{
- SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
- base + (cstart + offset) * sz,
- (sz * (cend - offset))));
+ if (base == NULL)
+ {
+ /* strings */
+ char *b = scm_i_string_writable_chars (v);
+ SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
+ b + (cstart + offset) * sz,
+ (sz * (cend - offset))));
+ scm_i_string_stop_writing ();
+ }
+ else
+ SCM_SYSCALL (ans = read (scm_to_int (port_or_fd),
+ base + (cstart + offset) * sz,
+ (sz * (cend - offset))));
if (ans == -1)
SCM_SYSERROR;
}
@@ -1615,7 +1636,7 @@ SCM_DEFINE (scm_uniform_array_write, "uniform-array-write", 1, 3, 0,
long offset = 0;
long cstart = 0;
long cend;
- char *base;
+ const char *base;
port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
@@ -1644,7 +1665,7 @@ loop:
v = SCM_ARRAY_V (v);
goto loop;
case scm_tc7_string:
- base = SCM_I_STRING_CHARS (v);
+ base = scm_i_string_chars (v);
sz = sizeof (char);
break;
case scm_tc7_bvect:
@@ -1708,7 +1729,7 @@ loop:
if (SCM_NIMP (port_or_fd))
{
- char *source = base + (cstart + offset) * sz;
+ const char *source = base + (cstart + offset) * sz;
ans = cend - offset;
scm_lfwrite (source, ans * sz, port_or_fd);
@@ -2014,13 +2035,16 @@ SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0,
SCM
-scm_istr2bve (char *str, long len)
+scm_istr2bve (SCM str)
{
+ size_t len = scm_i_string_length (str);
SCM v = scm_make_uve (len, SCM_BOOL_T);
long *data = (long *) SCM_VELTS (v);
register unsigned long mask;
register long k;
register long j;
+ const char *c_str = scm_i_string_chars (str);
+
for (k = 0; k < (len + SCM_LONG_BIT - 1) / SCM_LONG_BIT; k++)
{
data[k] = 0L;
@@ -2028,7 +2052,7 @@ scm_istr2bve (char *str, long len)
if (j > SCM_LONG_BIT)
j = SCM_LONG_BIT;
for (mask = 1L; j--; mask <<= 1)
- switch (*str++)
+ switch (*c_str++)
{
case '0':
break;
@@ -2320,17 +2344,22 @@ tail:
}
break;
case scm_tc7_string:
- if (n-- > 0)
- scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate);
- if (SCM_WRITINGP (pstate))
- for (j += inc; n-- > 0; j += inc)
- {
- scm_putc (' ', port);
- scm_iprin1 (SCM_MAKE_CHAR (SCM_I_STRING_UCHARS (ra)[j]), port, pstate);
- }
- else
- for (j += inc; n-- > 0; j += inc)
- scm_putc (SCM_I_STRING_CHARS (ra)[j], port);
+ {
+ const char *src;
+ src = scm_i_string_chars (ra);
+ if (n-- > 0)
+ scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
+ if (SCM_WRITINGP (pstate))
+ for (j += inc; n-- > 0; j += inc)
+ {
+ scm_putc (' ', port);
+ scm_iprin1 (SCM_MAKE_CHAR (src[j]), port, pstate);
+ }
+ else
+ for (j += inc; n-- > 0; j += inc)
+ scm_putc (src[j], port);
+ scm_remember_upto_here_1 (ra);
+ }
break;
case scm_tc7_byvect:
if (n-- > 0)
@@ -2560,10 +2589,10 @@ loop:
case scm_tc7_ivect:
return scm_from_int (-1);
case scm_tc7_svect:
- return scm_str2symbol ("s");
+ return scm_from_locale_symbol ("s");
#if SCM_SIZEOF_LONG_LONG != 0
case scm_tc7_llvect:
- return scm_str2symbol ("l");
+ return scm_from_locale_symbol ("l");
#endif
case scm_tc7_fvect:
return scm_from_double (1.0);
diff --git a/libguile/unif.h b/libguile/unif.h
index a5b6b9d15..80eaa674e 100644
--- a/libguile/unif.h
+++ b/libguile/unif.h
@@ -115,7 +115,7 @@ SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
SCM_API SCM scm_bit_invert_x (SCM v);
-SCM_API SCM scm_istr2bve (char *str, long len);
+SCM_API SCM scm_istr2bve (SCM str);
SCM_API SCM scm_array_to_list (SCM v);
SCM_API SCM scm_list_to_uniform_array (SCM ndim, SCM prot, SCM lst);
SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate);
diff --git a/libguile/validate.h b/libguile/validate.h
index 886a4d646..5fd016dcb 100644
--- a/libguile/validate.h
+++ b/libguile/validate.h
@@ -3,7 +3,7 @@
#ifndef SCM_VALIDATE_H
#define SCM_VALIDATE_H
-/* Copyright (C) 1999,2000,2001, 2002 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2002, 2004 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
@@ -152,7 +152,10 @@
cvar = SCM_CHAR (scm); \
} while (0)
-#define SCM_VALIDATE_STRING(pos, str) SCM_MAKE_VALIDATE_MSG (pos, str, I_STRINGP, "string")
+#define SCM_VALIDATE_STRING(pos, str) \
+ do { \
+ SCM_ASSERT_TYPE (scm_is_string (str), str, pos, FUNC_NAME, "string"); \
+ } while (0)
#define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real")
@@ -270,7 +273,10 @@
SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \
} while (0)
-#define SCM_VALIDATE_SYMBOL(pos, sym) SCM_MAKE_VALIDATE_MSG (pos, sym, SYMBOLP, "symbol")
+#define SCM_VALIDATE_SYMBOL(pos, str) \
+ do { \
+ SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \
+ } while (0)
#define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable")
diff --git a/libguile/values.c b/libguile/values.c
index d67b45926..88aef2bf6 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -76,8 +76,10 @@ scm_init_values (void)
print_values);
scm_values_vtable
- = scm_permanent_object (scm_make_vtable_vtable (scm_makfrom0str ("pr"),
- SCM_INUM0, SCM_EOL));
+ = scm_permanent_object (
+ scm_make_vtable_vtable (scm_from_locale_string ("pr"),
+ SCM_INUM0, SCM_EOL));
+
SCM_SET_STRUCT_PRINTER (scm_values_vtable, print);
scm_add_feature ("values");
diff --git a/libguile/version.c b/libguile/version.c
index 3a811f01e..d9e00be9a 100644
--- a/libguile/version.c
+++ b/libguile/version.c
@@ -95,7 +95,7 @@ SCM_DEFINE (scm_version, "version", 0, 0, 0,
SCM_MAJOR_VERSION,
SCM_MINOR_VERSION,
SCM_MICRO_VERSION);
- return scm_makfrom0str (version_str);
+ return scm_from_locale_string (version_str);
}
#undef FUNC_NAME
@@ -120,7 +120,7 @@ SCM_DEFINE (scm_effective_version, "effective-version", 0, 0, 0,
# error version string may overflow buffer
#endif
sprintf (version_str, "%d.%d", SCM_MAJOR_VERSION, SCM_MINOR_VERSION);
- return scm_makfrom0str (version_str);
+ return scm_from_locale_string (version_str);
}
#undef FUNC_NAME
diff --git a/libguile/vports.c b/libguile/vports.c
index e99d7961c..199c27a0a 100644
--- a/libguile/vports.c
+++ b/libguile/vports.c
@@ -76,7 +76,7 @@ sf_write (SCM port, const void *data, size_t size)
{
SCM p = SCM_PACK (SCM_STREAM (port));
- scm_call_1 (SCM_VELTS (p)[1], scm_mem2string ((char *) data, size));
+ scm_call_1 (SCM_VELTS (p)[1], scm_from_locale_stringn ((char *) data, size));
}
/* calling the flush proc (element 2) is in case old code needs it,