diff options
-rw-r--r-- | libguile/backtrace.c | 20 | ||||
-rw-r--r-- | libguile/debug.c | 20 | ||||
-rw-r--r-- | libguile/eval.c | 33 | ||||
-rw-r--r-- | libguile/frames.c | 20 | ||||
-rw-r--r-- | libguile/goops.c | 22 | ||||
-rw-r--r-- | libguile/ports.c | 32 | ||||
-rw-r--r-- | libguile/strings.c | 17 | ||||
-rw-r--r-- | libguile/strports.c | 25 | ||||
-rw-r--r-- | libguile/throw.c | 48 |
9 files changed, 135 insertions, 102 deletions
diff --git a/libguile/backtrace.c b/libguile/backtrace.c index 11a0cb1ee..e247aa7af 100644 --- a/libguile/backtrace.c +++ b/libguile/backtrace.c @@ -67,24 +67,30 @@ boot_print_exception (SCM port, SCM frame, SCM key, SCM args) } #undef FUNC_NAME +static SCM print_exception_var; + +static void +init_print_exception_var (void) +{ + print_exception_var + = scm_module_variable (scm_the_root_module (), + scm_from_latin1_symbol ("print-exception")); +} + SCM scm_print_exception (SCM port, SCM frame, SCM key, SCM args) #define FUNC_NAME "print-exception" { - static SCM print_exception = SCM_BOOL_F; + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_print_exception_var); SCM_VALIDATE_OPOUTPORT (1, port); if (scm_is_true (frame)) SCM_VALIDATE_FRAME (2, frame); SCM_VALIDATE_SYMBOL (3, key); SCM_VALIDATE_LIST (4, args); - - if (scm_is_false (print_exception)) - print_exception = - scm_module_variable (scm_the_root_module (), - scm_from_latin1_symbol ("print-exception")); - return scm_call_4 (scm_variable_ref (print_exception), + return scm_call_4 (scm_variable_ref (print_exception_var), port, frame, key, args); } #undef FUNC_NAME diff --git a/libguile/debug.c b/libguile/debug.c index 9e63f2c67..f9bcc33db 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -160,19 +160,21 @@ SCM_DEFINE (scm_debug_hang, "debug-hang", 0, 1, 0, #undef FUNC_NAME #endif +static SCM local_eval_var; + +static void +init_local_eval_var (void) +{ + local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval"); +} + SCM scm_local_eval (SCM exp, SCM env) { - static SCM local_eval_var = SCM_UNDEFINED; - static scm_i_pthread_mutex_t local_eval_var_mutex - = SCM_I_PTHREAD_MUTEX_INITIALIZER; - - scm_i_scm_pthread_mutex_lock (&local_eval_var_mutex); - if (SCM_UNBNDP (local_eval_var)) - local_eval_var = scm_c_public_variable ("ice-9 local-eval", "local-eval"); - scm_i_pthread_mutex_unlock (&local_eval_var_mutex); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_local_eval_var); - return scm_call_2 (SCM_VARIABLE_REF (local_eval_var), exp, env); + return scm_call_2 (scm_variable_ref (local_eval_var), exp, env); } static void diff --git a/libguile/eval.c b/libguile/eval.c index 3e828a178..39e66c5d7 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004, - * 2005,2006,2007,2008,2009,2010,2011,2012,2013 + * 2005,2006,2007,2008,2009,2010,2011,2012,2013,2014 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -620,30 +620,37 @@ scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args) return scm_apply_0 (proc, scm_cons (arg1, scm_cons2 (arg2, arg3, args))); } +static SCM map_var, for_each_var; + +static void init_map_var (void) +{ + map_var = scm_private_variable (scm_the_root_module (), + scm_from_latin1_symbol ("map")); +} + +static void init_for_each_var (void) +{ + for_each_var = scm_private_variable (scm_the_root_module (), + scm_from_latin1_symbol ("for-each")); +} SCM scm_map (SCM proc, SCM arg1, SCM args) { - static SCM var = SCM_BOOL_F; + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_map_var); - if (scm_is_false (var)) - var = scm_private_variable (scm_the_root_module (), - scm_from_latin1_symbol ("map")); - - return scm_apply_0 (scm_variable_ref (var), + return scm_apply_0 (scm_variable_ref (map_var), scm_cons (proc, scm_cons (arg1, args))); } SCM scm_for_each (SCM proc, SCM arg1, SCM args) { - static SCM var = SCM_BOOL_F; - - if (scm_is_false (var)) - var = scm_private_variable (scm_the_root_module (), - scm_from_latin1_symbol ("for-each")); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_for_each_var); - return scm_apply_0 (scm_variable_ref (var), + return scm_apply_0 (scm_variable_ref (for_each_var), scm_cons (proc, scm_cons (arg1, args))); } diff --git a/libguile/frames.c b/libguile/frames.c index b0f451f7d..a651694bb 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -131,20 +131,26 @@ SCM_DEFINE (scm_frame_procedure, "frame-procedure", 1, 0, 0, } #undef FUNC_NAME +static SCM frame_arguments_var; + +static void +init_frame_arguments_var (void) +{ + frame_arguments_var + = scm_c_private_lookup ("system vm frame", "frame-arguments"); +} + SCM_DEFINE (scm_frame_arguments, "frame-arguments", 1, 0, 0, (SCM frame), "") #define FUNC_NAME s_scm_frame_arguments { - static SCM var = SCM_BOOL_F; - - SCM_VALIDATE_VM_FRAME (1, frame); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_frame_arguments_var); - if (scm_is_false (var)) - var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"), - "frame-arguments"); + SCM_VALIDATE_VM_FRAME (1, frame); - return scm_call_1 (SCM_VARIABLE_REF (var), frame); + return scm_call_1 (scm_variable_ref (frame_arguments_var), frame); } #undef FUNC_NAME diff --git a/libguile/goops.c b/libguile/goops.c index 013a65c14..2cf343f79 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013 +/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -1711,16 +1711,24 @@ SCM_KEYWORD (k_name, "name"); SCM_GLOBAL_SYMBOL (scm_sym_args, "args"); - SCM_SYMBOL (sym_delayed_compile, "delayed-compile"); + +static SCM delayed_compile_var; + +static void +init_delayed_compile_var (void) +{ + delayed_compile_var + = scm_c_private_lookup ("oop goops dispatch", "delayed-compile"); +} + static SCM make_dispatch_procedure (SCM gf) { - static SCM var = SCM_BOOL_F; - if (scm_is_false (var)) - var = scm_module_variable (scm_c_resolve_module ("oop goops dispatch"), - sym_delayed_compile); - return scm_call_1 (SCM_VARIABLE_REF (var), gf); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_delayed_compile_var); + + return scm_call_1 (scm_variable_ref (delayed_compile_var), gf); } static void diff --git a/libguile/ports.c b/libguile/ports.c index c53b7c1f9..e256d65b8 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -435,19 +435,22 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0, } #undef FUNC_NAME +static SCM current_warning_port_var; +static scm_i_pthread_once_t current_warning_port_once = SCM_I_PTHREAD_ONCE_INIT; + +static void +init_current_warning_port_var (void) +{ + current_warning_port_var + = scm_c_private_variable ("guile", "current-warning-port"); +} + SCM scm_current_warning_port (void) { - static SCM cwp_var = SCM_UNDEFINED; - static scm_i_pthread_mutex_t cwp_var_mutex - = SCM_I_PTHREAD_MUTEX_INITIALIZER; - - scm_i_scm_pthread_mutex_lock (&cwp_var_mutex); - if (SCM_UNBNDP (cwp_var)) - cwp_var = scm_c_private_variable ("guile", "current-warning-port"); - scm_i_pthread_mutex_unlock (&cwp_var_mutex); - - return scm_call_0 (scm_variable_ref (cwp_var)); + scm_i_pthread_once (¤t_warning_port_once, + init_current_warning_port_var); + return scm_call_0 (scm_variable_ref (current_warning_port_var)); } SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0, @@ -508,12 +511,9 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, SCM scm_set_current_warning_port (SCM port) { - static SCM cwp_var = SCM_BOOL_F; - - if (scm_is_false (cwp_var)) - cwp_var = scm_c_private_lookup ("guile", "current-warning-port"); - - return scm_call_1 (scm_variable_ref (cwp_var), port); + scm_i_pthread_once (¤t_warning_port_once, + init_current_warning_port_var); + return scm_call_1 (scm_variable_ref (current_warning_port_var), port); } diff --git a/libguile/strings.c b/libguile/strings.c index 1f492bd0c..e8eb91cbd 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -280,6 +280,15 @@ scm_i_print_stringbuf (SCM exp, SCM port, scm_print_state *pstate) SCM scm_nullstr; +static SCM null_stringbuf; + +static void +init_null_stringbuf (void) +{ + null_stringbuf = make_stringbuf (0); + SET_STRINGBUF_SHARED (null_stringbuf); +} + /* Create a scheme string with space for LEN 8-bit Latin-1-encoded characters. CHARSP, if not NULL, will be set to location of the char array. If READ_ONLY_P, the returned string is read-only; @@ -287,17 +296,13 @@ SCM scm_nullstr; SCM scm_i_make_string (size_t len, char **charsp, int read_only_p) { - static SCM null_stringbuf = SCM_BOOL_F; SCM buf; SCM res; if (len == 0) { - if (SCM_UNLIKELY (scm_is_false (null_stringbuf))) - { - null_stringbuf = make_stringbuf (0); - SET_STRINGBUF_SHARED (null_stringbuf); - } + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_null_stringbuf); buf = null_stringbuf; } else diff --git a/libguile/strports.c b/libguile/strports.c index 591089477..dd3bc59d4 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -456,6 +456,16 @@ scm_c_eval_string_in_module (const char *expr, SCM module) } +static SCM eval_string_var; +static SCM k_module; + +static void +init_eval_string_var_and_k_module (void) +{ + eval_string_var = scm_c_public_variable ("ice-9 eval-string", "eval-string"); + k_module = scm_from_locale_keyword ("module"); +} + SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, (SCM string, SCM module), "Evaluate @var{string} as the text representation of a Scheme\n" @@ -467,23 +477,16 @@ SCM_DEFINE (scm_eval_string_in_module, "eval-string", 1, 1, 0, "procedure returns.") #define FUNC_NAME s_scm_eval_string_in_module { - static SCM eval_string = SCM_UNDEFINED, k_module = SCM_UNDEFINED; - static scm_i_pthread_mutex_t init_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER; - - scm_i_scm_pthread_mutex_lock (&init_mutex); - if (SCM_UNBNDP (eval_string)) - { - eval_string = scm_c_public_variable ("ice-9 eval-string", "eval-string"); - k_module = scm_from_locale_keyword ("module"); - } - scm_i_pthread_mutex_unlock (&init_mutex); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_eval_string_var_and_k_module); if (SCM_UNBNDP (module)) module = scm_current_module (); else SCM_VALIDATE_MODULE (2, module); - return scm_call_3 (scm_variable_ref (eval_string), string, k_module, module); + return scm_call_3 (scm_variable_ref (eval_string_var), + string, k_module, module); } #undef FUNC_NAME diff --git a/libguile/throw.c b/libguile/throw.c index 244bcf153..e10695a0a 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -53,24 +53,14 @@ baggage. */ -#define CACHE_VAR(var,name) \ - static SCM var = SCM_BOOL_F; \ - if (scm_is_false (var)) \ - { \ - var = scm_module_variable (scm_the_root_module (), \ - scm_from_latin1_symbol (name)); \ - if (scm_is_false (var)) \ - abort (); \ - } - +static SCM catch_var, throw_var, with_throw_handler_var; + SCM scm_catch (SCM key, SCM thunk, SCM handler) { - CACHE_VAR (var, "catch"); - - return scm_call_3 (scm_variable_ref (var), key, thunk, handler); + return scm_call_3 (scm_variable_ref (catch_var), key, thunk, handler); } SCM @@ -80,28 +70,32 @@ scm_catch_with_pre_unwind_handler (SCM key, SCM thunk, SCM handler, if (SCM_UNBNDP (pre_unwind_handler)) return scm_catch (key, thunk, handler); else - { - CACHE_VAR (var, "catch"); - - return scm_call_4 (scm_variable_ref (var), key, thunk, handler, - pre_unwind_handler); - } + return scm_call_4 (scm_variable_ref (catch_var), key, thunk, handler, + pre_unwind_handler); +} + +static void +init_with_throw_handler_var (void) +{ + with_throw_handler_var + = scm_module_variable (scm_the_root_module (), + scm_from_latin1_symbol ("with-throw-handler")); } SCM scm_with_throw_handler (SCM key, SCM thunk, SCM handler) { - CACHE_VAR (var, "with-throw-handler"); + static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT; + scm_i_pthread_once (&once, init_with_throw_handler_var); - return scm_call_3 (scm_variable_ref (var), key, thunk, handler); + return scm_call_3 (scm_variable_ref (with_throw_handler_var), + key, thunk, handler); } SCM scm_throw (SCM key, SCM args) { - CACHE_VAR (var, "throw"); - - return scm_apply_1 (scm_variable_ref (var), key, args); + return scm_apply_1 (scm_variable_ref (throw_var), key, args); } @@ -552,8 +546,10 @@ scm_init_throw () tc16_catch_closure = scm_make_smob_type ("catch-closure", 0); scm_set_smob_apply (tc16_catch_closure, apply_catch_closure, 0, 0, 1); - scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0, pre_init_catch)); - scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1, pre_init_throw)); + catch_var = scm_c_define ("catch", scm_c_make_gsubr ("catch", 3, 1, 0, + pre_init_catch)); + throw_var = scm_c_define ("throw", scm_c_make_gsubr ("throw", 1, 0, 1, + pre_init_throw)); #include "libguile/throw.x" } |