[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