[m-rev.] diff: clean up extras/net

Julien Fischer juliensf at csse.unimelb.edu.au
Mon May 7 17:30:58 AEST 2007


Estimated hours taken: 0.2
Branches: main

extras/net/sockets.m:
extras/net/tcp.m:
 	s/memcpy/MR_memcpy/

 	Fix a spot where a global variable was declared twice but
 	(potentially) never defined.

 	Convert the latter module to 4-space indentation.

 	s/__/./

 	Conform to our C coding standard.

 	Use the new foreign language interface throughout.

 	Add tabled_for_io attributes to a few foreign_procs.

Julien.

Index: sockets.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/net/sockets.m,v
retrieving revision 1.2
diff -u -b -r1.2 sockets.m
--- sockets.m	23 Feb 2007 05:46:30 -0000	1.2
+++ sockets.m	7 May 2007 07:25:06 -0000
@@ -71,7 +71,9 @@
    #include <winsock.h>

    #define  error()      WSAGetLastError
-#else
+
+#else /* !MR_WIN32 */
+
    #include <errno.h>
    #include <netdb.h>

@@ -83,19 +85,18 @@
    #define  error()      errno

    #define  INVALID_SOCKET   -1
-#endif
-  #include \"mercury_string.h\"
-
-  extern int socket_errno;
-
-").
+#endif /* !MR_WIN32 */

-:- pragma foreign_decl("C", "
+  #include \"mercury_string.h\"

      /*
      ** Save the errno into this variable if a function fails.
      */
+  extern int socket_errno;
+
+").

+:- pragma foreign_code("C", "
      int socket_errno;
  ").

@@ -119,19 +120,17 @@
          err = WSAStartup(wVersionRequested, &wsaData);

          if ( err != 0 ) {
-            MR_fatal_error(""Unable to find a ""
-                    ""usable winsock.dll\\n"");
+            MR_fatal_error(""Unable to find a usable winsock.dll\\n"");
          }

          if ( LOBYTE( wsaData.wVersion ) != 2 ||
                  HIBYTE( wsaData.wVersion ) != 2 ) {
              WSACleanup();
-            MR_fatal_error(""Unable to find a ""
-                    ""usable winsock.dll\\n"");
+            MR_fatal_error(""Unable to find a usable winsock.dll\\n"");
          }
          initialiased = MR_TRUE;
      }
-#endif
+#endif /* MR_WIN32 */
  ").

      % XXX thread safe?
@@ -155,8 +154,7 @@
             Port = (MR_Integer) ntohs(service->s_port);
          } else {
             Port = -1;
-        };
-
+    }
  ").

      % XXX thread safe?
@@ -220,11 +218,9 @@
              Success = MR_NO;
          } else {
              addr = MR_GC_NEW(struct sockaddr_in);
-
-            memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
+            MR_memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
              addr->sin_family = host->h_addrtype;
              addr->sin_port = service->s_port;
-
              SA = (MR_Word) addr;
              Success = MR_YES;
          }
Index: tcp.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/net/tcp.m,v
retrieving revision 1.5
diff -u -b -r1.5 tcp.m
--- tcp.m	23 Apr 2007 02:43:59 -0000	1.5
+++ tcp.m	7 May 2007 07:21:27 -0000
@@ -1,4 +1,6 @@
  %-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
  % Copyright (C) 2000, 2007 The University of Melbourne
  % This file may only be copied under the terms of the GNU Library General
  % Public License - see the file COPYING.LIB
@@ -15,14 +17,17 @@

  :- module tcp.
  :- interface.
+
  :- import_module io.
  :- import_module stream.
  :- import_module string.

+%-----------------------------------------------------------------------------%
+
  :- type tcp.
  :- type bound_tcp.

-:- type tcp__result(T)
+:- type tcp.result(T)
  	--->	ok(T)
  	;	error(string).

@@ -31,27 +36,43 @@
  :- type protocol == string.	% A protocol 	ie "tcp"
  :- type port 	 == int.	% A portnumber	ie 80 - the webserver

-:- pred tcp__connect(host::in, port::in, tcp__result(tcp)::out,
-		io::di, io::uo) is det.
+:- pred tcp.connect(host::in, port::in, tcp.result(tcp)::out, io::di, io::uo)
+    is det.

-:- pred tcp__bind(host::in, port::in, tcp__result(bound_tcp)::out,
+:- pred tcp.bind(host::in, port::in, tcp.result(bound_tcp)::out,
  		io::di, io::uo) is det.

-:- pred tcp__accept(bound_tcp::in, tcp__result(tcp)::out,
-		io::di, io::uo) is det.
+:- pred tcp.accept(bound_tcp::in, tcp.result(tcp)::out, io::di, io::uo) is det.

-:- pred tcp__shutdown(tcp::in, io::di, io::uo) is det.
+:- pred tcp.shutdown(tcp::in, io::di, io::uo) is det.

-        % Accesses the stream to see if there is data available,
-        % waits for a given period before timeing out
-        % (use this rather than a failure driven test and 
-        % loop on connects).
-:- pred tcp__data_available(bound_tcp,int,int,io,io).
-:- mode tcp__data_available(in,in,out,di,uo) is det.
+    % Accesses the stream to see if there is data available, waits for a given
+    % period before timing out.  (Use this rather than a failure driven test
+    % and loop on connects.)
+    %
+:- pred tcp.data_available(bound_tcp::in, int::in, int::out, io::di, io::uo)
+    is det.

  :- func socket_fd(tcp) = int.

-:- type error.
+    % Sending data to a broken pipe will cause the SIGPIPE signal to be
+    % sent to the process.  If SIGPIPE is ignored or blocked then send()
+    % fails with EPIPE.  This predicate causes SIGPIPE signals to be
+    % ignored.
+    %
+:- pred tcp.ignore_sigpipe(io::di, io::uo) is det.
+
+    % Restores the SIGPIPE signal handler before the last
+    % tcp.ignore_sigpipe() call.
+    %
+:- pred tcp.unignore_sigpipe(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Stream type class instances
+%
+
+:- type tcp.error.

  :- instance stream(tcp, io.state).
  :- instance error(tcp.error).
@@ -64,18 +85,6 @@
  :- instance writer(tcp, character, io.state).
  :- instance writer(tcp, string, io.state).

-	% Sending data to a broken pipe will cause the SIGPIPE signal to be
-	% sent to the process.  If SIGPIPE is ignored or blocked then send()
-	% fails with EPIPE.  This predicate causes SIGPIPE signals to be
-	% ignored.
-	%
-:- pred tcp__ignore_sigpipe(io::di, io::uo) is det.
-
-	% Restores the SIGPIPE signal handler before the last
-	% tcp__ignore_sigpipe() call.
-	%
-:- pred tcp__unignore_sigpipe(io::di, io::uo) is det.
-
  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%

@@ -86,6 +95,8 @@
  :- import_module list.
  :- import_module require.

+%-----------------------------------------------------------------------------%
+
  :- type tcp
  	--->	tcp(
  			name	:: string,
@@ -100,47 +111,44 @@

  %-----------------------------------------------------------------------------%

-tcp__connect(Host, Port, Result) -->
-	handle_connect(Host, Port, Handle, Errno),
-	{ Errno = 0 ->
+tcp.connect(Host, Port, Result, !IO) :-
+    handle_connect(Host, Port, Handle, Errno, !IO),
+    ( Errno = 0 ->
  		Result = ok(tcp(Host, Handle))
  	;
  		Result = tcp.error(tcp.error_message(Errno))
-	}.
+    ).

  %-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%

-tcp__bind(Host, Port, Result) -->
-	handle_bind(Host, Port, Socket, Addr, Errno),
-	{ Errno = 0 ->
+tcp.bind(Host, Port, Result, !IO) :-
+    handle_bind(Host, Port, Socket, Addr, Errno, !IO),
+    ( Errno = 0 ->
  		Result = ok(bound_tcp(Socket, Addr))
  	;
  		Result = tcp.error(tcp.error_message(Errno))
-	}.
+    ).

  %-----------------------------------------------------------------------------%

-tcp__accept(bound_tcp(Socket, Addr), Result) -->
-	handle_accept(Socket, Addr, Handle, Errno),
-	{ Errno = 0 ->
+tcp.accept(bound_tcp(Socket, Addr), Result, !IO) :-
+    handle_accept(Socket, Addr, Handle, Errno, !IO),
+    ( Errno = 0 ->
  		Result = ok(tcp("XXX unknown host", Handle))
  	;
  		Result = tcp.error(tcp.error_message(Errno))
-	}.
+    ).

  %-----------------------------------------------------------------------------%

-tcp__shutdown(tcp(_, Handle)) -->
-	handle_shutdown(Handle).
+tcp.shutdown(tcp(_, Handle), !IO) :-
+    handle_shutdown(Handle, !IO).

  :- pred handle_shutdown(tcp_handle::in, io::di, io::uo) is det.
-
-:- pragma foreign_proc(c,
+:- pragma foreign_proc("C",
  	handle_shutdown(TCP::in, IO0::di, IO::uo),
  	[may_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
+"
  	struct linger sockets_linger = { MR_TRUE, 2 };
  	ML_tcp *sock;
          int shutdown_erro = 0;
@@ -152,23 +160,26 @@

          errno=0;
  	if (close(((int)sock->socket)) == SOCKET_ERROR) {
-		ML_throw_tcp_exception((MR_String) ""tcp__shutdown failed (close)"");
+        ML_throw_tcp_exception((MR_String) ""tcp.shutdown failed (close)"");
  	}

  	IO = IO0;
-}").
+").

  %-----------------------------------------------------------------------------%

-:- type tcp_handle ---> socket(c_pointer).
+:- type tcp_handle
+    --->    socket(c_pointer).

-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
  #ifdef MR_WIN32
    #include <windows.h>
    #include <winsock.h>

    #define  ML_error()		WSAGetLastError()
-#else
+
+#else /* !MR_WIN32 */
+
    #include <errno.h>
    #include <unistd.h>
    #include <netdb.h>
@@ -182,7 +193,7 @@

    #define  INVALID_SOCKET	-1
    #define  SOCKET_ERROR		-1
-#endif
+#endif /* !MR_WIN32 */

  #define ADDRLEN	16
  #define BACKLOG	16
@@ -201,7 +212,7 @@
  void ML_tcp_init(void);
  ").

-:- pragma c_code("
+:- pragma foreign_code("C", "
  /*
  ** We must ensure that the socket DLL is initialiased before use under
  ** Win32.
@@ -220,31 +231,27 @@
  		err = WSAStartup(wVersionRequested, &wsaData);

  		if ( err != 0 ) {
-			MR_fatal_error(""Unable to find a ""
-					""usable winsock.dll\\n"");
+            MR_fatal_error(""Unable to find a usable winsock.dll\\n"");
  		}

  		if ( LOBYTE( wsaData.wVersion ) != 2 ||
  				HIBYTE( wsaData.wVersion ) != 2 ) {
  			WSACleanup();
-			MR_fatal_error(""Unable to find a ""
-					""usable winsock.dll\\n"");
+            MR_fatal_error(""Unable to find a usable winsock.dll\\n"");
  		}
  		initialiased = MR_TRUE;
  	}
-  #endif
+  #endif /* MR_WIN32 */
  }
  ").

  :- pred handle_connect(string::in, port::in, tcp_handle::out, int::out,
  		io::di, io::uo) is det.

-:- pragma foreign_proc(c,
-	handle_connect(Host::in, Port::in, TCP::out, Errno::out,
-		IO0::di, IO::uo), 
+:- pragma foreign_proc("C",
+    handle_connect(Host::in, Port::in, TCP::out, Errno::out, IO0::di, IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
+"
  	ML_tcp *sock;
          struct hostent *host;
          struct sockaddr_in *addr;
@@ -266,14 +273,16 @@
  			sock->error = ML_error();
  		} else {
  			addr = MR_GC_NEW(struct sockaddr_in);
-			memset(addr,0,sizeof(struct sockaddr_in));
-			memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
+            MR_memset(addr, 0, sizeof(struct sockaddr_in));
+            MR_memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
  			addr->sin_family = host->h_addrtype;
  			addr->sin_port = htons(Port);
-                        /*memset(&addr,0,sizeof(addr));
-			memcpy((char *)&addr.sin_addr, host->h_addr, host->h_length);
-			addr.sin_family = host->h_addrtype;
-			addr.sin_port = htons(Port);*/
+            /*
+            ** MR_memset(&addr, 0, sizeof(addr));
+            ** MR_memcpy((char *)&addr.sin_addr, host->h_addr, host->h_length);
+            ** addr.sin_family = host->h_addrtype;
+            ** addr.sin_port = htons(Port);
+            */

  			if (connect(sock->socket, (struct sockaddr *)addr, ADDRLEN) ==
  					SOCKET_ERROR)
@@ -286,13 +295,15 @@
  	Errno = sock->error;
  	TCP = (MR_Word) sock;
  	IO = IO0;
-}").
+").

  socket_fd(Tcp) = socket_fd_c(Tcp ^ handle).

  :- func socket_fd_c(tcp_handle) = int.
-:- pragma foreign_proc(c, socket_fd_c(Tcp::in) = (FD::out),
-		[will_not_call_mercury, thread_safe, promise_pure], "
+:- pragma foreign_proc("C",
+    socket_fd_c(Tcp::in) = (FD::out),
+    [will_not_call_mercury, thread_safe, promise_pure],
+"
  	ML_tcp *sock = (ML_tcp *) Tcp;
  	FD = sock->socket;
  ").
@@ -302,13 +313,12 @@
  :- pred handle_bind(string::in, port::in, int::out, c_pointer::out, int::out,
  		io::di, io::uo) is det.

-:- pragma foreign_proc(c,
-	handle_bind(Host::in, Port::in, Socket::out, Addr::out,
-		Errno::out, IO0::di, IO::uo),
+:- pragma foreign_proc("C",
+    handle_bind(Host::in, Port::in, Socket::out, Addr::out, Errno::out,
+        IO0::di, IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
-        struct hostent *host;
+"
+    struct hostent      *host = NULL;
          struct sockaddr_in *addr = NULL;

  	ML_tcp_init();
@@ -324,19 +334,16 @@
  			Errno = ML_error();
  		} else {
  			addr = MR_GC_NEW(struct sockaddr_in);
-			memset(addr,0,sizeof(struct sockaddr_in));
-			memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
+            MR_memset(addr, 0, sizeof(struct sockaddr_in));
+            MR_memcpy(&(addr->sin_addr), host->h_addr, host->h_length);
  			addr->sin_family = host->h_addrtype;
  			addr->sin_port = htons(Port);

-			if (bind(Socket, addr, ADDRLEN) == SOCKET_ERROR)
-			{
+            if (bind(Socket, (struct sockaddr *) addr, ADDRLEN)
+                    == SOCKET_ERROR) {
  				Errno = ML_error();
-			} 
-			else
-			{
-				if (listen(Socket, BACKLOG) == SOCKET_ERROR)
-				{
+            } else {
+                if (listen(Socket, BACKLOG) == SOCKET_ERROR) {
  					Errno = ML_error();
  				}
  			}
@@ -345,17 +352,16 @@

  	Addr = (MR_Word) addr;
  	IO = IO0;
-}").
+").

  :- pred handle_accept(int::in, c_pointer::in, tcp_handle::out, int::out,
  		io::di, io::uo) is det.

-:- pragma foreign_proc(c,
+:- pragma foreign_proc("C",
  	handle_accept(Socket::in, Addr::in, TCP::out, Errno::out,
  		IO0::di, IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
+"
  	ML_tcp *sock;
  	struct sockaddr *addr;
  	int size = sizeof(struct sockaddr_in);
@@ -373,29 +379,30 @@
  	}

          TCP = (MR_Word) sock;
-
          Errno = sock->error;
  	IO = IO0;
-}").
-
+").

  %-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%

-:- type error ---> errno(int).
+:- type tcp.error
+    --->    errno(int).

  :- instance stream(tcp, io.state) where [
  	name(TCP, TCP ^ name, !IO)
  ].
+
  :- instance error(tcp.error) where [
  	(error_message(E) = S :-
  		get_error(E, S)
  	)
  ].
+
  :- instance input(tcp, io.state) where [].
+
  :- instance reader(tcp, character, io.state, tcp.error) where [
  	(get(T, Result, !IO) :-
-		tcp__read_char(T ^ handle, Char, !IO),
+        tcp.read_char(T ^ handle, Char, !IO),
  		( Char = -1 ->
  			Result = eof
  		; Char = -2 ->
@@ -406,9 +413,10 @@
  		)
  	)
  ].
+
  :- instance reader(tcp, line, io.state, tcp.error) where [
  	(get(T, Result, !IO) :-
-		tcp__read_line_as_string_2(T ^ handle, ErrCode, String, !IO),
+        tcp.read_line_as_string_2(T ^ handle, ErrCode, String, !IO),
  		( ErrCode = -1 ->
  			Result = eof
  		; ErrCode = -2 ->
@@ -420,11 +428,11 @@
  	)
  ].

-
  :- instance output(tcp, io) where [
  		% XXX can one flush a socket?
  	flush(_, !IO)
  ].
+
  :- instance writer(tcp, character, io.state) where [
  	(put(T, C, !IO) :-
  		tcp.write_char(T ^ handle, C, B, !IO),
@@ -437,6 +445,7 @@
  		)
  	)
  ].
+
  :- instance writer(tcp, string, io.state) where [
  	(put(T, S, !IO) :-
  		tcp.write_string(T ^ handle, S, B, !IO),
@@ -454,7 +463,9 @@
  %-----------------------------------------------------------------------------%

  :- pragma foreign_decl("C", "
-	/* Note: some Mercury code uses the -1 and -2 constants directly. */
+    /*
+    ** Note: some Mercury code uses the -1 and -2 constants directly.
+    */
  	#define TCP_EOF	    -1
  	#define TCP_ERROR   -2

@@ -484,22 +495,21 @@
  	}
  ").

-:- pred tcp__read_char(tcp_handle::in, int::out, io::di, io::uo) is det.
-:- pragma foreign_proc(c,
-	tcp__read_char(Socket::in, Chr::out, _IO0::di, _IO::uo),
+:- pred tcp.read_char(tcp_handle::in, int::out, io::di, io::uo) is det.
+:- pragma foreign_proc("C",
+    tcp.read_char(Socket::in, Chr::out, _IO0::di, _IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
+"
  	ML_tcp *sock = (ML_tcp *) Socket;
-
  	Chr = TCP_get_char(sock);
-}").
+").

      % This implementation is based on io.read_line_as_string_2.
      %
-:- pred tcp__read_line_as_string_2(tcp_handle::in, int::out, string::out,
+:- pred tcp.read_line_as_string_2(tcp_handle::in, int::out, string::out,
  	io::di, io::uo) is det.
  :- pragma foreign_proc("C",
-	tcp__read_line_as_string_2(TCP::in, Res::out, RetString::out,
+    tcp.read_line_as_string_2(TCP::in, Res::out, RetString::out,
  		IO0::di, IO::uo),
  	[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
  "
@@ -563,12 +573,12 @@
      MR_update_io(IO0, IO);
  ").

-:- pred tcp__write_char(tcp_handle::in, char::in, bool::out,
+:- pred tcp.write_char(tcp_handle::in, char::in, bool::out,
  	io::di, io::uo) is det.
  :- pragma foreign_proc(c,
-	tcp__write_char(Socket::in, Chr::in, Success::out, _IO0::di, _IO::uo),
+    tcp.write_char(Socket::in, Chr::in, Success::out, _IO0::di, _IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
+"
  	ML_tcp *sock = (ML_tcp *) Socket;

  	if (send(sock->socket, &Chr, 1, 0) == SOCKET_ERROR) {
@@ -577,54 +587,50 @@
  	} else {
  		Success = MR_TRUE;
  	}
-}").
+").

-:- pred tcp__write_string(tcp_handle::in, string::in, bool::out,
+:- pred tcp.write_string(tcp_handle::in, string::in, bool::out,
  	io::di, io::uo) is det.
  :- pragma foreign_proc(c,
-	tcp__write_string(Socket::in, Str::in, Success::out,
-		_IO0::di, _IO::uo),
+    tcp.write_string(Socket::in, Str::in, Success::out, _IO0::di, _IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
+"
  	ML_tcp *sock = (ML_tcp *) Socket;

  	if (send(sock->socket, Str, strlen(Str), 0) == SOCKET_ERROR) {
  		sock->error = ML_error();
-		Success = MR_FALSE;
+        Success = MR_NO;
  	} else {
-		Success = MR_TRUE;
+        Success = MR_YES;
  	}
-}").
+").

  :- pred get_errno(tcp_handle::in, tcp.error::out, io::di, io::uo) is det.
-:- pragma foreign_proc(c,
+:- pragma foreign_proc("C",
  	get_errno(Socket::in, Errno::out, _IO0::di, _IO::uo),
  	[will_not_call_mercury, thread_safe, promise_pure, tabled_for_io],
-"{
-
+"
  	ML_tcp *sock = (ML_tcp *) Socket;
-
  	Errno = sock->error;
-}").
+").

-:- pred tcp__get_error(tcp.error::in, string::out) is det.
-:- pragma foreign_proc(c,
-	tcp__get_error(Errno::in, Msg::out),
+:- pred tcp.get_error(tcp.error::in, string::out) is det.
+:- pragma foreign_proc("C",
+    tcp.get_error(Errno::in, Msg::out),
  	[will_not_call_mercury, thread_safe, promise_pure],
-"{
+"
  	MR_save_transient_hp();
  	MR_make_aligned_string_copy(Msg, strerror(Errno));
  	MR_restore_transient_hp();
-}").
+").

  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%

-:- pragma foreign_proc(c,
-	tcp__data_available(Socket::in,Wait::in,Int::out,II::di,IO::uo),
+:- pragma foreign_proc("C",
+    tcp.data_available(Socket::in, Wait::in, Int::out, IO0::di, IO::uo),
  	[promise_pure, tabled_for_io],
-"{
+"
  	ML_tcp *sock = (ML_tcp *) Socket;
  	int selres = 0;
  	fd_set readfds, writefds, exceptfds;
@@ -633,19 +639,20 @@

          if ( Wait > 0 ) {
             sockets__timeout = &sockets__timeout_struct;
-           sockets__timeout -> tv_sec = ((int)Wait * 60);
-           sockets__timeout -> tv_usec = 0;
+           sockets__timeout->tv_sec = ((int)Wait * 60);
+           sockets__timeout->tv_usec = 0;
          } else {
             sockets__timeout = NULL;
-        };
+        }

          FD_ZERO(&writefds);
          FD_ZERO(&readfds);
          FD_ZERO(&exceptfds);
          FD_SET(sock->socket,&readfds);
          if ( sockets__timeout != NULL ) {
-	   /* Do a select to see if something is available */
-	   selres = select(0,&readfds,&writefds,&exceptfds,sockets__timeout);
+            /* Do a select to see if something is available......... */
+            selres = select(0, &readfds, &writefds, &exceptfds, 
+                sockets__timeout);
  	   if ( selres == 0 ) {
  	      Int = -1;
             } else { 
@@ -657,23 +664,25 @@
             };
  	} else {
             Int = 0;
-        };
-        IO = II;
-}").
-
+        }
+        IO = IO0;
+").

  %-----------------------------------------------------------------------------%
  %-----------------------------------------------------------------------------%

  :- func error_message(int) = string.

-:- pragma c_code(error_message(Errno::in) = (Err::out),
-		 [will_not_call_mercury], "{
+:- pragma foreign_proc("C",
+    error_message(Errno::in) = (Err::out),
+    [promise_pure, will_not_call_mercury],
+"
  	MR_make_aligned_string_copy(Err, strerror(Errno));
-}").
+").

  :- pred throw_tcp_exception(string::in) is erroneous.
-:- pragma export(throw_tcp_exception(in), "ML_throw_tcp_exception").
+:- pragma foreign_export("C", throw_tcp_exception(in),
+    "ML_throw_tcp_exception").

  throw_tcp_exception(S) :-
  	error(S).
@@ -692,20 +701,21 @@
  ").

  :- pragma foreign_proc("C",
-    tcp__ignore_sigpipe(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure, thread_safe],
+    tcp.ignore_sigpipe(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
  "
      TCP__prev_sigpipe_handler = signal(SIGPIPE, SIG_IGN);
      IO = IO0;
  ").

  :- pragma foreign_proc("C",
-    tcp__unignore_sigpipe(IO0::di, IO::uo),
-    [will_not_call_mercury, promise_pure, thread_safe],
+    tcp.unignore_sigpipe(IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
  "
      signal(SIGPIPE, TCP__prev_sigpipe_handler);
      IO = IO0;
  ").

  %-----------------------------------------------------------------------------%
+:- end_module tcp.
  %-----------------------------------------------------------------------------%

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list