core: Support redirection of stderr.

* 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

@@ -21,6 +21,11 @@
 #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

include/stdio.h

@@ -20,21 +20,7 @@
 #ifndef __MES_STDIO_H
 #define __MES_STDIO_H 1
 
-char **environ;
+#include <libmes.h>
-int g_stdin;
-int g_stdout;
-
-#ifndef STDIN
-#define STDIN 0
-#endif
-
-#ifndef STDOUT
-#define STDOUT 1
-#endif
-
-#ifndef STDERR
-#define STDERR 2
-#endif
 
 #if WITH_GLIBC
 #ifndef _GNU_SOURCE

lib/mes/eputc.c

@@ -23,5 +23,5 @@
 int
 eputc (int c)
 {
-  return fdputc (c, STDERR);
+  return fdputc (c, g_stderr);
 }

lib/mes/eputs.c

@@ -24,6 +24,6 @@ int
 eputs (char const* s)
 {
   int i = strlen (s);
-  write (STDERR, s, i);
+  write (g_stderr, s, i);
   return 0;
 }

lib/mes/oputc.c

@@ -23,5 +23,5 @@
 int
 oputc (int c)
 {
-  return fdputc (c, STDOUT);
+  return fdputc (c, g_stdout);
 }

lib/mes/oputs.c

@@ -24,6 +24,6 @@ int
 oputs (char const* s)
 {
   int i = strlen (s);
-  write (1, s, i);
+  write (g_stdout, s, i);
   return 0;
 }

mes/module/mes/boot-0.scm.in

@@ -111,8 +111,6 @@
 (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)

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

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 ("functions: ", g_stderr);
-      fdputs (itoa (g_function), STDERR);
+      fdputs (itoa (g_function), g_stderr);
-      fdputs ("\n", STDERR);
+      fdputs ("\n", g_stderr);
       for (int i = 0; i < g_function; i++)
         {
-          fdputs ("[", STDERR);
+          fdputs ("[", g_stderr);
-          fdputs (itoa (i), STDERR);
+          fdputs (itoa (i), g_stderr);
-          fdputs ("]: ", STDERR);
+          fdputs ("]: ", g_stderr);
-          fdputs (g_functions[i].name, STDERR);
+          fdputs (g_functions[i].name, g_stderr);
-          fdputs ("\n", 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);

src/posix.c

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