[m-dev.] for review: add Mission Critical extensions
Peter Ross
petdr at cs.mu.OZ.AU
Thu Jul 6 02:00:31 AEST 2000
Hi,
For Fergus to review.
===================================================================
Estimated hours taken: 16
Add the Mission Critical extensions to the compiler. These extensions
are only turned on if --enable-mc is supplied to configure.
The point of this change is to minimize the diff between the Mission
Critical Mercury compiler and the Melbourne Mercury compiler.
configure.in:
Add --enable-mc to configure. This options turns on the Mission
Critical extensions to the compiler.
runtime/mercury_conf.h.in:
Add MR_MISCRIT_EXTS which is defined when --enable-mc is passed to
configure.
runtime/mercury_conf_param.h:
If we are using the Mission Critical extensions, define
MISCRIT_STREAMS.
runtime/mercury_library_types.h:
If MISCRIT_STREAMS is defined use the Mission Critical version of
the type MercuryFile. The new definition of MercuryFile makes it
possible for Mercury to handle streams connected to sockets and
pipes under WinNT. The MercuryFile structure now contains pointers
to functions to do the basic operations on streams, which allows
them to be changed according to the type of stream.
All this extra functionality is then hidden behind macros,
allowing the original definition of MercuryFile to coexist.
library/io.m:
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.
runtime/Mmakefile:
Add mercury_miscrit_stream.{c,h} to the library.
runtime/mercury_miscrit_stream.c:
runtime/mercury_miscrit_stream.h:
Define the basic functions which operate on a MercuryFile structure
when it is a real file.
library/exception.m:
Export the modes of try/2 and try_io/4 that take det predicates as C
functions. This allows Mission Critical to change the semantics of
these two calls, in their own libraries.
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.212
diff -u -r1.212 configure.in
--- configure.in 2000/06/29 09:55:33 1.212
+++ configure.in 2000/07/05 15:52:53
@@ -2378,6 +2378,17 @@
LIBS="$save_LIBS"
#-----------------------------------------------------------------------------#
+
+AC_ARG_ENABLE(mc,
+[ --enable-mc enable the Mission Critical extensions],
+ac_miscrit=yes,ac_miscrit=no)
+
+if test "$ac_miscrit" = "yes"; then
+ MERCURY_MSG("Enabling the Mission Critical extensions.")
+ AC_DEFINE(MR_MISCRIT_EXTS)
+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/07/05 15:52:55
@@ -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: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.25
diff -u -r1.25 exception.m
--- library/exception.m 2000/06/26 08:14:55 1.25
+++ library/exception.m 2000/07/05 15:53:15
@@ -330,6 +330,10 @@
builtin_catch(wrap_success_or_failure(Goal), wrap_exception, Result).
*********************/
+ % XXX we export this mode of try/2 so that the nasty people
+ % at Mission Critical can change its semantics.
+:- pragma export(try(pred(out) is det, out(cannot_fail)), "ML_try").
+
try(Goal, Result) :-
get_determinism(Goal, Detism),
try(Detism, Goal, Result).
@@ -400,6 +404,11 @@
wrap_success(Goal, R)),
wrap_exception, Result)),
AccPred, Acc0, Acc).
+
+ % XXX we export this mode of try_io/4 so that the nasty people
+ % at Mission Critical can change its semantics.
+:- pragma export(try_io(pred(out, di, uo) is det, out(cannot_fail), di, uo),
+ "ML_try_io").
try_io(IO_Goal, Result) -->
{ get_determinism_2(IO_Goal, Detism) },
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/05 15:53:30
@@ -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;
@@ -2685,15 +2702,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 = MR_MERCURYFILE_INIT(NULL, 1);
+MercuryFile mercury_stdout = MR_MERCURYFILE_INIT(NULL, 1);
+MercuryFile mercury_stderr = MR_MERCURYFILE_INIT(NULL, 1);
+MercuryFile mercury_stdin_binary = MR_MERCURYFILE_INIT(NULL, 1);
+MercuryFile mercury_stdout_binary = MR_MERCURYFILE_INIT(NULL, 1);
-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 +2721,18 @@
void
mercury_init_io(void)
{
- mercury_stdin.file = stdin;
- mercury_stdout.file = stdout;
- mercury_stderr.file = stderr;
+ MR_file(mercury_stdin) = stdin;
+ MR_file(mercury_stdout) = stdout;
+ MR_file(mercury_stderr) = stderr;
#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 +2742,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
}
@@ -2736,13 +2755,14 @@
mercury_open(const char *filename, const char *type)
{
MercuryFile *mf;
+ MercuryFile tmp = MR_MERCURYFILE_INIT(NULL, 1);
FILE *f;
f = fopen(filename, type);
if (!f) return NULL;
mf = MR_GC_NEW(MercuryFile);
- mf->file = f;
- mf->line_number = 1;
+ *mf = tmp;
+ MR_file(*mf) = f;
return mf;
}
@@ -2795,12 +2815,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 +2832,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 +2844,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 +2862,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 +2872,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 +2901,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 +2914,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 +2930,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 +2949,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 +2958,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 +2974,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 +2982,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 +3009,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 +3019,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 +3039,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 +3051,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 +3060,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 +3070,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 +3086,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 +3095,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 +3163,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 +3171,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 +3185,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 +3199,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 +3213,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/05 15:53:33
@@ -62,6 +62,7 @@
mercury_memory_zones.h \
mercury_memory_handlers.h \
mercury_misc.h \
+ mercury_miscrit_stream.h \
mercury_overflow.h \
mercury_prof.h \
mercury_prof_mem.h \
@@ -131,6 +132,7 @@
mercury_memory_zones.c \
mercury_memory_handlers.c \
mercury_misc.c \
+ mercury_miscrit_stream.c \
mercury_prof.c \
mercury_prof_mem.c \
mercury_reg_workarounds.c \
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.27
diff -u -r1.27 mercury_conf.h.in
--- runtime/mercury_conf.h.in 2000/06/29 09:55:35 1.27
+++ runtime/mercury_conf.h.in 2000/07/05 15:53:33
@@ -346,6 +346,14 @@
#undef HAVE_READLINE_READLINE
#undef HAVE_READLINE_HISTORY
+
+/*
+** MR_MISCRIT_EXTS
+** Set this if you want to use the Mission Critical version of the
+** compiler.
+*/
+#undef MR_MISCRIT_EXTS
+
/*---------------------------------------------------------------------------*/
#include "mercury_conf_param.h"
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.38
diff -u -r1.38 mercury_conf_param.h
--- runtime/mercury_conf_param.h 2000/07/04 12:23:29 1.38
+++ runtime/mercury_conf_param.h 2000/07/05 15:53:34
@@ -392,4 +392,17 @@
/*---------------------------------------------------------------------------*/
+/*
+** Mission Critical specific.
+*/
+
+/*
+** MISCRIT_STREAMS -- Use Mission Critical streams for I/O.
+*/
+#ifdef MR_MISCRIT_EXTS
+ #define MISCRIT_STREAMS
+#endif
+
+/*---------------------------------------------------------------------------*/
+
#endif /* MERCURY_CONF_PARAM_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/05 15:53:35
@@ -23,10 +23,103 @@
** because we keep track of a little bit more information.
*/
-typedef struct mercury_file {
- FILE *file;
- int line_number;
-} MercuryFile;
+#ifndef MISCRIT_STREAMS
+ typedef struct mercury_file {
+ FILE *file1;
+ int line_number1;
+ } MercuryFile;
+
+ #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
+ #include "mercury_miscrit_stream.h"
+
+ typedef enum {
+ MR_FILE_STREAM = 1,
+ MR_SOCKET_STREAM = 2,
+ MR_PIPE_STREAM = 3,
+ MR_USER_STREAM = 4
+ } MR_StreamType;
+
+ typedef int (MR_Stream_close)(MR_StreamInfo *);
+ typedef int (MR_Stream_flush)(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_ungetch)(MR_StreamInfo *, int);
+ typedef int (MR_Stream_getch)(MR_StreamInfo *);
+ typedef int (MR_Stream_printf)(MR_StreamInfo *, const char *, va_list);
+ typedef int (MR_Stream_putch)(MR_StreamInfo *, int);
+
+ typedef struct mercury_file {
+ MR_StreamType stream_type;
+ MR_StreamInfo stream_info;
+ int line_number;
+
+ MR_Stream_close *close;
+ MR_Stream_flush *flush;
+ MR_Stream_read *read;
+ MR_Stream_write *write;
+
+ /* BUFFERED FUNCTIONS */
+ MR_Stream_ungetch *ungetch;
+ MR_Stream_getch *getch;
+ MR_Stream_printf *printf;
+ MR_Stream_putch *putch;
+ } MercuryFile;
+
+ #define MR_file(mf) (mf).stream_info.file
+ #define MR_line_number(mf) (mf).line_number
+
+ #define MR_IS_FILE_STREAM(mf) ( (mf).stream_type == MR_FILE_STREAM )
+
+ #define MR_MERCURYFILE_INIT(file, line_number) \
+ { MR_FILE_STREAM, (file), (line_number), \
+ MR_mc_close, MR_mc_flush, MR_mc_read, \
+ MR_mc_write, MR_mc_ungetch, MR_mc_getch, \
+ MR_mc_vfprintf, MR_mc_putch \
+ }
+
+ #define MR_CLOSE(mf) ((mf).close)(&((mf).stream_info))
+ #define MR_FLUSH(mf) ((mf).flush)(&((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_UNGETCH(mf, ch) \
+ ((mf).ungetch)(&((mf).stream_info), (ch))
+
+ #define MR_GETCH(mf) ((mf).getch)(&((mf).stream_info))
+
+ #define MR_VFPRINTF(mf, fmt, args) \
+ ((mf).printf)(&((mf).stream_info), (fmt), (args))
+
+ #define MR_PUTCH(mf, ch) \
+ ((mf).putch)(&((mf).stream_info), (ch))
+
+#endif
/*
** definitions for accessing the representation of the
Index: runtime/mercury_miscrit_stream.c
===================================================================
RCS file: mercury_miscrit_stream.c
diff -N mercury_miscrit_stream.c
--- /dev/null Sat Aug 7 21:45:41 1999
+++ mercury_miscrit_stream.c Thu Jul 6 01:53:35 2000
@@ -0,0 +1,102 @@
+/*
+** 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 the mission critical
+** streams.
+*/
+
+#include "mercury_miscrit_stream.h"
+
+#include <assert.h>
+
+#ifdef MISCRIT_STREAMS
+int
+MR_mc_getch(MR_StreamInfo *info)
+{
+ int ch;
+
+ assert(info!=NULL);
+ ch = getc(info->file);
+
+ return ch;
+}
+
+int
+MR_mc_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_mc_putch(MR_StreamInfo *info, int ch)
+{
+ assert(info!=NULL);
+ return putc(ch, info->file);
+}
+
+int
+MR_mc_close(MR_StreamInfo *info)
+{
+ assert(info!=NULL);
+ return fclose(info->file);
+}
+
+int
+MR_mc_flush(MR_StreamInfo *info)
+{
+ assert(info!=NULL);
+ return fflush(info->file);
+}
+
+int
+MR_mc_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_mc_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_mc_write(MR_StreamInfo *info, const void *buffer, size_t size)
+{
+ int rc;
+
+ assert(info!=NULL);
+ rc = fwrite(buffer, sizeof(unsigned char), size, info->file);
+
+}
+
+#endif /* MISCRIT_STREAMS */
Index: runtime/mercury_miscrit_stream.h
===================================================================
RCS file: mercury_miscrit_stream.h
diff -N mercury_miscrit_stream.h
--- /dev/null Sat Aug 7 21:45:41 1999
+++ mercury_miscrit_stream.h Thu Jul 6 01:53:35 2000
@@ -0,0 +1,30 @@
+/*
+** 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_MISCRIT_STREAM_H
+#define MERCURY_MISCRIT_STREAM_H
+
+#include <stdio.h>
+#include <stdarg.h>
+
+#include "mercury_conf.h"
+
+#ifdef MISCRIT_STREAMS
+ typedef union {
+ FILE *file;
+ void *data;
+ } MR_StreamInfo;
+
+ int MR_mc_getch(MR_StreamInfo *info);
+ int MR_mc_putch(MR_StreamInfo *info, int);
+ int MR_mc_ungetch(MR_StreamInfo *info,int);
+ int MR_mc_close(MR_StreamInfo *info);
+ int MR_mc_flush(MR_StreamInfo *info);
+ int MR_mc_vfprintf(MR_StreamInfo *info, const char *pszFormat, va_list ap);
+ int MR_mc_read(MR_StreamInfo *info, void *buffer, size_t size);
+ int MR_mc_write(MR_StreamInfo *info, const void *buffer, size_t size);
+#endif
+
+#endif /* MERCURY_MISCRIT_STREAM_H */
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/05 15:53:38
@@ -47,8 +47,8 @@
static void
MR_c_file_to_mercury_file(FILE *c_file, MercuryFile *mercury_file)
{
- mercury_file->file = c_file;
- mercury_file->line_number = 1;
+ MercuryFile tmp = MR_MERCURYFILE_INIT(c_file, 1);
+ *mercury_file = tmp;
}
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/05 15:53:42
@@ -1073,10 +1073,14 @@
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;
+ {
+ MercuryFile tmp = MR_MERCURYFILE_INIT(MR_mdb_in, 1);
+ mdb_in = tmp;
+ }
+ {
+ MercuryFile tmp = MR_MERCURYFILE_INIT(MR_mdb_out, 1);
+ mdb_out = tmp;
+ }
if (! done) {
MR_TRACE_CALL_MERCURY(
@@ -1320,10 +1324,7 @@
static void
MR_decl_diagnosis_test(MR_Trace_Node root)
{
- MercuryFile stream;
-
- stream.file = MR_trace_store_file;
- stream.line_number = 1;
+ MercuryFile stream = MR_MERCURYFILE_INIT(MR_trace_store_file, 1);
MR_TRACE_CALL_MERCURY(
MR_DD_save_trace((Word) &stream, MR_trace_node_store, root);
@@ -1436,10 +1437,7 @@
static void
MR_decl_checkpoint_loc(const char *str, MR_Trace_Node node)
{
- MercuryFile mdb_out;
-
- mdb_out.file = MR_mdb_out;
- mdb_out.line_number = 1;
+ MercuryFile mdb_out = MR_MERCURYFILE_INIT(MR_mdb_out, 1);
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/05 15:53:47
@@ -100,8 +100,8 @@
} MR_debugger_request_type;
-MercuryFile MR_debugger_socket_in;
-MercuryFile MR_debugger_socket_out;
+MercuryFile MR_debugger_socket_in = MR_MERCURYFILE_INIT(NULL, 1);
+MercuryFile MR_debugger_socket_out = MR_MERCURYFILE_INIT(NULL, 1);
static String MR_mmc_options;
@@ -404,11 +404,11 @@
fprintf(stderr, "Mercury runtime: fdopen(): ok\n");
}
- MR_debugger_socket_in.file = file_in;
- MR_debugger_socket_in.line_number = 1;
+ MR_file(MR_debugger_socket_in) = file_in;
+ MR_line_number(MR_debugger_socket_in) = 1;
- MR_debugger_socket_out.file = file_out;
- MR_debugger_socket_out.line_number = 1;
+ MR_file(MR_debugger_socket_out) = file_out;
+ MR_line_number(MR_debugger_socket_out) = 1;
/*
** Send hello
@@ -986,7 +986,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 +1059,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