mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

Merge commit '60617d819d'

Browse source 
Conflicts:
	libguile/continuations.c
	libguile/eval.c
	libguile/goops.c
	libguile/instructions.c
This commit is contained in:
Andy Wingo 2014-02-07 15:01:33 +01:00
commit dc7a33fa87
9 changed files with 135 additions and 102 deletions
Download patch file Download diff file Expand all files Collapse all files

20
libguile/backtrace.c
View file

@ -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

20
libguile/debug.c
View file

@ -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;
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_local_eval_var);
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);
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

33
libguile/eval.c
View file

@ -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;
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_for_each_var);
if (scm_is_false (var))
var = scm_private_variable (scm_the_root_module (),
scm_from_latin1_symbol ("for-each"));
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)));
}

20
libguile/frames.c
View file

@ -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;
static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
scm_i_pthread_once (&once, init_frame_arguments_var);
SCM_VALIDATE_VM_FRAME (1, frame);
if (scm_is_false (var))
var = scm_c_module_lookup (scm_c_resolve_module ("system vm frame"),
"frame-arguments");
return scm_call_1 (SCM_VARIABLE_REF (var), frame);
return scm_call_1 (scm_variable_ref (frame_arguments_var), frame);
}
#undef FUNC_NAME

22
libguile/goops.c
View file

@ -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

32
libguile/ports.c
View file

@ -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 (&current_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 (&current_warning_port_once,
init_current_warning_port_var);
return scm_call_1 (scm_variable_ref (current_warning_port_var), port);
}

17
libguile/strings.c
View file

@ -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

25
libguile/strports.c
View file

@ -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

48
libguile/throw.c
View file

@ -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"
}