[m-rev.] diff: Add spawn and spawn_native parallelisations to the
Paul Bone
paul at bone.id.au
Fri Oct 3 16:13:29 AEST 2014
Branches: master
---
Add spawn and spawn_native parallelisations to the mandelbrot benchmark
The mandelbrot benchmark can now be used to benchmark concurrency support
using either spawn or spawn_native. As before it can also use no
parallelism or the parallel conjunction operator.
benchmarks/progs/mandelbrot/mandelbrot.m:
As above.
benchmarks/progs/mandelbrot/bench.sh:
Update mandelbrot benchmarking script
---
benchmarks/progs/mandelbrot/bench.sh | 19 ++--
benchmarks/progs/mandelbrot/mandelbrot.m | 174 +++++++++++++++++++++++++------
2 files changed, 155 insertions(+), 38 deletions(-)
diff --git a/benchmarks/progs/mandelbrot/bench.sh b/benchmarks/progs/mandelbrot/bench.sh
index eed517c..e648798 100755
--- a/benchmarks/progs/mandelbrot/bench.sh
+++ b/benchmarks/progs/mandelbrot/bench.sh
@@ -3,20 +3,23 @@
set -e
TIME_CMD="time -a -v"
-REPS=25
+#REPS=25
+REPS=10
# Kill a process if it uses more than 3GB of memory.
MEMORY=$((3*1024*1024*1024))
ulimit -S -m $MEMORY -v $MEMORY
for PROGRAM in "$@"; do
- echo Testing $PROGRAM...
- LOG=$PROGRAM.log
- rm -f $LOG
- for ((I=0; I<$REPS; I++)); do
- echo Rep: $I
- echo Rep: $I >> $LOG
- $TIME_CMD -o $LOG ./$PROGRAM
+ for MODE in no spawn_native spawn conj; do
+ echo Testing $PROGRAM -p $MODE
+ LOG=${PROGRAM}_${MODE}.log
+ rm -f $LOG
+ for ((I=0; I<$REPS; I++)); do
+ echo Rep: $I
+ echo Rep: $I >> $LOG
+ $TIME_CMD -o $LOG ./$PROGRAM -p $MODE
+ done
done
done
diff --git a/benchmarks/progs/mandelbrot/mandelbrot.m b/benchmarks/progs/mandelbrot/mandelbrot.m
index bb9f2cd..93c2e87 100644
--- a/benchmarks/progs/mandelbrot/mandelbrot.m
+++ b/benchmarks/progs/mandelbrot/mandelbrot.m
@@ -20,6 +20,8 @@
:- import_module pair.
:- import_module require.
:- import_module string.
+:- import_module thread.
+:- import_module thread.mvar.
main(!IO) :-
command_line_arguments(Args, !IO),
@@ -43,7 +45,7 @@ main(!IO) :-
Result = ok
;
MaybeOptions = error(Error),
- Result = error(format("Error processing options: %s\n",
+ Result = error(format("Error processing options: %s\n",
[s(Error)]))
)
)
@@ -95,7 +97,7 @@ default_options(help, bool(no)).
default_options(dim_x, maybe_int(no)).
default_options(dim_y, maybe_int(no)).
default_options(dependent_conjunctions, bool(no)).
-default_options(parallel, bool(no)).
+default_options(parallel, string("no")).
:- type options
---> options(
@@ -110,7 +112,9 @@ default_options(parallel, bool(no)).
; use_independent_conjunctions.
:- type parallel
- ---> parallel
+ ---> parallel_conj
+ ; parallel_spawn
+ ; parallel_spawn_native
; sequential.
:- pred process_options(option_table(option)::in, maybe_error(options)::out)
@@ -125,27 +129,41 @@ process_options(Table, MaybeOptions) :-
DepConjsBool = no,
DepConjs = use_independent_conjunctions
),
- getopt.lookup_bool_option(Table, parallel, ParallelBool),
+ getopt.lookup_string_option(Table, parallel, ParallelStr),
(
- ParallelBool = yes,
- Parallel = parallel
+ (
+ ParallelStr = "no",
+ Parallel0 = sequential
+ ;
+ ParallelStr = "conj",
+ Parallel0 = parallel_conj
+ ;
+ ParallelStr = "spawn",
+ Parallel0 = parallel_spawn
+ ;
+ ParallelStr = "spawn_native",
+ Parallel0 = parallel_spawn_native
+ )
+ ->
+ MaybeParallel = ok(Parallel0)
;
- ParallelBool = no,
- Parallel = sequential
+ MaybeParallel = error(
+ "Parallel must be one of ""no"", ""conj"", ""spawn"" or " ++
+ """spawn_native""")
),
getopt.lookup_maybe_int_option(Table, dim_x, MaybeX),
getopt.lookup_maybe_int_option(Table, dim_y, MaybeY),
(
(
- MaybeX = yes(DimX),
- MaybeY = yes(DimY)
+ MaybeX = yes(DimX0),
+ MaybeY = yes(DimY0)
;
MaybeX = no,
MaybeY = no,
- dimension(DimX, DimY)
+ dimension(DimX0, DimY0)
),
- MaybeOptions = ok(options(DimX, DimY, DepConjs, Parallel))
+ MaybeDim = ok({DimX0, DimY0})
;
(
MaybeX = yes(_),
@@ -154,7 +172,19 @@ process_options(Table, MaybeOptions) :-
MaybeX = no,
MaybeY = yes(_)
),
- MaybeOptions = error("Specify both of -x and -y or neither of them")
+ MaybeDim = error("Specify both of -x and -y or neither of them")
+ ),
+ (
+ MaybeDim = ok({DimX, DimY}),
+ MaybeParallel = ok(Parallel),
+ MaybeOptions = ok(options(DimX, DimY, DepConjs, Parallel))
+ ;
+ MaybeDim = ok(_),
+ MaybeParallel = error(Error),
+ MaybeOptions = error(Error)
+ ;
+ MaybeDim = error(Error),
+ MaybeOptions = error(Error)
).
:- pred usage(io::di, io::uo) is det.
@@ -166,9 +196,11 @@ usage(!IO) :-
write_string("\t-x X -y Y\n", !IO),
write_string(
"\t\tThe dimensions of the image, specify neither or both\n", !IO),
- write_string("\t-p --parallel\n", !IO),
+ write_string("\t-p <how> --parallel <how>\n", !IO),
+ write_string(
+ "\t\t<how> is one of ""no"", ""conj"", ""spawn"" or\n", !IO),
write_string(
- "\t\tUse explicit parallel conjunctions (grade dependent)\n", !IO),
+ "\t\t""spawn_native"". These may be grade dependent.\n", !IO),
write_string("\t-d --dependent-conjunctions\n", !IO),
write_string(
"\t\tUse an accumulator to represent the rows rendered so far\n", !IO).
@@ -211,8 +243,12 @@ draw_rows(Options, StartY, StepY, DimY, StartX, StepX, DimX, Rows) :-
draw_rows_dep(sequential, Xs, Ys, Rows) :-
map_foldl(draw_row(Xs), append_row, Ys, empty, Rows).
-draw_rows_dep(parallel, Xs, Ys, Rows) :-
- map_foldl_par(draw_row(Xs), append_row, Ys, empty, Rows).
+draw_rows_dep(parallel_conj, Xs, Ys, Rows) :-
+ map_foldl_par_conj(draw_row(Xs), append_row, Ys, empty, Rows).
+draw_rows_dep(parallel_spawn, Xs, Ys, Rows) :-
+ map_foldl_par_spawn(draw_row(Xs), append_row, Ys, empty, Rows).
+draw_rows_dep(parallel_spawn_native, Xs, Ys, Rows) :-
+ map_foldl_par_spawn_native(draw_row(Xs), append_row, Ys, empty, Rows).
:- pred draw_rows_indep(parallel::in, list(float)::in, list(float)::in,
cord(colour)::out) is det.
@@ -222,13 +258,23 @@ draw_rows_indep(Parallel, Xs, Ys, Rows) :-
Parallel = sequential,
my_map(draw_row(Xs), Ys, RowList)
;
- Parallel = parallel,
- my_map_par(draw_row(Xs), Ys, RowList)
+ Parallel = parallel_conj,
+ my_map_par_conj(draw_row(Xs), Ys, RowList)
+ ;
+ Parallel = parallel_spawn,
+ promise_equivalent_solutions [RowList] (
+ my_map_par_spawn(draw_row(Xs), Ys, RowList)
+ )
+ ;
+ Parallel = parallel_spawn_native,
+ promise_equivalent_solutions [RowList] (
+ my_map_par_spawn_native(draw_row(Xs), Ys, RowList)
+ )
),
foldl(append_row, RowList, empty, Rows).
:- pred append_row(cord(X)::in, cord(X)::in, cord(X)::out) is det.
-
+
append_row(Row, !Rows) :-
!:Rows = !.Rows ++ Row.
@@ -316,19 +362,35 @@ map_foldl(M, F, [X | Xs], !Acc) :-
F(Y, !Acc),
map_foldl(M, F, Xs, !Acc).
-:- pred map_foldl_par(pred(X, Y), pred(Y, A, A), list(X), A, A).
-:- mode map_foldl_par(pred(in, out) is det, pred(in, in, out) is det,
+:- pred map_foldl_par_conj(pred(X, Y), pred(Y, A, A), list(X), A, A).
+:- mode map_foldl_par_conj(pred(in, out) is det, pred(in, in, out) is det,
in, in, out) is det.
-map_foldl_par(_, _, [], !Acc).
-map_foldl_par(M, F, [X | Xs], !Acc) :-
+map_foldl_par_conj(_, _, [], !Acc).
+map_foldl_par_conj(M, F, [X | Xs], !Acc) :-
(
M(X, Y),
F(Y, !Acc)
&
- map_foldl_par(M, F, Xs, !Acc)
+ map_foldl_par_conj(M, F, Xs, !Acc)
).
+:- pred map_foldl_par_spawn(pred(X, Y), pred(Y, A, A), list(X), A, A).
+:- mode map_foldl_par_spawn(pred(in, out) is det, pred(in, in, out) is det,
+ in, in, out) is erroneous.
+
+map_foldl_par_spawn(_, _, _, !Acc) :-
+ % XXX: Do the parallel conjunction transformation by hand.
+ sorry($file, $pred, "Unimplemented").
+
+:- pred map_foldl_par_spawn_native(pred(X, Y), pred(Y, A, A), list(X), A, A).
+:- mode map_foldl_par_spawn_native(pred(in, out) is det,
+ pred(in, in, out) is det, in, in, out) is erroneous.
+
+map_foldl_par_spawn_native(_, _, _, !Acc) :-
+ % XXX: Do the parallel conjunction transformation by hand.
+ sorry($file, $pred, "Unimplemented").
+
:- pred my_map(pred(X, Y), list(X), list(Y)).
:- mode my_map(pred(in, out) is det, in, out) is det.
@@ -337,13 +399,65 @@ my_map(M, [X | Xs], [Y | Ys]) :-
M(X, Y),
my_map(M, Xs, Ys).
-:- pred my_map_par(pred(X, Y), list(X), list(Y)).
-:- mode my_map_par(pred(in, out) is det, in, out) is det.
+:- pred my_map_par_conj(pred(X, Y), list(X), list(Y)).
+:- mode my_map_par_conj(pred(in, out) is det, in, out) is det.
-my_map_par(_, [], []).
-my_map_par(M, [X | Xs], [Y | Ys]) :-
+my_map_par_conj(_, [], []).
+my_map_par_conj(M, [X | Xs], [Y | Ys]) :-
M(X, Y) &
- my_map_par(M, Xs, Ys).
+ my_map_par_conj(M, Xs, Ys).
+
+:- pred my_map_par_spawn(pred(X, Y), list(X), list(Y)).
+:- mode my_map_par_spawn(pred(in, out) is det, in, out) is cc_multi.
+
+my_map_par_spawn(_, [], []).
+my_map_par_spawn(M, [X | Xs], Ys) :-
+ promise_pure (
+ some [!IO] (
+ impure make_io(!:IO),
+ mvar.init(YMVar, !IO),
+ spawn((pred(IO0::di, IO::uo) is cc_multi :-
+ M(X, Y0),
+ mvar.put(YMVar, Y0, IO0, IO)
+ ), !IO),
+ my_map_par_spawn(M, Xs, Ys0),
+ mvar.take(YMVar, Y, !IO),
+ Ys = [Y | Ys0],
+ _ = !.IO
+ )
+ ).
+
+:- pred my_map_par_spawn_native(pred(X, Y), list(X), list(Y)).
+:- mode my_map_par_spawn_native(pred(in, out) is det, in, out) is cc_multi.
+
+my_map_par_spawn_native(_, [], []).
+my_map_par_spawn_native(M, [X | Xs], Ys) :-
+ promise_pure (
+ some [!IO] (
+ impure make_io(!:IO),
+ mvar.init(YMVar, !IO),
+ spawn_native((pred(_::in, IO0::di, IO::uo) is cc_multi :-
+ M(X, Y0),
+ mvar.put(YMVar, Y0, IO0, IO)
+ ), _, !IO),
+ my_map_par_spawn_native(M, Xs, Ys0),
+ mvar.take(YMVar, Y, !IO),
+ Ys = [Y | Ys0],
+ _ = !.IO
+ )
+ ).
+
+:- impure pred make_io(io::uo) is det.
+
+:- pragma foreign_proc("C",
+ make_io(IO::uo),
+ [will_not_call_mercury, thread_safe],
+ "IO = 0;").
+
+:- pragma foreign_proc("Java",
+ make_io(IO::uo),
+ [will_not_call_mercury, thread_safe],
+ "IO = 0;").
%----------------------------------------------------------------------------%
--
2.1.0
More information about the reviews
mailing list