From f93f5f0cc2ab9a844e8e2b8152addf5bc770464f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 May 1996 20:22:30 +0000
Subject: [PATCH] Add support for sockets under OS/2.

---
 v7/src/microcode/os2api.h   |  74 +++++++++++++++++-
 v7/src/microcode/os2cthrd.c |  82 +++++++++++++++++---
 v7/src/microcode/os2cthrd.h |  11 ++-
 v7/src/microcode/os2io.c    |  67 +++++++++++-----
 v7/src/microcode/os2io.h    |   7 +-
 v7/src/microcode/os2pipe.c  |  99 ++++++++----------------
 v7/src/microcode/os2top.c   | 147 +++++++++++++++++++++++++++++++++++-
 v7/src/microcode/pruxsock.c | 140 ++++++++++++++++++----------------
 8 files changed, 453 insertions(+), 174 deletions(-)

diff --git a/v7/src/microcode/os2api.h b/v7/src/microcode/os2api.h
index f58b63127..72b54a880 100644
--- a/v7/src/microcode/os2api.h
+++ b/v7/src/microcode/os2api.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2api.h,v 1.7 1995/10/27 23:55:12 cph Exp $
+$Id: os2api.h,v 1.8 1996/05/09 20:20:58 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -109,7 +109,17 @@ enum syscall_names
   syscall_mktime,
   syscall_realloc,
   syscall_time,
-  syscall_vio_wrt_tty
+  syscall_vio_wrt_tty,
+
+  /* Socket calls: */
+  syscall_accept,
+  syscall_bind,
+  syscall_connect,
+  syscall_listen,
+  syscall_recv,
+  syscall_send,
+  syscall_socket,
+  syscall_soclose
 };
 
 /* Machine-generated table, do not edit: */
@@ -720,6 +730,52 @@ enum syserr_names
   syserr_cpsio_inv_command,
   syserr_cpsio_no_font_swit,
   syserr_entry_is_callgate,
+
+  /* Socket errors: */
+  syserr_socket_perm,
+  syserr_socket_srch,
+  syserr_socket_intr,
+  syserr_socket_nxio,
+  syserr_socket_badf,
+  syserr_socket_acces,
+  syserr_socket_fault,
+  syserr_socket_inval,
+  syserr_socket_mfile,
+  syserr_socket_pipe,
+  syserr_socket_os2err,
+  syserr_socket_wouldblock,
+  syserr_socket_inprogress,
+  syserr_socket_already,
+  syserr_socket_notsock,
+  syserr_socket_destaddrreq,
+  syserr_socket_msgsize,
+  syserr_socket_prototype,
+  syserr_socket_noprotoopt,
+  syserr_socket_protonosupport,
+  syserr_socket_socktnosupport,
+  syserr_socket_opnotsupp,
+  syserr_socket_pfnosupport,
+  syserr_socket_afnosupport,
+  syserr_socket_addrinuse,
+  syserr_socket_addrnotavail,
+  syserr_socket_netdown,
+  syserr_socket_netunreach,
+  syserr_socket_netreset,
+  syserr_socket_connaborted,
+  syserr_socket_connreset,
+  syserr_socket_nobufs,
+  syserr_socket_isconn,
+  syserr_socket_notconn,
+  syserr_socket_shutdown,
+  syserr_socket_toomanyrefs,
+  syserr_socket_timedout,
+  syserr_socket_connrefused,
+  syserr_socket_loop,
+  syserr_socket_nametoolong,
+  syserr_socket_hostdown,
+  syserr_socket_hostunreach,
+  syserr_socket_notempty,
+
   syserr_unknown
 };
 
@@ -903,7 +959,17 @@ static char * syscall_names_table [] =
   "mktime",
   "realloc",
   "time",
-  "vio-wrt-tty"
+  "vio-wrt-tty",
+
+  /* Socket calls: */
+  "accept",
+  "bind",
+  "connect",
+  "listen",
+  "recv",
+  "send",
+  "socket",
+  "soclose"
 };
 
 #endif /* SCM_OS2TOP_C */
diff --git a/v7/src/microcode/os2cthrd.c b/v7/src/microcode/os2cthrd.c
index efc45c874..94078425a 100644
--- a/v7/src/microcode/os2cthrd.c
+++ b/v7/src/microcode/os2cthrd.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2cthrd.c,v 1.7 1995/10/15 00:34:47 cph Exp $
+$Id: os2cthrd.c,v 1.8 1996/05/09 20:21:20 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,11 +36,76 @@ MIT in each case. */
 
 #include "os2.h"
 
+static void run_channel_thread (void *);
 static void start_readahead_thread (channel_context_t *);
 static void send_readahead_ack (qid_t, enum readahead_ack_action);
 static msg_list_t * new_list (void);
 static msg_t * new_message (void);
 
+typedef struct
+{
+  LHANDLE handle;
+  qid_t qid;
+  channel_reader_t reader;
+} thread_arg_t;
+
+void
+OS2_start_channel_thread (Tchannel channel,
+			  channel_reader_t reader,
+			  channel_op_t operator)
+{
+  channel_context_t * context = (OS2_make_channel_context ());
+  thread_arg_t * arg = (OS_malloc (sizeof (thread_arg_t)));
+  (CHANNEL_OPERATOR_CONTEXT (channel)) = context;
+  OS2_open_qid ((CHANNEL_CONTEXT_READER_QID (context)), OS2_scheme_tqueue);
+  OS2_open_qid
+    ((CHANNEL_CONTEXT_WRITER_QID (context)), (OS2_make_std_tqueue ()));
+  (arg -> handle) = (CHANNEL_HANDLE (channel));
+  (arg -> qid) = (CHANNEL_CONTEXT_WRITER_QID (context));
+  (arg -> reader) = reader;
+  (CHANNEL_CONTEXT_TID (context))
+    = (OS2_beginthread (run_channel_thread, arg, 0));
+  (CHANNEL_OPERATOR (channel)) = operator;
+}
+
+static void
+run_channel_thread (void * arg)
+{
+  LHANDLE handle = (((thread_arg_t *) arg) -> handle);
+  qid_t qid = (((thread_arg_t *) arg) -> qid);
+  channel_reader_t reader = (((thread_arg_t *) arg) -> reader);
+  EXCEPTIONREGISTRATIONRECORD registration;
+  OS_free (arg);
+  (void) OS2_thread_initialize ((&registration), qid);
+  /* Wait for first read request before doing anything.  */
+  while ((OS2_wait_for_readahead_ack (qid)) == raa_read)
+    {
+      int eofp;
+      msg_t * message
+	= ((*reader) (handle, qid, (OS2_make_readahead ()), (&eofp)));
+      if (message == 0)
+	break;
+      OS2_send_message (qid, message);
+      if (eofp)
+	break;
+    }
+  {
+    tqueue_t * tqueue = (OS2_qid_tqueue (qid));
+    OS2_close_qid (qid);
+    OS2_close_std_tqueue (tqueue);
+  }
+  OS2_endthread ();
+}
+
+void
+OS2_channel_thread_read_op (Tchannel channel,
+			    choparg_t arg1, choparg_t arg2, choparg_t arg3)
+{
+  (* ((long *) arg3))
+    = (OS2_channel_thread_read
+       (channel, ((char *) arg1), ((size_t) arg2)));
+}
+
 void
 OS2_initialize_channel_thread_messages (void)
 {
@@ -68,13 +133,12 @@ OS2_channel_thread_close (Tchannel channel)
   send_readahead_ack ((CHANNEL_CONTEXT_READER_QID (context)), raa_close);
   OS2_close_qid (CHANNEL_CONTEXT_READER_QID (context));
   OS_free (context);
-  /* Finally, close the channel handle.  If the channel thread is
-     blocked in dos_read, this will break it out and get it to kill
-     itself.  There's no race, because the channel thread won't try to
-     close the handle, and if it breaks out of dos_read before we do
-     the close, it will see the readahead ACK we just sent and that
-     will kill it.  */
-  STD_API_CALL (dos_close, (CHANNEL_HANDLE (channel)));
+  /* Finally, the caller must close the channel handle.  If the
+     channel thread is blocked in dos_read, this will break it out and
+     get it to kill itself.  There's no race, because the channel
+     thread won't try to close the handle, and if it breaks out of
+     dos_read before we do the close, it will see the readahead ACK we
+     just sent and that will kill it.  */
 }
 
 qid_t
diff --git a/v7/src/microcode/os2cthrd.h b/v7/src/microcode/os2cthrd.h
index b99048d58..ae44deb7c 100644
--- a/v7/src/microcode/os2cthrd.h
+++ b/v7/src/microcode/os2cthrd.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2cthrd.h,v 1.4 1995/04/28 07:04:57 cph Exp $
+$Id: os2cthrd.h,v 1.5 1996/05/09 20:21:30 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -73,6 +73,13 @@ typedef struct
 } sm_readahead_ack_t;
 #define SM_READAHEAD_ACK_ACTION(m) (((sm_readahead_ack_t *) (m)) -> action)
 
+typedef msg_t * (* channel_reader_t) (LHANDLE, qid_t, msg_t *, int *);
+
+extern void OS2_start_channel_thread
+  (Tchannel, channel_reader_t, channel_op_t);
+extern void OS2_channel_thread_read_op
+  (Tchannel, choparg_t, choparg_t, choparg_t);
+
 extern channel_context_t * OS2_make_channel_context (void);
 extern long OS2_channel_thread_read (Tchannel, char *, size_t);
 extern enum readahead_ack_action OS2_wait_for_readahead_ack (qid_t);
diff --git a/v7/src/microcode/os2io.c b/v7/src/microcode/os2io.c
index 5d5a11091..13efc6ddd 100644
--- a/v7/src/microcode/os2io.c
+++ b/v7/src/microcode/os2io.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2io.c,v 1.5 1995/11/03 01:23:41 cph Exp $
+$Id: os2io.c,v 1.6 1996/05/09 20:21:39 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -83,28 +83,14 @@ OS2_channel_operation (Tchannel channel, chop_t operation,
 Tchannel
 OS2_make_channel (LHANDLE handle, unsigned int mode)
 {
-  Tchannel channel = 0;
+  Tchannel channel;
   enum channel_type type;
   transaction_begin ();
   OS2_handle_close_on_abort (handle);
-  while (1)
-    {
-      if (channel == OS_channel_table_size)
-	OS2_error_out_of_channels ();
-      if (! (CHANNEL_OPEN (channel)))
-	break;
-      channel += 1;
-    }
   type = (handle_channel_type (handle));
   handle_noinherit (handle);
-  (CHANNEL_HANDLE (channel)) = handle;
-  (CHANNEL_TYPE (channel)) = type;
-  (CHANNEL_OPEN (channel)) = 1;
-  (CHANNEL_INTERNAL (channel)) = 0;
-  (CHANNEL_NONBLOCKING (channel)) = 0;
-  (CHANNEL_INPUTP (channel)) = ((mode & CHANNEL_READ) != 0);
-  (CHANNEL_OUTPUTP (channel)) = ((mode & CHANNEL_WRITE) != 0);
-  (CHANNEL_OPERATOR (channel)) = 0;
+  channel = (OS2_allocate_channel ());
+  OS2_initialize_channel (channel, handle, mode, type);
   switch (type)
     {
     case channel_type_console:
@@ -118,6 +104,20 @@ OS2_make_channel (LHANDLE handle, unsigned int mode)
   return (channel);
 }
 
+Tchannel
+OS2_allocate_channel (void)
+{
+  Tchannel channel = 0;
+  while (1)
+    {
+      if (channel == OS_channel_table_size)
+	OS2_error_out_of_channels ();
+      if (! (CHANNEL_OPEN (channel)))
+	return (channel);
+      channel += 1;
+    }
+}
+
 static enum channel_type
 handle_channel_type (LHANDLE handle)
 {
@@ -174,6 +174,35 @@ handle_noinherit (LHANDLE handle)
   STD_API_CALL
     (dos_set_fh_state, (handle, (state | OPEN_FLAGS_NOINHERIT)));
 }
+
+static void
+channel_discard_on_abort_1 (void * cp)
+{
+  (CHANNEL_OPEN (* ((Tchannel *) cp))) = 0;
+}
+
+static void
+channel_discard_on_abort (Tchannel c)
+{
+  Tchannel * cp = (dstack_alloc (sizeof (Tchannel)));
+  (*cp) = c;
+  transaction_record_action (tat_abort, channel_discard_on_abort_1, cp);
+}
+
+void
+OS2_initialize_channel (Tchannel channel, LHANDLE handle, unsigned int mode,
+			enum channel_type type)
+{
+  (CHANNEL_HANDLE (channel)) = handle;
+  (CHANNEL_TYPE (channel)) = type;
+  (CHANNEL_OPEN (channel)) = 1;
+  (CHANNEL_INTERNAL (channel)) = 0;
+  (CHANNEL_NONBLOCKING (channel)) = 0;
+  (CHANNEL_INPUTP (channel)) = ((mode & CHANNEL_READ) != 0);
+  (CHANNEL_OUTPUTP (channel)) = ((mode & CHANNEL_WRITE) != 0);
+  (CHANNEL_OPERATOR (channel)) = 0;
+  channel_discard_on_abort (channel);
+}
 
 void
 OS_channel_close (Tchannel channel)
diff --git a/v7/src/microcode/os2io.h b/v7/src/microcode/os2io.h
index dd4e71441..83489a0b0 100644
--- a/v7/src/microcode/os2io.h
+++ b/v7/src/microcode/os2io.h
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2io.h,v 1.2 1995/04/28 07:04:59 cph Exp $
+$Id: os2io.h,v 1.3 1996/05/09 20:21:48 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -90,6 +90,9 @@ struct channel
 extern struct channel * OS2_channel_table;
 extern Tchannel * OS2_channel_pointer_table;
 extern Tchannel OS2_make_channel (LHANDLE, unsigned int);
+extern void OS2_initialize_channel
+  (Tchannel, LHANDLE, unsigned int, enum channel_type);
+extern Tchannel OS2_allocate_channel (void);
 extern void OS2_channel_close_all_noerror (void);
 extern void OS_channel_close_on_abort (Tchannel);
 extern void OS2_handle_close_on_abort (LHANDLE);
diff --git a/v7/src/microcode/os2pipe.c b/v7/src/microcode/os2pipe.c
index 9933b3c71..40bc6ee61 100644
--- a/v7/src/microcode/os2pipe.c
+++ b/v7/src/microcode/os2pipe.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2pipe.c,v 1.6 1995/04/28 07:05:00 cph Exp $
+$Id: os2pipe.c,v 1.7 1996/05/09 20:21:56 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -34,9 +34,9 @@ MIT in each case. */
 
 #include "os2.h"
 
+static msg_t * input_pipe_reader (LHANDLE, qid_t, msg_t *, int *);
 static void input_pipe_operator
   (Tchannel, chop_t, choparg_t, choparg_t, choparg_t);
-static void input_pipe_thread (void *);
 
 void
 OS_make_pipe (Tchannel * readerp, Tchannel * writerp)
@@ -54,31 +54,38 @@ OS_make_pipe (Tchannel * readerp, Tchannel * writerp)
   transaction_commit ();
 }
 
-typedef struct
-{
-  LHANDLE handle;
-  qid_t qid;
-} thread_arg_t;
-
 void
 OS2_initialize_pipe_channel (Tchannel channel)
 {
   if (CHANNEL_INPUTP (channel))
+    OS2_start_channel_thread (channel,
+			      input_pipe_reader,
+			      input_pipe_operator);
+}
+
+static msg_t *
+input_pipe_reader (LHANDLE handle, qid_t qid, msg_t * message, int * eofp)
+{
+  ULONG nread;
+  APIRET rc
+    = (dos_read (handle,
+		 (SM_READAHEAD_DATA (message)),
+		 (sizeof (SM_READAHEAD_DATA (message))),
+		 (& nread)));
+  if (rc == NO_ERROR)
     {
-      channel_context_t * context = (OS2_make_channel_context ());
-      thread_arg_t * arg = (OS_malloc (sizeof (thread_arg_t)));
-      (CHANNEL_OPERATOR_CONTEXT (channel)) = context;
-      OS2_open_qid ((CHANNEL_CONTEXT_READER_QID (context)), OS2_scheme_tqueue);
-      OS2_open_qid
-	((CHANNEL_CONTEXT_WRITER_QID (context)), (OS2_make_std_tqueue ()));
-      (arg -> handle) = (CHANNEL_HANDLE (channel));
-      (arg -> qid) = (CHANNEL_CONTEXT_WRITER_QID (context));
-      (CHANNEL_CONTEXT_TID (context))
-	= (OS2_beginthread (input_pipe_thread, arg, 0));
-      (CHANNEL_OPERATOR (channel)) = input_pipe_operator;
+      (SM_READAHEAD_SIZE (message)) = nread;
+      (*eofp) = (nread == 0);
+      return (message);
     }
+  OS2_destroy_message (message);
+  if (rc == ERROR_INVALID_HANDLE)
+    /* Handle was closed on us -- no need to do anything else.  */
+    return (0);
+  (*eofp) = (rc == ERROR_BROKEN_PIPE);
+  return (OS2_make_syscall_error (rc, syscall_dos_read));
 }
-
+
 static void
 input_pipe_operator (Tchannel channel, chop_t operation,
 		     choparg_t arg1, choparg_t arg2, choparg_t arg3)
@@ -86,60 +93,14 @@ input_pipe_operator (Tchannel channel, chop_t operation,
   switch (operation)
     {
     case chop_read:
-      (* ((long *) arg3))
-	= (OS2_channel_thread_read
-	   (channel, ((char *) arg1), ((size_t) arg2)));
+      OS2_channel_thread_read_op (channel, arg1, arg2, arg3);
       break;
     case chop_close:
       OS2_channel_thread_close (channel);
+      STD_API_CALL (dos_close, (CHANNEL_HANDLE (channel)));
       break;
     default:
       OS2_logic_error ("Unknown operation for input pipe.");
       break;
     }
 }
-
-static void
-input_pipe_thread (void * arg)
-{
-  LHANDLE handle = (((thread_arg_t *) arg) -> handle);
-  qid_t qid = (((thread_arg_t *) arg) -> qid);
-  EXCEPTIONREGISTRATIONRECORD registration;
-  OS_free (arg);
-  (void) OS2_thread_initialize ((&registration), qid);
-  /* Wait for first read request before doing anything.  */
-  while ((OS2_wait_for_readahead_ack (qid)) == raa_read)
-    {
-      msg_t * message = (OS2_make_readahead ());
-      ULONG nread;
-      APIRET rc
-	= (dos_read (handle,
-		     (SM_READAHEAD_DATA (message)),
-		     (sizeof (SM_READAHEAD_DATA (message))),
-		     (& nread)));
-      int eofp;
-      if (rc == NO_ERROR)
-	{
-	  (SM_READAHEAD_SIZE (message)) = nread;
-	  eofp = (nread == 0);
-	}
-      else
-	{
-	  OS2_destroy_message (message);
-	  if (rc == ERROR_INVALID_HANDLE)
-	    /* Handle was closed on us -- no need to do anything else.  */
-	    break;
-	  message = (OS2_make_syscall_error (rc, syscall_dos_read));
-	  eofp = (rc == ERROR_BROKEN_PIPE);
-	}
-      OS2_send_message (qid, message);
-      if (eofp)
-	break;
-    }
-  {
-    tqueue_t * tqueue = (OS2_qid_tqueue (qid));
-    OS2_close_qid (qid);
-    OS2_close_std_tqueue (tqueue);
-  }
-  OS2_endthread ();
-}
diff --git a/v7/src/microcode/os2top.c b/v7/src/microcode/os2top.c
index 9328610cf..9ecf217be 100644
--- a/v7/src/microcode/os2top.c
+++ b/v7/src/microcode/os2top.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: os2top.c,v 1.16 1995/10/15 00:39:03 cph Exp $
+$Id: os2top.c,v 1.17 1996/05/09 20:22:20 cph Exp $
 
-Copyright (c) 1994-95 Massachusetts Institute of Technology
+Copyright (c) 1994-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -38,6 +38,9 @@ MIT in each case. */
 #include "os2.h"
 #include "ostop.h"
 #include "option.h"
+#ifndef DISABLE_SOCKET_SUPPORT
+#include <nerrno.h>
+#endif
 
 extern void OS2_initialize_channels (void);
 extern void OS2_initialize_channel_thread_messages (void);
@@ -1070,6 +1073,53 @@ OS_error_code_to_syserr (int code)
     case ERROR_CPSIO_INV_COMMAND:	return (syserr_cpsio_inv_command);
     case ERROR_CPSIO_NO_FONT_SWIT:	return (syserr_cpsio_no_font_swit);
     case ERROR_ENTRY_IS_CALLGATE:	return (syserr_entry_is_callgate);
+
+#ifndef DISABLE_SOCKET_SUPPORT
+    case SOCEPERM:		return (syserr_socket_perm);
+    case SOCESRCH:		return (syserr_socket_srch);
+    case SOCEINTR:		return (syserr_socket_intr);
+    case SOCENXIO:		return (syserr_socket_nxio);
+    case SOCEBADF:		return (syserr_socket_badf);
+    case SOCEACCES:		return (syserr_socket_acces);
+    case SOCEFAULT:		return (syserr_socket_fault);
+    case SOCEINVAL:		return (syserr_socket_inval);
+    case SOCEMFILE:		return (syserr_socket_mfile);
+    case SOCEPIPE:		return (syserr_socket_pipe);
+    case SOCEOS2ERR:		return (syserr_socket_os2err);
+    case SOCEWOULDBLOCK:	return (syserr_socket_wouldblock);
+    case SOCEINPROGRESS:	return (syserr_socket_inprogress);
+    case SOCEALREADY:		return (syserr_socket_already);
+    case SOCENOTSOCK:		return (syserr_socket_notsock);
+    case SOCEDESTADDRREQ:	return (syserr_socket_destaddrreq);
+    case SOCEMSGSIZE:		return (syserr_socket_msgsize);
+    case SOCEPROTOTYPE:		return (syserr_socket_prototype);
+    case SOCENOPROTOOPT:	return (syserr_socket_noprotoopt);
+    case SOCEPROTONOSUPPORT:	return (syserr_socket_protonosupport);
+    case SOCESOCKTNOSUPPORT:	return (syserr_socket_socktnosupport);
+    case SOCEOPNOTSUPP:		return (syserr_socket_opnotsupp);
+    case SOCEPFNOSUPPORT:	return (syserr_socket_pfnosupport);
+    case SOCEAFNOSUPPORT:	return (syserr_socket_afnosupport);
+    case SOCEADDRINUSE:		return (syserr_socket_addrinuse);
+    case SOCEADDRNOTAVAIL:	return (syserr_socket_addrnotavail);
+    case SOCENETDOWN:		return (syserr_socket_netdown);
+    case SOCENETUNREACH:	return (syserr_socket_netunreach);
+    case SOCENETRESET:		return (syserr_socket_netreset);
+    case SOCECONNABORTED:	return (syserr_socket_connaborted);
+    case SOCECONNRESET:		return (syserr_socket_connreset);
+    case SOCENOBUFS:		return (syserr_socket_nobufs);
+    case SOCEISCONN:		return (syserr_socket_isconn);
+    case SOCENOTCONN:		return (syserr_socket_notconn);
+    case SOCESHUTDOWN:		return (syserr_socket_shutdown);
+    case SOCETOOMANYREFS:	return (syserr_socket_toomanyrefs);
+    case SOCETIMEDOUT:		return (syserr_socket_timedout);
+    case SOCECONNREFUSED:	return (syserr_socket_connrefused);
+    case SOCELOOP:		return (syserr_socket_loop);
+    case SOCENAMETOOLONG:	return (syserr_socket_nametoolong);
+    case SOCEHOSTDOWN:		return (syserr_socket_hostdown);
+    case SOCEHOSTUNREACH:	return (syserr_socket_hostunreach);
+    case SOCENOTEMPTY:		return (syserr_socket_notempty);
+#endif /* not DISABLE_SOCKET_SUPPORT */
+
     default:	return (syserr_unknown);
     }
 }
@@ -1695,6 +1745,53 @@ syserr_to_error_code (enum syserr_names syserr)
     case syserr_cpsio_inv_command:	return (ERROR_CPSIO_INV_COMMAND);
     case syserr_cpsio_no_font_swit:	return (ERROR_CPSIO_NO_FONT_SWIT);
     case syserr_entry_is_callgate:	return (ERROR_ENTRY_IS_CALLGATE);
+
+#ifndef DISABLE_SOCKET_SUPPORT
+    case syserr_socket_perm:		return (SOCEPERM);
+    case syserr_socket_srch:		return (SOCESRCH);
+    case syserr_socket_intr:		return (SOCEINTR);
+    case syserr_socket_nxio:		return (SOCENXIO);
+    case syserr_socket_badf:		return (SOCEBADF);
+    case syserr_socket_acces:		return (SOCEACCES);
+    case syserr_socket_fault:		return (SOCEFAULT);
+    case syserr_socket_inval:		return (SOCEINVAL);
+    case syserr_socket_mfile:		return (SOCEMFILE);
+    case syserr_socket_pipe:		return (SOCEPIPE);
+    case syserr_socket_os2err:		return (SOCEOS2ERR);
+    case syserr_socket_wouldblock:	return (SOCEWOULDBLOCK);
+    case syserr_socket_inprogress:	return (SOCEINPROGRESS);
+    case syserr_socket_already:		return (SOCEALREADY);
+    case syserr_socket_notsock:		return (SOCENOTSOCK);
+    case syserr_socket_destaddrreq:	return (SOCEDESTADDRREQ);
+    case syserr_socket_msgsize:		return (SOCEMSGSIZE);
+    case syserr_socket_prototype:	return (SOCEPROTOTYPE);
+    case syserr_socket_noprotoopt:	return (SOCENOPROTOOPT);
+    case syserr_socket_protonosupport:	return (SOCEPROTONOSUPPORT);
+    case syserr_socket_socktnosupport:	return (SOCESOCKTNOSUPPORT);
+    case syserr_socket_opnotsupp:	return (SOCEOPNOTSUPP);
+    case syserr_socket_pfnosupport:	return (SOCEPFNOSUPPORT);
+    case syserr_socket_afnosupport:	return (SOCEAFNOSUPPORT);
+    case syserr_socket_addrinuse:	return (SOCEADDRINUSE);
+    case syserr_socket_addrnotavail:	return (SOCEADDRNOTAVAIL);
+    case syserr_socket_netdown:		return (SOCENETDOWN);
+    case syserr_socket_netunreach:	return (SOCENETUNREACH);
+    case syserr_socket_netreset:	return (SOCENETRESET);
+    case syserr_socket_connaborted:	return (SOCECONNABORTED);
+    case syserr_socket_connreset:	return (SOCECONNRESET);
+    case syserr_socket_nobufs:		return (SOCENOBUFS);
+    case syserr_socket_isconn:		return (SOCEISCONN);
+    case syserr_socket_notconn:		return (SOCENOTCONN);
+    case syserr_socket_shutdown:	return (SOCESHUTDOWN);
+    case syserr_socket_toomanyrefs:	return (SOCETOOMANYREFS);
+    case syserr_socket_timedout:	return (SOCETIMEDOUT);
+    case syserr_socket_connrefused:	return (SOCECONNREFUSED);
+    case syserr_socket_loop:		return (SOCELOOP);
+    case syserr_socket_nametoolong:	return (SOCENAMETOOLONG);
+    case syserr_socket_hostdown:	return (SOCEHOSTDOWN);
+    case syserr_socket_hostunreach:	return (SOCEHOSTUNREACH);
+    case syserr_socket_notempty:	return (SOCENOTEMPTY);
+#endif /* not DISABLE_SOCKET_SUPPORT */
+
     default:	return (NO_ERROR);
     }
 }
@@ -2371,6 +2468,52 @@ static char * syserr_names_table [] =
   "CPSIO-INV-COMMAND",
   "CPSIO-NO-FONT-SWIT",
   "ENTRY-IS-CALLGATE",
+
+  /* Socket errors: */
+  "SOCEPERM",
+  "SOCESRCH",
+  "SOCEINTR",
+  "SOCENXIO",
+  "SOCEBADF",
+  "SOCEACCES",
+  "SOCEFAULT",
+  "SOCEINVAL",
+  "SOCEMFILE",
+  "SOCEPIPE",
+  "SOCEOS2ERR",
+  "SOCEWOULDBLOCK",
+  "SOCEINPROGRESS",
+  "SOCEALREADY",
+  "SOCENOTSOCK",
+  "SOCEDESTADDRREQ",
+  "SOCEMSGSIZE",
+  "SOCEPROTOTYPE",
+  "SOCENOPROTOOPT",
+  "SOCEPROTONOSUPPORT",
+  "SOCESOCKTNOSUPPORT",
+  "SOCEOPNOTSUPP",
+  "SOCEPFNOSUPPORT",
+  "SOCEAFNOSUPPORT",
+  "SOCEADDRINUSE",
+  "SOCEADDRNOTAVAIL",
+  "SOCENETDOWN",
+  "SOCENETUNREACH",
+  "SOCENETRESET",
+  "SOCECONNABORTED",
+  "SOCECONNRESET",
+  "SOCENOBUFS",
+  "SOCEISCONN",
+  "SOCENOTCONN",
+  "SOCESHUTDOWN",
+  "SOCETOOMANYREFS",
+  "SOCETIMEDOUT",
+  "SOCECONNREFUSED",
+  "SOCELOOP",
+  "SOCENAMETOOLONG",
+  "SOCEHOSTDOWN",
+  "SOCEHOSTUNREACH",
+  "SOCENOTEMPTY",
+
   "UNKNOWN"
 };
 
diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c
index ea1e376d9..5e6d1701e 100644
--- a/v7/src/microcode/pruxsock.c
+++ b/v7/src/microcode/pruxsock.c
@@ -1,8 +1,8 @@
 /* -*-C-*-
 
-$Id: pruxsock.c,v 1.7 1993/06/24 07:09:34 gjr Exp $
+$Id: pruxsock.c,v 1.8 1996/05/09 20:22:30 cph Exp $
 
-Copyright (c) 1990-1992 Massachusetts Institute of Technology
+Copyright (c) 1990-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -36,26 +36,34 @@ MIT in each case. */
 
 #include "scheme.h"
 #include "prims.h"
+
+#ifdef _UNIX
+/* This obtains the HAVE_SOCKETS definition.  */
 #include "ux.h"
+#endif
 
-#ifdef HAVE_SOCKETS
+#ifdef __OS2__
+/* Under OS/2, socket support is the default but can be disabled.  */
+#ifndef DISABLE_SOCKET_SUPPORT
+#define HAVE_SOCKETS 1
+#define HAVE_UNIX_SOCKETS 1
+#endif
+#endif
 
-#include "uxsock.h"
-#include "osio.h"
+#ifdef HAVE_SOCKETS
 
-#define SOCKET_CODE(code) do					\
-{								\
-  code								\
-} while (0)
+#include "ossock.h"
+#define SOCKET_CODE(code) code
 
-#else /* HAVE_SOCKETS */
+#else /* not HAVE_SOCKETS */
 
-#define SOCKET_CODE(code) do					\
-{								\
-  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);	\
-} while (0)
+#define SOCKET_CODE(code)						\
+{									\
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);		\
+  PRIMITIVE_RETURN (UNSPECIFIC);					\
+}
 
-#endif /* HAVE_SOCKETS */
+#endif /* not HAVE_SOCKETS */
 
 DEFINE_PRIMITIVE ("GET-SERVICE-BY-NAME", Prim_get_service_by_name, 2, 2,
   "Given SERVICE-NAME and PROTOCOL-NAME, return a port number.\n\
@@ -63,12 +71,11 @@ The result is a nonnegative integer, or #F if no such service exists.")
 {
   PRIMITIVE_HEADER (2);
   SOCKET_CODE
-(
-  {
-    int result = (OS_get_service_by_name ((STRING_ARG (1)), (STRING_ARG (2))));
-    return ((result < 0) ? SHARP_F : (long_to_integer (result)));
-  }
-);
+    ({
+      int result
+	= (OS_get_service_by_name ((STRING_ARG (1)), (STRING_ARG (2))));
+      PRIMITIVE_RETURN ((result < 0) ? SHARP_F : (long_to_integer (result)));
+     });
 }
 
 DEFINE_PRIMITIVE ("HOST-ADDRESS-LENGTH", Prim_host_address_length, 0, 0,
@@ -76,11 +83,9 @@ DEFINE_PRIMITIVE ("HOST-ADDRESS-LENGTH", Prim_host_address_length, 0, 0,
 {
   PRIMITIVE_HEADER (0);
   SOCKET_CODE
-(
-  {
-    PRIMITIVE_RETURN (long_to_integer (OS_host_address_length ()));
-  }
-);
+    ({
+      PRIMITIVE_RETURN (long_to_integer (OS_host_address_length ()));
+    });
 }
 
 DEFINE_PRIMITIVE ("GET-HOST-BY-NAME", Prim_get_host_by_name, 1, 1,
@@ -89,28 +94,26 @@ The result is a vector of strings, or #F if no such host exists.")
 {
   PRIMITIVE_HEADER (1);
   SOCKET_CODE
-(
-  {
-    char ** addresses = (OS_get_host_by_name (STRING_ARG (1)));
-    if (addresses == 0)
-      PRIMITIVE_RETURN (SHARP_F);
-    {
-      char ** end = addresses;
-      while ((*end++) != 0) ;
-      end -= 1;
+    ({
+      char ** addresses = (OS_get_host_by_name (STRING_ARG (1)));
+      if (addresses == 0)
+	PRIMITIVE_RETURN (SHARP_F);
       {
-	SCHEME_OBJECT result =
-	  (allocate_marked_vector (TC_VECTOR, (end - addresses), 1));
-	SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
-	unsigned int length = (OS_host_address_length ());
-	while (addresses < end)
-	  (*scan_result++) =
-	    (memory_to_string (length, ((unsigned char *) (*addresses++))));
-	PRIMITIVE_RETURN (result);
+	char ** end = addresses;
+	while ((*end++) != 0) ;
+	end -= 1;
+	{
+	  SCHEME_OBJECT result =
+	    (allocate_marked_vector (TC_VECTOR, (end - addresses), 1));
+	  SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
+	  unsigned int length = (OS_host_address_length ());
+	  while (addresses < end)
+	    (*scan_result++) =
+	      (memory_to_string (length, ((unsigned char *) (*addresses++))));
+	  PRIMITIVE_RETURN (result);
+	}
       }
-    }
-  }
-);
+    });
 }
 
 #ifdef HAVE_SOCKETS
@@ -131,12 +134,12 @@ DEFINE_PRIMITIVE ("OPEN-TCP-STREAM-SOCKET", Prim_open_tcp_stream_socket, 2, 2,
 {
   PRIMITIVE_HEADER (2);
   SOCKET_CODE
-({
-  PRIMITIVE_RETURN
-    (long_to_integer
-     (OS_open_tcp_stream_socket ((arg_host (1)),
-				 (arg_nonnegative_integer (2)))));
-});
+    ({
+      PRIMITIVE_RETURN
+	(long_to_integer
+	 (OS_open_tcp_stream_socket ((arg_host (1)),
+				     (arg_nonnegative_integer (2)))));
+    });
 }
 
 DEFINE_PRIMITIVE ("OPEN-UNIX-STREAM-SOCKET", Prim_open_unix_stream_socket, 1, 1,
@@ -148,7 +151,7 @@ DEFINE_PRIMITIVE ("OPEN-UNIX-STREAM-SOCKET", Prim_open_unix_stream_socket, 1, 1,
     (long_to_integer (OS_open_unix_stream_socket (STRING_ARG (1))));
 #else
   signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
-#endif /* HAVE_UNIX_SOCKETS */
+#endif
 }
 
 DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1,
@@ -156,13 +159,15 @@ DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1,
 {
   PRIMITIVE_HEADER (1);
   SOCKET_CODE
-({
-  PRIMITIVE_RETURN
-    (long_to_integer (OS_open_server_socket ((arg_nonnegative_integer (1)), 1)));
-});
+    ({
+      PRIMITIVE_RETURN
+	(long_to_integer
+	 (OS_open_server_socket ((arg_nonnegative_integer (1)), 1)));
+    });
 }
 
 #ifdef HAVE_SOCKETS
+
 static Tchannel
 DEFUN (arg_server_socket, (arg), unsigned int arg)
 {
@@ -171,6 +176,7 @@ DEFUN (arg_server_socket, (arg), unsigned int arg)
     error_bad_range_arg (arg);
   return (server_socket);
 }
+
 #endif /* HAVE_SOCKETS */
 
 DEFINE_PRIMITIVE ("TCP-SERVER-CONNECTION-ACCEPT", Prim_tcp_server_connection_accept, 2, 2,
@@ -182,14 +188,14 @@ It is filled with the peer's address if given.")
 {
   PRIMITIVE_HEADER (2);
   SOCKET_CODE
-(
-  {
-    Tchannel server_socket = (arg_server_socket (1));
-    char * peer_host = (((ARG_REF (2)) == SHARP_F) ? 0 : (arg_host (2)));
-    Tchannel connection =
-      (OS_server_connection_accept (server_socket, peer_host, 0));
-    PRIMITIVE_RETURN
-      ((connection == NO_CHANNEL) ? SHARP_F : (long_to_integer (connection)));
-  }
-);
+    ({
+      Tchannel server_socket = (arg_server_socket (1));
+      char * peer_host = (((ARG_REF (2)) == SHARP_F) ? 0 : (arg_host (2)));
+      Tchannel connection =
+	(OS_server_connection_accept (server_socket, peer_host, 0));
+      PRIMITIVE_RETURN
+	((connection == NO_CHANNEL)
+	 ? SHARP_F
+	 : (long_to_integer (connection)));
+    });
 }
-- 
2.25.1