From: Chris Hanson Date: Sat, 18 May 1996 06:08:14 +0000 (+0000) Subject: Implement new primitives to support new method for opening files and X-Git-Tag: 20090517-FFI~5502 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=fcc9ced6ff3571c5e15115cdd1d91c7f704280b4;p=mit-scheme.git Implement new primitives to support new method for opening files and sockets. This code is required for runtime version 14.170. --- diff --git a/v7/src/microcode/prosfile.c b/v7/src/microcode/prosfile.c index 103dfe673..9d711693a 100644 --- a/v7/src/microcode/prosfile.c +++ b/v7/src/microcode/prosfile.c @@ -1,8 +1,8 @@ /* -*-C-*- -$Id: prosfile.c,v 1.7 1994/11/20 08:23:29 cph Exp $ +$Id: prosfile.c,v 1.8 1996/05/18 06:07:16 cph Exp $ -Copyright (c) 1987-94 Massachusetts Institute of Technology +Copyright (c) 1987-96 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -44,6 +44,42 @@ extern Tchannel EXFUN (arg_channel, (int)); #define OPEN_FILE_HOOK(channel) #endif +#define NEW_OPEN_FILE_PRIMITIVE(OS_open_file) \ +{ \ + PRIMITIVE_HEADER (2); \ + CHECK_ARG (2, WEAK_PAIR_P); \ + { \ + Tchannel channel = (OS_open_file (STRING_ARG (1))); \ + OPEN_FILE_HOOK (channel); \ + SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (channel))); \ + PRIMITIVE_RETURN (SHARP_T); \ + } \ +} + +DEFINE_PRIMITIVE ("NEW-FILE-OPEN-INPUT-CHANNEL", Prim_new_file_open_input_channel, 2, 2, + "Open an input file called FILENAME.\n\ +The channel number is saved in the cdr of WEAK-PAIR.") + NEW_OPEN_FILE_PRIMITIVE (OS_open_input_file) + +DEFINE_PRIMITIVE ("NEW-FILE-OPEN-OUTPUT-CHANNEL", Prim_new_file_open_output_channel, 2, 2, + "Open an output file called FILENAME.\n\ +The channel number is saved in the cdr of WEAK-PAIR.\n\ +If the file exists, it is rewritten.") + NEW_OPEN_FILE_PRIMITIVE (OS_open_output_file) + +DEFINE_PRIMITIVE ("NEW-FILE-OPEN-IO-CHANNEL", Prim_new_file_open_io_channel, 2, 2, + "Open a file called FILENAME.\n\ +The channel number is saved in the cdr of WEAK-PAIR.\n\ +The file is opened for both input and output.\n\ +If the file exists, its contents are not disturbed.") + NEW_OPEN_FILE_PRIMITIVE (OS_open_io_file) + +DEFINE_PRIMITIVE ("NEW-FILE-OPEN-APPEND-CHANNEL", Prim_new_file_open_append_channel, 2, 2, + "Open an output file called FILENAME.\n\ +The channel number is saved in the cdr of WEAK-PAIR.\n\ +If the file exists, output is appended to its contents.") + NEW_OPEN_FILE_PRIMITIVE (OS_open_append_file) + #define OPEN_FILE_PRIMITIVE(OS_open_file) \ { \ PRIMITIVE_HEADER (1); \ @@ -74,29 +110,6 @@ DEFINE_PRIMITIVE ("FILE-OPEN-APPEND-CHANNEL", Prim_file_open_append_channel, 1, If the file exists, output is appended to its contents.") OPEN_FILE_PRIMITIVE (OS_open_append_file) -DEFINE_PRIMITIVE ("FILE-OPEN-CHANNEL", Prim_file_open_channel, 2, 2, - "This is an obsolete primitive.\n\ -Open a file called FILENAME, returning a channel number.\n\ -Second argument MODE says how to open the file:\n\ - #F ==> open for input;\n\ - #T ==> open for output, rewriting file if it exists;\n\ - otherwise ==> open for output, appending to existing file.") -{ - PRIMITIVE_HEADER (2); - { - CONST char * filename = (STRING_ARG (1)); - fast SCHEME_OBJECT mode = (ARG_REF (2)); - fast Tchannel channel = - ((mode == SHARP_F) - ? (OS_open_input_file (filename)) - : (mode == SHARP_T) - ? (OS_open_output_file (filename)) - : (OS_open_append_file (filename))); - OPEN_FILE_HOOK (channel); - PRIMITIVE_RETURN (long_to_integer (channel)); - } -} - DEFINE_PRIMITIVE ("FILE-LENGTH-NEW", Prim_file_length_new, 1, 1, "Return the length of CHANNEL in characters.") { diff --git a/v7/src/microcode/pruxsock.c b/v7/src/microcode/pruxsock.c index 4147e6809..370fa94d4 100644 --- a/v7/src/microcode/pruxsock.c +++ b/v7/src/microcode/pruxsock.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: pruxsock.c,v 1.9 1996/05/09 20:38:40 cph Exp $ +$Id: pruxsock.c,v 1.10 1996/05/18 06:08:02 cph Exp $ Copyright (c) 1990-96 Massachusetts Institute of Technology @@ -129,6 +129,93 @@ DEFUN (arg_host, (arg), unsigned int arg) #endif /* HAVE_SOCKETS */ +DEFINE_PRIMITIVE ("NEW-OPEN-TCP-STREAM-SOCKET", Prim_new_open_tcp_stream_socket, 3, 3, + "Given HOST-ADDRESS and PORT-NUMBER, open a TCP stream socket.\n\ +The opened socket is stored in the cdr of WEAK-PAIR.") +{ + PRIMITIVE_HEADER (3); + CHECK_ARG (3, WEAK_PAIR_P); + SOCKET_CODE + ({ + SET_PAIR_CDR + ((ARG_REF (3)), + (long_to_integer + (OS_open_tcp_stream_socket ((arg_host (1)), + (arg_nonnegative_integer (2)))))); + PRIMITIVE_RETURN (SHARP_T); + }); +} + +DEFINE_PRIMITIVE ("NEW-OPEN-UNIX-STREAM-SOCKET", Prim_new_open_unix_stream_socket, 2, 2, + "Open the unix stream socket FILENAME.\n\ +The opened socket is stored in the cdr of WEAK-PAIR.") +{ + PRIMITIVE_HEADER (2); + CHECK_ARG (2, WEAK_PAIR_P); +#ifdef HAVE_UNIX_SOCKETS + SET_PAIR_CDR + ((ARG_REF (2)), + (long_to_integer (OS_open_unix_stream_socket (STRING_ARG (1))))); +#else + signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE); +#endif + PRIMITIVE_RETURN (SHARP_T); +} + +DEFINE_PRIMITIVE ("NEW-OPEN-TCP-SERVER-SOCKET", Prim_new_open_tcp_server_socket, 2, 2, + "Given PORT-NUMBER, open TCP server socket.\n\ +The opened socket is stored in the cdr of WEAK-PAIR.") +{ + PRIMITIVE_HEADER (2); + CHECK_ARG (2, WEAK_PAIR_P); + SOCKET_CODE + ({ + SET_PAIR_CDR + ((ARG_REF (2)), + (long_to_integer + (OS_open_server_socket ((arg_nonnegative_integer (1)), 1)))); + PRIMITIVE_RETURN (SHARP_T); + }); +} + +#ifdef HAVE_SOCKETS + +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); +} + +#endif /* HAVE_SOCKETS */ + +DEFINE_PRIMITIVE ("NEW-TCP-SERVER-CONNECTION-ACCEPT", Prim_new_tcp_server_connection_accept, 3, 3, + "Poll SERVER-SOCKET for a connection.\n\ +If a connection is available, it is opened and #T is returned;\n\ +the opened socket is stored in the cdr of WEAK-PAIR.\n\ +Otherwise, if SERVER-SOCKET is non-blocking, returns #F.\n\ +Second argument PEER-ADDRESS, if not #F, must be a host address string.\n\ +It is filled with the peer's address if given.") +{ + PRIMITIVE_HEADER (3); + CHECK_ARG (3, WEAK_PAIR_P); + 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)); + if (connection == NO_CHANNEL) + PRIMITIVE_RETURN (SHARP_F); + SET_PAIR_CDR ((ARG_REF (3)), (long_to_integer (connection))); + PRIMITIVE_RETURN (SHARP_T); + }); +} + +/* Obsolete Primitives, for compatibility with old runtime systems. */ + 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.") { @@ -153,7 +240,7 @@ DEFINE_PRIMITIVE ("OPEN-UNIX-STREAM-SOCKET", Prim_open_unix_stream_socket, 1, 1, signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE); #endif } - + DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1, "Given PORT-NUMBER, open and return a TCP server socket.") { @@ -166,19 +253,6 @@ DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1, }); } -#ifdef HAVE_SOCKETS - -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); -} - -#endif /* HAVE_SOCKETS */ - 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\ diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 6a41faca1..64fbf12ae 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: version.h,v 11.153 1996/05/09 17:01:38 cph Exp $ +$Id: version.h,v 11.154 1996/05/18 06:08:14 cph Exp $ Copyright (c) 1988-96 Massachusetts Institute of Technology @@ -46,5 +46,5 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 153 +#define SUBVERSION 154 #endif