[m-rev.] for review: improvements to net/tcp.m

[Peter Wang]

On 28/03/07, Peter Ross <pro at missioncriticalit.com> wrote:
> On Wed, Mar 28, 2007 at 03:50:36PM +1000, Peter Wang wrote:
> > Improvements to the tcp module.
...
> > diff -u -r1.1 tcp.m
> > --- tcp.m     16 Nov 2006 04:01:49 -0000      1.1
> > +++ tcp.m     28 Mar 2007 05:41:41 -0000
> > @@ -57,11 +57,23 @@
> >
> >  :- instance input(tcp, io.state, tcp.error).
> >  :- instance reader(tcp, character, io.state, tcp.error).
> > +:- instance reader(tcp, string, io.state, tcp.error).
> >
> You should state what sort of strings are read?
> Until a new line, for something else.

I've followed Julien's suggestion on this.

>
> Also for me the error returned should also include the string that
> has been read up until the error, when reading a string.

I think this can be added later if required.

> > +].
> > +:- instance reader(tcp, string, io.state, tcp.error) where [
> > +     (get(T, Result, !IO) :-
> > +             tcp__read_line_as_string(T ^ handle, ErrCode, String, !IO),
>
> I'm not sure this code handles the case of reading from a socket the
> following "ABC", eg no newline before the socket closes.

I've replaced my buggy implementation with one based on
io.read_line_as_string_2.  It should be slightly more efficient in the
common case as well.

Interdiff follows.

Thanks.
Peter

diff -u tcp.m tcp.m
--- tcp.m	28 Mar 2007 05:41:41 -0000
+++ tcp.m	29 Mar 2007 02:25:07 -0000
@@ -52,12 +52,14 @@

 :- type error.

+:- type line ---> line(string).
+
 :- instance stream(tcp, io.state).
 :- instance error(tcp.error).

 :- instance input(tcp, io.state, tcp.error).
 :- instance reader(tcp, character, io.state, tcp.error).
-:- instance reader(tcp, string, io.state, tcp.error).
+:- instance reader(tcp, line, io.state, tcp.error).

 :- instance output(tcp, io.state).
 :- instance writer(tcp, character, io.state).
@@ -406,16 +408,16 @@
 		)
 	)
 ].
-:- instance reader(tcp, string, io.state, tcp.error) where [
+:- instance reader(tcp, line, io.state, tcp.error) where [
 	(get(T, Result, !IO) :-
-		tcp__read_line_as_string(T ^ handle, ErrCode, String, !IO),
+		tcp__read_line_as_string_2(T ^ handle, ErrCode, String, !IO),
 		( ErrCode = -1 ->
 			Result = eof
 		; ErrCode = -2 ->
 			get_errno(T ^ handle, Errno, !IO),
 			Result = error(Errno)
 		;
-			Result = ok(String)
+			Result = ok(line(String))
 		)
 	)
 ].
@@ -494,52 +496,73 @@
 	Chr = TCP_get_char(sock);
 }").

-:- pred tcp__read_line_as_string(tcp_handle::in, int::out, string::out,
+    % 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,
 	io::di, io::uo) is det.
 :- pragma foreign_proc("C",
-	tcp__read_line_as_string(TCP::in, ErrCode::out, Str::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],
 "
-	ML_tcp *sock = (ML_tcp *) TCP;
-	size_t	BufLen = 1024;
-	off_t	BufPos = 0;
-	char	*Buf;
-	int	Chr;
-
-	Buf = MR_malloc(BufLen);
-
-	while (1) {
-		Chr = TCP_get_char(sock);
-		if (Chr < 0) {
-			ErrCode = Chr;
-			break;
-		}
-
-		if (BufPos >= BufLen) {
-			BufLen += 1024;
-			Buf = MR_realloc(Buf, BufLen);
-		}
-		Buf[BufPos++] = Chr;
-		if (Chr == '\\n') {
-			ErrCode = 0;
-			break;
-		}
-	}
-
-	if (ErrCode == 0) {
-		if (BufPos >= BufLen) {
-			BufLen += 1;
-			Buf = MR_realloc(Buf, BufLen);
-		}
-		Buf[BufPos] = '\\0';
-		MR_make_aligned_string_copy(Str, Buf);
-	} else {
-		Str = NULL;
-	}
-
-	MR_free(Buf);
-	IO = IO0;
+#define TCP_IO_READ_LINE_GROW(n) ((n) * 3 / 2)
+#define TCP_IO_BYTES_TO_WORDS(n) (((n) + sizeof(MR_Word) - 1) /
sizeof(MR_Word))
+#define TCP_IO_READ_LINE_START   1024
+
+    ML_tcp *sock = (ML_tcp *) TCP;
+    MR_Char initial_read_buffer[TCP_IO_READ_LINE_START];
+    MR_Char *read_buffer = initial_read_buffer;
+    size_t read_buf_size = TCP_IO_READ_LINE_START;
+    size_t i;
+    int char_code = '\\0';
+
+    Res = 0;
+    for (i = 0; char_code != '\\n'; ) {
+        char_code = TCP_get_char(sock);
+        if (char_code == TCP_EOF) {
+            if (i == 0) {
+                Res = -1;
+            }
+            break;
+        }
+        if (char_code == TCP_ERROR) {
+            Res = -2;
+            break;
+        }
+        read_buffer[i++] = char_code;
+        MR_assert(i <= read_buf_size);
+        if (i == read_buf_size) {
+            /* Grow the read buffer */
+            read_buf_size = TCP_IO_READ_LINE_GROW(read_buf_size);
+            if (read_buffer == initial_read_buffer) {
+                read_buffer = MR_NEW_ARRAY(MR_Char, read_buf_size);
+                MR_memcpy(read_buffer, initial_read_buffer,
+                    TCP_IO_READ_LINE_START);
+            } else {
+                read_buffer = MR_RESIZE_ARRAY(read_buffer, MR_Char,
+                    read_buf_size);
+            }
+        }
+    }
+    if (Res == 0) {
+        MR_Word ret_string_word;
+        MR_offset_incr_hp_atomic_msg(ret_string_word,
+            0, TCP_IO_BYTES_TO_WORDS((i + 1) * sizeof(MR_Char)),
+            MR_PROC_LABEL, ""string.string/0"");
+        RetString = (MR_String) ret_string_word;
+        MR_memcpy(RetString, read_buffer, i * sizeof(MR_Char));
+        RetString[i] = '\\0';
+    } else {
+        /*
+        ** We can't just return NULL here, because  otherwise mdb will break
+        ** when it tries to print the string.
+        */
+        RetString = MR_make_string_const("""");
+    }
+    if (read_buffer != initial_read_buffer) {
+        MR_free(read_buffer);
+    }
+    MR_update_io(IO0, IO);
 ").

 :- pred tcp__write_char(tcp_handle::in, char::in, bool::out,
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------