diff options
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, <, 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, |