* (host-address-length): New primitive specifies the size of a host

  name in characters.

* (get-host-by-name): Changes to match `OS_get_host_by_name'.

* (open-tcp-server-socket, tcp-server-connection-accept): New
  primitives permit Scheme to act as a TCP server.

diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c
index 444bd4db403705f132ee169366ac0fb1b4c019f2..93d48889c484c52e0d0409b741c9f520bb141a8c 100644 (file)
--- a/v7/src/microcode/pruxsock.c
+++ b/v7/src/microcode/pruxsock.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxsock.c,v 1.1 1990/06/20 19:38:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/pruxsock.c,v 1.2 1990/11/08 11:06:58 cph Exp $
 
 Copyright (c) 1990 Massachusetts Institute of Technology
 
@@ -41,6 +41,7 @@ MIT in each case. */
 #ifdef HAVE_SOCKETS
 
 #include "uxsock.h"
+#include "osio.h"
 \f
 DEFINE_PRIMITIVE ("GET-SERVICE-BY-NAME", Prim_get_service_by_name, 2, 2,
   "Given SERVICE-NAME and PROTOCOL-NAME, return a port number.\n\
@@ -53,40 +54,55 @@ The result is a nonnegative integer, or #F if no such service exists.")
   }
 }
 
+DEFINE_PRIMITIVE ("HOST-ADDRESS-LENGTH", Prim_host_address_length, 0, 0,
+  "The length of a host address string, in characters.")
+{
+  PRIMITIVE_HEADER (0);
+  PRIMITIVE_RETURN (long_to_integer (OS_host_address_length ()));
+}
+
 DEFINE_PRIMITIVE ("GET-HOST-BY-NAME", Prim_get_host_by_name, 1, 1,
   "Given HOST-NAME, return its internet host numbers.\n\
-The result is a vector of nonnegative integers, or #F if no such host exists.")
+The result is a vector of strings, or #F if no such host exists.")
 {
   PRIMITIVE_HEADER (1);
   {
-    struct host_addresses * result = (OS_get_host_by_name (STRING_ARG (1)));
-    if (result == 0)
+    char ** addresses = (OS_get_host_by_name (STRING_ARG (1)));
+    if (addresses == 0)
       PRIMITIVE_RETURN (SHARP_F);
     {
-      int length = (result -> address_length);
-      char ** scan = (result -> addresses);
-      char ** end = scan;
+      char ** end = addresses;
       while ((*end++) != 0) ;
       end -= 1;
       {
        SCHEME_OBJECT result =
-         (allocate_marked_vector (TC_VECTOR, (end - scan), 1));
+         (allocate_marked_vector (TC_VECTOR, (end - addresses), 1));
        SCHEME_OBJECT * scan_result = (VECTOR_LOC (result, 0));
-       while (scan < end)
-         (*scan_result++) = (memory_to_string (length, (*scan++)));
+       unsigned int length = (OS_host_address_length ());
+       while (addresses < end)
+         (*scan_result++) = (memory_to_string (length, (*addresses++)));
        PRIMITIVE_RETURN (result);
       }
     }
   }
 }
 
+static char *
+DEFUN (arg_host, (arg), unsigned int arg)
+{
+  CHECK_ARG (arg, STRING_P);
+  if ((STRING_LENGTH (ARG_REF (arg))) != (OS_host_address_length ()))
+    error_bad_range_arg (arg);
+  return ((char *) (STRING_LOC ((ARG_REF (arg)), 0)));
+}
+
 DEFINE_PRIMITIVE ("OPEN-TCP-STREAM-SOCKET", Prim_open_tcp_stream_socket, 2, 2,
   "Given HOST-ADDRESS and PORT-NUMBER, open and return a TCP stream socket.")
 {
   PRIMITIVE_HEADER (2);
   PRIMITIVE_RETURN
     (long_to_integer
-     (OS_open_tcp_stream_socket ((STRING_ARG (1)),
+     (OS_open_tcp_stream_socket ((arg_host (1)),
                                 (arg_nonnegative_integer (2)))));
 }
 
@@ -101,5 +117,40 @@ DEFINE_PRIMITIVE ("OPEN-UNIX-STREAM-SOCKET", Prim_open_unix_stream_socket, 1, 1,
 }
 
 #endif /* HAVE_UNIX_SOCKETS */
+\f
+DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1,
+  "Given PORT-NUMBER, open and return a TCP server socket.")
+{
+  PRIMITIVE_HEADER (1);
+  PRIMITIVE_RETURN
+    (long_to_integer (OS_open_server_socket (arg_nonnegative_integer (1))));
+}
+
+static Tchannel
+DEFUN (arg_server_socket, (arg), unsigned int arg)
+{
+  Tchannel server_socket = (arg_nonnegative_integer (arg));
+  if ((OS_channel_type (server_socket)) != channel_type_tcp_server_socket)
+    error_bad_range_arg (arg);
+  return (server_socket);
+}
+
+DEFINE_PRIMITIVE ("TCP-SERVER-CONNECTION-ACCEPT", Prim_tcp_server_connection_accept, 2, 2,
+  "Poll SERVER-SOCKET for a connection.\n\
+If a connection is available, it is opened and returned.\n\
+Otherwise, if SERVER-SOCKET is non-blocking, returns #F.\n\
+Second argument PEER-ADDRESS, if not #F, must be a host address string.
+It is filled with the peer's address if given.")
+{
+  PRIMITIVE_HEADER (2);
+  {
+    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)));
+  }
+}
 
 #endif /* HAVE_SOCKETS */