Thread-safety changes
Thomas Charles CONWAY
conway at cs.mu.OZ.AU
Mon Aug 24 14:29:56 AEST 1998
Hi
For whoever to review. I'll commit straight away, since the
changes only impact .par grades, and don't have bootstrapping
issues.
--
Thomas Conway <conway at cs.mu.oz.au>
Nail here [] for new monitor. )O+
Improve the multi-threaded execution support.
runtime/mercury_context.{c,h}:
Move the code for runnext from the .h file to the .c file -
it is reasonably large (in the thread_safe grades) so avoiding
the duplication is handy. It also makes debugging much easier!
Also, make scheduling a context as runnable append it to the
end of the runqueue, rather than consing it to the front. This
yeilds more useful behaviour for concurrent code that wants to
yeild in favour of any other runnable context.
library/math.m:
library/string.m:
library/io.m:
Add thread_safe to the flags for a whole bunch of predicates and
functions that are thread-safe.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/Togl-1.2
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing library
Index: library/array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/array.m,v
retrieving revision 1.46
diff -u -r1.46 array.m
--- array.m 1998/08/03 00:19:42 1.46
+++ array.m 1998/08/24 02:01:37
@@ -399,30 +399,34 @@
").
:- pragma c_code(array__init(Size::in, Item::in, Array::array_uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Array = (Word) ML_make_array(Size, Item);
").
:- pragma c_code(array__make_empty_array(Array::array_uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Array = (Word) ML_make_array(0, 0);
").
%-----------------------------------------------------------------------------%
-:- pragma c_code(array__min(Array::array_ui, Min::out), will_not_call_mercury, "
+:- pragma c_code(array__min(Array::array_ui, Min::out),
+ [will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma c_code(array__min(Array::in, Min::out), will_not_call_mercury, "
+:- pragma c_code(array__min(Array::in, Min::out),
+ [will_not_call_mercury, thread_safe], "
/* Array not used */
Min = 0;
").
-:- pragma c_code(array__max(Array::array_ui, Max::out), will_not_call_mercury, "
+:- pragma c_code(array__max(Array::array_ui, Max::out),
+ [will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
-:- pragma c_code(array__max(Array::in, Max::out), will_not_call_mercury, "
+:- pragma c_code(array__max(Array::in, Max::out),
+ [will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size - 1;
").
@@ -433,10 +437,11 @@
%-----------------------------------------------------------------------------%
:- pragma c_code(array__size(Array::array_ui, Max::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
-:- pragma c_code(array__size(Array::in, Max::out), will_not_call_mercury, "
+:- pragma c_code(array__size(Array::in, Max::out),
+ [will_not_call_mercury, thread_safe], "
Max = ((MR_ArrayType *)Array)->size;
").
@@ -465,7 +470,7 @@
%-----------------------------------------------------------------------------%
:- pragma c_code(array__lookup(Array::array_ui, Index::in, Item::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((Unsigned) Index >= (Unsigned) array->size) {
@@ -475,7 +480,7 @@
Item = array->elements[Index];
}").
:- pragma c_code(array__lookup(Array::in, Index::in, Item::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((Unsigned) Index >= (Unsigned) array->size) {
@@ -488,7 +493,8 @@
%-----------------------------------------------------------------------------%
:- pragma c_code(array__set(Array0::array_di, Index::in,
- Item::in, Array::array_uo), will_not_call_mercury, "{
+ Item::in, Array::array_uo),
+ [will_not_call_mercury, thread_safe], "{
MR_ArrayType *array = (MR_ArrayType *)Array0;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((Unsigned) Index >= (Unsigned) array->size) {
@@ -541,7 +547,7 @@
").
:- pragma c_code(array__resize(Array0::array_di, Size::in, Item::in,
- Array::array_uo), will_not_call_mercury, "
+ Array::array_uo), [will_not_call_mercury, thread_safe], "
Array = (Word) ML_resize_array(
(MR_ArrayType *) Array0, Size, Item);
").
@@ -584,7 +590,7 @@
").
:- pragma c_code(array__shrink(Array0::array_di, Size::in, Array::array_uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Array = (Word) ML_shrink_array(
(MR_ArrayType *) Array0, Size);
").
@@ -619,12 +625,12 @@
").
:- pragma c_code(array__copy(Array0::array_ui, Array::array_uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
:- pragma c_code(array__copy(Array0::in, Array::array_uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Array = (Word) ML_copy_array((MR_ArrayType *) Array0);
").
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.161
diff -u -r1.161 io.m
--- io.m 1998/08/04 02:21:54 1.161
+++ io.m 1998/08/24 01:59:43
@@ -1319,7 +1319,7 @@
% same as ANSI C's clearerr().
:- pragma c_code(io__clear_err(Stream::in, _IO0::di, _IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
clearerr(f->file);
@@ -1342,7 +1342,7 @@
:- pragma c_code(ferror(Stream::in, RetVal::out, RetStr::out,
_IO0::di, _IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
RetVal = ferror(f->file);
@@ -1385,7 +1385,7 @@
:- pragma c_code(io__stream_file_size(Stream::in, Size::out,
_IO0::di, _IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
struct stat s;
@@ -1405,7 +1405,7 @@
:- pred io__alloc_buffer(int::in, buffer::uo) is det.
:- pragma c_code(io__alloc_buffer(Size::in, Buffer::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
incr_hp_atomic(Buffer,
(Size * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word));
@@ -1414,7 +1414,7 @@
:- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
:- pragma c_code(io__resize_buffer(Buffer0::di, OldSize::in, NewSize::in,
Buffer::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
Char *buffer0 = (Char *) Buffer0;
Char *buffer;
@@ -1446,7 +1446,7 @@
:- pred io__buffer_to_string(buffer::di, int::in, string::uo) is det.
:- pragma c_code(io__buffer_to_string(Buffer::di, Len::in, Str::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
Str = (String) Buffer;
Str[Len] = '\\0';
@@ -1454,7 +1454,7 @@
:- pred io__buffer_to_string(buffer::di, string::uo) is det.
:- pragma c_code(io__buffer_to_string(Buffer::di, Str::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
Str = (String) Buffer;
}").
@@ -1465,7 +1465,7 @@
:- pragma c_code(io__read_into_buffer(Stream::in,
Buffer0::di, Pos0::in, Size::in,
Buffer::uo, Pos::out, _IO0::di, _IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *f = (MercuryFile *) Stream;
char *buffer = (Char *) Buffer0;
@@ -1738,7 +1738,7 @@
:- func unsafe_cast(T1::in) = (T2::out) is det.
:- pragma c_code(unsafe_cast(VarIn::in) = (VarOut::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
VarOut = VarIn;
").
@@ -1746,7 +1746,7 @@
:- func univ_value_as_type_any(univ) = any.
:- pragma c_code(univ_value_as_type_any(Univ::in) = (Val::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Val = field(mktag(0), Univ, UNIV_OFFSET_FOR_DATA);
").
@@ -2551,13 +2551,13 @@
/* output predicates - with output to mercury_current_text_output */
:- pragma c_code(io__write_string(Message::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
mercury_print_string(mercury_current_text_output, Message);
update_io(IO0, IO);
").
:- pragma c_code(io__write_char(Character::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (putc(Character, mercury_current_text_output->file) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -2568,7 +2568,7 @@
").
:- pragma c_code(io__write_int(Val::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (fprintf(mercury_current_text_output->file, ""%ld"", (long) Val) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -2576,7 +2576,7 @@
").
:- pragma c_code(io__write_float(Val::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (fprintf(mercury_current_text_output->file, ""%#.15g"", Val) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -2584,7 +2584,7 @@
").
:- pragma c_code(io__write_byte(Byte::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_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) {
@@ -2594,13 +2594,13 @@
").
:- pragma c_code(io__write_bytes(Message::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
mercury_print_binary_string(mercury_current_binary_output, Message);
update_io(IO0, IO);
}").
:- pragma c_code(io__flush_output(IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (fflush(mercury_current_text_output->file) < 0) {
mercury_output_error(mercury_current_text_output);
}
@@ -2608,7 +2608,7 @@
").
:- pragma c_code(io__flush_binary_output(IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (fflush(mercury_current_binary_output->file) < 0) {
mercury_output_error(mercury_current_binary_output);
}
@@ -2631,7 +2631,7 @@
:- mode io__seek_binary_2(in, in, in, di, uo) is det.
:- pragma c_code(io__seek_binary_2(Stream::in, Flag::in, Off::in,
- IO0::di, IO::uo), will_not_call_mercury,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
static const int seek_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END };
MercuryFile *stream = (MercuryFile *) Stream;
@@ -2640,7 +2640,7 @@
}").
:- pragma c_code(io__binary_stream_offset(Stream::in, Offset::out,
- IO0::di, IO::uo), will_not_call_mercury,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
Offset = ftell(stream->file);
@@ -2651,7 +2651,7 @@
/* output predicates - with output to the specified stream */
:- pragma c_code(io__write_string(Stream::in, Message::in, IO0::di, IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
mercury_print_string(stream, Message);
@@ -2659,7 +2659,7 @@
}").
:- pragma c_code(io__write_char(Stream::in, Character::in, IO0::di, IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
MercuryFile *stream = (MercuryFile *) Stream;
if (putc(Character, stream->file) < 0) {
@@ -2672,7 +2672,7 @@
}").
:- pragma c_code(io__write_int(Stream::in, Val::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (fprintf(stream->file, ""%ld"", (long) Val) < 0) {
mercury_output_error(stream);
@@ -2681,7 +2681,7 @@
}").
:- pragma c_code(io__write_float(Stream::in, Val::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (fprintf(stream->file, ""%#.15g"", Val) < 0) {
mercury_output_error(stream);
@@ -2690,7 +2690,7 @@
}").
:- pragma c_code(io__write_byte(Stream::in, Byte::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_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) {
@@ -2700,14 +2700,14 @@
}").
:- pragma c_code(io__write_bytes(Stream::in, Message::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
mercury_print_binary_string(stream, Message);
update_io(IO0, IO);
}").
:- pragma c_code(io__flush_output(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (fflush(stream->file) < 0) {
mercury_output_error(stream);
@@ -2716,7 +2716,7 @@
}").
:- pragma c_code(io__flush_binary_output(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
MercuryFile *stream = (MercuryFile *) Stream;
if (fflush(stream->file) < 0) {
mercury_output_error(stream);
@@ -2727,31 +2727,31 @@
/* stream predicates */
:- pragma c_code(io__stdin_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Stream = (Word) &mercury_stdin;
update_io(IO0, IO);
").
:- pragma c_code(io__stdout_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Stream = (Word) &mercury_stdout;
update_io(IO0, IO);
").
:- pragma c_code(io__stderr_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Stream = (Word) &mercury_stderr;
update_io(IO0, IO);
").
:- pragma c_code(io__stdin_binary_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Stream = (Word) &mercury_stdin;
update_io(IO0, IO);
").
:- pragma c_code(io__stdout_binary_stream(Stream::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Stream = (Word) &mercury_stdout;
update_io(IO0, IO);
").
@@ -2878,7 +2878,8 @@
% ResultCode is 0 for success, -1 for failure.
:- pragma c_code(
io__do_open(FileName::in, Mode::in, ResultCode::out,
- Stream::out, IO0::di, IO::uo), will_not_call_mercury,
+ Stream::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe],
"
Stream = (Word) mercury_open(FileName, Mode);
ResultCode = (Stream ? 0 : -1);
@@ -2886,25 +2887,25 @@
").
:- pragma c_code(io__close_input(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
mercury_close((MercuryFile*)Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_output(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
mercury_close((MercuryFile*)Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_input(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
mercury_close((MercuryFile*)Stream);
update_io(IO0, IO);
").
:- pragma c_code(io__close_binary_output(Stream::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
mercury_close((MercuryFile*)Stream);
update_io(IO0, IO);
").
@@ -2913,7 +2914,7 @@
:- pragma c_code(
io__progname(DefaultProgname::in, PrognameOut::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if (progname) {
/* The silly casting below is needed to avoid
a gcc warning about casting away const.
@@ -2930,7 +2931,7 @@
").
:- pragma c_code(io__command_line_arguments(Args::out, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
/* convert mercury_argv from a vector to a list */
{ int i = mercury_argc;
Args = list_empty();
@@ -2954,7 +2955,7 @@
").
:- pragma c_code(io__preallocate_heap_space(HeapSpace::in, IO0::di, IO::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
/* HeapSpace not used */
/* don't do anything - preallocate_heap_space was just a
hack for NU-Prolog */
@@ -3053,7 +3054,7 @@
:- pragma c_code(io__make_temp(Dir::in, Prefix::in, FileName::out,
IO0::di, IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
/*
** Constructs a temporary name by concatenating Dir, `/',
@@ -3152,7 +3153,7 @@
:- mode io__remove_file_2(in, out, out, di, uo) is det.
:- pragma c_code(io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
- IO0::di, IO::uo), will_not_call_mercury,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
"{
RetVal = remove(FileName);
ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "", RetStr);
@@ -3172,7 +3173,7 @@
:- pragma c_code(io__rename_file_2(OldFileName::in, NewFileName::in,
RetVal::out, RetStr::out, IO0::di, IO::uo),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
RetVal = rename(OldFileName, NewFileName);
ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "", RetStr);
Index: library/math.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/math.m,v
retrieving revision 1.14
diff -u -r1.14 math.m
--- math.m 1998/08/04 01:58:21 1.14
+++ math.m 1998/08/24 02:06:17
@@ -209,12 +209,12 @@
% Mathematical constants from math.m
%
% Pythagoras' number
-:- pragma c_code(math__pi = (Pi::out), will_not_call_mercury,"
+:- pragma c_code(math__pi = (Pi::out), [will_not_call_mercury, thread_safe],"
Pi = MERCURY_FLOAT__PI;
").
% Base of natural logarithms
-:- pragma c_code(math__e = (E::out), will_not_call_mercury,"
+:- pragma c_code(math__e = (E::out), [will_not_call_mercury, thread_safe],"
E = MERCURY_FLOAT__E;
").
@@ -222,7 +222,8 @@
% math__ceiling(X) = Ceil is true if Ceil is the smallest integer
% not less than X.
%
-:- pragma c_code(math__ceiling(Num::in) = (Ceil::out), will_not_call_mercury,"
+:- pragma c_code(math__ceiling(Num::in) = (Ceil::out),
+ [will_not_call_mercury, thread_safe],"
Ceil = ceil(Num);
").
@@ -230,7 +231,8 @@
% math__floor(X) = Floor is true if Floor is the largest integer
% not greater than X.
%
-:- pragma c_code(math__floor(Num::in) = (Floor::out), will_not_call_mercury,"
+:- pragma c_code(math__floor(Num::in) = (Floor::out),
+ [will_not_call_mercury, thread_safe],"
Floor = floor(Num);
").
@@ -239,7 +241,8 @@
% closest to X. If X has a fractional component of 0.5,
% it is rounded up.
%
-:- pragma c_code(math__round(Num::in) = (Rounded::out), will_not_call_mercury,"
+:- pragma c_code(math__round(Num::in) = (Rounded::out),
+ [will_not_call_mercury, thread_safe],"
Rounded = floor(Num+0.5);
").
@@ -247,7 +250,8 @@
% math__truncate(X) = Trunc is true if Trunc is the integer
% closest to X such that |Trunc| =< |X|.
%
-:- pragma c_code(math__truncate(X::in) = (Trunc::out), will_not_call_mercury,"
+:- pragma c_code(math__truncate(X::in) = (Trunc::out),
+ [will_not_call_mercury, thread_safe],"
if (X < 0.0) {
Trunc = ceil(X);
} else {
@@ -262,7 +266,8 @@
% Domain restrictions:
% X >= 0
%
-:- pragma c_code(math__sqrt(X::in) = (SquareRoot::out), will_not_call_mercury,"
+:- pragma c_code(math__sqrt(X::in) = (SquareRoot::out),
+ [will_not_call_mercury, thread_safe],"
if (X < 0.0) {
mercury_domain_error(""math__sqrt"");
}
@@ -277,7 +282,8 @@
% X >= 0
% X = 0 implies Y > 0
%
-:- pragma c_code(math__pow(X::in, Y::in) = (Res::out), will_not_call_mercury,"
+:- pragma c_code(math__pow(X::in, Y::in) = (Res::out),
+ [will_not_call_mercury, thread_safe],"
if (X < 0.0) {
mercury_domain_error(""math__pow"");
}
@@ -295,7 +301,8 @@
% math__exp(X) = Exp is true if Exp is X raised to the
% power of e.
%
-:- pragma c_code(math__exp(X::in) = (Exp::out), will_not_call_mercury,"
+:- pragma c_code(math__exp(X::in) = (Exp::out),
+ [will_not_call_mercury, thread_safe],"
Exp = exp(X);
").
@@ -306,7 +313,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__ln(X::in) = (Log::out), will_not_call_mercury,"
+:- pragma c_code(math__ln(X::in) = (Log::out),
+ [will_not_call_mercury, thread_safe],"
if (X <= 0.0) {
mercury_domain_error(""math__ln"");
}
@@ -320,7 +328,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log10(X::in) = (Log10::out), will_not_call_mercury,"
+:- pragma c_code(math__log10(X::in) = (Log10::out),
+ [will_not_call_mercury, thread_safe],"
if (X <= 0.0)
mercury_domain_error(""math__log10"");
Log10 = log10(X);
@@ -333,7 +342,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log2(X::in) = (Log2::out), will_not_call_mercury,"
+:- pragma c_code(math__log2(X::in) = (Log2::out),
+ [will_not_call_mercury, thread_safe],"
if (X <= 0.0) {
mercury_domain_error(""math__log2"");
}
@@ -349,7 +359,8 @@
% B > 0
% B \= 1
%
-:- pragma c_code(math__log(B::in, X::in) = (Log::out), will_not_call_mercury,"
+:- pragma c_code(math__log(B::in, X::in) = (Log::out),
+ [will_not_call_mercury, thread_safe],"
if (X <= 0.0 || B <= 0.0) {
mercury_domain_error(""math__log"");
}
@@ -362,21 +373,24 @@
%
% math__sin(X) = Sin is true if Sin is the sine of X.
%
-:- pragma c_code(math__sin(X::in) = (Sin::out), will_not_call_mercury,"
+:- pragma c_code(math__sin(X::in) = (Sin::out),
+ [will_not_call_mercury, thread_safe],"
Sin = sin(X);
").
%
% math__cos(X) = Sin is true if Cos is the cosine of X.
%
-:- pragma c_code(math__cos(X::in) = (Cos::out), will_not_call_mercury,"
+:- pragma c_code(math__cos(X::in) = (Cos::out),
+ [will_not_call_mercury, thread_safe],"
Cos = cos(X);
").
%
% math__tan(X) = Tan is true if Tan is the tangent of X.
%
-:- pragma c_code(math__tan(X::in) = (Tan::out), will_not_call_mercury,"
+:- pragma c_code(math__tan(X::in) = (Tan::out),
+ [will_not_call_mercury, thread_safe],"
Tan = tan(X);
").
@@ -387,7 +401,8 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__asin(X::in) = (ASin::out), will_not_call_mercury,"
+:- pragma c_code(math__asin(X::in) = (ASin::out),
+ [will_not_call_mercury, thread_safe],"
if (X < -1.0 || X > 1.0) {
mercury_domain_error(""math__asin"");
}
@@ -401,7 +416,8 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__acos(X::in) = (ACos::out), will_not_call_mercury,"
+:- pragma c_code(math__acos(X::in) = (ACos::out),
+ [will_not_call_mercury, thread_safe],"
if (X < -1.0 || X > 1.0) {
mercury_domain_error(""math__acos"");
}
@@ -412,7 +428,8 @@
% math__atan(X) = ATan is true if ATan is the inverse
% tangent of X, where ATan is in the range [-pi/2,pi/2].
%
-:- pragma c_code(math__atan(X::in) = (ATan::out), will_not_call_mercury,"
+:- pragma c_code(math__atan(X::in) = (ATan::out),
+ [will_not_call_mercury, thread_safe],"
ATan = atan(X);
").
@@ -421,7 +438,7 @@
% tangent of Y/X, where ATan is in the range [-pi,pi].
%
:- pragma c_code(math__atan2(Y::in, X::in) = (ATan2::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
ATan2 = atan2(Y, X);
").
@@ -429,7 +446,8 @@
% math__sinh(X) = Sinh is true if Sinh is the hyperbolic
% sine of X.
%
-:- pragma c_code(math__sinh(X::in) = (Sinh::out), will_not_call_mercury,"
+:- pragma c_code(math__sinh(X::in) = (Sinh::out),
+ [will_not_call_mercury, thread_safe],"
Sinh = sinh(X);
").
@@ -437,7 +455,8 @@
% math__cosh(X) = Cosh is true if Cosh is the hyperbolic
% cosine of X.
%
-:- pragma c_code(math__cosh(X::in) = (Cosh::out), will_not_call_mercury,"
+:- pragma c_code(math__cosh(X::in) = (Cosh::out),
+ [will_not_call_mercury, thread_safe],"
Cosh = cosh(X);
").
@@ -445,7 +464,8 @@
% math__tanh(X) = Tanh is true if Tanh is the hyperbolic
% tangent of X.
%
-:- pragma c_code(math__tanh(X::in) = (Tanh::out), will_not_call_mercury,"
+:- pragma c_code(math__tanh(X::in) = (Tanh::out),
+ [will_not_call_mercury, thread_safe],"
Tanh = tanh(X);
").
@@ -639,33 +659,36 @@
% Mathematical constants from math.m
%
% Pythagoras' number
-:- pragma c_code(math__pi(Pi::out), will_not_call_mercury,
+:- pragma c_code(math__pi(Pi::out), [will_not_call_mercury, thread_safe],
"Pi = MERCURY_FLOAT__PI;").
% Base of natural logarithms
-:- pragma c_code(math__e(E::out), will_not_call_mercury,
+:- pragma c_code(math__e(E::out), [will_not_call_mercury, thread_safe],
"E = MERCURY_FLOAT__E;").
%
% math__ceiling(X, Ceil) is true if Ceil is the smallest integer
% not less than X.
%
-:- pragma c_code(math__ceiling(Num::in, Ceil::out), will_not_call_mercury,
- "Ceil = ceil(Num);").
+:- pragma c_code(math__ceiling(Num::in, Ceil::out),
+ [will_not_call_mercury, thread_safe],
+ "Ceil = ceil(Num);").
%
% math__floor(X, Floor) is true if Floor is the largest integer
% not greater than X.
%
-:- pragma c_code(math__floor(Num::in, Floor::out), will_not_call_mercury,
- "Floor = floor(Num);").
+:- pragma c_code(math__floor(Num::in, Floor::out),
+ [will_not_call_mercury, thread_safe],
+ "Floor = floor(Num);").
%
% math__round(X, Round) is true if Round is the integer
% closest to X. If X has a fractional component of 0.5,
% it is rounded up.
%
-:- pragma c_code(math__round(Num::in, Rounded::out), will_not_call_mercury, "
+:- pragma c_code(math__round(Num::in, Rounded::out),
+ [will_not_call_mercury, thread_safe], "
Rounded = floor(Num+0.5);
").
@@ -673,7 +696,8 @@
% math__truncate(X, Trunc) is true if Trunc is the integer
% closest to X such that |Trunc| =< |X|.
%
-:- pragma c_code(math__truncate(X::in, Trunc::out), will_not_call_mercury, "
+:- pragma c_code(math__truncate(X::in, Trunc::out),
+ [will_not_call_mercury, thread_safe], "
if (X < 0.0) {
Trunc = ceil(X);
} else {
@@ -688,7 +712,8 @@
% Domain restrictions:
% X >= 0
%
-:- pragma c_code(math__sqrt(X::in, SquareRoot::out), will_not_call_mercury, "
+:- pragma c_code(math__sqrt(X::in, SquareRoot::out),
+ [will_not_call_mercury, thread_safe], "
if (X < 0.0) {
mercury_domain_error(""math__sqrt"");
}
@@ -703,7 +728,8 @@
% X >= 0
% X = 0 implies Y > 0
%
-:- pragma c_code(math__pow(X::in, Y::in, Res::out), will_not_call_mercury, "
+:- pragma c_code(math__pow(X::in, Y::in, Res::out),
+ [will_not_call_mercury, thread_safe], "
if (X < 0.0) {
mercury_domain_error(""math__pow"");
}
@@ -721,7 +747,8 @@
% math__exp(X, Exp) is true if Exp is X raised to the
% power of e.
%
-:- pragma c_code(math__exp(X::in, Exp::out), will_not_call_mercury, "
+:- pragma c_code(math__exp(X::in, Exp::out),
+ [will_not_call_mercury, thread_safe], "
Exp = exp(X);
").
@@ -732,7 +759,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__ln(X::in, Log::out), will_not_call_mercury, "
+:- pragma c_code(math__ln(X::in, Log::out),
+ [will_not_call_mercury, thread_safe], "
if (X <= 0.0) {
mercury_domain_error(""math__ln"");
}
@@ -746,7 +774,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log10(X::in, Log10::out), will_not_call_mercury, "
+:- pragma c_code(math__log10(X::in, Log10::out),
+ [will_not_call_mercury, thread_safe], "
if (X <= 0.0)
mercury_domain_error(""math__log10"");
Log10 = log10(X);
@@ -759,7 +788,8 @@
% Domain restrictions:
% X > 0
%
-:- pragma c_code(math__log2(X::in, Log2::out), will_not_call_mercury, "
+:- pragma c_code(math__log2(X::in, Log2::out),
+ [will_not_call_mercury, thread_safe], "
if (X <= 0.0) {
mercury_domain_error(""math__log2"");
}
@@ -775,7 +805,8 @@
% B > 0
% B \= 1
%
-:- pragma c_code(math__log(B::in, X::in, Log::out), will_not_call_mercury, "
+:- pragma c_code(math__log(B::in, X::in, Log::out),
+ [will_not_call_mercury, thread_safe], "
if (X <= 0.0 || B <= 0.0) {
mercury_domain_error(""math__log"");
}
@@ -788,21 +819,24 @@
%
% math__sin(X, Sin) is true if Sin is the sine of X.
%
-:- pragma c_code(math__sin(X::in, Sin::out), will_not_call_mercury, "
+:- pragma c_code(math__sin(X::in, Sin::out),
+ [will_not_call_mercury, thread_safe], "
Sin = sin(X);
").
%
% math__cos(X, Sin) is true if Cos is the cosine of X.
%
-:- pragma c_code(math__cos(X::in, Cos::out), will_not_call_mercury, "
+:- pragma c_code(math__cos(X::in, Cos::out),
+ [will_not_call_mercury, thread_safe], "
Cos = cos(X);
").
%
% math__tan(X, Tan) is true if Tan is the tangent of X.
%
-:- pragma c_code(math__tan(X::in, Tan::out), will_not_call_mercury, "
+:- pragma c_code(math__tan(X::in, Tan::out),
+ [will_not_call_mercury, thread_safe], "
Tan = tan(X);
").
@@ -813,7 +847,8 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__asin(X::in, ASin::out), will_not_call_mercury, "
+:- pragma c_code(math__asin(X::in, ASin::out),
+ [will_not_call_mercury, thread_safe], "
if (X < -1.0 || X > 1.0) {
mercury_domain_error(""math__asin"");
}
@@ -827,7 +862,8 @@
% Domain restrictions:
% X must be in the range [-1,1]
%
-:- pragma c_code(math__acos(X::in, ACos::out), will_not_call_mercury, "
+:- pragma c_code(math__acos(X::in, ACos::out),
+ [will_not_call_mercury, thread_safe], "
if (X < -1.0 || X > 1.0) {
mercury_domain_error(""math__acos"");
}
@@ -838,7 +874,8 @@
% math__atan(X, ATan) is true if ATan is the inverse
% tangent of X, where ATan is in the range [-pi/2,pi/2].
%
-:- pragma c_code(math__atan(X::in, ATan::out), will_not_call_mercury, "
+:- pragma c_code(math__atan(X::in, ATan::out),
+ [will_not_call_mercury, thread_safe], "
ATan = atan(X);
").
@@ -846,7 +883,8 @@
% math__atan2(Y, X, ATan) is true if ATan is the inverse
% tangent of Y/X, where ATan is in the range [-pi,pi].
%
-:- pragma c_code(math__atan2(Y::in, X::in, ATan2::out), will_not_call_mercury, "
+:- pragma c_code(math__atan2(Y::in, X::in, ATan2::out),
+ [will_not_call_mercury, thread_safe], "
ATan2 = atan2(Y, X);
").
@@ -854,7 +892,8 @@
% math__sinh(X, Sinh) is true if Sinh is the hyperbolic
% sine of X.
%
-:- pragma c_code(math__sinh(X::in, Sinh::out), will_not_call_mercury, "
+:- pragma c_code(math__sinh(X::in, Sinh::out),
+ [will_not_call_mercury, thread_safe], "
Sinh = sinh(X);
").
@@ -862,7 +901,8 @@
% math__cosh(X, Cosh) is true if Cosh is the hyperbolic
% cosine of X.
%
-:- pragma c_code(math__cosh(X::in, Cosh::out), will_not_call_mercury, "
+:- pragma c_code(math__cosh(X::in, Cosh::out),
+ [will_not_call_mercury, thread_safe], "
Cosh = cosh(X);
").
@@ -870,7 +910,8 @@
% math__tanh(X, Tanh) is true if Tanh is the hyperbolic
% tangent of X.
%
-:- pragma c_code(math__tanh(X::in, Tanh::out), will_not_call_mercury, "
+:- pragma c_code(math__tanh(X::in, Tanh::out),
+ [will_not_call_mercury, thread_safe], "
Tanh = tanh(X);
").
Index: library/string.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/string.m,v
retrieving revision 1.105
diff -u -r1.105 string.m
--- string.m 1998/08/03 00:19:49 1.105
+++ string.m 1998/08/24 01:46:32
@@ -587,7 +587,7 @@
% it improves the overall speed of parsing by about 7%.
%
:- pragma c_code(string__from_rev_char_list(Chars::in, Str::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
{
Word list_ptr;
Word size, len;
@@ -1551,7 +1551,7 @@
%-----------------------------------------------------------------------------%
:- pragma c_code(string__float_to_string(FloatVal::in, FloatString::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
char buf[500];
Word tmp;
sprintf(buf, ""%#.15g"", FloatVal);
@@ -1566,7 +1566,7 @@
:- pred string__float_to_f_string(float::in, string::out) is det.
:- pragma c_code(string__float_to_f_string(FloatVal::in, FloatString::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
char buf[500];
Word tmp;
sprintf(buf, ""%.15f"", FloatVal);
@@ -1576,7 +1576,7 @@
}").
:- pragma c_code(string__to_float(FloatString::in, FloatVal::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
/* use a temporary, since we can't don't know whether FloatVal
is a double or float */
double tmp;
@@ -1594,7 +1594,7 @@
*/
:- pragma c_code(string__to_int_list(Str::in, IntList::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
const char *p = Str + strlen(Str);
IntList = list_empty();
while (p > Str) {
@@ -1604,7 +1604,7 @@
}").
:- pragma c_code(string__to_int_list(Str::out, IntList::in),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
/* mode (out, in) is det */
Word int_list_ptr;
size_t size;
@@ -1647,7 +1647,7 @@
:- mode string__contains_char(in, in) is semidet.
*/
:- pragma c_code(string__contains_char(Str::in, Ch::in),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = (strchr(Str, Ch) != NULL);
").
@@ -1658,7 +1658,7 @@
:- mode string__index(in, in, out) is semidet.
*/
:- pragma c_code(string__index(Str::in, Index::in, Ch::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
if ((Word) Index >= strlen(Str)) {
SUCCESS_INDICATOR = FALSE;
} else {
@@ -1670,7 +1670,7 @@
/*-----------------------------------------------------------------------*/
:- pragma c_code(string__unsafe_index(Str::in, Index::in, Ch::out),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Ch = Str[Index];
").
@@ -1681,7 +1681,7 @@
:- mode string__length(in, out) is det.
*/
:- pragma c_code(string__length(Str::in, Length::uo),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
Length = strlen(Str);
").
@@ -1699,7 +1699,7 @@
:- mode string__append(in, in, in) is semidet.
*/
:- pragma c_code(string__append(S1::in, S2::in, S3::in),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
size_t len_1 = strlen(S1);
SUCCESS_INDICATOR = (
strncmp(S1, S3, len_1) == 0 &&
@@ -1711,7 +1711,7 @@
:- mode string__append(in, out, in) is semidet.
*/
:- pragma c_code(string__append(S1::in, S2::out, S3::in),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
Word tmp;
size_t len_1, len_2, len_3;
@@ -1736,7 +1736,7 @@
:- mode string__append(in, in, out) is det.
*/
:- pragma c_code(string__append(S1::in, S2::in, S3::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
size_t len_1, len_2;
Word tmp;
len_1 = strlen(S1);
@@ -1818,7 +1818,7 @@
% :- mode string__append(out, out, in) is multidet.
:- pragma c_code(string__append(S1::out, S2::out, S3::in),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
/*
** The pragma_c_code will generate a mkframe();
** we need to pop off that frame before jumping to the hand-coded
@@ -1857,7 +1857,7 @@
:- pragma c_code(string__substring(Str::in, Start::in, Count::in,
SubString::out),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
Integer len;
Word tmp;
@@ -1884,7 +1884,7 @@
:- pragma c_code(string__unsafe_substring(Str::in, Start::in, Count::in,
SubString::out),
- will_not_call_mercury,
+ [will_not_call_mercury, thread_safe],
"{
Integer len;
Word tmp;
@@ -1906,7 +1906,7 @@
*/
:- pragma c_code(string__split(Str::in, Count::in, Left::out, Right::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
Integer len;
Word tmp;
if (Count <= 0) {
@@ -1948,7 +1948,7 @@
:- mode string__first_char(in, in, in) is semidet. % implied
*/
:- pragma c_code(string__first_char(Str::in, First::in, Rest::in),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = (
Str[0] == First &&
First != '\\0' &&
@@ -1960,7 +1960,7 @@
:- mode string__first_char(in, out, in) is semidet. % implied
*/
:- pragma c_code(string__first_char(Str::in, First::out, Rest::in),
- will_not_call_mercury, "
+ [will_not_call_mercury, thread_safe], "
First = Str[0];
SUCCESS_INDICATOR = (First != '\\0' && strcmp(Str + 1, Rest) == 0);
").
@@ -1969,7 +1969,7 @@
:- mode string__first_char(in, in, out) is semidet. % implied
*/
:- pragma c_code(string__first_char(Str::in, First::in, Rest::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
Word tmp;
if (Str[0] != First || First == '\\0') {
SUCCESS_INDICATOR = FALSE;
@@ -1991,7 +1991,7 @@
:- mode string__first_char(in, out, out) is semidet.
*/
:- pragma c_code(string__first_char(Str::in, First::out, Rest::out),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
Word tmp;
First = Str[0];
if (First == '\\0') {
@@ -2014,7 +2014,7 @@
:- mode string__first_char(out, in, in) is det.
*/
:- pragma c_code(string__first_char(Str::out, First::in, Rest::in),
- will_not_call_mercury, "{
+ [will_not_call_mercury, thread_safe], "{
size_t len = strlen(Rest) + 1;
Word tmp;
incr_hp_atomic(tmp, (len + sizeof(Word)) / sizeof(Word));
Index: library/term.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/term.m,v
retrieving revision 1.82
diff -u -r1.82 term.m
--- term.m 1998/05/25 21:47:46 1.82
+++ term.m 1998/08/24 00:03:44
@@ -1120,3 +1120,4 @@
compare(Cmp, TermA, TermB).
%-----------------------------------------------------------------------------%
+
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing runtime
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_context.c,v
retrieving revision 1.10
diff -u -r1.10 mercury_context.c
--- mercury_context.c 1998/08/07 00:50:15 1.10
+++ mercury_context.c 1998/08/24 01:31:17
@@ -22,7 +22,8 @@
#include "mercury_context.h"
#include "mercury_engine.h" /* for `memdebug' */
-MR_Context *MR_runqueue;
+MR_Context *MR_runqueue_head;
+MR_Context *MR_runqueue_tail;
#ifdef MR_THREAD_SAFE
MercuryLock *MR_runqueue_lock;
MercuryCond *MR_runqueue_cond;
@@ -159,6 +160,74 @@
fatal_error("computation floundered");
}
-void mercury_sys_init_context(void); /* suppress gcc warning */
-void mercury_sys_init_context(void) {
+/*
+INIT mercury_scheduler_wrapper
+ENDINIT
+*/
+
+BEGIN_MODULE(scheduler_module)
+ init_entry(do_runnext);
+BEGIN_CODE
+
+Define_entry(do_runnext);
+#ifdef MR_THREAD_SAFE
+{
+ MR_Context *tmp, *prev;
+ unsigned depth;
+ MercuryThread thd;
+
+ depth = MR_ENGINE(c_depth);
+ thd = MR_ENGINE(owner_thread);
+
+ MR_LOCK(MR_runqueue_lock, "do_runnext (i)");
+
+ while (1) {
+ if (MR_exit_now = TRUE) {
+ MR_UNLOCK(MR_runqueue_lock, "do_runnext (ii)");
+ destroy_thread(MR_engine_base);
+ }
+ tmp = MR_runqueue_head;
+ prev = NULL;
+ while(tmp != NULL) {
+ if (depth > 0 && tmp->owner_thread == thd
+ || tmp->owner_thread == NULL)
+ break;
+ prev = tmp;
+ tmp = tmp->next;
+ }
+ if (tmp != NULL)
+ break;
+ MR_WAIT(MR_runqueue_cond, MR_runqueue_lock);
+ }
+ MR_ENGINE(this_context) = tmp;
+ if (prev != NULL)
+ prev->next = tmp->next;
+ else
+ MR_runqueue_head = tmp->next;
+ if (MR_runqueue_tail == tmp)
+ MR_runqueue_tail = prev;
+ MR_UNLOCK(MR_runqueue_lock, "do_runnext (iii)");
+ load_context(MR_ENGINE(this_context));
+ GOTO(MR_ENGINE(this_context)->resume);
+}
+#else /* !MR_THREAD_SAFE */
+{
+ if (MR_runqueue_head == NULL)
+ fatal_error("empty runqueue!");
+
+ MR_ENGINE(this_context) = MR_runqueue_head;
+ MR_runqueue_head = MR_runqueue_head->next;
+ if (MR_runqueue_head == NULL)
+ MR_runqueue_tail = NULL;
+
+ load_context(MR_ENGINE(this_context));
+ GOTO(MR_ENGINE(this_context)->resume);
+}
+#endif
+
+END_MODULE
+
+void mercury_scheduler_wrapper(void); /* suppress gcc warning */
+void mercury_scheduler_wrapper(void) {
+ scheduler_module();
}
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_context.h,v
retrieving revision 1.6
diff -u -r1.6 mercury_context.h
--- mercury_context.h 1998/07/13 22:44:04 1.6
+++ mercury_context.h 1998/08/21 01:09:23
@@ -132,8 +132,8 @@
** the runqueue is a linked list of contexts that are
** runnable.
*/
-extern MR_Context *MR_runqueue;
-extern MR_Context *MR_suspended_forks;
+extern MR_Context *MR_runqueue_head;
+extern MR_Context *MR_runqueue_tail;
#ifdef MR_THREAD_SAFE
extern MercuryLock *MR_runqueue_lock;
extern MercuryCond *MR_runqueue_cond;
@@ -175,84 +175,31 @@
*/
void flounder(void);
-#ifdef MR_THREAD_SAFE
- /*
- ** schedule(MR_Context *cptr):
- ** Inserts a context onto the start of the run queue.
- */
- #define schedule(cptr) \
+/*
+** schedule(MR_Context *cptr):
+** Append a context onto the end of the run queue.
+*/
+#define schedule(cptr) \
do { \
+ MR_Context *ctxt = (MR_Context *) (cptr); \
+ ctxt->next = NULL; \
MR_LOCK(MR_runqueue_lock, "schedule"); \
- ((MR_Context *)cptr)->next = MR_runqueue; \
- MR_runqueue = (MR_Context *) (cptr); \
+ if (MR_runqueue_tail) { \
+ MR_runqueue_tail->next = ctxt; \
+ MR_runqueue_tail = ctxt; \
+ } else { \
+ MR_runqueue_head = ctxt; \
+ MR_runqueue_tail = ctxt; \
+ } \
MR_SIGNAL(MR_runqueue_cond); \
MR_UNLOCK(MR_runqueue_lock, "schedule"); \
} while(0)
-
- /*
- ** runnext() tries to execute the first context on the
- ** runqueue. If the context was directly called from C
- ** it may only be executed in the thread that the C call
- ** originated in or should the context return to C the
- ** C stack will be wrong!
- ** If there are no contexts that the current thread can
- ** execute, then we suspend until another thread puts something
- ** into the runqueue. Currently, it is not possible for
- ** floundering to occur, so we haven't got a check for it.
- */
- #define runnext() \
- do { \
- MR_Context *rn_c, *rn_p; \
- unsigned x; \
- MercuryThread t; \
- x = MR_ENGINE(c_depth); \
- t = MR_ENGINE(owner_thread); \
- MR_LOCK(MR_runqueue_lock, "runnext i"); \
- while (1) { \
- if (MR_exit_now == TRUE) \
- destroy_thread(MR_engine_base); \
- rn_c = MR_runqueue; \
- rn_p = NULL; \
- while (rn_c != NULL) { \
- if ( (x > 0 && rn_c->owner_thread == t) \
- || (rn_c->owner_thread == NULL)) \
- break; \
- rn_p = rn_c; \
- rn_c = rn_c->next; \
- } \
- if (rn_c != NULL) \
- break; \
- MR_WAIT(MR_runqueue_cond, MR_runqueue_lock); \
- } \
- MR_ENGINE(this_context) = rn_c; \
- if (rn_p == NULL) \
- MR_runqueue = rn_c->next; \
- else \
- rn_p->next = rn_c->next; \
- MR_UNLOCK(MR_runqueue_lock, "runnext"); \
- load_context(MR_ENGINE(this_context)); \
- GOTO(MR_ENGINE(this_context)->resume); \
- } while(0)
-#else
- /* see above for documentation */
- #define schedule(cptr) \
- do { \
- ((MR_Context *)cptr)->next = MR_runqueue; \
- MR_runqueue = (MR_Context *) (cptr); \
- } while(0)
- /* see above for documentation */
- #define runnext() \
- do { \
- if (MR_runqueue == NULL) { \
- fatal_error("empty runqueue"); \
- } \
- MR_ENGINE(this_context) = MR_runqueue; \
- MR_runqueue = MR_runqueue->next; \
- load_context(MR_ENGINE(this_context)); \
- GOTO(MR_ENGINE(this_context)->resume); \
- } while(0)
-#endif
+Declare_entry(do_runnext);
+#define runnext() \
+ do { \
+ GOTO(ENTRY(do_runnext)); \
+ } while (0) \
#ifdef MR_THREAD_SAFE
#define IF_MR_THREAD_SAFE(x) x
Index: runtime/mercury_thread.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_thread.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_thread.c
--- mercury_thread.c 1998/08/07 00:50:29 1.4
+++ mercury_thread.c 1998/08/24 00:28:50
@@ -138,7 +138,7 @@
{
int err;
-#if 0
+#ifdef MR_DEBUG_THREADS
fprintf(stderr, "%d locking on %p (%s)\n", pthread_self(), lock, from);
#endif
err = pthread_mutex_lock(lock);
@@ -150,7 +150,7 @@
{
int err;
-#if 0
+#ifdef MR_DEBUG_THREADS
fprintf(stderr, "%d unlocking on %p (%s)\n",
pthread_self(), lock, from);
#endif
@@ -163,7 +163,7 @@
{
int err;
-#if 0
+#ifdef MR_DEBUG_THREADS
fprintf(stderr, "%d signaling %p\n", pthread_self(), cond);
#endif
err = pthread_cond_broadcast(cond);
@@ -175,35 +175,11 @@
{
int err;
-#if 0
+#ifdef MR_DEBUG_THREADS
fprintf(stderr, "%d waiting on %p (%p)\n", pthread_self(), cond, lock);
#endif
err = pthread_cond_wait(cond, lock);
assert(err == 0);
}
#endif
-
-/*
-INIT mercury_scheduler_wrapper
-ENDINIT
-*/
-
-
-Define_extern_entry(do_runnext);
-
-BEGIN_MODULE(scheduler_module)
- init_entry(do_runnext);
-BEGIN_CODE
-
-Define_entry(do_runnext);
- runnext();
-
- fatal_error("Execution should never reach here.");
-
-END_MODULE
-
-void mercury_scheduler_wrapper(void); /* suppress gcc warning */
-void mercury_scheduler_wrapper(void) {
- scheduler_module();
-}
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.22
diff -u -r1.22 mercury_wrapper.c
--- mercury_wrapper.c 1998/08/10 07:17:54 1.22
+++ mercury_wrapper.c 1998/08/21 01:30:35
@@ -218,7 +218,7 @@
** Double-check that the garbage collector knows about
** global variables in shared libraries.
*/
- GC_is_visible(&MR_runqueue);
+ GC_is_visible(&MR_runqueue_head);
/* The following code is necessary to tell the conservative */
/* garbage collector that we are using tagged pointers */
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing scripts
cvs diff: Diffing tools
cvs diff: Diffing trial
cvs diff: Diffing util
More information about the developers
mailing list