[m-dev.] for review: change MercuryFile structure
Peter Ross
peter.ross at miscrit.be
Fri Jul 28 22:15:41 AEST 2000
Hi,
For Fergus to review.
I will do the changes required to io.m to handle bidirectional streams
as a seperate change, as they are independent of this change.
===================================================================
Estimated hours taken: 20
Change the MercuryFile structure so that it now 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.
runtime/mercury_library_types.h:
Define the new implementation of MercuryFile structure.
The MercuryFile structure 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: 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/07/28 11:42:31
@@ -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 Jul 28 21:42:39 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 Jul 28 21:42:39 2000
@@ -0,0 +1,5 @@
+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.
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 Jul 28 21:42:39 2000
@@ -0,0 +1,148 @@
+%------------------------------------------------------------------------------%
+% 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("
+#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 Jul 28 21:42:39 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.198
diff -u -r1.198 io.m
--- library/io.m 2000/06/08 07:59:01 1.198
+++ library/io.m 2000/07/28 11:42:55
@@ -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.58
diff -u -r1.58 Mmakefile
--- runtime/Mmakefile 2000/06/22 08:50:24 1.58
+++ runtime/Mmakefile 2000/07/28 11:42:56
@@ -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 \
@@ -118,6 +119,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_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 Jul 28 21:43:00 2000
@@ -0,0 +1,116 @@
+/*
+** 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 C `FILE *' streams.
+*/
+
+#include "mercury_file.h"
+#include <assert.h>
+
+
+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)
+{
+ int ch;
+
+ assert(info!=NULL);
+ ch = getc(info->file);
+
+ return ch;
+}
+
+int
+MR_ungetch(MR_StreamInfo *info, int ch)
+{
+ int res;
+ assert(info!=NULL);
+ if ((res = ungetc((int) ch, info->file)) == EOF) {
+ fprintf(stderr, "io__putback_char2(%c,%d): ungetc failed\n",
+ res, (int) ch);
+ }
+ return (int) res;
+}
+
+int
+MR_putch(MR_StreamInfo *info, int ch)
+{
+ assert(info!=NULL);
+ return putc(ch, info->file);
+}
+
+int
+MR_close(MR_StreamInfo *info)
+{
+ assert(info!=NULL);
+ return fclose(info->file);
+}
+
+int
+MR_flush(MR_StreamInfo *info)
+{
+ assert(info!=NULL);
+ return fflush(info->file);
+}
+
+int
+MR_vfprintf(MR_StreamInfo *info, const char *format, va_list ap)
+{
+ int rc;
+
+ assert(info != NULL);
+ assert(format != NULL);
+
+ rc = vfprintf(info->file, format, ap);
+
+ return rc;
+}
+
+int
+MR_read(MR_StreamInfo *info, void *buffer, size_t size)
+{
+ int rc;
+ 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;
+
+ assert(info!=NULL);
+ rc = fwrite(buffer, sizeof(unsigned char), size, info->file);
+
+}
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 Jul 28 21:43:01 2000
@@ -0,0 +1,27 @@
+/*
+** 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"
+
+#define MR_IS_FILE_STREAM(mf) ( (mf).stream_type == MR_FILE_STREAM )
+
+/*
+** Initialise a MercuryFile structure to use the C stdlib FILE *type.
+*/
+void MR_mercuryfile_init(FILE *file, int line_number, MercuryFile *mf);
+
+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 *pszFormat, 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 /* MERCURY_FILE_H */
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.15
diff -u -r1.15 mercury_imp.h
--- runtime/mercury_imp.h 2000/05/05 10:14:48 1.15
+++ runtime/mercury_imp.h 2000/07/28 11:43:01
@@ -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_stack_trace.h"
Index: runtime/mercury_library_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_library_types.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_library_types.h
--- runtime/mercury_library_types.h 1999/10/18 15:46:56 1.3
+++ runtime/mercury_library_types.h 2000/07/28 11:43:01
@@ -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 `Word' and `Integer' */
#include "mercury_std.h" /* for MR_VARIABLE_SIZED */
@@ -20,13 +21,92 @@
** 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.
*/
-typedef struct mercury_file {
+ /* 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;
+ 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))
/*
** 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.12
diff -u -r1.12 mercury_trace_browse.c
--- trace/mercury_trace_browse.c 2000/05/15 16:37:40 1.12
+++ trace/mercury_trace_browse.c 2000/07/28 11:43:03
@@ -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.24
diff -u -r1.24 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 2000/06/21 19:00:38 1.24
+++ trace/mercury_trace_declarative.c 2000/07/28 11:43:06
@@ -1073,10 +1073,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(
@@ -1320,10 +1318,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((Word) &stream, MR_trace_node_store, root);
@@ -1436,10 +1433,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.40
diff -u -r1.40 mercury_trace_external.c
--- trace/mercury_trace_external.c 2000/05/15 16:37:42 1.40
+++ trace/mercury_trace_external.c 2000/07/28 11:43:09
@@ -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 @@
Word *debugger_request_ptr,
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