diff --git a/pkgs/racket-doc/scribblings/reference/logging.scrbl b/pkgs/racket-doc/scribblings/reference/logging.scrbl index 48b949a5b5..62559a019a 100644 --- a/pkgs/racket-doc/scribblings/reference/logging.scrbl +++ b/pkgs/racket-doc/scribblings/reference/logging.scrbl @@ -55,6 +55,14 @@ through environment variables: The default is @racket["error"].} + @item{If the @indexed-envvar{PLTSTDOUT} environment variable is + defined and is not overridden by a command-line flag, it + determines the level of the @tech{log receiver} that propagates + events to the original output port. The possible values are the + same as for @envvar{PLTSTDERR}. + + The default is @racket["none"].} + @item{If the @indexed-envvar{PLTSYSLOG} environment variable is defined and is not overridden by a command-line flag, it determines the level of the @tech{log receiver} that propagates @@ -78,7 +86,8 @@ would produce a run-time error if evaluated. of @envvar{PLTSTDERR} and @envvar{PLTSYSLOG} was very strict. Leading and trailing whitespace was forbidden, and anything other than exactly one space character separating two specifications was - rejected.}] + rejected.} + #:changed "6.90.0.17" @elem{Added @envvar{PLTSTDOUT}.}] @; ---------------------------------------- @section{Creating Loggers} diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index 67ed1ae730..dfb3adf6f5 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -347,6 +347,12 @@ flags: are the same as for the @envvar{PLTSTDERR} environment variable. See @secref["logging"] for more information.} + @item{@FlagFirst{O} @nonterm{levels} or @DFlagFirst{stdout} + @nonterm{levels} : Sets the logging level for writing events to + the original output port. The possible @nonterm{level} values + are the same as for the @envvar{PLTSTDOUT} environment + variable. See @secref["logging"] for more information.} + @item{@FlagFirst{L} @nonterm{levels} or @DFlagFirst{syslog} @nonterm{levels} : Sets the logging level for writing events to the system log. The possible @nonterm{level} values @@ -439,6 +445,8 @@ of the collapsed set. Extra arguments following the last option are available from the @indexed-racket[current-command-line-arguments] parameter. +@history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.}] + @; ---------------------------------------------------------------------- @section[#:tag "configure-runtime"]{Language Run-Time Configuration} diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index 77daac3621..5aadb205eb 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -77,10 +77,10 @@ (define rx:logging-spec (pregexp "^[\\s]*(none|fatal|error|warning|info|debug)(?:@([^\\s @]+))?(.*)$")) (define rx:all-whitespace (pregexp "^[\\s]*$")) - (define (parse-logging-spec str where exit-on-fail?) + (define (parse-logging-spec which str where exit-on-fail?) (define (fail) (let ([msg (string-append - "stderr " where " must be one of the following\n" + which " " where " must be one of the following\n" " s:\n" " none fatal error warning info debug\n" "or up to one such in whitespace-separated sequence of\n" @@ -161,6 +161,7 @@ (define repl-init? #t) (define version? #f) (define stderr-logging-arg #f) + (define stdout-logging-arg #f) (define runtime-for-init? #t) (define exit-value 0) (define host-collects-dir init-collects-dir) @@ -309,7 +310,11 @@ (loop (cdr args))] [("-W" "--stderr") (let-values ([(spec rest-args) (next-arg "stderr level" arg within-arg args)]) - (set! stderr-logging-arg (parse-logging-spec spec (format "after ~a switch" (or within-arg arg)) #t)) + (set! stderr-logging-arg (parse-logging-spec "stderr" spec (format "after ~a switch" (or within-arg arg)) #t)) + (loop rest-args))] + [("-O" "--stdout") + (let-values ([(spec rest-args) (next-arg "stdout level" arg within-arg args)]) + (set! stdout-logging-arg (parse-logging-spec "stdout" spec (format "after ~a switch" (or within-arg arg)) #t)) (loop rest-args))] [("-N" "--name") (let-values ([(name rest-args) (next-arg "name" arg within-arg args)]) @@ -431,6 +436,13 @@ (parse-logging-spec spec "in PLTSTDERR environment variable" #f) '(error))))) + (define stdout-logging + (or stdout-logging-arg + (let ([spec (getenv "PLTSTDOUT")]) + (if spec + (parse-logging-spec spec "in PLTSTDOUT environment variable" #f) + '())))) + (when (getenv "PLT_STATS_ON_BREAK") (keyboard-interrupt-handler (let ([orig (keyboard-interrupt-handler)]) @@ -446,6 +458,9 @@ (when (and stderr-logging (not (null? stderr-logging))) (apply add-stderr-log-receiver! (|#%app| current-logger) stderr-logging)) + (when (and stdout-logging + (not (null? stdout-logging))) + (apply add-stdout-log-receiver! (|#%app| current-logger) stdout-logging)) (cond [(eq? init-collects-dir 'disable) (|#%app| use-collection-link-paths #f) diff --git a/racket/src/gracket/Makefile.in b/racket/src/gracket/Makefile.in index a77884663b..44f82f6e1e 100644 --- a/racket/src/gracket/Makefile.in +++ b/racket/src/gracket/Makefile.in @@ -89,7 +89,7 @@ LINKRESULT_wx_xt = gracket@CGC@ LINKRESULT_wx_mac = GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@ LINKRESULT = $(LINKRESULT_@WXVARIANT@) -BOOT_SETUP = @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled # Incremented each time the binaries change: DOWNLOAD_BIN_VERSION = 1 @@ -128,7 +128,7 @@ GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@: $(MZFW) $(MRAPPSKEL) grmain.@LTO@ /usr/bin/install_name_tool -change "Racket.framework/Versions/$(FWVERSION)/Racket" "@executable_path/../../../../racket/Racket.framework/Versions/$(FWVERSION)/Racket" GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@ $(MRAPPSKEL): $(srcdir)/../mac/osx_appl.rkt $(srcdir)/../racket/src/schvers.h $(srcdir)/../mac/icon/GRacket.icns - env BUILDBASE=.. @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) -l- setup $(BOOT_SETUP) $(MRAPPSKEL) mrappskel.d $(srcdir)/../mac/osx_appl.rkt $(srcdir)/.. "@CGC@" + env BUILDBASE=.. @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) $(SETUP_BOOT) $(MRAPPSKEL) mrappskel.d $(srcdir)/../mac/osx_appl.rkt $(srcdir)/.. "@CGC@" @INCLUDEDEP@ mrappskel.d ee-app: gracket grmain_ee.@LTO@ diff --git a/racket/src/io/logger/main.rkt b/racket/src/io/logger/main.rkt index 2ae0c4d053..cc1756ad94 100644 --- a/racket/src/io/logger/main.rkt +++ b/racket/src/io/logger/main.rkt @@ -17,7 +17,8 @@ log-message ; ok to call in host-Scheme interrupt handler log-receiver? make-log-receiver - add-stderr-log-receiver!) + add-stderr-log-receiver! + add-stdout-log-receiver!) (define root-logger (create-logger #:topic #f #:parent #f #:propagate-filters 'none)) diff --git a/racket/src/io/logger/receiver.rkt b/racket/src/io/logger/receiver.rkt index c33675cb0d..c75e2704d5 100644 --- a/racket/src/io/logger/receiver.rkt +++ b/racket/src/io/logger/receiver.rkt @@ -10,6 +10,7 @@ (provide (struct-out log-receiver) make-log-receiver add-stderr-log-receiver! + add-stdout-log-receiver! log-receiver-send!) (struct log-receiver (filters)) @@ -72,12 +73,12 @@ ;; ---------------------------------------- -(struct stderr-log-receiver log-receiver () +(struct stdio-log-receiver log-receiver (which) #:property prop:receiver-send (lambda (lr msg) ;; called in atomic mode and possibly in host interrupt handler - (define fd (rktio_std_fd rktio RKTIO_STDERR)) + (define fd (rktio_std_fd rktio (stdio-log-receiver-which lr))) (define bstr (bytes-append (string->bytes/utf-8 (vector-ref msg 1)) #"\n")) (define len (bytes-length bstr)) (let loop ([i 0]) @@ -88,13 +89,20 @@ (loop i))))) (rktio_forget rktio fd))) -(define/who (add-stderr-log-receiver! logger . args) +(define (add-stdio-log-receiver! who logger args parse-who which) (check who logger? logger) - (define lr (stderr-log-receiver (parse-filters 'make-stderr-log-receiver args #:default-level 'none))) + (define lr (stdio-log-receiver (parse-filters parse-who args #:default-level 'none) + which)) (atomically (add-log-receiver! logger lr) (set-logger-permanent-receivers! logger (cons lr (logger-permanent-receivers logger))))) +(define/who (add-stderr-log-receiver! logger . args) + (add-stdio-log-receiver! who logger args 'make-stderr-log-receiver RKTIO_STDERR)) + +(define/who (add-stdout-log-receiver! logger . args) + (add-stdio-log-receiver! who logger args 'make-stdio-log-receiver RKTIO_STDOUT)) + ;; ---------------------------------------- (define (add-log-receiver! logger lr) diff --git a/racket/src/racket/Makefile.in b/racket/src/racket/Makefile.in index e2b68d5690..266283e81d 100644 --- a/racket/src/racket/Makefile.in +++ b/racket/src/racket/Makefile.in @@ -49,7 +49,7 @@ RACKET = racket RUN_THIS_RACKET_CGC = ./racket@CGC@ RUN_THIS_RACKET_MMM = ./racket@MMM@ -SETUP_BOOT = -W "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled MZSRC = $(srcdir)/src diff --git a/racket/src/racket/cmdline.inc b/racket/src/racket/cmdline.inc index 4fe14ae4b0..094b3ca78b 100644 --- a/racket/src/racket/cmdline.inc +++ b/racket/src/racket/cmdline.inc @@ -729,7 +729,7 @@ static int run_from_cmd_line(int argc, char *_argv[], int no_compiled = 0; int init_ns = 0, no_init_ns = 0; int cross_compile = 0; - Scheme_Object *syslog_level = NULL, *stderr_level = NULL; + Scheme_Object *syslog_level = NULL, *stderr_level = NULL, *stdout_level = NULL; FinishArgs *fa; FinishArgsAtoms *fa_a; @@ -1113,6 +1113,14 @@ static int run_from_cmd_line(int argc, char *_argv[], argv++; was_config_flag = 1; break; + case 'O': + stdout_level = get_arg_log_level(prog, real_switch, "stdout", argc, argv); + if (!stdout_level) + goto show_need_help; + --argc; + argv++; + was_config_flag = 1; + break; case 'L': syslog_level = get_arg_log_level(prog, real_switch, "syslog", argc, argv); if (!syslog_level) @@ -1189,6 +1197,13 @@ static int run_from_cmd_line(int argc, char *_argv[], stderr_level = get_log_level(prog, NULL, "PLTSTDERR", "stderr", s); } } + if (!stdout_level) { + char *s; + s = getenv("PLTSTDOUT"); + if (s) { + stdout_level = get_log_level(prog, NULL, "PLTSTDOUT", "stdout", s); + } + } if (getenv("PLTDISABLEGC")) { scheme_enable_garbage_collection(0); } @@ -1227,7 +1242,7 @@ static int run_from_cmd_line(int argc, char *_argv[], } } - scheme_set_logging_spec(syslog_level, stderr_level); + scheme_set_logging2_spec(syslog_level, stderr_level, stdout_level); collects_path = adjust_collects_path(collects_path, &skip_coll_dirs); scheme_set_collects_path(collects_path); @@ -1407,6 +1422,7 @@ static int run_from_cmd_line(int argc, char *_argv[], " -d, --no-delay: Disable on-demand loading of syntax and code\n" " -b, --binary : Read stdin and write stdout/stderr in binary mode\n" " -W , --warn : Set stderr logging to \n" + " -O , --stdout : Set stdout logging to \n" " -L , --syslog : Set syslog logging to \n" " Meta options:\n" " -- : No argument following this switch is used as a switch\n" diff --git a/racket/src/racket/gc2/Makefile.in b/racket/src/racket/gc2/Makefile.in index 5d4c18a7a8..654b315972 100644 --- a/racket/src/racket/gc2/Makefile.in +++ b/racket/src/racket/gc2/Makefile.in @@ -43,7 +43,7 @@ DEF_C_DIRS = $(DEF_COLLECTS_DIR) $(DEF_CONFIG_DIR) # typically redirects to RUN_THIS_RACKET_CGC: RUN_THIS_RACKET_CGC = ../racket@CGC@ -SETUP_BOOT = -W "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled XFORM_SETUP = @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) $(SETUP_BOOT) --tag ++out $(srcdir)/xform-mod.rkt --depends XFORM_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(ALL_CPPFLAGS)" @XFORMFLAGS@ -o ++out XSRCDIR = xsrc diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index 6cc7c07896..aee08f2ab6 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1848,6 +1848,8 @@ MZ_EXTERN void scheme_set_ignore_link_paths(int); MZ_EXTERN void scheme_set_cross_compile_mode(int); MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level); MZ_EXTERN void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level); +MZ_EXTERN void scheme_set_logging2(int syslog_level, int stderr_level, int stdout_level); +MZ_EXTERN void scheme_set_logging2_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level, Scheme_Object *stdout_level); MZ_EXTERN int scheme_get_allow_set_undefined(); diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index e6aeb71913..c0014ec39e 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -54,6 +54,7 @@ void scheme_set_console_output(scheme_console_output_t p) { scheme_console_outpu SHARED_OK static Scheme_Object *init_syslog_level = scheme_make_integer(INIT_SYSLOG_LEVEL); SHARED_OK static Scheme_Object *init_stderr_level = scheme_make_integer(SCHEME_LOG_ERROR); +SHARED_OK static Scheme_Object *init_stdout_level = scheme_make_integer(0); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_main_logger); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_gc_logger); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_future_logger); @@ -146,15 +147,23 @@ static Scheme_Object *check_arity_property_value_ok(int argc, Scheme_Object *arg static char *make_provided_list(Scheme_Object *o, int count, intptr_t *lenout); static char *init_buf(intptr_t *len, intptr_t *blen); -void scheme_set_logging(int syslog_level, int stderr_level) + +void scheme_set_logging2(int syslog_level, int stderr_level, int stdout_level) { if (syslog_level > -1) init_syslog_level = scheme_make_integer(syslog_level); if (stderr_level > -1) init_stderr_level = scheme_make_integer(stderr_level); + if (stdout_level > -1) + init_stdout_level = scheme_make_integer(stdout_level); } -void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level) +void scheme_set_logging(int syslog_level, int stderr_level) +{ + scheme_set_logging2(syslog_level, stderr_level, -1); +} + +void scheme_set_logging2_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level, Scheme_Object *stdout_level) { /* A spec is (list* .... ) */ if (syslog_level) { @@ -165,6 +174,15 @@ void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_ REGISTER_SO(init_stderr_level); init_stderr_level = stderr_level; } + if (stdout_level) { + REGISTER_SO(init_stdout_level); + init_stdout_level = stdout_level; + } +} + +void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level) +{ + scheme_set_logging2_spec(syslog_level, stderr_level, NULL); } void scheme_init_logging_once(void) @@ -173,8 +191,12 @@ void scheme_init_logging_once(void) int j; Scheme_Object *l, *s; - for (j = 0; j < 2; j++) { - l = (j ? init_stderr_level : init_syslog_level); + for (j = 0; j < 3; j++) { + switch (j) { + case 0: l = init_syslog_level; break; + case 1: l = init_stderr_level; break; + default: l = init_stdout_level; break; + } if (l) { while (!SCHEME_INTP(l)) { l = SCHEME_CDR(l); @@ -885,6 +907,7 @@ void scheme_init_logger() scheme_main_logger = scheme_make_logger(NULL, NULL); scheme_main_logger->syslog_level = init_syslog_level; scheme_main_logger->stderr_level = init_stderr_level; + scheme_main_logger->stdout_level = init_stdout_level; REGISTER_SO(scheme_gc_logger); scheme_gc_logger = scheme_make_logger(scheme_main_logger, scheme_intern_symbol("GC")); @@ -3513,6 +3536,9 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name) if (level > want_level) want_level = level; level = extract_max_spec_level(parent->stderr_level, name); + if (level > want_level) + want_level = level; + level = extract_max_spec_level(parent->stdout_level, name); if (level > want_level) want_level = level; @@ -3736,7 +3762,19 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object fwrite(buffer, len, 1, stderr); fwrite("\n", 1, 1, stderr); } - + + if (extract_spec_level(logger->stdout_level, name) >= level) { + if (name) { + intptr_t slen; + slen = SCHEME_SYM_LEN(name); + fwrite(SCHEME_SYM_VAL(name), slen, 1, stdout); + fwrite(": ", 2, 1, stdout); + } + fwrite(buffer, len, 1, stdout); + fwrite("\n", 1, 1, stdout); + fflush(stdout); + } + queue = logger->readers; while (queue) { b = SCHEME_CAR(queue); @@ -3797,6 +3835,7 @@ void scheme_log_abort(char *buffer) logger.local_timestamp = 0; logger.syslog_level = init_syslog_level; logger.stderr_level = init_stderr_level; + logger.stdout_level = init_stdout_level; scheme_log_message(&logger, SCHEME_LOG_FATAL, buffer, strlen(buffer), scheme_false); } diff --git a/racket/src/racket/src/mzmark_type.inc b/racket/src/racket/src/mzmark_type.inc index 588f653d2a..e3fcd1e1df 100644 --- a/racket/src/racket/src/mzmark_type.inc +++ b/racket/src/racket/src/mzmark_type.inc @@ -3740,6 +3740,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) { gcMARK2(l->root_timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->stdout_level, gc); gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS @@ -3760,6 +3761,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(l->root_timestamp, gc); gcFIXUP2(l->syslog_level, gc); gcFIXUP2(l->stderr_level, gc); + gcFIXUP2(l->stdout_level, gc); gcFIXUP2(l->propagate_level, gc); gcFIXUP2(l->readers, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 04b00f5f0c..6173372504 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -1052,6 +1052,7 @@ mark_logger { gcMARK2(l->root_timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->stdout_level, gc); gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); size: diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index a470b8447f..3cb721d2b8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3422,6 +3422,7 @@ struct Scheme_Logger { intptr_t local_timestamp; /* determines when want_level is up-to-date */ Scheme_Object *syslog_level; /* (list* ... ) */ Scheme_Object *stderr_level; + Scheme_Object *stdout_level; Scheme_Object *propagate_level; /* can be NULL */ Scheme_Object *readers; /* list of (cons (make-weak-box ) ) */ };