[m-dev.] for review: change MercuryFile structure

Peter Ross peter.ross at miscrit.be
Fri Aug 11 21:17:03 AEST 2000


On Thu, Aug 10, 2000 at 05:13:57AM +1000, Fergus Henderson wrote:
> On 09-Aug-2000, Peter Ross <peter.ross at miscrit.be> wrote:
> > On Tue, Aug 08, 2000 at 10:58:01PM +1000, Fergus Henderson wrote:
> > > Hmm, that's nearly a factor of three slowdown overall,
> > > and nearly a factor of ten slowdown in user time.
> > > I think that is a too much to have this change enabled by default,
> > > at least in the absence of a compelling compensatory feature.
> >
> > OK. Is it fine to check this change in?
> > I will add the flag
> > 
> > --enable-new-mercuryfile-structure
> > 
> > to the configure script to turn this feature on and revise the code for
> > logged_output.m to mention that you need to have a version of the
> > compiler with built with the above option supplied to configure.
> 
> That sounds good, but I would like the review the final diff before
> you commit.
> 

===================================================================


Estimated hours taken: 28

Add a variant of the MercuryFile structure that it contains pointers to
functions which operate on the MercuryFile.  This allows us, for
example, to create a MercuryFile structure which operates on sockets and
use the predicates in io.m to operate on the socket stream.

This variant is turned on by passing --enable-new-mercuryfile-struct to
configure.

configure.in:
runtime/mercury_conf.h.in:
    Handle the new --enable-new-mercuryfile-struct option.

runtime/mercury_library_types.h:
    Define the new variant of the MercuryFile structure.
    The variant now contains pointers to functions to do all the basic
    I/O operations.
    Define macros to access all the different parts of the MercuryFile
    structure.

runtime/mercury_file.h:
runtime/mercury_file.c:
    Implement a MercuryFile structure which operates on C FILE *'s.

library/io.m:
    Call the basic I/O operations from the MercuryFile structure.
    Explicitly check that we are using a file stream when required.
    As we cannot supply a variable number of arguments to a macro,
    define a new function ML_fprintf() to provide fprintf functionality.
    Hide all direct access to the MercuryFile data structure behind
    macros.
    
browser/util.m:
trace/mercury_trace_browse.c:
trace/mercury_trace_declarative.c:
trace/mercury_trace_external.c:
    Hide all direct access to the MercuryFile data structure behind
    macros.

extras/logged_output/Mmakefile:
extras/logged_output/README:
extras/logged_output/logged_output.m:
extras/logged_output/main.m:
    Add an example of defining a new MercuryFile structure.  This new
    structure defines an output stream which writes to stdout and logs
    to a file at the same time.
    
runtime/Mmakefile:
    Add the new files mercury_file.{c,h}.

runtime/mercury_imp.h:
    Include `mercury_file.h'.

Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.215
diff -u -r1.215 configure.in
--- configure.in	2000/08/10 09:01:14	1.215
+++ configure.in	2000/08/11 11:01:47
@@ -2369,6 +2369,20 @@
 LIBS="$save_LIBS"
 
 #-----------------------------------------------------------------------------#
+
+AC_MSG_CHECKING(whether to enable the new MercuryFile struct)
+AC_ARG_ENABLE(new-mercuryfile-struct,
+[  --enable-new-mercuryfile-struct   enable new MercuryFile struct.],
+ac_new_mercuryfile_struct=yes,ac_new_mercuryfile_struct=no)
+
+if test "$ac_new_mercuryfile_struct" = "yes"; then
+	AC_MSG_RESULT(yes)
+	AC_DEFINE(MR_NEW_MERCURYFILE_STRUCT)
+else
+	AC_MSG_RESULT(no)
+fi
+
+#-----------------------------------------------------------------------------#
 #
 # Add an option that enables the external debugger support.
 # By default, external debugger support is enabled if and only if
Index: browser/util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/util.m,v
retrieving revision 1.7
diff -u -r1.7 util.m
--- browser/util.m	2000/02/04 03:45:30	1.7
+++ browser/util.m	2000/08/11 11:01:47
@@ -96,7 +96,7 @@
 
 		if (MR_address_of_trace_getline != NULL) {
 			line = (*MR_address_of_trace_getline)((char *) Prompt,
-					mdb_in->file, mdb_out->file);
+					MR_file(*mdb_in), MR_file(*mdb_out));
 		} else {
 			MR_tracing_not_enabled();
 			/* not reached */
Index: extras/logged_output/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ Mmakefile	Fri Aug 11 21:01:59 2000
@@ -0,0 +1,5 @@
+MAIN_TARGET=main
+depend: main.depend
+clean: main.clean
+realclean: main.realclean
+	-rm -f OUTPUT
Index: extras/logged_output/README
===================================================================
RCS file: README
diff -N README
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ README	Fri Aug 11 21:01:59 2000
@@ -0,0 +1,9 @@
+This directory shows how you can use the MercuryFile structure to change
+the behaviour of io.m.
+
+The file logged_output.m implements an io__output_stream which writes to
+stdout and also logs all of its output to a file at the same time.
+
+To compile this module you need a mercury compiler which has has been
+configured with --enable-new-mercuryfile-struct.
+
Index: extras/logged_output/logged_output.m
===================================================================
RCS file: logged_output.m
diff -N logged_output.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ logged_output.m	Fri Aug 11 21:01:59 2000
@@ -0,0 +1,152 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2000 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 in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: 	logged_output.m
+% main author:	Peter Ross (petdr at miscrit.be)
+%
+% This provides an implementation of a stream which writes to stdout and
+% logs to a file at the same time.
+%
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- module logged_output.
+
+:- interface.
+
+:- import_module io.
+
+:- pred logged_output__init(string::in, io__result(io__output_stream)::out,
+		io__state::di, io__state::uo) is det.
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+logged_output__init(FileName, Result) -->
+	create_stream(FileName, Stream),
+	{ Result = ok(Stream) }.
+	
+%------------------------------------------------------------------------------%
+
+:- pred create_stream(string::in, io__output_stream::out,
+		io__state::di, io__state::uo) is det.
+
+:- pragma c_code(create_stream(FileName::in, IOStream::out, IO0::di, IO::uo), "
+	MercuryFile	*stream;
+	FILE		*file;
+
+	file = fopen(FileName, ""w"");
+
+	incr_hp(stream, sizeof(MercuryFile));
+
+	stream->stream_type	= MR_FILE_STREAM;
+	stream->stream_info.file= file;
+	stream->line_number	= 1;
+
+	stream->close		= ME_logged_output_close;
+	stream->read		= ME_logged_output_read;
+	stream->write		= ME_logged_output_write;
+
+	stream->flush		= ME_logged_output_flush;
+	stream->ungetc		= ME_logged_output_ungetch;
+	stream->getc		= ME_logged_output_getch;
+	stream->vprintf		= ME_logged_output_vfprintf;
+	stream->putc		= ME_logged_output_putch;
+
+	IOStream = (Word) stream;
+
+	IO = IO0;
+").
+
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_header_code("
+#ifndef MR_NEW_MERCURYFILE_STRUCT
+  #error ""you need to use version of the mercury compiler configured with --enable-new-mercuryfile-struct""
+#endif
+
+#include ""stdio.h""
+
+int ME_logged_output_putch(MR_StreamInfo *info, int);
+int ME_logged_output_close(MR_StreamInfo *info);
+int ME_logged_output_vfprintf(MR_StreamInfo *info,
+		const char *pszFormat, va_list ap);
+int ME_logged_output_write(MR_StreamInfo *info,
+		const void *buffer, size_t size);
+
+int ME_logged_output_getch(MR_StreamInfo *info);
+int ME_logged_output_ungetch(MR_StreamInfo *info,int);
+int ME_logged_output_flush(MR_StreamInfo *info);
+int ME_logged_output_read(MR_StreamInfo *info, void *buffer, size_t size);
+").
+
+:- pragma c_code("
+int
+ME_logged_output_putch(MR_StreamInfo *info, int ch)
+{
+	putc(ch, stdout);
+	return putc(ch, info->file);
+}
+
+int
+ME_logged_output_close(MR_StreamInfo *info)
+{
+	return fclose(info->file);
+}
+  
+int
+ME_logged_output_vfprintf(MR_StreamInfo *info, const char *format, va_list ap)
+{
+	int rc;							  
+	vfprintf(stdout, format, ap);
+	rc = vfprintf(info->file, format, ap);
+	return rc;
+}
+
+int
+ME_logged_output_write(MR_StreamInfo *info, const void *buffer, size_t size)
+{
+	int rc;							       
+	fwrite(buffer, sizeof(unsigned char), size, stdout);
+	rc = fwrite(buffer, sizeof(unsigned char), size, info->file);
+}
+  
+/*
+** We are creating an output stream so none of these functions will ever
+** be called.
+*/
+int
+ME_logged_output_getch(MR_StreamInfo *info) 
+{
+	MR_fatal_error(""ME_logged_output_getch"");
+}
+	  
+int
+ME_logged_output_ungetch(MR_StreamInfo *info, int ch)
+{
+	MR_fatal_error(""ME_logged_output_ungetch"");
+}
+
+int
+ME_logged_output_flush(MR_StreamInfo *info)
+{
+	fflush(stdout);
+	return fflush(info->file);
+}
+  
+int
+ME_logged_output_read(MR_StreamInfo *info, void *buffer, size_t size)
+{ 
+	MR_fatal_error(""ME_logged_output_read"");
+}
+").
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
Index: extras/logged_output/main.m
===================================================================
RCS file: main.m
diff -N main.m
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ main.m	Fri Aug 11 21:01:59 2000
@@ -0,0 +1,28 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2000 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 in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: 	main.m
+% main author:	Peter Ross (petdr at miscrit.be)
+%
+% Use the logged_output stream.
+%
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+:- module main.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is det.
+:- implementation.
+:- import_module logged_output.
+main -->
+	logged_output__init("OUTPUT", Result),
+	(
+		{ Result = ok(OutputStream) }
+	->
+		io__write_string(OutputStream, "Hi there.\n")
+	;
+		io__write_string("Unable to open OUTPUT\n")
+	).
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.200
diff -u -r1.200 io.m
--- library/io.m	2000/08/01 09:04:19	1.200
+++ library/io.m	2000/08/11 11:02:18
@@ -1494,7 +1494,7 @@
 		[will_not_call_mercury, thread_safe],
 "{
 	MercuryFile *f = (MercuryFile *) Stream;
-	clearerr(f->file);
+	clearerr(MR_file(*f));
 }").
 
 :- pred io__check_err(stream, io__res, io__state, io__state).
@@ -1517,7 +1517,13 @@
 		[will_not_call_mercury, thread_safe],
 "{
 	MercuryFile *f = (MercuryFile *) Stream;
-	RetVal = ferror(f->file);
+
+	if (MR_IS_FILE_STREAM(*f)) {
+		RetVal = ferror(MR_file(*f));
+	} else {
+		RetVal = -1;
+	}
+
 	ML_maybe_make_err_msg(RetVal != 0, ""read failed: "",
 		MR_PROC_LABEL, RetStr);
 }").
@@ -1561,8 +1567,14 @@
     (defined(HAVE_FILENO) || defined(fileno)) && \
     defined(S_ISREG)
 	struct stat s;
-	if (fstat(fileno(f->file), &s) == 0 && S_ISREG(s.st_mode)) {
-		Size = s.st_size;
+	if (MR_IS_FILE_STREAM(*f)) {
+		if (fstat(fileno(MR_file(*f)), &s) == 0 &&
+				S_ISREG(s.st_mode))
+		{
+			Size = s.st_size;
+		} else {
+			Size = -1;
+		}
 	} else {
 		Size = -1;
 	}
@@ -1650,7 +1662,12 @@
 	char *buffer = (Char *) Buffer0;
 	int items_read;
 
-	items_read = fread(buffer + Pos0, sizeof(Char), Size - Pos0, f->file);
+	if (MR_IS_FILE_STREAM(*f)) {
+		items_read = fread(buffer + Pos0, sizeof(Char), Size - Pos0,
+				MR_file(*f));
+	} else {
+		mercury_io_error(f, ""Attempted fread from non-file stream"");
+	}
 
 	Buffer = (Word) buffer;
 	Pos = Pos0 + items_read;
@@ -2650,6 +2667,7 @@
 #include ""mercury_wrapper.h""
 #include ""mercury_type_info.h""
 #include ""mercury_library_types.h""
+#include ""mercury_file.h""
 #include ""mercury_heap.h""
 #include ""mercury_misc.h""
 
@@ -2685,15 +2703,17 @@
 void		mercury_print_binary_string(MercuryFile* mf, const char *s);
 int		mercury_getc(MercuryFile* mf);
 void		mercury_close(MercuryFile* mf);
+int		ML_fprintf(MercuryFile* mf, const char *format, ...);
 ").
 
 :- pragma c_code("
+
+MercuryFile mercury_stdin;
+MercuryFile mercury_stdout;
+MercuryFile mercury_stderr;
+MercuryFile mercury_stdin_binary;
+MercuryFile mercury_stdout_binary;
 
-MercuryFile mercury_stdin = { NULL, 1 };
-MercuryFile mercury_stdout = { NULL, 1 };
-MercuryFile mercury_stderr = { NULL, 1 };
-MercuryFile mercury_stdin_binary = { NULL, 1 };
-MercuryFile mercury_stdout_binary = { NULL, 1 };
 MercuryFile *mercury_current_text_input = &mercury_stdin;
 MercuryFile *mercury_current_text_output = &mercury_stdout;
 MercuryFile *mercury_current_binary_input = &mercury_stdin_binary;
@@ -2702,18 +2722,22 @@
 void
 mercury_init_io(void)
 {
-	mercury_stdin.file = stdin;
-	mercury_stdout.file = stdout;
-	mercury_stderr.file = stderr;
+	MR_mercuryfile_init(stdin, 1, &mercury_stdin);
+	MR_mercuryfile_init(stdout, 1, &mercury_stdout);
+	MR_mercuryfile_init(stderr, 1, &mercury_stderr);
+
+	MR_mercuryfile_init(NULL, 1, &mercury_stdin_binary);
+	MR_mercuryfile_init(NULL, 1, &mercury_stdout_binary);
+
 #if defined(HAVE_FDOPEN) && (defined(HAVE_FILENO) || defined(fileno))
-	mercury_stdin_binary.file = fdopen(fileno(stdin), ""rb"");
-	if (mercury_stdin_binary.file == NULL) {
+	MR_file(mercury_stdin_binary) = fdopen(fileno(stdin), ""rb"");
+	if (MR_file(mercury_stdin_binary) == NULL) {
 		MR_fatal_error(""error opening standard input stream in ""
 			""binary mode:\\n\\tfdopen() failed: %s"",
 			strerror(errno));
 	}
-	mercury_stdout_binary.file = fdopen(fileno(stdout), ""wb"");
-	if (mercury_stdout_binary.file == NULL) {
+	MR_file(mercury_stdout_binary) = fdopen(fileno(stdout), ""wb"");
+	if (MR_file(mercury_stdout_binary) == NULL) {
 		MR_fatal_error(""error opening standard output stream in ""
 			""binary mode:\\n\\tfdopen() failed: %s"",
 			strerror(errno));
@@ -2723,8 +2747,8 @@
 	** XXX Standard ANSI/ISO C provides no way to set stdin/stdout
 	** to binary mode.  I guess we just have to punt...
 	*/
-	mercury_stdin_binary.file = stdin;
-	mercury_stdout_binary.file = stdout;
+	MR_file(mercury_stdin_binary) = stdin;
+	MR_file(mercury_stdout_binary) = stdout;
 #endif
 }
 
@@ -2741,8 +2765,7 @@
 	f = fopen(filename, type);
 	if (!f) return NULL;
 	mf = MR_GC_NEW(MercuryFile);
-	mf->file = f;
-	mf->line_number = 1;
+	MR_mercuryfile_init(f, 1, mf);
 	return mf;
 }
 
@@ -2795,12 +2818,12 @@
 void
 mercury_print_string(MercuryFile* mf, const char *s)
 {
-	if (fprintf(mf->file, ""%s"", s) < 0) {
+	if (ML_fprintf(mf, ""%s"", s) < 0) {
 		mercury_output_error(mf);
 	}
 	while (*s) {
 		if (*s++ == '\\n') {
-			mf->line_number++;
+			MR_line_number(*mf)++;
 		}
 	}
 }
@@ -2812,7 +2835,7 @@
 void
 mercury_print_binary_string(MercuryFile* mf, const char *s)
 {
-	if (fprintf(mf->file, ""%s"", s) < 0) {
+	if (ML_fprintf(mf, ""%s"", s) < 0) {
 		mercury_output_error(mf);
 	}
 }
@@ -2824,9 +2847,9 @@
 int
 mercury_getc(MercuryFile* mf)
 {
-	int c = getc(mf->file);
+	int c = MR_GETCH(*mf);
 	if (c == '\\n') {
-		mf->line_number++;
+		MR_line_number(*mf)++;
 	}
 	return c;
 }
@@ -2842,7 +2865,7 @@
 	    mf != &mercury_stdout &&
 	    mf != &mercury_stderr)
 	{
-		if (fclose(mf->file) < 0) {
+		if (MR_CLOSE(*mf) < 0) {
 			mercury_io_error(mf, ""error closing file: %s"",
 				strerror(errno));
 		}
@@ -2852,6 +2875,23 @@
 
 ").
 
+:- pragma c_code("
+
+int
+ML_fprintf(MercuryFile* mf, const char *format, ...)
+{
+	int rc;
+	va_list args;
+
+	va_start(args, format);
+	rc = MR_VFPRINTF(*mf, format, args);
+	va_end(args);
+
+	return rc;
+}
+
+").
+
 /* input predicates */
 
 :- pragma c_code(io__read_char_code(File::in, CharCode::out, IO0::di, IO::uo),
@@ -2864,10 +2904,10 @@
 		may_call_mercury, "{
 	MercuryFile* mf = (MercuryFile *) File;
 	if (Character == '\\n') {
-		mf->line_number--;
+		MR_line_number(*mf)--;
 	}
 	/* XXX should work even if ungetc() fails */
-	if (ungetc(Character, mf->file) == EOF) {
+	if (MR_UNGETCH(*mf, Character) == EOF) {
 		mercury_io_error(mf, ""io__putback_char: ungetc failed"");
 	}
 	update_io(IO0, IO);
@@ -2877,7 +2917,7 @@
 		may_call_mercury, "{
 	MercuryFile* mf = (MercuryFile *) File;
 	/* XXX should work even if ungetc() fails */
-	if (ungetc(Character, mf->file) == EOF) {
+	if (MR_UNGETCH(*mf, Character) == EOF) {
 		mercury_io_error(mf, ""io__putback_byte: ungetc failed"");
 	}
 	update_io(IO0, IO);
@@ -2893,18 +2933,18 @@
 
 :- pragma c_code(io__write_char(Character::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
-	if (putc(Character, mercury_current_text_output->file) < 0) {
+	if (MR_PUTCH(*mercury_current_text_output, Character) < 0) {
 		mercury_output_error(mercury_current_text_output);
 	}
 	if (Character == '\\n') {
-		mercury_current_text_output->line_number++;
+		MR_line_number(*mercury_current_text_output)++;
 	}
 	update_io(IO0, IO);
 ").
 
 :- pragma c_code(io__write_int(Val::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
-	if (fprintf(mercury_current_text_output->file, ""%ld"", (long) Val) < 0) {
+	if (ML_fprintf(mercury_current_text_output, ""%ld"", (long) Val) < 0) {
 		mercury_output_error(mercury_current_text_output);
 	}
 	update_io(IO0, IO);
@@ -2912,7 +2952,7 @@
 
 :- pragma c_code(io__write_float(Val::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
-	if (fprintf(mercury_current_text_output->file, ""%#.15g"", Val) < 0) {
+	if (ML_fprintf(mercury_current_text_output, ""%#.15g"", Val) < 0) {
 		mercury_output_error(mercury_current_text_output);
 	}
 	update_io(IO0, IO);
@@ -2921,8 +2961,9 @@
 :- pragma c_code(io__write_byte(Byte::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
 	/* call putc with a strictly non-negative byte-sized integer */
-	if (putc((int) ((unsigned char) Byte),
-			mercury_current_binary_output->file) < 0) {
+	if (MR_PUTCH(*mercury_current_binary_output,
+			(int) ((unsigned char) Byte)) < 0)
+	{
 		mercury_output_error(mercury_current_text_output);
 	}
 	update_io(IO0, IO);
@@ -2936,7 +2977,7 @@
 
 :- pragma c_code(io__flush_output(IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
-	if (fflush(mercury_current_text_output->file) < 0) {
+	if (MR_FLUSH(*mercury_current_text_output) < 0) {
 		mercury_output_error(mercury_current_text_output);
 	}
 	update_io(IO0, IO);
@@ -2944,7 +2985,7 @@
 
 :- pragma c_code(io__flush_binary_output(IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "
-	if (fflush(mercury_current_binary_output->file) < 0) {
+	if (MR_FLUSH(*mercury_current_binary_output) < 0) {
 		mercury_output_error(mercury_current_binary_output);
 	}
 	update_io(IO0, IO);
@@ -2971,7 +3012,8 @@
 	static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
 	MercuryFile *stream = (MercuryFile *) Stream;
 	/* XXX should check for failure */
-	fseek(stream->file, Off, seek_flags[Flag]);
+	/* XXX should also check if the stream is seekable */
+	fseek(MR_file(*stream), Off, seek_flags[Flag]);
 	IO = IO0;
 }").
 
@@ -2980,7 +3022,8 @@
 "{
 	MercuryFile *stream = (MercuryFile *) Stream;
 	/* XXX should check for failure */
-	Offset = ftell(stream->file);
+	/* XXX should check if the stream is tellable */
+	Offset = ftell(MR_file(*stream));
 	IO = IO0;
 }").
 
@@ -2999,11 +3042,11 @@
 		[may_call_mercury, thread_safe], 
 "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	if (putc(Character, stream->file) < 0) {
+	if (MR_PUTCH(*stream, Character) < 0) {
 		mercury_output_error(stream);
 	}
 	if (Character == '\\n') {
-		stream->line_number++;
+		MR_line_number(*stream)++;
 	}
 	update_io(IO0, IO);
 }").
@@ -3011,7 +3054,7 @@
 :- pragma c_code(io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	if (fprintf(stream->file, ""%ld"", (long) Val) < 0) {
+	if (ML_fprintf(stream, ""%ld"", (long) Val) < 0) {
 		mercury_output_error(stream);
 	}
 	update_io(IO0, IO);
@@ -3020,7 +3063,7 @@
 :- pragma c_code(io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	if (fprintf(stream->file, ""%#.15g"", Val) < 0) {
+	if (ML_fprintf(stream, ""%#.15g"", Val) < 0) {
 		mercury_output_error(stream);
 	}
 	update_io(IO0, IO);
@@ -3030,7 +3073,7 @@
 		[may_call_mercury, thread_safe], "{
 	MercuryFile *stream = (MercuryFile *) Stream;
 	/* call putc with a strictly non-negative byte-sized integer */
-	if (putc((int) ((unsigned char) Byte), stream->file) < 0) {
+	if (MR_PUTCH(*stream, (int) ((unsigned char) Byte)) < 0) {
 		mercury_output_error(stream);
 	}
 	update_io(IO0, IO);
@@ -3046,7 +3089,7 @@
 :- pragma c_code(io__flush_output(Stream::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	if (fflush(stream->file) < 0) {
+	if (MR_FLUSH(*stream) < 0) {
 		mercury_output_error(stream);
 	}
 	update_io(IO0, IO);
@@ -3055,7 +3098,7 @@
 :- pragma c_code(io__flush_binary_output(Stream::in, IO0::di, IO::uo),
 		[may_call_mercury, thread_safe], "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	if (fflush(stream->file) < 0) {
+	if (MR_FLUSH(*stream) < 0) {
 		mercury_output_error(stream);
 	}
 	update_io(IO0, IO);
@@ -3123,7 +3166,7 @@
 
 :- pragma c_code(io__get_line_number(LineNum::out, IO0::di, IO::uo),
 		will_not_call_mercury, "
-	LineNum = mercury_current_text_input->line_number;
+	LineNum = MR_line_number(*mercury_current_text_input);
 	update_io(IO0, IO);
 ").
 	
@@ -3131,13 +3174,13 @@
 	io__get_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
 		will_not_call_mercury, "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	LineNum = stream->line_number;
+	LineNum = MR_line_number(*stream);
 	update_io(IO0, IO);
 }").
 	
 :- pragma c_code(io__set_line_number(LineNum::in, IO0::di, IO::uo),
 		will_not_call_mercury, "
-	mercury_current_text_input->line_number = LineNum;
+	MR_line_number(*mercury_current_text_input) = LineNum;
 	update_io(IO0, IO);
 ").
 	
@@ -3145,13 +3188,13 @@
 	io__set_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
 		will_not_call_mercury, "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	stream->line_number = LineNum;
+	MR_line_number(*stream) = LineNum;
 	update_io(IO0, IO);
 }").
 	
 :- pragma c_code(io__get_output_line_number(LineNum::out, IO0::di, IO::uo),
 		will_not_call_mercury, "
-	LineNum = mercury_current_text_output->line_number;
+	LineNum = MR_line_number(*mercury_current_text_output);
 	update_io(IO0, IO);
 ").
 	
@@ -3159,13 +3202,13 @@
 	io__get_output_line_number(Stream::in, LineNum::out, IO0::di, IO::uo),
 		will_not_call_mercury, "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	LineNum = stream->line_number;
+	LineNum = MR_line_number(*stream);
 	update_io(IO0, IO);
 }").
 
 :- pragma c_code(io__set_output_line_number(LineNum::in, IO0::di, IO::uo),
 		will_not_call_mercury, "
-	mercury_current_text_output->line_number = LineNum;
+	MR_line_number(*mercury_current_text_output) = LineNum;
 	update_io(IO0, IO);
 ").
 	
@@ -3173,7 +3216,7 @@
 	io__set_output_line_number(Stream::in, LineNum::in, IO0::di, IO::uo),
 		will_not_call_mercury, "{
 	MercuryFile *stream = (MercuryFile *) Stream;
-	stream->line_number = LineNum;
+	MR_line_number(*stream) = LineNum;
 	update_io(IO0, IO);
 }").
 	
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.60
diff -u -r1.60 Mmakefile
--- runtime/Mmakefile	2000/08/10 09:01:16	1.60
+++ runtime/Mmakefile	2000/08/11 11:02:20
@@ -45,6 +45,7 @@
 			mercury_dummy.h		\
 			mercury_dlist.h		\
 		  	mercury_engine.h	\
+			mercury_file.h		\
 			mercury_float.h		\
 			mercury_getopt.h	\
 			mercury_goto.h		\
@@ -120,6 +121,7 @@
 			mercury_dlist.c		\
 			mercury_dummy.c		\
 			mercury_engine.c	\
+			mercury_file.c		\
 			mercury_float.c		\
 			mercury_getopt.c	\
 			mercury_getopt1.c	\
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.29
diff -u -r1.29 mercury_conf.h.in
--- runtime/mercury_conf.h.in	2000/08/10 09:01:17	1.29
+++ runtime/mercury_conf.h.in	2000/08/11 11:02:21
@@ -348,6 +348,16 @@
 #undef  HAVE_READLINE_READLINE
 #undef  HAVE_READLINE_HISTORY
 
+
+/*
+** MR_NEW_MERCURYFILE_STRUCT
+**	Set this if you want to use the new MercuryFile structure.  The
+**	new structure contains pointers to functions to do all the basic IO
+**	functions.  See extras/logged_output for an example of how to
+**	override the pointers to provide IO streams with extra functionality.
+*/
+#undef	MR_NEW_MERCURYFILE_STRUCT
+
 /*---------------------------------------------------------------------------*/
 
 #include "mercury_conf_param.h"
Index: runtime/mercury_file.c
===================================================================
RCS file: mercury_file.c
diff -N mercury_file.c
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ mercury_file.c	Fri Aug 11 21:02:22 2000
@@ -0,0 +1,119 @@
+/*
+** Copyright (C) 2000 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 in the Mercury distribution.
+*/
+
+/*
+** This module contains the implementation of Mercury streams using
+** C `FILE *' streams.
+*/
+
+#include "mercury_file.h"
+#include "mercury_std.h"	/* for MR_assert */
+
+#ifndef MR_NEW_MERCURYFILE_STRUCT
+  void
+  MR_mercuryfile_init(FILE *file, int line_number, MercuryFile *mf)
+  {
+	MR_file(*mf)	    = file;
+	MR_line_number(*mf) = line_number;
+  }
+
+#else
+
+  void
+  MR_mercuryfile_init(FILE *file, int line_number, MercuryFile *mf)
+  {
+	mf->stream_type	= MR_FILE_STREAM;
+	mf->stream_info.file	= file;
+	mf->line_number	= line_number;
+
+	mf->close		= MR_close;
+	mf->read		= MR_read;
+	mf->write		= MR_write;
+
+	mf->flush		= MR_flush;
+	mf->ungetc		= MR_ungetch;
+	mf->getc		= MR_getch;
+	mf->vprintf		= MR_vfprintf;
+	mf->putc		= MR_putch;
+  }
+
+  int
+  MR_getch(MR_StreamInfo *info) 
+  {
+	MR_assert(info != NULL);
+	return getc(info->file);	  
+  }
+
+  int
+  MR_ungetch(MR_StreamInfo *info, int ch)
+  {
+	int res;
+	MR_assert(info != NULL);		
+	res = ungetc(ch, info->file);
+	if (res == EOF) {
+		mercury_io_error(NULL, "io__putback_char: ungetc failed");
+	}
+	return (int) res;
+  }
+
+  int
+  MR_putch(MR_StreamInfo *info, int ch)
+  {
+	MR_assert(info != NULL);
+	return putc(ch, info->file);
+  }
+
+  int
+  MR_close(MR_StreamInfo *info)
+  {
+	MR_assert(info != NULL);				      
+	return fclose(info->file);
+  }
+  
+  int
+  MR_flush(MR_StreamInfo *info)
+  {
+	MR_assert(info != NULL);				       
+	return fflush(info->file);
+  }
+  
+  int
+  MR_vfprintf(MR_StreamInfo *info, const char *format, va_list ap)
+  {
+	MR_assert(info != NULL);
+	MR_assert(format != NULL);
+
+	return vfprintf(info->file, format, ap);
+  }
+  
+  int
+  MR_read(MR_StreamInfo *info, void *buffer, size_t size)
+  { 
+	int rc;							       
+	MR_assert(info != NULL);				
+	rc = fread(buffer, sizeof(unsigned char), size, info->file);
+
+		/* Handle error/eof special cases */
+	if ( (rc < size) &&  feof(info->file) ) {
+		/* nothing to do */;
+	} else if ( ferror(info->file) ) {
+		rc = -1;
+	}
+
+	return rc;
+  }
+
+  int
+  MR_write(MR_StreamInfo *info, const void *buffer, size_t size)
+  {
+	int rc;							       
+
+	MR_assert(info != NULL);
+	rc = fwrite(buffer, sizeof(unsigned char), size, info->file);
+
+  }
+#endif /* MR_NEW_MERCURYFILE_STRUCT */
Index: runtime/mercury_file.h
===================================================================
RCS file: mercury_file.h
diff -N mercury_file.h
--- /dev/null	Sat Aug  7 21:45:41 1999
+++ mercury_file.h	Fri Aug 11 21:02:22 2000
@@ -0,0 +1,29 @@
+/*
+** Copyright (C) 2000 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 in the Mercury distribution.
+*/
+#ifndef MERCURY_FILE_H
+#define MERCURY_FILE_H
+
+#include "mercury_library_types.h"
+
+/*
+** Initialise a MercuryFile structure to use the C stdlib FILE *type.
+*/
+void MR_mercuryfile_init(FILE *file, int line_number, MercuryFile *mf);
+
+#ifdef MR_NEW_MERCURYFILE_STRUCT
+  #define MR_IS_FILE_STREAM(mf)	( (mf).stream_type == MR_FILE_STREAM )
+
+  int MR_getch(MR_StreamInfo *info);
+  int MR_putch(MR_StreamInfo *info, int);
+  int MR_ungetch(MR_StreamInfo *info, int);
+  int MR_close(MR_StreamInfo *info);
+  int MR_flush(MR_StreamInfo *info);
+  int MR_vfprintf(MR_StreamInfo *info, const char *format, va_list ap);
+  int MR_read(MR_StreamInfo *info, void *buffer, size_t size);
+  int MR_write(MR_StreamInfo *info, const void *buffer, size_t size);
+#endif
+
+#endif /* MERCURY_FILE_H */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.16
diff -u -r1.16 mercury_imp.h
--- runtime/mercury_imp.h	2000/08/03 06:18:46	1.16
+++ runtime/mercury_imp.h	2000/08/11 11:02:22
@@ -47,6 +47,7 @@
 
 #include	"mercury_types.h"
 #include	"mercury_library_types.h"
+#include	"mercury_file.h"
 #include	"mercury_string.h"
 #include	"mercury_float.h"
 #include	"mercury_bootstrap.h"
Index: runtime/mercury_library_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_library_types.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_library_types.h
--- runtime/mercury_library_types.h	2000/08/03 06:18:48	1.4
+++ runtime/mercury_library_types.h	2000/08/11 11:02:23
@@ -13,6 +13,7 @@
 #define MERCURY_LIBRARY_TYPES_H
 
 #include <stdio.h>		/* for `FILE' */
+#include <stdarg.h>		/* for `va_list' */
 #include "mercury_types.h"	/* for `MR_Word' and `MR_Integer' */
 #include "mercury_std.h"	/* for MR_VARIABLE_SIZED */
 
@@ -20,13 +21,125 @@
 ** The C `MercuryFile' type is used for the Mercury `io__stream' type
 ** in library/io.m.
 ** Mercury files are not quite the same as C stdio FILEs,
-** because we keep track of a little bit more information.
+** because we keep track of a lot more information.
 */
+#ifndef MR_NEW_MERCURYFILE_STRUCT
+  typedef struct mercury_file {
+	FILE *file1;
+	int line_number1;
+  } MercuryFile;
 
-typedef struct mercury_file {
+  #define MR_file(mf)		(mf).file1
+  #define MR_line_number(mf)	(mf).line_number1
+
+  #define MR_IS_FILE_STREAM(mf)	( TRUE )
+
+  #define MR_MERCURYFILE_INIT(file, line_number)		\
+  		{ (file), (line_number) }
+
+  #define MR_CLOSE(mf)		fclose(MR_file(mf))
+  #define MR_FLUSH(mf)		fflush(MR_file(mf))
+
+  #define MR_READ(mf, ptr, size)	\
+  		fread((ptr), sizeof(unsigned char), (size), MR_file(mf))
+  #define MR_WRITE(mf, ptr, size)	\
+  		fwrite((ptr), sizeof(unsigned char), (size), MR_file(mf))
+
+  #define MR_UNGETCH(mf, ch)	ungetc((int) (ch), MR_file(mf))
+  #define MR_GETCH(mf)		getc(MR_file(mf))
+
+  #define MR_VFPRINTF(mf, fmt, args)	\
+  		vfprintf(MR_file(mf), (fmt), (args))
+
+  #define MR_PUTCH(mf, ch)	putc((ch), MR_file(mf))
+
+#else /* MR_NEW_MERCURYFILE_STRUCT */
+
+	/* Possible types of a MercuryFile */
+  typedef enum {
+	MR_FILE_STREAM		= 1,
+	MR_SOCKET_STREAM	= 2,
+	MR_PIPE_STREAM		= 3,
+	MR_USER_STREAM		= 4
+  } MR_StreamType;
+
+  /*
+  ** A pointer to the data which can be used to access the MercuryFile.
+  */
+  typedef union {
 	FILE *file;
-	int line_number;
-} MercuryFile;
+	void *data;
+  } MR_StreamInfo;
+
+  typedef int (MR_Stream_close)(MR_StreamInfo *);
+  typedef int (MR_Stream_read)(MR_StreamInfo *, void *, size_t);
+  typedef int (MR_Stream_write)(MR_StreamInfo *, const void *, size_t);
+
+  typedef int (MR_Stream_flush)(MR_StreamInfo *);
+  typedef int (MR_Stream_ungetc)(MR_StreamInfo *, int);
+  typedef int (MR_Stream_getc)(MR_StreamInfo *);
+  typedef int (MR_Stream_vprintf)(MR_StreamInfo *, const char *, va_list);
+  typedef int (MR_Stream_putc)(MR_StreamInfo *, int);
+
+  /*
+  ** The MercuryFile structure records:
+  **	- the type of the stream
+  **	- a pointer to the information which describes the stream
+  **	- the line number we are up to in the stream
+  **
+  **	- pointer to functions which provide the same functionality
+  **	  as close/read/write of fds.
+  **
+  **	- pointers to functions which provide the same functionality
+  **	  as flush/ungetc/getc/vprintf/putc on stdio files.
+  **
+  ** MercuryFiles record all this extra information so that users can use all
+  ** the functionality of io.m on their own streams.  For instance see
+  ** extras/logged_output.
+  */
+  typedef struct mercury_file {
+	MR_StreamType	stream_type;
+	MR_StreamInfo	stream_info;
+	int		line_number;
+
+		/* UNBUFFERED FUNCTIONS */
+	MR_Stream_close	*close;    
+	MR_Stream_read	*read;
+	MR_Stream_write	*write;
+
+		/* BUFFERED FUNCTIONS */
+	MR_Stream_flush		*flush;
+	MR_Stream_ungetc	*ungetc;
+	MR_Stream_getc		*getc;
+	MR_Stream_vprintf	*vprintf;
+	MR_Stream_putc		*putc;
+  } MercuryFile;
+
+  /*
+  ** access the file and line number fields
+  */
+  #define MR_file(mf)		(mf).stream_info.file
+  #define MR_line_number(mf)	(mf).line_number
+
+  /*
+  ** Call the functions associated with the MercuryFile structure
+  */
+  #define MR_CLOSE(mf)	((mf).close)(&((mf).stream_info))
+  #define MR_READ(mf, ptr, size)	\
+  		((mf).read)(&((mf).stream_info), (ptr), (size))
+  #define MR_WRITE(mf, ptr, size)	\
+  		((mf).write)(&((mf).stream_info), (ptr), (size))
+
+  #define MR_FLUSH(mf)	((mf).flush)(&((mf).stream_info))
+  #define MR_UNGETCH(mf, ch)	\
+  		((mf).ungetc)(&((mf).stream_info), (ch))
+  #define MR_GETCH(mf)	((mf).getc)(&((mf).stream_info))
+  #define MR_VFPRINTF(mf, fmt, args)	\
+  		((mf).vprintf)(&((mf).stream_info), (fmt), (args))
+  #define MR_PUTCH(mf, ch)	\
+  		((mf).putc)(&((mf).stream_info), (ch))
+
+#endif	/* MR_NEW_MERCURYFILE_STRUCT */
 
 /*
 ** definitions for accessing the representation of the
Index: trace/mercury_trace_browse.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_browse.c,v
retrieving revision 1.13
diff -u -r1.13 mercury_trace_browse.c
--- trace/mercury_trace_browse.c	2000/08/03 06:19:24	1.13
+++ trace/mercury_trace_browse.c	2000/08/11 11:02:26
@@ -47,8 +47,7 @@
 static void
 MR_c_file_to_mercury_file(FILE *c_file, MercuryFile *mercury_file)
 {
-	mercury_file->file = c_file;
-	mercury_file->line_number = 1;
+	MR_mercuryfile_init(c_file, 1, mercury_file);
 }
 
 void
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.27
diff -u -r1.27 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c	2000/08/10 05:51:28	1.27
+++ trace/mercury_trace_declarative.c	2000/08/11 11:02:31
@@ -1104,10 +1104,8 @@
 	static MercuryFile	mdb_in;
 	static MercuryFile	mdb_out;
 
-	mdb_in.file = MR_mdb_in;
-	mdb_in.line_number = 1;
-	mdb_out.file = MR_mdb_out;
-	mdb_out.line_number = 1;
+	MR_mercuryfile_init(MR_mdb_in, 1, &mdb_in);
+	MR_mercuryfile_init(MR_mdb_out, 1, &mdb_out);
 
 	if (! done) {
 		MR_TRACE_CALL_MERCURY(
@@ -1351,10 +1349,9 @@
 static	void
 MR_decl_diagnosis_test(MR_Trace_Node root)
 {
-	MercuryFile		stream;
+	MercuryFile stream;
 
-	stream.file = MR_trace_store_file;
-	stream.line_number = 1;
+	MR_mercuryfile_init(MR_trace_store_file, 1, &stream);
 
 	MR_TRACE_CALL_MERCURY(
 		MR_DD_save_trace((MR_Word) &stream, MR_trace_node_store, root);
@@ -1467,10 +1464,9 @@
 static	void
 MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node)
 {
-	MercuryFile		mdb_out;
+	MercuryFile mdb_out;
 
-	mdb_out.file = MR_mdb_out;
-	mdb_out.line_number = 1;
+	MR_mercuryfile_init(MR_mdb_out, 1, &mdb_out);
 
 	fprintf(MR_mdb_out, "DD %s: %ld ", str, (long) node);
 	MR_TRACE_CALL_MERCURY(
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.41
diff -u -r1.41 mercury_trace_external.c
--- trace/mercury_trace_external.c	2000/08/03 06:19:26	1.41
+++ trace/mercury_trace_external.c	2000/08/11 11:02:36
@@ -404,12 +404,9 @@
 		fprintf(stderr, "Mercury runtime: fdopen(): ok\n");
 	}
 
-	MR_debugger_socket_in.file = file_in;
-	MR_debugger_socket_in.line_number = 1;
+	MR_mercuryfile_init(file_in, 1, &MR_debugger_socket_in);
+	MR_mercuryfile_init(file_out, 1, &MR_debugger_socket_out);
 
-	MR_debugger_socket_out.file = file_out;
-	MR_debugger_socket_out.line_number = 1;
-
 	/*
 	** Send hello
 	*/
@@ -986,7 +983,7 @@
 			MR_Word *debugger_request_ptr, 
 			MR_Integer *debugger_request_type_ptr)
 {		
-	fflush(MR_debugger_socket_in.file);
+	fflush(MR_file(MR_debugger_socket_in));
 
     MR_TRACE_CALL_MERCURY(
 	ML_DI_read_request_from_socket(
@@ -1059,18 +1056,18 @@
 	va_list args;
 
 	va_start(args, format);
-	vfprintf(MR_debugger_socket_out.file, format, args);
+	vfprintf(MR_file(MR_debugger_socket_out), format, args);
 	va_end(args);
-	fflush(MR_debugger_socket_out.file);
-	MR_debugger_socket_out.line_number++;
+	fflush(MR_file(MR_debugger_socket_out));
+	MR_line_number(MR_debugger_socket_out)++;
 }
 
 static void
 MR_send_message_to_socket(const char *message)
 {
-	fprintf(MR_debugger_socket_out.file, "%s.\n", message);
-	fflush(MR_debugger_socket_out.file);
-	MR_debugger_socket_out.line_number++;
+	fprintf(MR_file(MR_debugger_socket_out), "%s.\n", message);
+	fflush(MR_file(MR_debugger_socket_out));
+	MR_line_number(MR_debugger_socket_out)++;
 }
 
 /*

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list