core: Support redirection of stderr.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 11 Nov 2018 09:04:03 +0000 (10:04 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 11 Nov 2018 09:04:03 +0000 (10:04 +0100)
* include/libmes-mini.h (g_stderr): New global.
* lib/mes/eputc.c (eputc): Use it.
* lib/mes/eputs.c (eputs): Likewise.
* lib/mes/oputc.c (oputc): Likewise.
* lib/mes/oputs.c (oputs): Likewise.
* src/lib.c (display_error_, write_error_): Likewise.
* src/posix.c (write_byte): Likewise.
* src/mes.c (mes_builtins): Likewise.
(main): Iniitalize g_stderr.
* src/posix.c (current_error_port, set_current_error_port): New
function.
* mes/module/mes/boot-0.scm.in (current-output-port,
current-error-port): Remove.

include/libmes-mini.h
include/stdio.h
lib/mes/eputc.c
lib/mes/eputs.c
lib/mes/oputc.c
lib/mes/oputs.c
mes/module/mes/boot-0.scm.in
src/lib.c
src/mes.c
src/posix.c

index 28696418f75148f6012e6a4a5558ba08419cb24d..75800f1a6acb23508ba2d9f93f10d52cefa07484 100644 (file)
 #ifndef __MES_LIBMES_MINI_H
 #define __MES_LIBMES_MINI_H
 
+char **environ;
+int g_stdin;
+int g_stdout;
+int g_stderr;
+
 #ifndef _SIZE_T
 #define _SIZE_T
 #ifndef __SIZE_T
index 36b336720e198848b4a2b7d87ca8bfa27346a9c5..9395d39b00cc157e8ca81f4e0270e3fc16b8e0f1 100644 (file)
 #ifndef __MES_STDIO_H
 #define __MES_STDIO_H 1
 
-char **environ;
-int g_stdin;
-int g_stdout;
-
-#ifndef STDIN
-#define STDIN 0
-#endif
-
-#ifndef STDOUT
-#define STDOUT 1
-#endif
-
-#ifndef STDERR
-#define STDERR 2
-#endif
+#include <libmes.h>
 
 #if WITH_GLIBC
 #ifndef _GNU_SOURCE
index e9f7dc05fe63c40eeb96416491e7375bb2f2fee7..ac4cd15e3706d974456505324be08d029950bcc6 100644 (file)
@@ -23,5 +23,5 @@
 int
 eputc (int c)
 {
-  return fdputc (c, STDERR);
+  return fdputc (c, g_stderr);
 }
index 3b0ece0b15c77b25edd614f87aeb3879f24a9905..7b6896eff4425c0db812b3f88598937fbad4f736 100644 (file)
@@ -24,6 +24,6 @@ int
 eputs (char const* s)
 {
   int i = strlen (s);
-  write (STDERR, s, i);
+  write (g_stderr, s, i);
   return 0;
 }
index b16ed3be3b34e4de985f4c4857094e6d58748ac0..3b50e27ea763db230528e0ae2a23e12fba45635f 100644 (file)
@@ -23,5 +23,5 @@
 int
 oputc (int c)
 {
-  return fdputc (c, STDOUT);
+  return fdputc (c, g_stdout);
 }
index 123a8117843f87f53d28176bb5e0066b41610b5e..f82e3b8d2530657f3897db35f785d25a303ed3c1 100644 (file)
@@ -24,6 +24,6 @@ int
 oputs (char const* s)
 {
   int i = strlen (s);
-  write (1, s, i);
+  write (g_stdout, s, i);
   return 0;
 }
index d8b61babf2715fb921cb99f693f64202ceeb4747..b497b0e17d5eaa022dd5a520c865d95fcce2b84f 100644 (file)
 (define (primitive-eval e) (core:eval e (current-module)))
 (define eval core:eval)
 
-(define (current-output-port) 1)
-(define (current-error-port) 2)
 (define (port-filename port) "<stdin>")
 (define (port-line port) 0)
 (define (port-column port) 0)
index 25bb0884d6c3a2b0d60f10b3a5f94cf5a4a6ccf9..3dd6dd3548ce50e8020f48e63ef816cc679709fa 100644 (file)
--- a/src/lib.c
+++ b/src/lib.c
@@ -228,7 +228,7 @@ SCM
 display_error_ (SCM x)
 {
   g_depth = 5;
-  return display_helper (x, 0, "", STDERR, 0);
+  return display_helper (x, 0, "", g_stderr, 0);
 }
 
 SCM
@@ -249,7 +249,7 @@ SCM
 write_error_ (SCM x)
 {
   g_depth = 5;
-  return display_helper (x, 0, "", STDERR, 1);
+  return display_helper (x, 0, "", g_stderr, 1);
 }
 
 SCM
index 698ebe2746a57867e0d5de57c52e6272b568e1e3..48a91e2466bb4e521a13caea28dc31f5e3e01d36 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -2365,18 +2365,18 @@ a = acons (list_to_symbol (scm_getenv_.string), cell_getenv_, a);
 
   if (g_debug > 3)
     {
-      fdputs ("functions: ", STDERR);
-      fdputs (itoa (g_function), STDERR);
-      fdputs ("\n", STDERR);
+      fdputs ("functions: ", g_stderr);
+      fdputs (itoa (g_function), g_stderr);
+      fdputs ("\n", g_stderr);
       for (int i = 0; i < g_function; i++)
         {
-          fdputs ("[", STDERR);
-          fdputs (itoa (i), STDERR);
-          fdputs ("]: ", STDERR);
-          fdputs (g_functions[i].name, STDERR);
-          fdputs ("\n", STDERR);
+          fdputs ("[", g_stderr);
+          fdputs (itoa (i), g_stderr);
+          fdputs ("]: ", g_stderr);
+          fdputs (g_functions[i].name, g_stderr);
+          fdputs ("\n", g_stderr);
         }
-      fdputs ("\n", STDERR);
+      fdputs ("\n", g_stderr);
     }
 
   return a;
@@ -2549,6 +2549,7 @@ main (int argc, char *argv[])
     STACK_SIZE = atoi (p);
   g_stdin = STDIN;
   g_stdout = STDOUT;
+  g_stderr = STDERR;
 
   SCM a = mes_environment (argc, argv);
   a = mes_builtins (a);
index eba767a416c595ab9cccd8476640420f254b3cde..d8deb3a93fe52217849324b1fbe79bba8fc2d552 100644 (file)
@@ -136,6 +136,8 @@ write_byte (SCM x) ///((arity . n))
   int fd = g_stdout;
   if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) != 1)
     fd = VALUE (CAR (p));
+  if (TYPE (p) == TPAIR && TYPE (car (p)) == TNUMBER && VALUE (CAR (p)) == 2)
+    fd = g_stderr;
   char cc = VALUE (c);
   write (fd, (char*)&cc, 1);
 #if !__MESC__
@@ -230,6 +232,12 @@ current_output_port ()
   return MAKE_NUMBER (g_stdout);
 }
 
+SCM
+current_error_port ()
+{
+  return MAKE_NUMBER (g_stderr);
+}
+
 SCM
 open_output_file (SCM x) ///((arity . n))
 {
@@ -248,6 +256,13 @@ set_current_output_port (SCM port)
   return current_output_port ();
 }
 
+SCM
+set_current_error_port (SCM port)
+{
+  g_stderr = VALUE (port) ? VALUE (port) : STDERR;
+  return current_error_port ();
+}
+
 SCM
 force_output (SCM p) ///((arity . n))
 {