From b8d93a50cac5eb3c08b06c340c823e1314be6d0a Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 8 Nov 1990 11:06:58 +0000 Subject: [PATCH] * (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. --- v7/src/microcode/pruxsock.c | 73 +++++++++++++++++++++++++++++++------ 1 file changed, 62 insertions(+), 11 deletions(-) diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c index 444bd4db4..93d48889c 100644 --- 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" 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 */ + +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 */ -- 2.25.1