/* -*-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
#define OPEN_FILE_HOOK(channel)
#endif
\f
+#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); \
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.")
{
/* -*-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
#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);
+}
+\f
+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);
+ });
+}
+\f
+/* 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.")
{
signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
#endif
}
-\f
+
DEFINE_PRIMITIVE ("OPEN-TCP-SERVER-SOCKET", Prim_open_tcp_server_socket, 1, 1,
"Given PORT-NUMBER, open and return a TCP server socket.")
{
});
}
-#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\
projects / mit-scheme.git / commitdiff