diff options
author | Andy Wingo <wingo@pobox.com> | 2016-07-14 16:18:47 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-07-14 16:18:47 +0200 |
commit | da757c6814294281b59c8a307b68d24e9d7a01b5 (patch) | |
tree | 8d18db09613d44a61fe641b28cbda5689c1d1dd2 | |
parent | 1c98b7884819a295511d1e3245bf19873c3ae21e (diff) | |
download | guile-da757c6814294281b59c8a307b68d24e9d7a01b5.tar.gz |
Refactor implementation of current-warning-port
* module/ice-9/boot-9.scm (current-warning-port):
* libguile/init.c (scm_init_standard_ports):
* libguile/ports.c (cur_warnport_fluid, scm_current_warning_port)
(scm_set_current_warning_port, scm_init_ports): Define the warning
port in the same way as the error/output/input ports, with a fluid
that doesn't require calling out to Scheme.
-rw-r--r-- | libguile/init.c | 1 | ||||
-rw-r--r-- | libguile/ports.c | 37 | ||||
-rw-r--r-- | module/ice-9/boot-9.scm | 18 |
3 files changed, 22 insertions, 34 deletions
diff --git a/libguile/init.c b/libguile/init.c index a5630d1f0..adab2b5d6 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -223,6 +223,7 @@ scm_init_standard_ports () (scm_standard_stream_to_port (1, isatty (1) ? "w0" : "w")); scm_set_current_error_port (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w")); + scm_set_current_warning_port (scm_current_error_port ()); } diff --git a/libguile/ports.c b/libguile/ports.c index 5a756b78e..6705e8e22 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -409,6 +409,7 @@ SCM_DEFINE (scm_drain_input, "drain-input", 1, 0, 0, static SCM cur_inport_fluid = SCM_BOOL_F; static SCM cur_outport_fluid = SCM_BOOL_F; static SCM cur_errport_fluid = SCM_BOOL_F; +static SCM cur_warnport_fluid = SCM_BOOL_F; static SCM cur_loadport_fluid = SCM_BOOL_F; SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0, @@ -453,23 +454,17 @@ 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) +SCM_DEFINE (scm_current_warning_port, "current-warning-port", 0, 0, 0, + (), + "Return the port to which warnings should be sent.") +#define FUNC_NAME s_scm_current_warning_port { - scm_i_pthread_once (¤t_warning_port_once, - init_current_warning_port_var); - return scm_call_0 (scm_variable_ref (current_warning_port_var)); + if (scm_is_true (cur_warnport_fluid)) + return scm_fluid_ref (cur_warnport_fluid); + else + return scm_current_error_port (); } +#undef FUNC_NAME SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0, (), @@ -528,11 +523,15 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0, SCM scm_set_current_warning_port (SCM port) +#define FUNC_NAME "set-current-warning-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); + SCM owarnp = scm_fluid_ref (cur_warnport_fluid); + port = SCM_COERCE_OUTPORT (port); + SCM_VALIDATE_OPOUTPORT (1, port); + scm_fluid_set_x (cur_warnport_fluid, port); + return owarnp; } +#undef FUNC_NAME void @@ -2900,6 +2899,7 @@ scm_init_ports () cur_inport_fluid = scm_make_fluid (); cur_outport_fluid = scm_make_fluid (); cur_errport_fluid = scm_make_fluid (); + cur_warnport_fluid = scm_make_fluid (); cur_loadport_fluid = scm_make_fluid (); scm_i_port_weak_hash = scm_make_weak_key_hash_table (SCM_I_MAKINUM(31)); @@ -2923,6 +2923,7 @@ scm_init_ports () scm_c_define ("%current-input-port-fluid", cur_inport_fluid); scm_c_define ("%current-output-port-fluid", cur_outport_fluid); scm_c_define ("%current-error-port-fluid", cur_errport_fluid); + scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid); } /* diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 1ed2f9de7..0d5a00587 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -217,9 +217,6 @@ If there is no handler at all, Guile prints an error and then exits." (define pk peek) -;; Temporary definition; replaced later. -(define current-warning-port current-error-port) - (define (warn . stuff) (with-output-to-port (current-warning-port) (lambda () @@ -3311,24 +3308,13 @@ CONV is not applied to the initial value." (port-parameterize! current-output-port %current-output-port-fluid output-port? "expected an output port") (port-parameterize! current-error-port %current-error-port-fluid + output-port? "expected an output port") + (port-parameterize! current-warning-port %current-warning-port-fluid output-port? "expected an output port")) ;;; -;;; Warnings. -;;; - -(define current-warning-port - (make-parameter (current-error-port) - (lambda (x) - (if (output-port? x) - x - (error "expected an output port" x))))) - - - -;;; ;;; Languages. ;;; |