From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 9 May 2018 04:45:21 +0000 (-0700)
Subject: Implement support for stderr.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~73
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8377a31e8947031a9d0c737ba7babb5a7dcb082b;p=mit-scheme.git

Implement support for stderr.
---

diff --git a/src/microcode/nttty.c b/src/microcode/nttty.c
index 78f2aa32b..82529fe70 100644
--- a/src/microcode/nttty.c
+++ b/src/microcode/nttty.c
@@ -33,8 +33,7 @@ USA.
 
 /* Standard Input and Output */
 
-static Tchannel input_channel;
-static Tchannel output_channel;
+static Tchannel tty_channel;
 
 HANDLE master_tty_window = 0;
 
@@ -47,13 +46,19 @@ static char * tty_command_clear;
 Tchannel
 OS_tty_input_channel (void)
 {
-  return (input_channel);
+  return (tty_channel);
 }
 
 Tchannel
 OS_tty_output_channel (void)
 {
-  return (output_channel);
+  return (tty_channel);
+}
+
+Tchannel
+OS_tty_error_channel (void)
+{
+  return (tty_channel);
 }
 
 unsigned int
@@ -85,9 +90,8 @@ OS_tty_command_clear (void)
 void
 NT_initialize_tty (void)
 {
-  input_channel = (NT_open_handle (master_tty_window));
-  (CHANNEL_INTERNAL (input_channel)) = 1;
-  output_channel = input_channel;
+  tty_channel = (NT_open_handle (master_tty_window));
+  (CHANNEL_INTERNAL (tty_channel)) = 1;
   Screen_GetSize (master_tty_window, (&tty_y_size), (&tty_x_size));
   tty_command_beep = ALERT_STRING;
   tty_command_clear = "\014";
diff --git a/src/microcode/ostty.h b/src/microcode/ostty.h
index cc2a8ad60..ed0b4f840 100644
--- a/src/microcode/ostty.h
+++ b/src/microcode/ostty.h
@@ -31,6 +31,7 @@ USA.
 
 extern Tchannel OS_tty_input_channel (void);
 extern Tchannel OS_tty_output_channel (void);
+extern Tchannel OS_tty_error_channel (void);
 extern unsigned int OS_tty_x_size (void);
 extern unsigned int OS_tty_y_size (void);
 extern const char * OS_tty_command_beep (void);
diff --git a/src/microcode/prostty.c b/src/microcode/prostty.c
index 19c6b4bdb..54b40e3f8 100644
--- a/src/microcode/prostty.c
+++ b/src/microcode/prostty.c
@@ -47,6 +47,13 @@ DEFINE_PRIMITIVE ("TTY-OUTPUT-CHANNEL", Prim_tty_output_channel, 0, 0,
   PRIMITIVE_RETURN (long_to_integer (OS_tty_output_channel ()));
 }
 
+DEFINE_PRIMITIVE ("TTY-ERROR-CHANNEL", Prim_tty_error_channel, 0, 0,
+  "Return the standard error channel.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (OS_tty_error_channel ()));
+}
+
 DEFINE_PRIMITIVE ("TTY-X-SIZE", Prim_tty_x_size, 0, 0,
   "Return the display width in character columns.")
 {
diff --git a/src/microcode/uxtty.c b/src/microcode/uxtty.c
index a1ceeee1c..7551f72ca 100644
--- a/src/microcode/uxtty.c
+++ b/src/microcode/uxtty.c
@@ -44,6 +44,7 @@ extern void tputs (const char *, int, void (*) (char));
 
 static Tchannel input_channel;
 static Tchannel output_channel;
+static Tchannel error_channel;
 
 static int tty_x_size;
 static int tty_y_size;
@@ -65,6 +66,12 @@ OS_tty_output_channel (void)
   return (output_channel);
 }
 
+Tchannel
+OS_tty_error_channel (void)
+{
+  return (error_channel);
+}
+
 unsigned int
 OS_tty_x_size (void)
 {
@@ -218,6 +225,8 @@ UX_initialize_tty (void)
   (CHANNEL_INTERNAL (input_channel)) = 1;
   output_channel = (OS_open_fd (STDOUT_FILENO));
   (CHANNEL_INTERNAL (output_channel)) = 1;
+  error_channel = (OS_open_fd (STDERR_FILENO));
+  (CHANNEL_INTERNAL (error_channel)) = 1;
   tty_size_synchronized_p = false;
   UX_synchronize_tty_size ();
   tty_command_beep = ALERT_STRING;