for review: independent AND parallelsim
Thomas Charles CONWAY
conway at cs.mu.OZ.AU
Mon Apr 27 21:29:23 AEST 1998
Hi
This post contains the changes to the compiler for independent AND
parallelism. See the previous post for the log message.
--
Thomas Conway || conway at cs.mu.oz.au
AD DEUM ET VINUM || Nail here [] for new monitor.
cvs diff: Diffing compiler
Index: compiler/basic_block.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/basic_block.m,v
retrieving revision 1.3
diff -u -r1.3 basic_block.m
--- basic_block.m 1998/01/13 10:11:02 1.3
+++ basic_block.m 1998/03/11 04:50:29
@@ -187,6 +187,10 @@
possible_targets(discard_tickets_to(_), []).
possible_targets(incr_sp(_, _), []).
possible_targets(decr_sp(_), []).
+possible_targets(init_sync_term(_, _), []).
+possible_targets(fork(P, C, _), [P, C]).
+possible_targets(join_and_terminate(_), []).
+possible_targets(join_and_continue(_, L), [L]).
possible_targets(pragma_c(_, _, _, _), []).
%-----------------------------------------------------------------------------%
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.35
diff -u -r1.35 bytecode_gen.m
--- bytecode_gen.m 1998/02/12 01:16:56 1.35
+++ bytecode_gen.m 1998/03/11 04:50:01
@@ -197,6 +197,9 @@
GoalExpr = conj(GoalList),
bytecode_gen__conj(GoalList, ByteInfo0, ByteInfo, Code)
;
+ GoalExpr = par_conj(_GoalList, _SM),
+ error("sorry, bytecode_gen of parallel conj not implemented")
+ ;
GoalExpr = disj(GoalList, _),
( GoalList = [] ->
Code = node([fail]),
Index: compiler/code_gen.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_gen.m,v
retrieving revision 1.48
diff -u -r1.48 code_gen.m
--- code_gen.m 1998/03/03 17:33:45 1.48
+++ code_gen.m 1998/03/11 04:50:02
@@ -58,7 +58,7 @@
:- implementation.
:- import_module call_gen, unify_gen, ite_gen, switch_gen, disj_gen.
-:- import_module pragma_c_gen, trace, options, hlds_out.
+:- import_module par_conj_gen, pragma_c_gen, trace, options, hlds_out.
:- import_module code_aux, middle_rec, passes_aux, llds_out.
:- import_module code_util, type_util, mode_util.
:- import_module prog_data, prog_out, instmap.
@@ -869,6 +869,8 @@
code_gen__generate_det_goal_2(conj(Goals), _GoalInfo, Instr) -->
code_gen__generate_goals(Goals, model_det, Instr).
+code_gen__generate_det_goal_2(par_conj(Goals, _StoreMap), GoalInfo, Instr) -->
+ par_conj_gen__generate_det_par_conj(Goals, GoalInfo, Instr).
code_gen__generate_det_goal_2(some(_Vars, Goal), _GoalInfo, Instr) -->
{ Goal = _ - InnerGoalInfo },
{ goal_info_get_code_model(InnerGoalInfo, CodeModel) },
@@ -956,6 +958,10 @@
code_gen__generate_semi_goal_2(conj(Goals), _GoalInfo, Code) -->
code_gen__generate_goals(Goals, model_semi, Code).
+code_gen__generate_semi_goal_2(par_conj(_Goals, _SM), _GoalInfo, _Code) -->
+ % Determinism analysis will report a determinism error if the
+ % parallel conj is not det.
+ { error("sorry, semidet parallel conjunction not implemented") }.
code_gen__generate_semi_goal_2(some(_Vars, Goal), _GoalInfo, Code) -->
{ Goal = _ - InnerGoalInfo },
{ goal_info_get_code_model(InnerGoalInfo, CodeModel) },
@@ -1166,6 +1172,10 @@
code_gen__generate_non_goal_2(conj(Goals), _GoalInfo, Code) -->
code_gen__generate_goals(Goals, model_non, Code).
+code_gen__generate_non_goal_2(par_conj(_Goals, _SM), _GoalInfo, _Code) -->
+ % Determinism analysis will report a determinism error if the
+ % parallel conj is not det.
+ { error("sorry, nondet parallel conjunction not implemented") }.
code_gen__generate_non_goal_2(some(_Vars, Goal), _GoalInfo, Code) -->
{ Goal = _ - InnerGoalInfo },
{ goal_info_get_code_model(InnerGoalInfo, CodeModel) },
Index: compiler/code_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_info.m,v
retrieving revision 1.218
diff -u -r1.218 code_info.m
--- code_info.m 1998/03/03 17:33:48 1.218
+++ code_info.m 1998/03/11 04:50:02
@@ -277,12 +277,6 @@
% switched on.
).
-:- type slot_contents
- ---> ticket % a ticket (trail pointer)
- ; ticket_counter % a copy of the ticket counter
- ; trace_data
- ; lval(lval).
-
%---------------------------------------------------------------------------%
code_info__init(Varset, Liveness, StackSlots, SaveSuccip, Globals,
@@ -2975,6 +2969,7 @@
% modify this, if the GC is going
% to garbage-collect the trail.
code_info__get_live_value_type(ticket_counter, unwanted).
+code_info__get_live_value_type(sync_term, unwanted).
code_info__get_live_value_type(trace_data, unwanted).
%---------------------------------------------------------------------------%
@@ -3012,6 +3007,15 @@
:- interface.
+:- type slot_contents
+ ---> ticket % a ticket (trail pointer)
+ ; ticket_counter % a copy of the ticket counter
+ ; trace_data
+ ; sync_term % a syncronization term used
+ % at the end of par_conjs.
+ % see par_conj_gen.m for details.
+ ; lval(lval).
+
% Returns the total stackslot count, but not including space for
% succip.
:- pred code_info__get_total_stackslot_count(int, code_info, code_info).
@@ -3020,11 +3024,6 @@
:- pred code_info__get_trace_slot(lval, code_info, code_info).
:- mode code_info__get_trace_slot(out, in, out) is det.
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-:- implementation.
-
:- pred code_info__acquire_temp_slot(slot_contents, lval,
code_info, code_info).
:- mode code_info__acquire_temp_slot(in, out, in, out) is det.
@@ -3035,12 +3034,20 @@
:- pred code_info__get_variable_slot(var, lval, code_info, code_info).
:- mode code_info__get_variable_slot(in, out, in, out) is det.
-:- pred code_info__max_var_slot(stack_slots, int).
-:- mode code_info__max_var_slot(in, out) is det.
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
:- pred code_info__stack_variable(int, lval, code_info, code_info).
:- mode code_info__stack_variable(in, out, in, out) is det.
+:- pred code_info__stack_variable_reference(int, rval, code_info, code_info).
+:- mode code_info__stack_variable_reference(in, out, in, out) is det.
+
+:- pred code_info__max_var_slot(stack_slots, int).
+:- mode code_info__max_var_slot(in, out) is det.
+
code_info__get_trace_slot(StackVar) -->
code_info__acquire_temp_slot(trace_data, StackVar).
@@ -3115,6 +3122,15 @@
{ Lval = framevar(Num1) }
;
{ Lval = stackvar(Num) } % stackvars start at one
+ ).
+
+code_info__stack_variable_reference(Num, mem_addr(Ref)) -->
+ code_info__get_proc_model(CodeModel),
+ ( { CodeModel = model_non } ->
+ { Num1 is Num - 1 }, % framevars start at zero
+ { Ref = framevar_ref(Num1) }
+ ;
+ { Ref = stackvar_ref(Num) } % stackvars start at one
).
%---------------------------------------------------------------------------%
Index: compiler/code_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/code_util.m,v
retrieving revision 1.95
diff -u -r1.95 code_util.m
--- code_util.m 1998/03/03 17:33:50 1.95
+++ code_util.m 1998/03/11 04:50:02
@@ -801,6 +801,8 @@
code_util__count_recursive_calls_2(conj(Goals), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0,
Min, Max).
+code_util__count_recursive_calls_2(par_conj(Goals, _), PredId, ProcId, Min, Max) :-
+ code_util__count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0, Min, Max).
code_util__count_recursive_calls_2(disj(Goals, _), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls_disj(Goals, PredId, ProcId, Min, Max).
code_util__count_recursive_calls_2(switch(_, _, Cases, _), PredId, ProcId,
Index: compiler/constraint.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/constraint.m,v
retrieving revision 1.39
diff -u -r1.39 constraint.m
--- constraint.m 1998/01/13 10:11:21 1.39
+++ constraint.m 1998/03/11 04:50:03
@@ -140,6 +140,9 @@
constraint__propagate_conj(Goals0, Goals),
mode_checkpoint(exit, "conj").
+constraint__propagate_goal_2(par_conj(_, _), par_conj(_, _)) -->
+ { error("constraint__propagate_goal_2: par_conj not supported") }.
+
constraint__propagate_goal_2(disj(Goals0, SM), disj(Goals, SM)) -->
mode_checkpoint(enter, "disj"),
constraint__propagate_disj(Goals0, Goals),
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/cse_detection.m,v
retrieving revision 1.53
diff -u -r1.53 cse_detection.m
--- cse_detection.m 1998/02/12 01:17:01 1.53
+++ cse_detection.m 1998/03/11 04:50:03
@@ -244,6 +244,10 @@
Redo, conj(Goals)) :-
detect_cse_in_conj(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
+detect_cse_in_goal_2(par_conj(Goals0, SM), _, InstMap, CseInfo0, CseInfo, Redo,
+ par_conj(Goals, SM)) :-
+ detect_cse_in_par_conj(Goals0, InstMap, CseInfo0, CseInfo, Redo, Goals).
+
detect_cse_in_goal_2(disj(Goals0, SM), GoalInfo, InstMap, CseInfo0, CseInfo,
Redo, Goal) :-
( Goals0 = [] ->
@@ -288,6 +292,20 @@
;
Goals = [Goal1 | Goals1]
),
+ bool__or(Redo1, Redo2, Redo).
+
+%-----------------------------------------------------------------------------%
+
+:- pred detect_cse_in_par_conj(list(hlds_goal), instmap, cse_info, cse_info,
+ bool, list(hlds_goal)).
+:- mode detect_cse_in_par_conj(in, in, in, out, out, out) is det.
+
+detect_cse_in_par_conj([], _InstMap, CseInfo, CseInfo, no, []).
+detect_cse_in_par_conj([Goal0 | Goals0], InstMap0, CseInfo0, CseInfo,
+ Redo, [Goal | Goals]) :-
+ detect_cse_in_goal(Goal0, InstMap0, CseInfo0, CseInfo1, Redo1, Goal),
+ detect_cse_in_par_conj(Goals0, InstMap0, CseInfo1, CseInfo,
+ Redo2, Goals),
bool__or(Redo1, Redo2, Redo).
%-----------------------------------------------------------------------------%
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.38
diff -u -r1.38 dead_proc_elim.m
--- dead_proc_elim.m 1998/03/03 17:33:56 1.38
+++ dead_proc_elim.m 1998/03/11 04:50:04
@@ -413,6 +413,10 @@
Needed0, Needed) :-
dead_proc_elim__examine_goals(Goals, CurrProc, Queue0, Queue,
Needed0, Needed).
+dead_proc_elim__examine_expr(par_conj(Goals, _SM), CurrProc, Queue0, Queue,
+ Needed0, Needed) :-
+ dead_proc_elim__examine_goals(Goals, CurrProc, Queue0, Queue,
+ Needed0, Needed).
dead_proc_elim__examine_expr(not(Goal), CurrProc, Queue0, Queue,
Needed0, Needed) :-
dead_proc_elim__examine_goal(Goal, CurrProc, Queue0, Queue,
@@ -755,6 +759,8 @@
dead_pred_info::in, dead_pred_info::out) is det.
pre_modecheck_examine_goal(conj(Goals) - _) -->
+ list__foldl(pre_modecheck_examine_goal, Goals).
+pre_modecheck_examine_goal(par_conj(Goals, _) - _) -->
list__foldl(pre_modecheck_examine_goal, Goals).
pre_modecheck_examine_goal(disj(Goals, _) - _) -->
list__foldl(pre_modecheck_examine_goal, Goals).
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dependency_graph.m,v
retrieving revision 1.34
diff -u -r1.34 dependency_graph.m
--- dependency_graph.m 1998/01/13 10:11:30 1.34
+++ dependency_graph.m 1998/03/11 04:50:04
@@ -189,6 +189,10 @@
DepGraph0, DepGraph) :-
dependency_graph__add_arcs_in_list(Goals, Caller, DepGraph0, DepGraph).
+dependency_graph__add_arcs_in_goal_2(par_conj(Goals, _SM), Caller,
+ DepGraph0, DepGraph) :-
+ dependency_graph__add_arcs_in_list(Goals, Caller, DepGraph0, DepGraph).
+
dependency_graph__add_arcs_in_goal_2(disj(Goals, _), Caller,
DepGraph0, DepGraph) :-
dependency_graph__add_arcs_in_list(Goals, Caller, DepGraph0, DepGraph).
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_analysis.m,v
retrieving revision 1.130
diff -u -r1.130 det_analysis.m
--- det_analysis.m 1998/03/03 17:34:02 1.130
+++ det_analysis.m 1998/03/11 04:50:04
@@ -381,6 +381,23 @@
det_infer_conj(Goals0, InstMap0, SolnContext, DetInfo,
Goals, Detism, Msgs).
+det_infer_goal_2(par_conj(Goals0, SM), GoalInfo, InstMap0, SolnContext,
+ DetInfo, _, _, par_conj(Goals, SM), Detism, Msgs) :-
+ det_infer_par_conj(Goals0, InstMap0, SolnContext, DetInfo,
+ Goals, Detism, Msgs0),
+ (
+ determinism_components(Detism, CanFail, Solns),
+ CanFail = cannot_fail,
+ Solns \= at_most_many
+ ->
+ Msgs = Msgs0
+ ;
+ det_info_get_pred_id(DetInfo, PredId),
+ det_info_get_proc_id(DetInfo, ProcId),
+ Msg = par_conj_not_det(Detism, PredId, ProcId, GoalInfo, Goals),
+ Msgs = [Msg|Msgs0]
+ ).
+
det_infer_goal_2(disj(Goals0, SM), _, InstMap0, SolnContext, DetInfo, _, _,
disj(Goals, SM), Detism, Msgs) :-
det_infer_disj(Goals0, InstMap0, SolnContext, DetInfo,
@@ -705,6 +722,27 @@
% Finally combine the results computed above.
%
det_conjunction_detism(DetismA, DetismB, Detism),
+ list__append(MsgsA, MsgsB, Msgs).
+
+:- pred det_infer_par_conj(list(hlds_goal), instmap, soln_context, det_info,
+ list(hlds_goal), determinism, list(det_msg)).
+:- mode det_infer_par_conj(in, in, in, in, out, out, out) is det.
+
+det_infer_par_conj([], _InstMap0, _SolnContext, _DetInfo, [], det, []).
+det_infer_par_conj([Goal0 | Goals0], InstMap0, SolnContext, DetInfo,
+ [Goal | Goals], Detism, Msgs) :-
+
+ det_infer_goal(Goal0, InstMap0, SolnContext, DetInfo,
+ Goal, DetismA, MsgsA),
+ determinism_components(DetismA, CanFailA, MaxSolnsA),
+
+ det_infer_par_conj(Goals0, InstMap0, SolnContext, DetInfo,
+ Goals, DetismB, MsgsB),
+ determinism_components(DetismB, CanFailB, MaxSolnsB),
+
+ det_conjunction_maxsoln(MaxSolnsA, MaxSolnsB, MaxSolns),
+ det_conjunction_canfail(CanFailA, CanFailB, CanFail),
+ determinism_components(Detism, CanFail, MaxSolns),
list__append(MsgsA, MsgsB, Msgs).
:- pred det_infer_disj(list(hlds_goal), instmap, soln_context, det_info,
Index: compiler/det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.49
diff -u -r1.49 det_report.m
--- det_report.m 1998/03/03 17:34:04 1.49
+++ det_report.m 1998/03/11 04:50:04
@@ -51,6 +51,8 @@
; error_in_lambda(
determinism, determinism, % declared, inferred
hlds_goal, hlds_goal_info, pred_id, proc_id)
+ ; par_conj_not_det(determinism, pred_id, proc_id,
+ hlds_goal_info, list(hlds_goal))
; pragma_c_code_without_det_decl(pred_id, proc_id)
.
@@ -386,6 +388,10 @@
Diagnosed) -->
det_diagnose_conj(Goals, Desired, Context, DetInfo, Diagnosed).
+det_diagnose_goal_2(par_conj(Goals, _SM), _GoalInfo, Desired, _Actual,
+ Context, DetInfo, Diagnosed) -->
+ det_diagnose_conj(Goals, Desired, Context, DetInfo, Diagnosed).
+
det_diagnose_goal_2(disj(Goals, _), GoalInfo, Desired, Actual, SwitchContext,
DetInfo, Diagnosed) -->
det_diagnose_disj(Goals, Desired, Actual, SwitchContext, DetInfo, 0,
@@ -610,6 +616,12 @@
io__write_string(".\n")
).
+ % det_diagnose_conj is used for both normal [sequential]
+ % conjunction and parallel conjunction.
+
+ % det_diagnose_conj is used for both normal [sequential]
+ % conjunction and parallel conjunction.
+
:- pred det_diagnose_conj(list(hlds_goal), determinism,
list(switch_context), det_info, bool, io__state, io__state).
:- mode det_diagnose_conj(in, in, in, in, out, di, uo) is det.
@@ -911,6 +923,7 @@
det_msg_get_type(cc_pred_in_wrong_context(_, _, _, _), error).
det_msg_get_type(higher_order_cc_pred_in_wrong_context(_, _), error).
det_msg_get_type(error_in_lambda(_, _, _, _, _, _), error).
+det_msg_get_type(par_conj_not_det(_, _, _, _, _), error).
det_msg_get_type(pragma_c_code_without_det_decl(_, _), error).
:- pred det_report_msg(det_msg, module_info, io__state, io__state).
@@ -1125,6 +1138,33 @@
globals__io_get_globals(Globals),
{ det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) },
det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, _),
+ io__set_exit_status(1).
+det_report_msg(par_conj_not_det(InferredDetism, PredId,
+ ProcId, GoalInfo, Goals), ModuleInfo) -->
+ { goal_info_get_context(GoalInfo, Context) },
+ prog_out__write_context(Context),
+ { determinism_components(InferredDetism, CanFail, MaxSoln) },
+ (
+ { CanFail \= cannot_fail }
+ ->
+ io__write_string("Error: parallel conjunct may fail.\n")
+ ;
+ { MaxSoln = at_most_many }
+ ->
+ prog_out__write_context(Context),
+ io__write_string("Error: parallel conjunct may have multiple solutions.\n")
+ ;
+ { error("strange determinism error for parallel conjunction") }
+ ),
+ prog_out__write_context(Context),
+ io__write_string(
+ " The current implementation supports only single-solution\n"
+ ),
+ prog_out__write_context(Context),
+ io__write_string(" non-failing parallel conjunctions.\n"),
+ globals__io_get_globals(Globals),
+ { det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) },
+ det_diagnose_conj(Goals, det, [], DetInfo, _),
io__set_exit_status(1).
det_report_msg(pragma_c_code_without_det_decl(PredId, ProcId),
ModuleInfo) -->
Index: compiler/dnf.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dnf.m,v
retrieving revision 1.29
diff -u -r1.29 dnf.m
--- dnf.m 1998/03/03 17:34:08 1.29
+++ dnf.m 1998/03/11 04:50:05
@@ -175,6 +175,9 @@
Goals, NewPredIds0, NewPredIds),
Goal = conj(Goals) - GoalInfo
;
+ GoalExpr0 = par_conj(_Goals0, _SM),
+ error("sorry, dnf of parallel conjunction not implemented")
+ ;
GoalExpr0 = some(_, _),
dnf__transform_conj([Goal0], InstMap0, MaybeNonAtomic,
ModuleInfo0, ModuleInfo, Base, 0, _, DnfInfo,
@@ -420,6 +423,7 @@
:- pred dnf__is_atomic_expr(hlds_goal_expr::in, bool::out) is det.
dnf__is_atomic_expr(conj(_), no).
+dnf__is_atomic_expr(par_conj(_, _), no).
dnf__is_atomic_expr(higher_order_call(_, _, _, _, _, _), yes).
dnf__is_atomic_expr(class_method_call(_, _, _, _, _, _), yes).
dnf__is_atomic_expr(call(_, _, _, _, _, _), yes).
Index: compiler/dupelim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dupelim.m,v
retrieving revision 1.31
diff -u -r1.31 dupelim.m
--- dupelim.m 1998/01/16 07:05:38 1.31
+++ dupelim.m 1998/03/11 04:50:05
@@ -354,6 +354,21 @@
Instr1 = decr_sp(_),
Instr = Instr1
;
+ Instr1 = fork(_, _, _),
+ Instr = Instr1
+ ;
+ Instr1 = init_sync_term(Lval1, N),
+ standardize_lval(Lval1, Lval),
+ Instr = init_sync_term(Lval, N)
+ ;
+ Instr1 = join_and_terminate(Lval1),
+ standardize_lval(Lval1, Lval),
+ Instr = join_and_terminate(Lval)
+ ;
+ Instr1 = join_and_continue(Lval1, N),
+ standardize_lval(Lval1, Lval),
+ Instr = join_and_continue(Lval, N)
+ ;
Instr1 = pragma_c(_, _, _, _),
Instr = Instr1
).
@@ -823,6 +838,21 @@
dupelim__replace_labels_rval(Rval0, ReplMap, Rval).
dupelim__replace_labels_instr(incr_sp(Size, Msg), _, incr_sp(Size, Msg)).
dupelim__replace_labels_instr(decr_sp(Size), _, decr_sp(Size)).
+dupelim__replace_labels_instr(init_sync_term(T, N), _, init_sync_term(T, N)).
+dupelim__replace_labels_instr(fork(Child0, Parent0, SlotCount), Replmap,
+ fork(Child, Parent, SlotCount)) :-
+ dupelim__replace_labels_label(Child0, Replmap, Child),
+ dupelim__replace_labels_label(Parent0, Replmap, Parent).
+dupelim__replace_labels_instr(join_and_terminate(Lval0), Replmap, join_and_terminate(Lval)) :-
+ dupelim__replace_labels_lval(Lval0, Replmap, Lval).
+dupelim__replace_labels_instr(join_and_continue(Lval0, Label0),
+ Replmap, join_and_continue(Lval, Label)) :-
+ dupelim__replace_labels_label(Label0, Replmap, Label),
+ dupelim__replace_labels_lval(Lval0, Replmap, Lval).
+
+:- pred dupelim__replace_labels_lval(lval, map(label, label), lval).
+:- mode dupelim__replace_labels_lval(in, in, out) is det.
+
dupelim__replace_labels_instr(pragma_c(A,B,C,D), ReplMap, pragma_c(A,B,C,D)) :-
(
D = no
@@ -833,9 +863,6 @@
% itself.
require(unify(Label0, Label), "trying to replace Mercury label in C code")
).
-
-:- pred dupelim__replace_labels_lval(lval::in, map(label, label)::in,
- lval::out) is det.
dupelim__replace_labels_lval(reg(RegType, RegNum), _, reg(RegType, RegNum)).
dupelim__replace_labels_lval(stackvar(N), _, stackvar(N)).
Index: compiler/excess.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/excess.m,v
retrieving revision 1.28
diff -u -r1.28 excess.m
--- excess.m 1998/01/13 10:11:53 1.28
+++ excess.m 1998/03/11 04:50:05
@@ -91,6 +91,12 @@
Goals, ElimVars),
conj_list_to_goal(Goals, GoalInfo0, Goal)
;
+ GoalExpr0 = par_conj(Goals0, _SM),
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ excess_assignments_in_conj(Goals0, [], ElimVars0, NonLocals,
+ Goals, ElimVars),
+ par_conj_list_to_goal(Goals, GoalInfo0, Goal)
+ ;
GoalExpr0 = disj(Goals0, SM),
excess_assignments_in_disj(Goals0, ElimVars0, Goals, ElimVars),
Goal = disj(Goals, SM) - GoalInfo0
@@ -146,6 +152,9 @@
% If (say) V_4 and V_6 are nonlocal, then after the V_5 => V_4
% substitution has been made, the second assignment V_4 = V_6
% is left alone.
+ %
+ % This code is used for both sequential conjunction (conj/1) and
+ % parallel conjunction (par_conj/2).
:- pred excess_assignments_in_conj(list(hlds_goal), list(hlds_goal),
list(var), set(var), list(hlds_goal), list(var)).
Index: compiler/follow_code.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_code.m,v
retrieving revision 1.48
diff -u -r1.48 follow_code.m
--- follow_code.m 1998/03/03 17:34:16 1.48
+++ follow_code.m 1998/03/11 04:50:06
@@ -88,6 +88,13 @@
move_follow_code_in_goal_2(conj(Goals0), conj(Goals), Flags, R0, R) :-
move_follow_code_in_conj(Goals0, Goals, Flags, R0, R).
+move_follow_code_in_goal_2(par_conj(Goals0, SM), par_conj(Goals, SM),
+ Flags, R0, R) :-
+ % move_follow_code_in_disj treats its list of goals as
+ % independent goals, so we can use it to process the
+ % independent parallel conjuncts.
+ move_follow_code_in_disj(Goals0, Goals, Flags, R0, R).
+
move_follow_code_in_goal_2(disj(Goals0, SM), disj(Goals, SM), Flags, R0, R) :-
move_follow_code_in_disj(Goals0, Goals, Flags, R0, R).
@@ -121,6 +128,9 @@
pragma_c_code(A,B,C,D,E,F,G), _, R, R).
%-----------------------------------------------------------------------------%
+
+ % move_follow_code_in_disj is used both for disjunction and
+ % parallel conjunction.
:- pred move_follow_code_in_disj(list(hlds_goal), list(hlds_goal),
pair(bool), bool, bool).
Index: compiler/follow_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/follow_vars.m,v
retrieving revision 1.48
diff -u -r1.48 follow_vars.m
--- follow_vars.m 1998/03/03 17:34:17 1.48
+++ follow_vars.m 1998/03/11 04:50:06
@@ -95,6 +95,14 @@
find_follow_vars_in_conj(Goals0, ModuleInfo, FollowVars0,
no, Goals, FollowVars).
+find_follow_vars_in_goal_2(par_conj(Goals0, SM), ModuleInfo,
+ FollowVars0, par_conj(Goals, SM), FollowVars) :-
+ % find_follow_vars_in_disj treats its list of goals as a
+ % series of independent goals, so we can use it to process
+ % independent parallel conjunction.
+ find_follow_vars_in_disj(Goals0, ModuleInfo, FollowVars0,
+ Goals, FollowVars).
+
% We record that at the end of each disjunct, live variables should
% be in the locations given by the initial follow_vars, which reflects
% the requirements of the code following the disjunction.
@@ -281,6 +289,8 @@
% they can only be entered with everything in stack slots; for
% model_det and model_semi disjunctions, they will never be
% entered at all.)
+ %
+ % This code is used both for disjunction and parallel conjunction.
:- pred find_follow_vars_in_disj(list(hlds_goal), module_info,
follow_vars, list(hlds_goal), follow_vars).
Index: compiler/frameopt.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/frameopt.m,v
retrieving revision 1.68
diff -u -r1.68 frameopt.m
--- frameopt.m 1998/01/16 07:05:39 1.68
+++ frameopt.m 1998/03/11 04:50:06
@@ -687,6 +687,10 @@
possible_targets(discard_tickets_to(_), []).
possible_targets(incr_sp(_, _), []).
possible_targets(decr_sp(_), []).
+possible_targets(init_sync_term(_, _), []).
+possible_targets(fork(Child, Parent, _), [Child, Parent]).
+possible_targets(join_and_terminate(_), []).
+possible_targets(join_and_continue(_, Label), [Label]).
possible_targets(pragma_c(_, _, _, MaybeLabel), List) :-
(
MaybeLabel = no,
@@ -1303,6 +1307,15 @@
substitute_labels_instr(discard_tickets_to(Rval), _, discard_tickets_to(Rval)).
substitute_labels_instr(incr_sp(Size, Name), _, incr_sp(Size, Name)).
substitute_labels_instr(decr_sp(Size), _, decr_sp(Size)).
+substitute_labels_instr(init_sync_term(T, N), _, init_sync_term(T, N)).
+substitute_labels_instr(fork(Child0, Parent0, Lval), LabelMap,
+ fork(Child, Parent, Lval)) :-
+ substitute_label(LabelMap, Child0, Child),
+ substitute_label(LabelMap, Parent0, Parent).
+substitute_labels_instr(join_and_terminate(Lval), _LabelMap, join_and_terminate(Lval)).
+substitute_labels_instr(join_and_continue(Lval, Label0), LabelMap,
+ join_and_continue(Lval, Label)) :-
+ substitute_label(LabelMap, Label0, Label).
substitute_labels_instr(pragma_c(Decls, Components, MayCallMercury, MaybeLabel),
_, pragma_c(Decls, Components, MayCallMercury, MaybeLabel)).
@@ -1311,12 +1324,19 @@
substitute_labels_list([], _, []).
substitute_labels_list([Label0 | Labels0], LabelMap, [Label | Labels]) :-
- ( assoc_list__search(LabelMap, Label0, Label1) ->
+ substitute_label(LabelMap, Label0, Label),
+ substitute_labels_list(Labels0, LabelMap, Labels).
+
+:- pred substitute_label(assoc_list(label)::in, label::in, label::out) is det.
+
+substitute_label(LabelMap, Label0, Label) :-
+ (
+ assoc_list__search(LabelMap, Label0, Label1)
+ ->
Label = Label1
;
Label = Label0
- ),
- substitute_labels_list(Labels0, LabelMap, Labels).
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/goal_path.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_path.m,v
retrieving revision 1.4
diff -u -r1.4 goal_path.m
--- goal_path.m 1998/01/13 10:12:03 1.4
+++ goal_path.m 1998/03/11 04:50:06
@@ -40,6 +40,8 @@
fill_expr_slots(conj(Goals0), Path0, conj(Goals)) :-
fill_conj_slots(Goals0, Path0, 0, Goals).
+fill_expr_slots(par_conj(Goals0, SM), Path0, par_conj(Goals, SM)) :-
+ fill_conj_slots(Goals0, Path0, 0, Goals).
fill_expr_slots(disj(Goals0, B), Path0, disj(Goals, B)) :-
fill_disj_slots(Goals0, Path0, 0, Goals).
fill_expr_slots(switch(A, B, Cases0, D), Path0, switch(A, B, Cases, D)) :-
Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.43
diff -u -r1.43 goal_util.m
--- goal_util.m 1998/03/03 17:34:19 1.43
+++ goal_util.m 1998/03/11 04:50:06
@@ -192,6 +192,11 @@
goal_util__name_apart_2(conj(Goals0), Must, Subn, conj(Goals)) :-
goal_util__name_apart_list(Goals0, Must, Subn, Goals).
+goal_util__name_apart_2(par_conj(Goals0, SM0), Must, Subn,
+ par_conj(Goals, SM)) :-
+ goal_util__name_apart_list(Goals0, Must, Subn, Goals),
+ goal_util__rename_var_maps(SM0, Must, Subn, SM).
+
goal_util__name_apart_2(disj(Goals0, SM0), Must, Subn, disj(Goals, SM)) :-
goal_util__name_apart_list(Goals0, Must, Subn, Goals),
goal_util__rename_var_maps(SM0, Must, Subn, SM).
@@ -432,6 +437,9 @@
goal_util__goal_vars_2(conj(Goals), Set0, Set) :-
goal_util__goals_goal_vars(Goals, Set0, Set).
+goal_util__goal_vars_2(par_conj(Goals, _SM), Set0, Set) :-
+ goal_util__goals_goal_vars(Goals, Set0, Set).
+
goal_util__goal_vars_2(disj(Goals, _), Set0, Set) :-
goal_util__goals_goal_vars(Goals, Set0, Set).
@@ -520,6 +528,9 @@
goal_expr_size(conj(Goals), Size) :-
goals_size(Goals, Size).
+goal_expr_size(par_conj(Goals, _SM), Size) :-
+ goals_size(Goals, Size1),
+ Size is Size1 + 1.
goal_expr_size(disj(Goals, _), Size) :-
goals_size(Goals, Size1),
Size is Size1 + 1.
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.45
diff -u -r1.45 handle_options.m
--- handle_options.m 1998/03/03 17:34:21 1.45
+++ handle_options.m 1998/03/11 04:50:07
@@ -383,6 +383,7 @@
*/
globals__get_args_method(Globals, ArgsMethod),
globals__lookup_bool_option(Globals, debug, Debug),
+ globals__lookup_bool_option(Globals, parallel, Parallel),
/*
globals__lookup_bool_option(Globals, pic_reg, PIC_Reg),
*/
@@ -405,6 +406,9 @@
Part2 = "none"
)
),
+ ( Parallel = yes, Part2a = ".par"
+ ; Parallel = no, Part2a = ""
+ ),
( GC_Method = conservative, Part3 = ".gc"
; GC_Method = accurate, Part3 = ".agc"
; GC_Method = none, Part3 = ""
@@ -487,7 +491,7 @@
*******/
Part10 = "",
- string__append_list( [Part1, Part2, Part3, Part4, Part5,
+ string__append_list( [Part1, Part2, Part2a, Part3, Part4, Part5,
Part6, Part7, Part8, Part9, Part10], Grade).
% IMPORTANT: any changes here may require similar changes to
@@ -563,13 +567,13 @@
),
% part 3
( { string__remove_suffix(Grade14, ".gc", Grade15) } ->
- { Grade = Grade15 },
+ { Grade16 = Grade15 },
{ GC = conservative }
; { string__remove_suffix(Grade14, ".agc", Grade15) } ->
- { Grade = Grade15 },
+ { Grade16 = Grade15 },
{ GC = accurate }
;
- { Grade = Grade14 },
+ { Grade16 = Grade14 },
{ GC = none }
),
% Set the type of gc that the grade option implies.
@@ -583,6 +587,12 @@
;
{ GC = none },
set_string_opt(gc, "none")
+ ),
+ ( { string__remove_suffix(Grade16, ".par", Grade17) } ->
+ { Grade = Grade17 },
+ set_bool_opt(parallel, yes)
+ ;
+ { Grade = Grade16 }
),
% parts 2 & 1
convert_grade_option_2(Grade).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/higher_order.m,v
retrieving revision 1.42
diff -u -r1.42 higher_order.m
--- higher_order.m 1998/03/03 17:34:25 1.42
+++ higher_order.m 1998/03/11 04:50:07
@@ -274,6 +274,13 @@
traverse_conj(Goals0, Goals, PredProcId, unchanged, Changed,
0, GoalSize).
+traverse_goal(par_conj(Goals0, SM) - Info, par_conj(Goals, SM) - Info,
+ PredProcId, Changed, GoalSize) -->
+ % traverse_disj treats its list of goals as independent
+ % rather than specifically disjoint, so we can use it
+ % to process a list of independent parallel conjuncts.
+ traverse_disj(Goals0, Goals, PredProcId, Changed, GoalSize).
+
traverse_goal(disj(Goals0, SM) - Info, disj(Goals, SM) - Info,
PredProcId, Changed, GoalSize) -->
traverse_disj(Goals0, Goals, PredProcId, Changed, GoalSize).
@@ -345,6 +352,10 @@
% specialization information before the goal, then merge the
% results to give the specialization information after the
% disjunction.
+ %
+ % This code is used both for disjunction and parallel
+ % conjunction.
+
:- pred traverse_disj(hlds_goals::in, hlds_goals::out, pred_proc_id::in,
changed::out, int::out, higher_order_info::in,
higher_order_info::out) is det.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.49
diff -u -r1.49 hlds_goal.m
--- hlds_goal.m 1998/03/03 17:34:29 1.49
+++ hlds_goal.m 1998/03/11 04:50:07
@@ -174,9 +174,17 @@
% (With inlining, the actual types may
% be instances of the original types.)
pragma_c_code_impl
- % Info about the code that does the
- % actual work.
- ).
+ % Extra information for model_non
+ % pragma_c_codes; none for others.
+ )
+
+ ; par_conj(hlds_goals, store_map)
+ % parallel conjunction
+ % The store_map specifies the locations
+ % in which live variables should be
+ % stored at the start of the parallel
+ % conjunction.
+ .
% Given the variable info field from a pragma c_code, get all the
% variable names.
@@ -631,6 +639,13 @@
:- pred goal_to_conj_list(hlds_goal, list(hlds_goal)).
:- mode goal_to_conj_list(in, out) is det.
+ % Convert a goal to a list of parallel conjuncts.
+ % If the goal is a parallel conjunction, then return its conjuncts,
+ % otherwise return the goal as a singleton list.
+
+:- pred goal_to_par_conj_list(hlds_goal, list(hlds_goal)).
+:- mode goal_to_par_conj_list(in, out) is det.
+
% Convert a goal to a list of disjuncts.
% If the goal is a disjunction, then return its disjuncts,
% otherwise return the goal as a singleton list.
@@ -646,6 +661,14 @@
:- pred conj_list_to_goal(list(hlds_goal), hlds_goal_info, hlds_goal).
:- mode conj_list_to_goal(in, in, out) is det.
+ % Convert a list of parallel conjuncts to a goal.
+ % If the list contains only one goal, then return that goal,
+ % otherwise return the parallel conjunction of the conjuncts,
+ % with the specified goal_info.
+
+:- pred par_conj_list_to_goal(list(hlds_goal), hlds_goal_info, hlds_goal).
+:- mode par_conj_list_to_goal(in, in, out) is det.
+
% Convert a list of disjuncts to a goal.
% If the list contains only one goal, then return that goal,
% otherwise return the disjunction of the disjuncts,
@@ -855,6 +878,17 @@
ConjList = [Goal]
).
+ % Convert a goal to a list of parallel conjuncts.
+ % If the goal is a conjunction, then return its conjuncts,
+ % otherwise return the goal as a singleton list.
+
+goal_to_par_conj_list(Goal, ConjList) :-
+ ( Goal = (par_conj(List, _) - _) ->
+ ConjList = List
+ ;
+ ConjList = [Goal]
+ ).
+
% Convert a goal to a list of disjuncts.
% If the goal is a disjunction, then return its disjuncts
% otherwise return the goal as a singleton list.
@@ -876,6 +910,19 @@
Goal = Goal0
;
Goal = conj(ConjList) - GoalInfo
+ ).
+
+ % Convert a list of parallel conjuncts to a goal.
+ % If the list contains only one goal, then return that goal,
+ % otherwise return the parallel conjunction of the conjuncts,
+ % with the specified goal_info.
+
+par_conj_list_to_goal(ConjList, GoalInfo, Goal) :-
+ ( ConjList = [Goal0] ->
+ Goal = Goal0
+ ;
+ map__init(StoreMap),
+ Goal = par_conj(ConjList, StoreMap) - GoalInfo
).
% Convert a list of disjuncts to a goal.
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.190
diff -u -r1.190 hlds_out.m
--- hlds_out.m 1998/03/03 17:34:33 1.190
+++ hlds_out.m 1998/03/11 04:50:08
@@ -961,14 +961,15 @@
hlds_out__write_indent(Indent),
io__write_string("( % conjunction\n"),
hlds_out__write_conj(Goal, Goals, ModuleInfo, VarSet,
- AppendVarnums, Indent1, "", Verbose, TypeQual),
+ AppendVarnums, Indent1, "", Verbose, ",\n",
+ TypeQual),
hlds_out__write_indent(Indent),
io__write_string(")"),
io__write_string(Follow),
io__write_string("\n")
;
hlds_out__write_conj(Goal, Goals, ModuleInfo, VarSet,
- AppendVarnums, Indent, Follow, Verbose,
+ AppendVarnums, Indent, Follow, Verbose, ",\n",
TypeQual)
)
;
@@ -978,6 +979,27 @@
io__write_string("\n")
).
+hlds_out__write_goal_2(par_conj(List, _), ModuleInfo, VarSet, AppendVarnums,
+ Indent, Follow, TypeQual) -->
+ hlds_out__write_indent(Indent),
+ ( { List = [Goal | Goals] } ->
+ io__write_string("( % parallel conjunction\n"),
+ { Indent1 is Indent + 1 },
+ hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
+ Indent1, "", TypeQual),
+ % See comments at hlds_out__write_goal_list.
+ hlds_out__write_goal_list(Goals, ModuleInfo, VarSet,
+ AppendVarnums, Indent, "&", TypeQual),
+ hlds_out__write_indent(Indent),
+ io__write_string(")"),
+ io__write_string(Follow),
+ io__write_string("\n")
+ ;
+ io__write_string("fail"),
+ io__write_string(Follow),
+ io__write_string("\n")
+ ).
+
hlds_out__write_goal_2(disj(List, _), ModuleInfo, VarSet, AppendVarnums,
Indent, Follow, TypeQual) -->
hlds_out__write_indent(Indent),
@@ -986,8 +1008,8 @@
{ Indent1 is Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent1, "", TypeQual),
- hlds_out__write_disj(Goals, ModuleInfo, VarSet, AppendVarnums,
- Indent, TypeQual),
+ hlds_out__write_goal_list(Goals, ModuleInfo, VarSet,
+ AppendVarnums, Indent, ";", TypeQual),
hlds_out__write_indent(Indent),
io__write_string(")"),
io__write_string(Follow),
@@ -1496,11 +1518,12 @@
mercury_output_mode(Mode, VarSet).
:- pred hlds_out__write_conj(hlds_goal, list(hlds_goal), module_info, varset,
- bool, int, string, string, vartypes, io__state, io__state).
-:- mode hlds_out__write_conj(in, in, in, in, in, in, in, in, in, di, uo) is det.
+ bool, int, string, string, string, vartypes, io__state, io__state).
+:- mode hlds_out__write_conj(in, in, in, in, in, in, in, in, in, in,
+ di, uo) is det.
hlds_out__write_conj(Goal1, Goals1, ModuleInfo, VarSet, AppendVarnums,
- Indent, Follow, Verbose, TypeQual) -->
+ Indent, Follow, Verbose, Separator, TypeQual) -->
(
{ Goals1 = [Goal2 | Goals2] }
->
@@ -1513,34 +1536,39 @@
hlds_out__write_goal_a(Goal1, ModuleInfo, VarSet,
AppendVarnums, Indent, "", TypeQual),
hlds_out__write_indent(Indent),
- io__write_string(",\n")
+ io__write_string(Separator)
;
hlds_out__write_goal_a(Goal1, ModuleInfo, VarSet,
- AppendVarnums, Indent, ",", TypeQual)
+ AppendVarnums, Indent, Separator, TypeQual)
),
hlds_out__write_conj(Goal2, Goals2, ModuleInfo, VarSet,
- AppendVarnums, Indent, Follow, Verbose, TypeQual)
+ AppendVarnums, Indent, Follow, Verbose, Separator,
+ TypeQual)
;
hlds_out__write_goal_a(Goal1, ModuleInfo, VarSet,
AppendVarnums, Indent, Follow, TypeQual)
).
-:- pred hlds_out__write_disj(list(hlds_goal), module_info, varset, bool, int,
- vartypes, io__state, io__state).
-:- mode hlds_out__write_disj(in, in, in, in, in, in, di, uo) is det.
+ % hlds_out__write_goal_list is used to write both disjunctions and
+ % parallel conjunctions.
+
+:- pred hlds_out__write_goal_list(list(hlds_goal), module_info, varset, bool,
+ int, string, vartypes, io__state, io__state).
+:- mode hlds_out__write_goal_list(in, in, in, in, in, in, in, di, uo) is det.
-hlds_out__write_disj(GoalList, ModuleInfo, VarSet, AppendVarnums, Indent,
- TypeQual) -->
+hlds_out__write_goal_list(GoalList, ModuleInfo, VarSet, AppendVarnums, Indent,
+ Separator, TypeQual) -->
(
{ GoalList = [Goal | Goals] }
->
hlds_out__write_indent(Indent),
- io__write_string(";\n"),
+ io__write_string(Separator),
+ io__write_string("\n"),
{ Indent1 is Indent + 1 },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet,
AppendVarnums, Indent1, "", TypeQual),
- hlds_out__write_disj(Goals, ModuleInfo, VarSet,
- AppendVarnums, Indent, TypeQual)
+ hlds_out__write_goal_list(Goals, ModuleInfo, VarSet,
+ AppendVarnums, Indent, Separator, TypeQual)
;
[]
).
Index: compiler/inlining.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inlining.m,v
retrieving revision 1.74
diff -u -r1.74 inlining.m
--- inlining.m 1998/03/03 17:34:37 1.74
+++ inlining.m 1998/03/11 04:50:08
@@ -380,6 +380,10 @@
inlining__inlining_in_goal(conj(Goals0) - GoalInfo, conj(Goals) - GoalInfo) -->
inlining__inlining_in_conj(Goals0, Goals).
+inlining__inlining_in_goal(par_conj(Goals0, SM) - GoalInfo,
+ par_conj(Goals, SM) - GoalInfo) -->
+ inlining__inlining_in_disj(Goals0, Goals).
+
inlining__inlining_in_goal(disj(Goals0, SM) - GoalInfo,
disj(Goals, SM) - GoalInfo) -->
inlining__inlining_in_disj(Goals0, Goals).
@@ -525,6 +529,9 @@
pragma_c_code(A, B, C, D, E, F, G) - GoalInfo) --> [].
%-----------------------------------------------------------------------------%
+
+ % inlining__inlining_in_disj is used for both disjunctions and
+ % parallel conjunctions.
:- pred inlining__inlining_in_disj(list(hlds_goal), list(hlds_goal),
inline_info, inline_info).
Index: compiler/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.20
diff -u -r1.20 instmap.m
--- instmap.m 1998/03/03 17:34:42 1.20
+++ instmap.m 1998/03/11 04:50:09
@@ -22,7 +22,7 @@
:- import_module hlds_module, prog_data, mode_info, (inst), mode_errors.
:- import_module hlds_data.
-:- import_module map, bool, set, term, list, assoc_list.
+:- import_module map, bool, set, term, list, assoc_list, std_util.
:- type instmap.
:- type instmap_delta.
@@ -193,6 +193,18 @@
mode_info, mode_info).
:- mode instmap__merge(in, in, in, mode_info_di, mode_info_uo) is det.
+ % instmap__unify(NonLocalVars, InstMapNonlocalvarPairss):
+ % Unify the `InstMaps' in the list of pairs resulting
+ % from different branches of a parallel conjunction and
+ % update the instantiatedness of all the nonlocal variables.
+ % The variable locking that is done when modechecking
+ % the individual conjuncts ensures that variables have
+ % at most one producer.
+ %
+:- pred instmap__unify(set(var), list(pair(instmap, set(var))),
+ mode_info, mode_info).
+:- mode instmap__unify(in, in, mode_info_di, mode_info_uo) is det.
+
% instmap__restrict takes an instmap and a set of vars and
% returns an instmap with its domain restricted to those
% vars.
@@ -222,8 +234,8 @@
% merge_instmap_delta(InitialInstMap, NonLocals,
% InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo)
- % Merge the instmap_deltas of different branches of an ite, disj
- % or switch.
+ % Merge the instmap_deltas of different branches of an if-then-else,
+ % disj or switch.
:- pred merge_instmap_delta(instmap, set(var), instmap_delta, instmap_delta,
instmap_delta, module_info, module_info).
:- mode merge_instmap_delta(in, in, in, in, out, in, out) is det.
@@ -237,6 +249,14 @@
instmap_delta, module_info, module_info).
:- mode merge_instmap_deltas(in, in, in, out, in, out) is det.
+ % unify_instmap_delta(InitialInstMap, NonLocals,
+ % InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo)
+ % Unify the instmap_deltas of different branches of a parallel
+ % conjunction.
+:- pred unify_instmap_delta(instmap, set(var), instmap_delta, instmap_delta,
+ instmap_delta, module_info, module_info).
+:- mode unify_instmap_delta(in, in, in, in, out, in, out) is det.
+
%-----------------------------------------------------------------------------%
% `instmap_delta_apply_sub(InstmapDelta0, Must, Sub, InstmapDelta)'
@@ -653,6 +673,127 @@
MergedDelta, ModuleInfo1, ModuleInfo).
%-----------------------------------------------------------------------------%
+
+instmap__unify(NonLocals, InstMapList, ModeInfo0, ModeInfo) :-
+ (
+ % If any of the instmaps is unreachable, then
+ % the final instmap is unreachable.
+ list__member(unreachable - _, InstMapList)
+ ->
+ mode_info_set_instmap(unreachable, ModeInfo0, ModeInfo)
+ ;
+ % If there is only one instmap, then we just
+ % stick it in the mode_info.
+ InstMapList = [InstMap - _]
+ ->
+ mode_info_set_instmap(InstMap, ModeInfo0, ModeInfo)
+ ;
+ InstMapList = [InstMap0 - _|InstMapList1],
+ InstMap0 = reachable(InstMapping0)
+ ->
+ % having got the first instmapping, to use as
+ % an accumulator, all instmap__unify_2 which
+ % unifies each of the nonlocals from each instmap
+ % with the corresponding inst in the accumulator.
+ mode_info_get_module_info(ModeInfo0, ModuleInfo0),
+ set__to_sorted_list(NonLocals, NonLocalsList),
+ instmap__unify_2(NonLocalsList, InstMap0, InstMapList1,
+ ModuleInfo0, InstMapping0, ModuleInfo,
+ InstMapping, ErrorList),
+ mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo1),
+
+ % If there were any errors, then add the error
+ % to the list of possible errors in the mode_info.
+ ( ErrorList = [FirstError | _] ->
+ FirstError = Var - _,
+ set__singleton_set(WaitingVars, Var),
+ mode_info_error(WaitingVars,
+ mode_error_par_conj(ErrorList),
+ ModeInfo1, ModeInfo2)
+ ;
+ ModeInfo2 = ModeInfo1
+ ),
+ mode_info_set_instmap(reachable(InstMapping),
+ ModeInfo2, ModeInfo)
+ ;
+ ModeInfo = ModeInfo0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % instmap__unify_2(Vars, InitialInstMap, InstMaps, ModuleInfo,
+ % ErrorList):
+ % Let `ErrorList' be the list of variables in `Vars' for
+ % which there are two instmaps in `InstMaps' for which the insts
+ % of the variable is incompatible.
+:- pred instmap__unify_2(list(var), instmap, list(pair(instmap, set(var))),
+ module_info, map(var, inst), module_info,
+ map(var, inst), merge_errors).
+:- mode instmap__unify_2(in, in, in, in, in, out, out, out) is det.
+
+instmap__unify_2([], _, _, ModuleInfo, InstMap, ModuleInfo, InstMap, []).
+instmap__unify_2([Var|Vars], InitialInstMap, InstMapList, ModuleInfo0, InstMap0,
+ ModuleInfo, InstMap, ErrorList) :-
+ instmap__unify_2(Vars, InitialInstMap, InstMapList, ModuleInfo0,
+ InstMap0, ModuleInfo1, InstMap1, ErrorList1),
+ instmap__lookup_var(InitialInstMap, Var, InitialVarInst),
+ instmap__unify_var(InstMapList, Var, [], Insts, InitialVarInst, Inst,
+ ModuleInfo1, ModuleInfo, no, Error),
+ ( Error = yes ->
+ ErrorList = [Var - Insts | ErrorList1]
+ ;
+ ErrorList = ErrorList1
+ ),
+ map__set(InstMap1, Var, Inst, InstMap).
+
+ % instmap__unify_var(InstMaps, Var, InitialInstMap, ModuleInfo,
+ % Insts, Error):
+ % Let `Insts' be the list of the inst of `Var' in
+ % each of the corresponding `InstMaps'. Let `Error' be yes
+ % iff there are two instmaps for which the inst of `Var'
+ % is incompatible.
+
+:- pred instmap__unify_var(list(pair(instmap, set(var))), var,
+ list(inst), list(inst), inst, inst, module_info, module_info,
+ bool, bool).
+:- mode instmap__unify_var(in, in, in, out, in, out, in, out, in, out) is det.
+
+instmap__unify_var([], _, Insts, Insts, Inst, Inst, ModuleInfo, ModuleInfo,
+ Error, Error).
+instmap__unify_var([InstMap - Nonlocals| Rest], Var, InstList0, InstList,
+ Inst0, Inst, ModuleInfo0, ModuleInfo, Error0, Error) :-
+ (
+ set__member(Var, Nonlocals)
+ ->
+ instmap__lookup_var(InstMap, Var, VarInst),
+ (
+ % We unify the accumulated inst and the inst from the
+ % given instmap - we don't care about the determinism.
+ % Variable locking during mode analysis ensures that
+ % there is a unique producer for each variable - whether
+ % or not the unification may fail is up to determinism
+ % analysis.
+
+ abstractly_unify_inst(live, Inst0, VarInst, fake_unify,
+ ModuleInfo0, Inst1, _Det, ModuleInfo1)
+ ->
+ Inst2 = Inst1,
+ ModuleInfo2 = ModuleInfo1,
+ Error1 = Error0
+ ;
+ Error1 = yes,
+ ModuleInfo2 = ModuleInfo0,
+ Inst2 = not_reached
+ )
+ ;
+ VarInst = free,
+ Inst2 = Inst0,
+ Error1 = Error0,
+ ModuleInfo2 = ModuleInfo0
+ ),
+ instmap__unify_var(Rest, Var, [VarInst | InstList0], InstList,
+ Inst2, Inst, ModuleInfo2, ModuleInfo, Error1, Error).
+
%-----------------------------------------------------------------------------%
% Given two instmaps and a set of variables, compute an instmap delta
@@ -769,6 +910,80 @@
error("merge_instmapping_delta_2: unexpected mode error")
),
merge_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB,
+ InstMapping1, InstMapping, ModuleInfo1, ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+ % Given two instmap deltas, unify them to produce a new instmap_delta.
+
+unify_instmap_delta(_, _, unreachable, InstMapDelta, InstMapDelta) --> [].
+unify_instmap_delta(_, _, reachable(InstMapping), unreachable,
+ reachable(InstMapping)) --> [].
+unify_instmap_delta(InstMap, NonLocals, reachable(InstMappingA),
+ reachable(InstMappingB), reachable(InstMapping)) -->
+ unify_instmapping_delta(InstMap, NonLocals, InstMappingA,
+ InstMappingB, InstMapping).
+
+:- pred unify_instmapping_delta(instmap, set(var), instmapping, instmapping,
+ instmapping, module_info, module_info).
+:- mode unify_instmapping_delta(in, in, in, in, out, in, out) is det.
+
+unify_instmapping_delta(InstMap, NonLocals, InstMappingA,
+ InstMappingB, InstMapping) -->
+ { map__keys(InstMappingA, VarsInA) },
+ { map__keys(InstMappingB, VarsInB) },
+ { set__sorted_list_to_set(VarsInA, SetofVarsInA) },
+ { set__insert_list(SetofVarsInA, VarsInB, SetofVars0) },
+ { set__intersect(SetofVars0, NonLocals, SetofVars) },
+ { map__init(InstMapping0) },
+ { set__to_sorted_list(SetofVars, ListofVars) },
+ unify_instmapping_delta_2(ListofVars, InstMap, InstMappingA,
+ InstMappingB, InstMapping0, InstMapping).
+
+:- pred unify_instmapping_delta_2(list(var), instmap, instmapping, instmapping,
+ instmapping, instmapping, module_info, module_info).
+:- mode unify_instmapping_delta_2(in, in, in, in, in, out, in, out) is det.
+
+unify_instmapping_delta_2([], _, _, _, InstMapping, InstMapping,
+ ModInfo, ModInfo).
+unify_instmapping_delta_2([Var | Vars], InstMap, InstMappingA, InstMappingB,
+ InstMapping0, InstMapping, ModuleInfo0, ModuleInfo) :-
+ ( map__search(InstMappingA, Var, InstA) ->
+ ( map__search(InstMappingB, Var, InstB) ->
+ (
+ % We unify the accumulated inst and the inst from the
+ % given instmap - we don't care about the determinism.
+ % Variable locking during mode analysis ensures that
+ % there is a unique producer for each variable - whether
+ % or not the unification may fail is up to determinism
+ % analysis.
+
+ abstractly_unify_inst(live, InstA, InstB,
+ fake_unify, ModuleInfo0, Inst, _Det,
+ ModuleInfoPrime)
+ ->
+ ModuleInfo1 = ModuleInfoPrime,
+ map__det_insert(InstMapping0, Var, Inst,
+ InstMapping1)
+ ;
+ error(
+ "unify_instmapping_delta_2: unexpected error")
+ )
+ ;
+ ModuleInfo1 = ModuleInfo0,
+ map__det_insert(InstMapping0, Var, InstA, InstMapping1)
+ )
+ ;
+ ( map__search(InstMappingB, Var, InstB) ->
+ ModuleInfo1 = ModuleInfo0,
+ map__det_insert(InstMapping0, Var, InstB, InstMapping1)
+ ;
+ ModuleInfo1 = ModuleInfo0,
+ InstMapping1 = InstMapping0
+ )
+ ),
+ unify_instmapping_delta_2(Vars, InstMap, InstMappingA, InstMappingB,
InstMapping1, InstMapping, ModuleInfo1, ModuleInfo).
%-----------------------------------------------------------------------------%
Index: compiler/intermod.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/intermod.m,v
retrieving revision 1.46
diff -u -r1.46 intermod.m
--- intermod.m 1998/03/03 17:34:44 1.46
+++ intermod.m 1998/03/11 04:50:09
@@ -341,6 +341,10 @@
intermod__traverse_goal(conj(Goals0) - Info, conj(Goals) - Info, DoWrite) -->
intermod__traverse_list_of_goals(Goals0, Goals, DoWrite).
+intermod__traverse_goal(par_conj(Goals0, SM) - Info, par_conj(Goals, SM) - Info,
+ DoWrite) -->
+ intermod__traverse_list_of_goals(Goals0, Goals, DoWrite).
+
intermod__traverse_goal(disj(Goals0, SM) - Info, disj(Goals, SM) - Info,
DoWrite) -->
intermod__traverse_list_of_goals(Goals0, Goals, DoWrite).
Index: compiler/lambda.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lambda.m,v
retrieving revision 1.40
diff -u -r1.40 lambda.m
--- lambda.m 1998/03/03 17:34:45 1.40
+++ lambda.m 1998/03/11 04:50:09
@@ -180,6 +180,9 @@
lambda__process_goal_2(conj(Goals0), GoalInfo, conj(Goals) - GoalInfo) -->
lambda__process_goal_list(Goals0, Goals).
+lambda__process_goal_2(par_conj(Goals0, SM), GoalInfo,
+ par_conj(Goals, SM) - GoalInfo) -->
+ lambda__process_goal_list(Goals0, Goals).
lambda__process_goal_2(disj(Goals0, SM), GoalInfo, disj(Goals, SM) - GoalInfo)
-->
lambda__process_goal_list(Goals0, Goals).
Index: compiler/lco.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/lco.m,v
retrieving revision 1.10
diff -u -r1.10 lco.m
--- lco.m 1998/01/13 10:12:26 1.10
+++ lco.m 1998/03/11 04:50:09
@@ -28,7 +28,7 @@
:- implementation.
:- import_module hlds_goal, passes_aux, hlds_out.
-:- import_module list, std_util.
+:- import_module list, require, std_util.
%-----------------------------------------------------------------------------%
@@ -62,6 +62,10 @@
lco_in_goal_2(conj(Goals0), ModuleInfo, conj(Goals)) :-
list__reverse(Goals0, RevGoals0),
lco_in_conj(RevGoals0, [], ModuleInfo, Goals).
+
+ % XXX Some execution algorithm issues here.
+lco_in_goal_2(par_conj(_Goals0, SM), _ModuleInfo, par_conj(_Goals, SM)) :-
+ error("sorry: lco of parallel conjunction not implemented").
lco_in_goal_2(disj(Goals0, SM), ModuleInfo, disj(Goals, SM)) :-
lco_in_disj(Goals0, ModuleInfo, Goals).
Index: compiler/live_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/live_vars.m,v
retrieving revision 1.72
diff -u -r1.72 live_vars.m
--- live_vars.m 1998/02/03 08:18:22 1.72
+++ live_vars.m 1998/03/11 04:50:09
@@ -135,7 +135,7 @@
(
/*******
% goal_is_atomic(Goal0)
- fail
+ semidet_fail
% NB: `fail' is a conservative approximation
% We could do better, but `goal_is_atomic' is not
% quite right
@@ -170,6 +170,25 @@
build_live_sets_in_conj(Goals0, Liveness0, ResumeVars0, LiveSets0,
ModuleInfo, ProcInfo, Liveness, ResumeVars, LiveSets).
+build_live_sets_in_goal_2(par_conj(Goals0, _SM), Liveness0, ResumeVars0,
+ LiveSets0, GoalInfo, ModuleInfo, ProcInfo, Liveness,
+ ResumeVars, LiveSets) :-
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
+ set__union(NonLocals, Liveness0, LiveSet),
+ % We insert all the union of the live vars and the nonlocals.
+ % Since each parallel conjunct may be run on a different
+ % Mercury engine to the current engine, we must save all
+ % the variables that are live or nonlocal to the parallel
+ % conjunction. Nonlocal variables that are currently free, but
+ % are bound inside one of the conjuncts need a stackslot
+ % because they are passed out by reference to that stackslot.
+ set__insert(LiveSets0, LiveSet, LiveSets1),
+ % build_live_sets_in_disj treats its list of goals as a list
+ % of independent goals, so we can use it for parallel conj's
+ % too.
+ build_live_sets_in_disj(Goals0, Liveness0, ResumeVars0, LiveSets1,
+ GoalInfo, ModuleInfo, ProcInfo, Liveness, ResumeVars, LiveSets).
+
build_live_sets_in_goal_2(disj(Goals0, _), Liveness0, ResumeVars0, LiveSets0,
GoalInfo, ModuleInfo, ProcInfo, Liveness, ResumeVars, LiveSets)
:-
@@ -419,6 +438,9 @@
).
%-----------------------------------------------------------------------------%
+
+ % build_live_sets_in_disj is used for both disjunctions and
+ % parallel conjunctions.
:- pred build_live_sets_in_disj(list(hlds_goal), set(var), set(var),
set(set(var)), hlds_goal_info, module_info, proc_info,
Index: compiler/livemap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/livemap.m,v
retrieving revision 1.33
diff -u -r1.33 livemap.m
--- livemap.m 1998/03/03 17:34:47 1.33
+++ livemap.m 1998/03/11 04:50:10
@@ -60,9 +60,9 @@
livemap__build_2(Backinstrs, Livemap0, MaybeLivemap) :-
set__init(Livevals0),
- livemap__build_livemap(Backinstrs, Livevals0, no, Ccode1,
+ livemap__build_livemap(Backinstrs, Livevals0, no, DontValueNumber1,
Livemap0, Livemap1),
- ( Ccode1 = yes ->
+ ( DontValueNumber1 = yes ->
MaybeLivemap = no
; livemap__equal_livemaps(Livemap0, Livemap1) ->
MaybeLivemap = yes(Livemap1)
@@ -105,13 +105,15 @@
livemap, livemap).
:- mode livemap__build_livemap(in, in, in, out, in, out) is det.
-livemap__build_livemap([], _, Ccode, Ccode, Livemap, Livemap).
-livemap__build_livemap([Instr0 | Instrs0], Livevals0, Ccode0, Ccode,
- Livemap0, Livemap) :-
+livemap__build_livemap([], _, DontValueNumber, DontValueNumber,
+ Livemap, Livemap).
+livemap__build_livemap([Instr0 | Instrs0], Livevals0,
+ DontValueNumber0, DontValueNumber, Livemap0, Livemap) :-
livemap__build_livemap_instr(Instr0, Instrs0, Instrs1,
- Livevals0, Livevals1, Ccode0, Ccode1, Livemap0, Livemap1),
+ Livevals0, Livevals1, DontValueNumber0, DontValueNumber1,
+ Livemap0, Livemap1),
livemap__build_livemap(Instrs1, Livevals1,
- Ccode1, Ccode, Livemap1, Livemap).
+ DontValueNumber1, DontValueNumber, Livemap1, Livemap).
:- pred livemap__build_livemap_instr(instruction, list(instruction),
list(instruction), lvalset, lvalset, bool, bool, livemap, livemap).
@@ -119,14 +121,15 @@
is det.
livemap__build_livemap_instr(Instr0, Instrs0, Instrs,
- Livevals0, Livevals, Ccode0, Ccode, Livemap0, Livemap) :-
+ Livevals0, Livevals, DontValueNumber0, DontValueNumber,
+ Livemap0, Livemap) :-
Instr0 = Uinstr0 - _,
(
Uinstr0 = comment(_),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = livevals(_),
error("livevals found in backward scan in build_livemap")
@@ -149,31 +152,31 @@
Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = call(_, _, _, _),
livemap__look_for_livevals(Instrs0, Instrs,
Livevals0, Livevals, "call", yes, _),
Livemap = Livemap0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = mkframe(_, _, _, _),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = modframe(_),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = label(Label),
map__set(Livemap0, Label, Livevals0, Livemap),
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = goto(CodeAddr),
opt_util__livevals_addr(CodeAddr, LivevalsNeeded),
@@ -202,7 +205,7 @@
Livevals = Livevals3
),
Livemap = Livemap0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = computed_goto(Rval, Labels),
set__init(Livevals1),
@@ -211,13 +214,13 @@
Livevals2, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = c_code(_),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = yes
+ DontValueNumber = yes
;
Uinstr0 = if_val(Rval, CodeAddr),
livemap__look_for_livevals(Instrs0, Instrs,
@@ -249,7 +252,7 @@
Livevals = Livevals3
),
Livemap = Livemap0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = incr_hp(Lval, _, Rval, _),
@@ -266,7 +269,7 @@
Livevals1, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = mark_hp(Lval),
set__delete(Livevals0, Lval, Livevals1),
@@ -274,13 +277,13 @@
livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = restore_hp(Rval),
livemap__make_live_in_rvals([Rval], Livevals0, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = store_ticket(Lval),
set__delete(Livevals0, Lval, Livevals1),
@@ -288,19 +291,19 @@
livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = reset_ticket(Rval, _Reason),
livemap__make_live_in_rval(Rval, Livevals0, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = discard_ticket,
Livevals = Livevals0,
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = mark_ticket_stack(Lval),
set__delete(Livevals0, Lval, Livevals1),
@@ -308,32 +311,62 @@
livemap__make_live_in_rvals(Rvals, Livevals1, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = discard_tickets_to(Rval),
livemap__make_live_in_rval(Rval, Livevals0, Livevals),
Livemap = Livemap0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = incr_sp(_, _),
- Livevals = Livevals0,
Livemap = Livemap0,
+ Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = DontValueNumber0
;
Uinstr0 = decr_sp(_),
+ Livemap = Livemap0,
Livevals = Livevals0,
+ Instrs = Instrs0,
+ DontValueNumber = DontValueNumber0
+ ;
+ Uinstr0 = init_sync_term(_, _),
Livemap = Livemap0,
+ Livevals = Livevals0,
+ Instrs = Instrs0,
+ DontValueNumber = DontValueNumber0
+ ;
+ % XXX Value numbering doesn't handle fork [yet] so
+ % set DontValueNumber to yes.
+ Uinstr0 = fork(_, _, _),
+ Livemap = Livemap0,
+ Livevals = Livevals0,
+ Instrs = Instrs0,
+ DontValueNumber = yes
+ ;
+ % XXX Value numbering doesn't handle join_and_terminate [yet] so
+ % set DontValueNumber to yes.
+ Uinstr0 = join_and_terminate(_),
+ Livemap = Livemap0,
+ Livevals = Livevals0,
+ Instrs = Instrs0,
+ DontValueNumber = yes
+ ;
+ % XXX Value numbering doesn't handle join_and_continue [yet] so
+ % set DontValueNumber to yes.
+ Uinstr0 = join_and_continue(_, _),
+ Livemap = Livemap0,
+ Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = Ccode0
+ DontValueNumber = yes
;
% XXX we shouldn't just give up here
Uinstr0 = pragma_c(_, _, _, _),
Livemap = Livemap0,
Livevals = Livevals0,
Instrs = Instrs0,
- Ccode = yes
+ DontValueNumber = yes
).
:- pred livemap__look_for_livevals(list(instruction), list(instruction),
Index: compiler/liveness.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/liveness.m,v
retrieving revision 1.91
diff -u -r1.91 liveness.m
--- liveness.m 1998/03/03 17:34:49 1.91
+++ liveness.m 1998/03/11 04:50:10
@@ -233,6 +233,13 @@
Liveness, conj(Goals)) :-
detect_liveness_in_conj(Goals0, Liveness0, LiveInfo, Liveness, Goals).
+detect_liveness_in_goal_2(par_conj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
+ Liveness, par_conj(Goals, SM)) :-
+ set__init(Union0),
+ detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
+ Union0, Union, Goals),
+ set__union(Liveness0, Union, Liveness).
+
detect_liveness_in_goal_2(disj(Goals0, SM), Liveness0, NonLocals, LiveInfo,
Liveness, disj(Goals, SM)) :-
set__init(Union0),
@@ -360,6 +367,24 @@
add_liveness_after_goal(Goal1, Residue, Goal).
%-----------------------------------------------------------------------------%
+
+:- pred detect_liveness_in_par_conj(list(hlds_goal), set(var), set(var),
+ live_info, set(var), set(var), list(hlds_goal)).
+:- mode detect_liveness_in_par_conj(in, in, in, in, in, out, out) is det.
+
+detect_liveness_in_par_conj([], _Liveness, _NonLocals, _LiveInfo,
+ Union, Union, []).
+detect_liveness_in_par_conj([Goal0 | Goals0], Liveness0, NonLocals, LiveInfo,
+ Union0, Union, [Goal | Goals]) :-
+ detect_liveness_in_goal(Goal0, Liveness0, LiveInfo, Liveness1, Goal1),
+ set__union(Union0, Liveness1, Union1),
+ detect_liveness_in_par_conj(Goals0, Liveness0, NonLocals, LiveInfo,
+ Union1, Union, Goals),
+ set__intersect(Union, NonLocals, NonLocalUnion),
+ set__difference(NonLocalUnion, Liveness1, Residue),
+ add_liveness_after_goal(Goal1, Residue, Goal).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred detect_deadness_in_goal(hlds_goal, set(var), live_info,
@@ -423,6 +448,14 @@
detect_deadness_in_conj(Goals0, Deadness0, LiveInfo,
Goals, Deadness).
+detect_deadness_in_goal_2(par_conj(Goals0, SM), GoalInfo, Deadness0, LiveInfo,
+ Deadness, par_conj(Goals, SM)) :-
+ set__init(Union0),
+ goal_info_get_nonlocals(GoalInfo, NonLocals),
+ detect_deadness_in_par_conj(Goals0, Deadness0, NonLocals,
+ LiveInfo, Union0, Union, Goals),
+ set__union(Union, Deadness0, Deadness).
+
detect_deadness_in_goal_2(disj(Goals0, SM), GoalInfo, Deadness0,
LiveInfo, Deadness, disj(Goals, SM)) :-
set__init(Union0),
@@ -545,6 +578,24 @@
add_deadness_before_goal(Goal1, Residue, Goal).
%-----------------------------------------------------------------------------%
+
+:- pred detect_deadness_in_par_conj(list(hlds_goal), set(var), set(var),
+ live_info, set(var), set(var), list(hlds_goal)).
+:- mode detect_deadness_in_par_conj(in, in, in, in, in, out, out) is det.
+
+detect_deadness_in_par_conj([], _Deadness, _NonLocals, _LiveInfo,
+ Union, Union, []).
+detect_deadness_in_par_conj([Goal0 | Goals0], Deadness, NonLocals, LiveInfo,
+ Union0, Union, [Goal | Goals]) :-
+ detect_deadness_in_goal(Goal0, Deadness, LiveInfo, Deadness1, Goal1),
+ set__union(Union0, Deadness1, Union1),
+ detect_deadness_in_par_conj(Goals0, Deadness, NonLocals, LiveInfo,
+ Union1, Union, Goals),
+ set__intersect(Union, NonLocals, NonLocalUnion),
+ set__difference(NonLocalUnion, Deadness1, Residue),
+ add_deadness_before_goal(Goal1, Residue, Goal).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred detect_resume_points_in_goal(hlds_goal, set(var), live_info, set(var),
@@ -576,6 +627,11 @@
detect_resume_points_in_conj(Goals0, Liveness0, LiveInfo, ResumeVars0,
Goals, Liveness).
+detect_resume_points_in_goal_2(par_conj(Goals0, SM), _, Liveness0, LiveInfo,
+ ResumeVars0, par_conj(Goals, SM), Liveness) :-
+ detect_resume_points_in_par_conj(Goals0, Liveness0, LiveInfo,
+ ResumeVars0, Goals, Liveness).
+
detect_resume_points_in_goal_2(disj(Goals0, SM), GoalInfo, Liveness0, LiveInfo,
ResumeVars0, disj(Goals, SM), Liveness) :-
goal_info_get_code_model(GoalInfo, CodeModel),
@@ -829,6 +885,18 @@
;
Cases = Cases0
).
+
+:- pred detect_resume_points_in_par_conj(list(hlds_goal), set(var), live_info,
+ set(var), list(hlds_goal), set(var)).
+:- mode detect_resume_points_in_par_conj(in, in, in, in, out, out) is det.
+
+detect_resume_points_in_par_conj([], Liveness, _, _, [], Liveness).
+detect_resume_points_in_par_conj([Goal0 | Goals0], Liveness0, LiveInfo,
+ ResumeVars0, [Goal | Goals], LivenessFirst) :-
+ detect_resume_points_in_goal(Goal0, Liveness0, LiveInfo, ResumeVars0,
+ Goal, LivenessFirst),
+ detect_resume_points_in_par_conj(Goals0, Liveness0, LiveInfo,
+ ResumeVars0, Goals, _LivenessRest).
:- pred require_equal(set(var), set(var), string, live_info).
:- mode require_equal(in, in, in, in) is det.
Index: compiler/llds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds.m,v
retrieving revision 1.222
diff -u -r1.222 llds.m
--- llds.m 1998/03/03 17:34:51 1.222
+++ llds.m 1998/03/11 04:50:10
@@ -231,7 +231,7 @@
% Decrement the det stack pointer.
; pragma_c(list(pragma_c_decl), list(pragma_c_component),
- may_call_mercury, maybe(label)).
+ may_call_mercury, maybe(label))
% The first argument says what local variable
% declarations are required for the following
% components, which in turn can specify how
@@ -254,6 +254,33 @@
% prevent the label from being optimized away.
% To make it known to labelopt, we mention it in
% the fourth arg.
+
+ ; init_sync_term(lval, int)
+ % Initialize a synchronization term.
+
+ ; fork(label, label, int)
+ % Create a new context.
+ % fork(Child, Parent, NumSlots) creates a new thread
+ % which will start executing at Child, then execution
+ % in the current context branches to Parent.
+ % NumSlots is the number of stack slots that need to
+ % be copied to the child's stack (see comments in
+ % runtime/context.{h,mod}).
+
+ ; join_and_terminate(lval)
+ % Signal that this thread of execution has finished in
+ % the current parallel conjunction, then terminate it.
+ % The synchronisation term specified by the
+ % given lval. (See the documentation in par_conj_gen.m
+ % and runtime/context.mod for further information about
+ % synchronisation terms.)
+
+ ; join_and_continue(lval, label)
+ % Signal that this thread of execution has finished
+ % in the current parallel conjunction, then branch to
+ % the given label. The synchronisation
+ % term specified by the given lval.
+ .
% Procedures defined by nondet pragma C codes must have some way of
% preserving information after a success, so that when control
Index: compiler/llds_common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_common.m,v
retrieving revision 1.16
diff -u -r1.16 llds_common.m
--- llds_common.m 1998/03/03 17:34:53 1.16
+++ llds_common.m 1998/03/11 04:50:10
@@ -253,6 +253,22 @@
Instr = Instr0,
Info = Info0
;
+ Instr0 = init_sync_term(_, _),
+ Instr = Instr0,
+ Info = Info0
+ ;
+ Instr0 = fork(_, _, _),
+ Instr = Instr0,
+ Info = Info0
+ ;
+ Instr0 = join_and_terminate(_),
+ Instr = Instr0,
+ Info = Info0
+ ;
+ Instr0 = join_and_continue(_, _),
+ Instr = Instr0,
+ Info = Info0
+ ;
Instr0 = pragma_c(_, _, _, _),
Instr = Instr0,
Info = Info0
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.74
diff -u -r1.74 llds_out.m
--- llds_out.m 1998/03/06 02:30:14 1.74
+++ llds_out.m 1998/03/11 04:50:10
@@ -677,8 +677,8 @@
llds_out__find_caller_label(Instrs, CallerLabel)
).
- % Locate all the labels which are the continutation labels for calls
- % or nondet disjunctions, and store them in ContLabelSet.
+ % Locate all the labels which are the continuation labels for calls,
+ % nondet disjunctions, forks or joins, and store them in ContLabelSet.
:- pred llds_out__find_cont_labels(list(instruction), set(label), set(label)).
:- mode llds_out__find_cont_labels(in, in, out) is det.
@@ -694,12 +694,18 @@
;
Instr = modframe(label(ContLabel))
;
+ Instr = join_and_continue(_, ContLabel)
+ ;
Instr = assign(redoip(lval(maxfr)),
const(code_addr_const(label(ContLabel))))
)
->
set__insert(ContLabelSet0, ContLabel, ContLabelSet1)
;
+ Instr = fork(Label1, Label2, _)
+ ->
+ set__insert_list(ContLabelSet0, [Label1, Label2], ContLabelSet1)
+ ;
Instr = block(_, _, Block)
->
llds_out__find_cont_labels(Block, ContLabelSet0, ContLabelSet1)
@@ -860,6 +866,16 @@
DeclSet0, DeclSet) -->
output_pragma_c_component_decls(Component, DeclSet0, DeclSet1),
output_pragma_c_component_list_decls(Components, DeclSet1, DeclSet).
+output_instruction_decls(init_sync_term(Lval, _), DeclSet0, DeclSet) -->
+ output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
+output_instruction_decls(fork(Child, Parent, _), DeclSet0, DeclSet) -->
+ output_code_addr_decls(label(Child), "", "", 0, _, DeclSet0, DeclSet2),
+ output_code_addr_decls(label(Parent), "", "", 0, _, DeclSet2, DeclSet).
+output_instruction_decls(join_and_terminate(Lval), DeclSet0, DeclSet) -->
+ output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet).
+output_instruction_decls(join_and_continue(Lval, Label), DeclSet0, DeclSet) -->
+ output_lval_decls(Lval, "", "", 0, _, DeclSet0, DeclSet1),
+ output_code_addr_decls(label(Label), "", "", 0, _, DeclSet1, DeclSet).
:- pred output_pragma_c_component_decls(pragma_c_component,
decl_set, decl_set, io__state, io__state).
@@ -1153,6 +1169,34 @@
output_pragma_c_components(Components),
io__write_string("\n\t}\n").
+output_instruction(init_sync_term(Lval, N), _) -->
+ io__write_string("\tMR_init_sync_term("),
+ output_lval_as_word(Lval),
+ io__write_string(", "),
+ io__write_int(N),
+ io__write_string(");\n").
+
+output_instruction(fork(Child, Parent, Lval), _) -->
+ io__write_string("\tfork_new_context("),
+ output_label_as_code_addr(Child),
+ io__write_string(", "),
+ output_label_as_code_addr(Parent),
+ io__write_string(", "),
+ io__write_int(Lval),
+ io__write_string(");\n").
+
+output_instruction(join_and_terminate(Lval), _) -->
+ io__write_string("\tjoin_and_terminate("),
+ output_lval(Lval),
+ io__write_string(");\n").
+
+output_instruction(join_and_continue(Lval, Label), _) -->
+ io__write_string("\tjoin_and_continue("),
+ output_lval(Lval),
+ io__write_string(", "),
+ output_label_as_code_addr(Label),
+ io__write_string(");\n").
+
:- pred output_pragma_c_components(list(pragma_c_component),
io__state, io__state).
:- mode output_pragma_c_components(in, di, uo) is det.
@@ -2212,7 +2256,7 @@
output_proc_label(ProcLabel),
io__write_string(")").
output_code_addr(succip) -->
- io__write_string("succip").
+ io__write_string("MR_succip").
output_code_addr(do_succeed(Last)) -->
(
{ Last = no },
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/make_hlds.m,v
retrieving revision 1.263
diff -u -r1.263 make_hlds.m
--- make_hlds.m 1998/03/04 19:47:34 1.263
+++ make_hlds.m 1998/03/11 04:50:11
@@ -2703,6 +2703,10 @@
PredCallId, MI) -->
warn_singletons_in_goal_list(Goals, QuantVars, VarSet, PredCallId, MI).
+warn_singletons_in_goal_2(par_conj(Goals, _SM), _GoalInfo, QuantVars, VarSet,
+ PredCallId, MI) -->
+ warn_singletons_in_goal_list(Goals, QuantVars, VarSet, PredCallId, MI).
+
warn_singletons_in_goal_2(disj(Goals, _), _GoalInfo, QuantVars, VarSet,
PredCallId, MI) -->
warn_singletons_in_goal_list(Goals, QuantVars, VarSet, PredCallId, MI).
@@ -3346,6 +3350,12 @@
{ goal_info_init(GoalInfo) },
{ conj_list_to_goal(L, GoalInfo, Goal) }.
+transform_goal_2((A0 & B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
+ get_par_conj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1),
+ get_par_conj(A0, Subst, L0, VarSet1, L, VarSet, Info1, Info),
+ { goal_info_init(GoalInfo) },
+ { par_conj_list_to_goal(L, GoalInfo, Goal) }.
+
transform_goal_2((A0;B0), _, VarSet0, Subst, Goal, VarSet, Info0, Info) -->
get_disj(B0, Subst, [], VarSet0, L0, VarSet1, Info0, Info1),
get_disj(A0, Subst, L0, VarSet1, L, VarSet, Info1, Info),
@@ -4042,6 +4052,29 @@
Info0, Info),
{ goal_to_conj_list(Goal1, ConjList) },
{ list__append(ConjList, Conj0, Conj) }
+ ).
+
+% get_par_conj(Goal, ParConj0, Subst, ParConj) :
+% Goal is a tree of conjuncts. Flatten it into a list (applying Subst),
+% append ParConj0, and return the result in ParConj.
+
+:- pred get_par_conj(goal, substitution, list(hlds_goal), varset,
+ list(hlds_goal), varset, qual_info, qual_info, io__state, io__state).
+:- mode get_par_conj(in, in, in, in, out, out, in, out, di, uo) is det.
+
+get_par_conj(Goal, Subst, ParConj0, VarSet0, ParConj, VarSet, Info0, Info) -->
+ (
+ { Goal = (A & B) - _Context }
+ ->
+ get_par_conj(B, Subst, ParConj0, VarSet0, ParConj1, VarSet1,
+ Info0, Info1),
+ get_par_conj(A, Subst, ParConj1, VarSet1, ParConj, VarSet,
+ Info1, Info)
+ ;
+ transform_goal(Goal, VarSet0, Subst, Goal1, VarSet,
+ Info0, Info),
+ { goal_to_par_conj_list(Goal1, ParConjList) },
+ { list__append(ParConjList, ParConj0, ParConj) }
).
% get_disj(Goal, Subst, Disj0, Disj) :
Index: compiler/mercury_to_c.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_c.m,v
retrieving revision 1.34
diff -u -r1.34 mercury_to_c.m
--- mercury_to_c.m 1998/03/03 17:35:05 1.34
+++ mercury_to_c.m 1998/03/11 04:50:11
@@ -605,6 +605,9 @@
c_gen_goal_2(conj(Goals), Indent, CGenInfo0, CGenInfo) -->
c_gen_conj(Goals, Indent, CGenInfo0, CGenInfo).
+c_gen_goal_2(par_conj(_Goals, _SM), _Indent, _CGenInfo0, _CGenInfo) -->
+ { error("sorry, c_gen of parallel conjunction not implemented") }.
+
c_gen_goal_2(disj(List, _), Indent, CGenInfo0, CGenInfo) -->
{ c_gen_info_get_code_model(CGenInfo0, CodeModel) },
( { CodeModel = model_non } ->
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.63
diff -u -r1.63 mercury_to_goedel.m
--- mercury_to_goedel.m 1998/03/03 17:35:06 1.63
+++ mercury_to_goedel.m 1998/03/11 04:50:11
@@ -624,6 +624,14 @@
goedel_output_newline(Indent),
goedel_output_goal(B, VarSet, Indent).
+ % Goedel doesn't have parallel conjunction,
+ % but we can use sequential conjunction instead.
+goedel_output_goal_2((A & B), VarSet, Indent) -->
+ goedel_output_goal(A, VarSet, Indent),
+ io__write_string(" &"),
+ goedel_output_newline(Indent),
+ goedel_output_goal(B, VarSet, Indent).
+
goedel_output_goal_2((A;B), VarSet, Indent) -->
io__write_string("("),
{ Indent1 is Indent + 1 },
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.133
diff -u -r1.133 mercury_to_mercury.m
--- mercury_to_mercury.m 1998/03/03 17:35:08 1.133
+++ mercury_to_mercury.m 1998/03/11 04:50:12
@@ -1713,6 +1713,16 @@
mercury_output_newline(Indent),
mercury_output_goal(B, VarSet, Indent).
+mercury_output_goal_2((A & B), VarSet, Indent) -->
+ io__write_string("("),
+ { Indent1 is Indent + 1 },
+ mercury_output_newline(Indent1),
+ mercury_output_goal(A, VarSet, Indent1),
+ mercury_output_par_conj(B, VarSet, Indent),
+ mercury_output_newline(Indent),
+ io__write_string(")").
+
+
mercury_output_goal_2((A;B), VarSet, Indent) -->
io__write_string("("),
{ Indent1 is Indent + 1 },
@@ -1761,6 +1771,23 @@
->
mercury_output_goal(A, VarSet, Indent1),
mercury_output_disj(B, VarSet, Indent)
+ ;
+ mercury_output_goal(Goal, VarSet, Indent1)
+ ).
+
+:- pred mercury_output_par_conj(goal, varset, int, io__state, io__state).
+:- mode mercury_output_par_conj(in, in, in, di, uo) is det.
+
+mercury_output_par_conj(Goal, VarSet, Indent) -->
+ mercury_output_newline(Indent),
+ io__write_string("&"),
+ { Indent1 is Indent + 1 },
+ mercury_output_newline(Indent1),
+ (
+ { Goal = (A & B) - _Context }
+ ->
+ mercury_output_goal(A, VarSet, Indent1),
+ mercury_output_par_conj(B, VarSet, Indent)
;
mercury_output_goal(Goal, VarSet, Indent1)
).
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/middle_rec.m,v
retrieving revision 1.70
diff -u -r1.70 middle_rec.m
--- middle_rec.m 1998/03/03 17:35:09 1.70
+++ middle_rec.m 1998/03/11 04:50:12
@@ -420,6 +420,13 @@
middle_rec__find_used_registers_instr(pragma_c(_, Components, _, _),
Used0, Used) :-
middle_rec__find_used_registers_components(Components, Used0, Used).
+middle_rec__find_used_registers_instr(init_sync_term(Lval, _), Used0, Used) :-
+ middle_rec__find_used_registers_lval(Lval, Used0, Used).
+middle_rec__find_used_registers_instr(fork(_, _, _), Used, Used).
+middle_rec__find_used_registers_instr(join_and_terminate(Lval), Used0, Used) :-
+ middle_rec__find_used_registers_lval(Lval, Used0, Used).
+middle_rec__find_used_registers_instr(join_and_continue(Lval,_), Used0, Used) :-
+ middle_rec__find_used_registers_lval(Lval, Used0, Used).
:- pred middle_rec__find_used_registers_components(list(pragma_c_component),
set(int), set(int)).
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_errors.m,v
retrieving revision 1.57
diff -u -r1.57 mode_errors.m
--- mode_errors.m 1998/03/03 17:35:11 1.57
+++ mode_errors.m 1998/03/11 04:50:12
@@ -40,6 +40,9 @@
---> mode_error_disj(merge_context, merge_errors)
% different arms of a disjunction result in
% different insts for some non-local variables
+ ; mode_error_par_conj(merge_errors)
+ % different arms of a parallel conj result in
+ % mutually exclusive bindings
; mode_error_higher_order_pred_var(pred_or_func, var, inst, arity)
% the predicate variable in a higher-order predicate
% or function call didn't have a higher-order
@@ -68,7 +71,8 @@
% instantiated variable (for preds with >1 mode)
; mode_error_bind_var(var_lock_reason, var, inst, inst)
% attempt to bind a non-local variable inside
- % a negated context
+ % a negated context, or attempt to re-bind a variable
+ % in a parallel conjunct
; mode_error_non_local_lambda_var(var, inst)
% attempt to pass a live non-ground var as a
% non-local variable to a lambda goal
@@ -85,9 +89,13 @@
% a conjunction contains one or more unscheduleable
% goals; schedule_culprit gives the reason why
% they couldn't be scheduled.
- ; mode_error_final_inst(int, var, inst, inst, final_inst_error).
+ ; mode_error_final_inst(int, var, inst, inst, final_inst_error)
% one of the head variables did not have the
% expected final inst on exit from the proc
+ ; mode_error_parallel_var(var, inst, inst)
+ % attempt to bind a non-local variable that has already
+ % been bound in another parallel conjunct.
+ .
:- type schedule_culprit
---> goal_itself_was_impure
@@ -174,6 +182,8 @@
report_mode_error(mode_error_disj(MergeContext, ErrorList), ModeInfo) -->
report_mode_error_disj(ModeInfo, MergeContext, ErrorList).
+report_mode_error(mode_error_par_conj(ErrorList), ModeInfo) -->
+ report_mode_error_par_conj(ModeInfo, ErrorList).
report_mode_error(mode_error_higher_order_pred_var(PredOrFunc, Var, Inst,
Arity), ModeInfo) -->
report_mode_error_higher_order_pred_var(ModeInfo, PredOrFunc, Var,
@@ -211,6 +221,8 @@
ModeInfo) -->
report_mode_error_final_inst(ModeInfo, ArgNum, Var, VarInst, Inst,
Reason).
+report_mode_error(mode_error_parallel_var(Var, InstA, InstB), ModeInfo) -->
+ report_mode_error_parallel_var(ModeInfo, Var, InstA, InstB).
%-----------------------------------------------------------------------------%
@@ -348,6 +360,17 @@
io__write_string(".\n"),
write_merge_error_list(ErrorList, ModeInfo).
+:- pred report_mode_error_par_conj(mode_info, merge_errors,
+ io__state, io__state).
+:- mode report_mode_error_par_conj(mode_info_no_io, in, di, uo) is det.
+
+report_mode_error_par_conj(ModeInfo, ErrorList) -->
+ { mode_info_get_context(ModeInfo, Context) },
+ mode_info_write_context(ModeInfo),
+ prog_out__write_context(Context),
+ io__write_string(" mode error: mutually exclusive bindings in parallel conjunction.\n"),
+ write_merge_error_list(ErrorList, ModeInfo).
+
:- pred write_merge_error_list(merge_errors, mode_info, io__state, io__state).
:- mode write_merge_error_list(in, mode_info_no_io, di, uo) is det.
@@ -396,6 +419,10 @@
io__write_string("attempt to bind a non-local variable inside\n"),
prog_out__write_context(Context),
io__write_strings([" a ", PredOrFuncS, " lambda goal.\n"])
+ ; { Reason = par_conj },
+ io__write_string("attempt to bind a non-local variable\n"),
+ prog_out__write_context(Context),
+ io__write_string(" inside more than one parallel conjunct.\n")
),
prog_out__write_context(Context),
io__write_string(" Variable `"),
@@ -420,6 +447,9 @@
; { Reason = lambda(_) },
io__write_string("\tA lambda goal is only allowed to bind its arguments\n"),
io__write_string("\tand variables local to the lambda expression.\n")
+ ; { Reason = par_conj },
+ io__write_string("\tA nonlocal variable of a parallel conjunction may be\n"),
+ io__write_string("\tbound in at most one conjunct.\n")
)
;
[]
@@ -801,6 +831,24 @@
%-----------------------------------------------------------------------------%
+
+:- pred report_mode_error_parallel_var(mode_info, var, inst, inst,
+ io__state, io__state).
+:- mode report_mode_error_parallel_var(mode_info_ui, in, in, in, di, uo) is det.
+
+report_mode_error_parallel_var(ModeInfo, Var, _VarInst, _Inst) -->
+ { mode_info_get_context(ModeInfo, Context) },
+ { mode_info_get_varset(ModeInfo, VarSet) },
+ mode_info_write_context(ModeInfo),
+ prog_out__write_context(Context),
+ io__write_string(" mode error: attempt to bind a variable already bound\n"),
+ prog_out__write_context(Context),
+ io__write_string(" in anonther parallel conjunct.\n"),
+ prog_out__write_context(Context),
+ io__write_string(" The variable concerned was `"),
+ mercury_output_var(Var, VarSet, no),
+ io__write_string("'.\n").
+
%-----------------------------------------------------------------------------%
mode_context_init(uninitialized).
Index: compiler/mode_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_info.m,v
retrieving revision 1.45
diff -u -r1.45 mode_info.m
--- mode_info.m 1998/03/03 17:35:13 1.45
+++ mode_info.m 1998/03/11 04:50:12
@@ -18,7 +18,7 @@
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, instmap.
:- import_module prog_data, mode_errors, delay_info, (inst).
-:- import_module map, list, varset, set, bool, term, assoc_list.
+:- import_module map, list, varset, set, bool, term, assoc_list, std_util.
:- interface.
@@ -59,7 +59,9 @@
:- type var_lock_reason
---> negation
; if_then_else
- ; lambda(pred_or_func).
+ ; lambda(pred_or_func)
+ ; par_conj
+ .
:- type locked_vars == assoc_list(var_lock_reason, set(var)).
@@ -218,6 +220,14 @@
:- mode mode_info_set_last_checkpoint_insts(in, mode_info_di, mode_info_uo)
is det.
+:- pred mode_info_get_parallel_vars(list(pair(set(var))), mode_info,
+ mode_info).
+:- mode mode_info_get_parallel_vars(out, mode_info_di, mode_info_uo) is det.
+
+:- pred mode_info_set_parallel_vars(list(pair(set(var))), mode_info,
+ mode_info).
+:- mode mode_info_set_parallel_vars(in, mode_info_di, mode_info_uo) is det.
+
:- pred mode_info_get_changed_flag(mode_info, bool).
:- mode mode_info_get_changed_flag(mode_info_no_io, out) is det.
@@ -231,7 +241,7 @@
ground, ground, ground,
ground, ground, ground, ground,
ground, ground, ground, ground,
- ground, ground, ground
+ ground, ground, ground, ground
)
).
*/
@@ -250,7 +260,7 @@
dead, ground, ground, ground,
ground, ground, ground, ground,
ground, ground, ground, ground,
- ground, ground, ground
+ ground, ground, ground, ground
)
).
*/
@@ -325,6 +335,14 @@
% This field will always contain an empty list if debug_modes is off,
% since its information is not needed then.
+ list(pair(set(var), set(var))),
+ % A stack of pairs of sets of variables used to mode-check
+ % parallel conjunctions. The first set is the nonlocals of
+ % the parallel conjunction. The second set is a subset of the
+ % first, and is the set of variables that have been [further]
+ % bound inside the current parallel conjunct - the stack is for
+ % the correct handling of nested parallel conjunctions.
+
bool % Changed flag
% If `yes', then we may need
% to repeat mode inference.
@@ -360,7 +378,7 @@
ModeInfo = mode_info(
IOState, ModuleInfo, PredId, ProcId, VarSet, VarTypes,
Context, ModeContext, InstMapping0, LockedVars, DelayInfo,
- ErrorList, LiveVarsList, NondetLiveVarsList, [],
+ ErrorList, LiveVarsList, NondetLiveVarsList, [], [],
Changed
).
@@ -368,89 +386,95 @@
% Lots of very boring access predicates.
-mode_info_get_io_state(mode_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_io_state(mode_info(IOState0,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
IOState) :-
% XXX
unsafe_promise_unique(IOState0, IOState).
%-----------------------------------------------------------------------------%
-mode_info_set_io_state( mode_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P), IOState0,
- mode_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P)) :-
+mode_info_set_io_state( mode_info(_,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q), IOState0,
+ mode_info(IOState,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q)) :-
% XXX
unsafe_promise_unique(IOState0, IOState).
%-----------------------------------------------------------------------------%
-mode_info_get_module_info(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_module_info(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
ModuleInfo).
%-----------------------------------------------------------------------------%
-mode_info_set_module_info(mode_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P), ModuleInfo,
- mode_info(A,ModuleInfo,C,D,E,F,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_module_info(mode_info(A,_,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q),
+ ModuleInfo,
+ mode_info(A,ModuleInfo,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_preds(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Preds) :-
+mode_info_get_preds(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Preds) :-
module_info_preds(ModuleInfo, Preds).
%-----------------------------------------------------------------------------%
-mode_info_get_modes(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Modes) :-
+mode_info_get_modes(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Modes) :-
module_info_modes(ModuleInfo, Modes).
%-----------------------------------------------------------------------------%
-mode_info_get_insts(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_), Insts) :-
+mode_info_get_insts(mode_info(_,ModuleInfo,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_),
+ Insts) :-
module_info_insts(ModuleInfo, Insts).
%-----------------------------------------------------------------------------%
-mode_info_get_predid(mode_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_,_,_,_), PredId).
+mode_info_get_predid(mode_info(_,_,PredId,_,_,_,_,_,_,_,_,_,_,_,_,_,_), PredId).
%-----------------------------------------------------------------------------%
-mode_info_get_procid(mode_info(_,_,_,ProcId,_,_,_,_,_,_,_,_,_,_,_,_), ProcId).
+mode_info_get_procid(mode_info(_,_,_,ProcId,_,_,_,_,_,_,_,_,_,_,_,_,_), ProcId).
%-----------------------------------------------------------------------------%
-mode_info_get_varset(mode_info(_,_,_,_,VarSet,_,_,_,_,_,_,_,_,_,_,_), VarSet).
+mode_info_get_varset(mode_info(_,_,_,_,VarSet,_,_,_,_,_,_,_,_,_,_,_,_), VarSet).
%-----------------------------------------------------------------------------%
-mode_info_set_varset(VarSet, mode_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,VarSet,F,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_varset(VarSet, mode_info(A,B,C,D,_,F,G,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,VarSet,F,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_var_types(mode_info(_,_,_,_,_,VarTypes,_,_,_,_,_,_,_,_,_,_),
+mode_info_get_var_types(mode_info(_,_,_,_,_,VarTypes,_,_,_,_,_,_,_,_,_,_,_),
VarTypes).
%-----------------------------------------------------------------------------%
-mode_info_set_var_types(VarTypes, mode_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,VarTypes,G,H,I,J,K,L,M,N,O,P)).
+mode_info_set_var_types(VarTypes, mode_info(A,B,C,D,E,_,G,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,VarTypes,G,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_context(mode_info(_,_,_,_,_,_,Context,_,_,_,_,_,_,_,_,_), Context).
+mode_info_get_context(mode_info(_,_,_,_,_,_,Context,_,_,_,_,_,_,_,_,_,_),
+ Context).
%-----------------------------------------------------------------------------%
-mode_info_set_context(Context, mode_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,Context,H,I,J,K,L,M,N,O,P)).
+mode_info_set_context(Context, mode_info(A,B,C,D,E,F,_,H,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,Context,H,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_mode_context(mode_info(_,_,_,_,_,_,_,ModeContext,_,_,_,_,_,_,_,_),
- ModeContext).
+mode_info_get_mode_context(
+ mode_info(_,_,_,_,_,_,_,ModeContext,_,_,_,_,_,_,_,_,_),
+ ModeContext).
%-----------------------------------------------------------------------------%
mode_info_set_mode_context(ModeContext,
- mode_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,ModeContext,I,J,K,L,M,N,O,P)).
+ mode_info(A,B,C,D,E,F,G,_,I,J,K,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,ModeContext,I,J,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -479,7 +503,8 @@
%-----------------------------------------------------------------------------%
-mode_info_get_instmap(mode_info(_,_,_,_,_,_,_,_,InstMap,_,_,_,_,_,_,_), InstMap).
+mode_info_get_instmap(mode_info(_,_,_,_,_,_,_,_,InstMap,_,_,_,_,_,_,_,_),
+ InstMap).
% mode_info_dcg_get_instmap/3 is the same as mode_info_get_instmap/2
% except that it's easier to use inside a DCG.
@@ -490,8 +515,8 @@
%-----------------------------------------------------------------------------%
mode_info_set_instmap( InstMap,
- mode_info(A,B,C,D,E,F,G,H,InstMap0,J,DelayInfo0,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,InstMap,J,DelayInfo,L,M,N,O,P)) :-
+ mode_info(A,B,C,D,E,F,G,H,InstMap0,J,DelayInfo0,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,InstMap,J,DelayInfo,L,M,N,O,P,Q)) :-
( instmap__is_unreachable(InstMap), instmap__is_reachable(InstMap0) ->
delay_info__bind_all_vars(DelayInfo0, DelayInfo)
;
@@ -500,28 +525,29 @@
%-----------------------------------------------------------------------------%
-mode_info_get_locked_vars(mode_info(_,_,_,_,_,_,_,_,_,LockedVars,_,_,_,_,_,_),
+mode_info_get_locked_vars(mode_info(_,_,_,_,_,_,_,_,_,LockedVars,_,_,_,_,_,_,_),
LockedVars).
%-----------------------------------------------------------------------------%
-mode_info_set_locked_vars( mode_info(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P), LockedVars,
- mode_info(A,B,C,D,E,F,G,H,I,LockedVars,K,L,M,N,O,P)).
+mode_info_set_locked_vars( mode_info(A,B,C,D,E,F,G,H,I,_,K,L,M,N,O,P,Q),
+ LockedVars,
+ mode_info(A,B,C,D,E,F,G,H,I,LockedVars,K,L,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
-mode_info_get_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_), Errors).
+mode_info_get_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_,_), Errors).
%-----------------------------------------------------------------------------%
-mode_info_get_num_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_),
+mode_info_get_num_errors(mode_info(_,_,_,_,_,_,_,_,_,_,_,Errors,_,_,_,_,_),
NumErrors) :-
list__length(Errors, NumErrors).
%-----------------------------------------------------------------------------%
-mode_info_set_errors( Errors, mode_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,Errors,M,N,O,P)).
+mode_info_set_errors( Errors, mode_info(A,B,C,D,E,F,G,H,I,J,K,_,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,Errors,M,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -535,9 +561,9 @@
mode_info_add_live_vars(NewLiveVars,
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars0,NondetLiveVars0,O,P),
+ LiveVars0,NondetLiveVars0,O,P,Q),
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars,NondetLiveVars,O,P)) :-
+ LiveVars,NondetLiveVars,O,P,Q)) :-
LiveVars = [NewLiveVars | LiveVars0],
NondetLiveVars = [NewLiveVars | NondetLiveVars0].
@@ -547,9 +573,9 @@
mode_info_remove_live_vars(OldLiveVars, ModeInfo0, ModeInfo) :-
ModeInfo0 = mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars0, NondetLiveVars0,O,P),
+ LiveVars0, NondetLiveVars0,O,P,Q),
ModeInfo1 = mode_info(A,B,C,D,E,F,G,H,I,J,K,L,
- LiveVars, NondetLiveVars,O,P),
+ LiveVars, NondetLiveVars,O,P,Q),
(
list__delete_first(LiveVars0, OldLiveVars, LiveVars1),
list__delete_first(NondetLiveVars0, OldLiveVars,
@@ -576,8 +602,8 @@
% Check whether a variable is live or not
-mode_info_var_is_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_), Var,
- Result) :-
+mode_info_var_is_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
+ Var, Result) :-
(
% some [LiveVars]
list__member(LiveVars, LiveVarsList),
@@ -591,7 +617,7 @@
% Check whether a variable is nondet_live or not.
mode_info_var_is_nondet_live(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,
- NondetLiveVarsList,_,_), Var, Result) :-
+ NondetLiveVarsList,_,_,_), Var, Result) :-
(
% some [LiveVars]
list__member(LiveVars, NondetLiveVarsList),
@@ -602,7 +628,7 @@
Result = dead
).
-mode_info_get_liveness(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_),
+mode_info_get_liveness(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
LiveVars) :-
set__init(LiveVars0),
mode_info_get_liveness_2(LiveVarsList, LiveVars0, LiveVars).
@@ -612,12 +638,12 @@
set__union(LiveVars0, LiveVarsSet, LiveVars1),
mode_info_get_liveness_2(LiveVarsList, LiveVars1, LiveVars).
-mode_info_get_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_),
+mode_info_get_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,LiveVarsList,_,_,_,_),
LiveVarsList).
mode_info_set_live_vars(LiveVarsList,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,LiveVarsList,N,O,P)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,_,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,LiveVarsList,N,O,P,Q)).
%-----------------------------------------------------------------------------%
@@ -670,33 +696,41 @@
mode_info_var_is_locked_2(Sets, Var, Reason)
).
-mode_info_get_delay_info(mode_info(_,_,_,_,_,_,_,_,_,_,DelayInfo,_,_,_,_,_),
+mode_info_get_delay_info(mode_info(_,_,_,_,_,_,_,_,_,_,DelayInfo,_,_,_,_,_,_),
DelayInfo).
-mode_info_set_delay_info(DelayInfo, mode_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,DelayInfo,L,M,N,O,P)).
+mode_info_set_delay_info(DelayInfo,
+ mode_info(A,B,C,D,E,F,G,H,I,J,_,L,M,N,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,DelayInfo,L,M,N,O,P,Q)).
mode_info_get_nondet_live_vars(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,
- NondetLiveVars,_,_), NondetLiveVars).
+ NondetLiveVars,_,_,_), NondetLiveVars).
mode_info_set_nondet_live_vars(NondetLiveVars,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,NondetLiveVars,O,P)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,_,O,P,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,NondetLiveVars,O,P,Q)).
mode_info_get_last_checkpoint_insts(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,
- LastCheckpointInsts,_), LastCheckpointInsts).
+ LastCheckpointInsts,_,_), LastCheckpointInsts).
mode_info_set_last_checkpoint_insts(LastCheckpointInsts,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,_,P,Q),
mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,
- LastCheckpointInsts,P)).
+ LastCheckpointInsts,P,Q)).
+
+mode_info_get_parallel_vars(PVars, ModeInfo, ModeInfo) :-
+ ModeInfo = mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,PVars,_).
+
+mode_info_set_parallel_vars(PVars,
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_,Q),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,PVars,Q)).
-mode_info_get_changed_flag(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Changed),
+mode_info_get_changed_flag(mode_info(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,Changed),
Changed).
mode_info_set_changed_flag(Changed,
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,_),
- mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Changed)).
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,_),
+ mode_info(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Changed)).
%-----------------------------------------------------------------------------%
Index: compiler/mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.108
diff -u -r1.108 mode_util.m
--- mode_util.m 1998/03/03 17:35:15 1.108
+++ mode_util.m 1998/03/11 04:50:12
@@ -1110,6 +1110,12 @@
recompute_instmap_delta_conj(Atomic, Goals0, Goals,
InstMap, InstMapDelta).
+recompute_instmap_delta_2(Atomic, par_conj(Goals0, SM), GoalInfo,
+ par_conj(Goals, SM), InstMap, InstMapDelta) -->
+ { goal_info_get_nonlocals(GoalInfo, NonLocals) },
+ recompute_instmap_delta_par_conj(Atomic, Goals0, Goals,
+ InstMap, NonLocals, InstMapDelta).
+
recompute_instmap_delta_2(Atomic, disj(Goals0, SM), GoalInfo, disj(Goals, SM),
InstMap, InstMapDelta) -->
{ goal_info_get_nonlocals(GoalInfo, NonLocals) },
@@ -1222,6 +1228,27 @@
recompute_instmap_delta_disj(Atomic, Goals0, Goals,
InstMap, NonLocals, InstMapDelta1),
merge_instmap_delta(InstMap, NonLocals, InstMapDelta0,
+ InstMapDelta1, InstMapDelta).
+
+:- pred recompute_instmap_delta_par_conj(bool, list(hlds_goal),
+ list(hlds_goal), instmap, set(var), instmap_delta,
+ module_info, module_info).
+:- mode recompute_instmap_delta_par_conj(in, in, out, in, in, out,
+ in, out) is det.
+
+recompute_instmap_delta_par_conj(_, [], [], _, _, InstMapDelta) -->
+ { instmap_delta_init_unreachable(InstMapDelta) }.
+recompute_instmap_delta_par_conj(Atomic, [Goal0], [Goal],
+ InstMap, _, InstMapDelta) -->
+ recompute_instmap_delta(Atomic, Goal0, Goal, InstMap, InstMapDelta).
+recompute_instmap_delta_par_conj(Atomic, [Goal0 | Goals0], [Goal | Goals],
+ InstMap, NonLocals, InstMapDelta) -->
+ { Goals0 = [_|_] },
+ recompute_instmap_delta(Atomic, Goal0, Goal,
+ InstMap, InstMapDelta0),
+ recompute_instmap_delta_par_conj(Atomic, Goals0, Goals,
+ InstMap, NonLocals, InstMapDelta1),
+ unify_instmap_delta(InstMap, NonLocals, InstMapDelta0,
InstMapDelta1, InstMapDelta).
%-----------------------------------------------------------------------------%
Index: compiler/modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/modes.m,v
retrieving revision 1.221
diff -u -r1.221 modes.m
--- modes.m 1998/03/03 17:35:23 1.221
+++ modes.m 1998/03/11 04:50:13
@@ -878,6 +878,33 @@
),
mode_checkpoint(exit, "conj").
+ % To modecheck a parallel conjunction, we modecheck each
+ % conjunct independently (just like for disjunctions).
+ % To make sure that we don't try to bind a variable more than
+ % once (by binding it in more than one conjunct), we maintain a
+ % datastructure that keeps track of three things:
+ % the set of variables that are nonlocal to the conjuncts
+ % (which may be a superset of the nonlocals of the par_conj
+ % as a whole);
+ % the set of nonlocal variables that have been bound in the
+ % current conjunct; and
+ % the set of variables that were bound in previous conjuncts.
+ % When binding a variable, we check that it wasn't in the set of
+ % variables bound in other conjuncts, and we add it to the set of
+ % variables bound in this conjunct.
+ % At the end of the conjunct, we add the set of variables bound in
+ % this conjunct to the set of variables bound in previous conjuncts
+ % and set the set of variables bound in the current conjunct to
+ % empty.
+ % A stack of these structures is maintained to handle nested parallel
+ % conjunctions properly.
+modecheck_goal_expr(par_conj(List0, SM), GoalInfo0, par_conj(List, SM)) -->
+ mode_checkpoint(enter, "par_conj"),
+ { goal_info_get_nonlocals(GoalInfo0, NonLocals) },
+ modecheck_par_conj_list(List0, List, NonLocals, InstMapNonlocalList),
+ instmap__unify(NonLocals, InstMapNonlocalList),
+ mode_checkpoint(exit, "par_conj").
+
modecheck_goal_expr(disj(List0, SM), GoalInfo0, disj(List, SM)) -->
mode_checkpoint(enter, "disj"),
( { List0 = [] } -> % for efficiency, optimize common case
@@ -1223,8 +1250,8 @@
% Now see whether the goal was successfully scheduled.
% If we didn't manage to schedule the goal, then we
- % restore the original instmap, delay_info & livevars here,
- % and delay the goal.
+ % restore the original instmap, delay_info and livevars
+ % here, and delay the goal.
=(ModeInfo1),
{ mode_info_get_errors(ModeInfo1, Errors) },
( { Errors = [ FirstErrorInfo | _] } ->
@@ -1399,6 +1426,58 @@
%-----------------------------------------------------------------------------%
+:- pred modecheck_par_conj_list(list(hlds_goal), list(hlds_goal),
+ set(var), list(pair(instmap, set(var))), mode_info, mode_info).
+:- mode modecheck_par_conj_list(in, out, in, out,
+ mode_info_di, mode_info_uo) is det.
+
+modecheck_par_conj_list([], [], _NonLocals, []) --> [].
+modecheck_par_conj_list([Goal0|Goals0], [Goal|Goals], NonLocals,
+ [InstMap - GoalNonLocals|InstMaps]) -->
+ mode_info_dcg_get_instmap(InstMap0),
+ { Goal0 = _ - GoalInfo },
+ { goal_info_get_nonlocals(GoalInfo, GoalNonLocals) },
+ mode_info_get_parallel_vars(PVars0),
+ { set__init(Bound0) },
+ mode_info_set_parallel_vars([NonLocals - Bound0|PVars0]),
+
+ modecheck_goal(Goal0, Goal),
+ mode_info_get_parallel_vars(PVars1),
+ (
+ { PVars1 = [_ - Bound1|PVars2] },
+ (
+ { PVars2 = [OuterNonLocals - OuterBound0|PVars3] },
+ { set__intersect(OuterNonLocals, Bound1, Bound) },
+ { set__union(OuterBound0, Bound, OuterBound) },
+ { PVars = [OuterNonLocals - OuterBound|PVars3] },
+ mode_info_set_parallel_vars(PVars)
+ ;
+ { PVars2 = [] },
+ mode_info_set_parallel_vars(PVars2)
+ )
+ ;
+ { PVars1 = [] },
+ { error("lost parallel vars") }
+ ),
+ mode_info_dcg_get_instmap(InstMap),
+ mode_info_set_instmap(InstMap0),
+ mode_info_lock_vars(par_conj, Bound1),
+ modecheck_par_conj_list(Goals0, Goals, NonLocals, InstMaps),
+ mode_info_unlock_vars(par_conj, Bound1).
+
+:- pred get_all_conjunct_nonlocals(list(hlds_goal), set(var), set(var)).
+:- mode get_all_conjunct_nonlocals(in, in, out) is det.
+
+get_all_conjunct_nonlocals([], NonLocals, NonLocals).
+get_all_conjunct_nonlocals([G|Gs], NonLocals0, NonLocals) :-
+ G = _ - GoalInfo,
+ goal_info_get_nonlocals(GoalInfo, GoalNonLocals),
+ set__union(GoalNonLocals, NonLocals0, NonLocals1),
+ get_all_conjunct_nonlocals(Gs, NonLocals1, NonLocals).
+
+
+%-----------------------------------------------------------------------------%
+
% Given a list of variables and a list of expected livenesses,
% ensure the liveness of each variable satisfies the corresponding
% expected liveness.
@@ -1537,8 +1616,9 @@
% The former is used for predicate calls, where we may need
% to introduce unifications to handle calls to implied modes.
-modecheck_set_var_inst(Var0, FinalInst, ModeInfo0, ModeInfo) :-
+modecheck_set_var_inst(Var0, FinalInst, ModeInfo00, ModeInfo) :-
mode_info_get_instmap(ModeInfo0, InstMap0),
+ mode_info_get_parallel_vars(PVars0, ModeInfo00, ModeInfo0),
( instmap__is_reachable(InstMap0) ->
% The new inst must be computed by unifying the
% old inst and the proc's final inst
@@ -1561,7 +1641,7 @@
inst_expand(ModuleInfo, Inst, not_reached)
->
instmap__init_unreachable(InstMap),
- mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo)
+ mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo3)
;
% If we haven't added any information and
% we haven't bound any part of the var, then
@@ -1569,7 +1649,7 @@
inst_matches_initial(Inst0, Inst, ModuleInfo)
->
instmap__set(InstMap0, Var0, Inst, InstMap),
- mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo)
+ mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo3)
;
% We must have either added some information,
% lost some uniqueness, or bound part of the var.
@@ -1583,7 +1663,8 @@
mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo2),
mode_info_get_delay_info(ModeInfo2, DelayInfo0),
delay_info__bind_var(DelayInfo0, Var0, DelayInfo),
- mode_info_set_delay_info(DelayInfo, ModeInfo2, ModeInfo)
+ mode_info_set_delay_info(DelayInfo,
+ ModeInfo2, ModeInfo3)
;
% We've bound part of the var. If the var was locked,
% then we need to report an error.
@@ -1592,17 +1673,31 @@
set__singleton_set(WaitingVars, Var0),
mode_info_error(WaitingVars,
mode_error_bind_var(Reason0, Var0, Inst0, Inst),
- ModeInfo1, ModeInfo
+ ModeInfo1, ModeInfo3
)
;
instmap__set(InstMap0, Var0, Inst, InstMap),
mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo2),
mode_info_get_delay_info(ModeInfo2, DelayInfo0),
delay_info__bind_var(DelayInfo0, Var0, DelayInfo),
- mode_info_set_delay_info(DelayInfo, ModeInfo2, ModeInfo)
+ mode_info_set_delay_info(DelayInfo,
+ ModeInfo2, ModeInfo3)
)
;
- ModeInfo = ModeInfo0
+ ModeInfo3 = ModeInfo0
+ ),
+ (
+ PVars0 = [],
+ ModeInfo = ModeInfo3
+ ;
+ PVars0 = [NonLocals - Bound0|PVars1],
+ ( set__member(Var0, NonLocals) ->
+ set__insert(Bound0, Var0, Bound),
+ PVars = [NonLocals - Bound|PVars1]
+ ;
+ PVars = PVars0
+ ),
+ mode_info_set_parallel_vars(PVars, ModeInfo3, ModeInfo)
).
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_debug.m,v
retrieving revision 1.80
diff -u -r1.80 opt_debug.m
--- opt_debug.m 1998/03/03 17:35:28 1.80
+++ opt_debug.m 1998/03/11 04:50:13
@@ -902,6 +902,23 @@
opt_debug__dump_instr(decr_sp(Size), Str) :-
string__int_to_string(Size, S_str),
string__append_list(["decr_sp(", S_str, ")"], Str).
+opt_debug__dump_instr(init_sync_term(Lval, N), Str) :-
+ opt_debug__dump_lval(Lval, L_str),
+ string__int_to_string(N, N_str),
+ string__append_list(["init_sync_term(", L_str, ", ", N_str, ")"], Str).
+opt_debug__dump_instr(fork(Child, Parent, Lval), Str) :-
+ opt_debug__dump_label(Child, ChildStr),
+ opt_debug__dump_label(Parent, ParentStr),
+ string__int_to_string(Lval, LvalStr),
+ string__append_list(["fork(", ChildStr, ", ", ParentStr, ", ",
+ LvalStr, ")"], Str).
+opt_debug__dump_instr(join_and_terminate(Lval), Str) :-
+ opt_debug__dump_lval(Lval, LvalStr),
+ string__append_list(["join_and_terminate(", LvalStr, ")"], Str).
+opt_debug__dump_instr(join_and_continue(Lval, Label), Str) :-
+ opt_debug__dump_lval(Lval, LvalStr),
+ opt_debug__dump_label(Label, LabelStr),
+ string__append_list(["join(", LvalStr, ", ", LabelStr, ")"], Str).
% XXX should probably give more info than this
opt_debug__dump_instr(pragma_c(_, Comps, _, _), Str) :-
opt_debug__dump_components(Comps, C_str),
Index: compiler/opt_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/opt_util.m,v
retrieving revision 1.90
diff -u -r1.90 opt_util.m
--- opt_util.m 1998/03/03 17:35:30 1.90
+++ opt_util.m 1998/03/11 04:50:14
@@ -893,6 +893,28 @@
;
Uinstr0 = pragma_c(_, _, _, _),
Need = no
+ ;
+ Uinstr0 = init_sync_term(Lval, _),
+ opt_util__lval_refers_stackvars(Lval, Need)
+ ;
+ Uinstr0 = fork(_, _, _),
+ Need = no
+ ;
+ Uinstr0 = join_and_terminate(Lval),
+ opt_util__lval_refers_stackvars(Lval, Use),
+ ( Use = yes ->
+ Need = yes
+ ;
+ opt_util__block_refers_stackvars(Instrs0, Need)
+ )
+ ;
+ Uinstr0 = join_and_continue(Lval, _),
+ opt_util__lval_refers_stackvars(Lval, Use),
+ ( Use = yes ->
+ Need = yes
+ ;
+ opt_util__block_refers_stackvars(Instrs0, Need)
+ )
).
opt_util__filter_out_labels([], []).
@@ -991,6 +1013,10 @@
opt_util__can_instr_branch_away(discard_tickets_to(_), no).
opt_util__can_instr_branch_away(incr_sp(_, _), no).
opt_util__can_instr_branch_away(decr_sp(_), no).
+opt_util__can_instr_branch_away(init_sync_term(_, _), no).
+opt_util__can_instr_branch_away(fork(_, _, _), yes).
+opt_util__can_instr_branch_away(join_and_terminate(_), no).
+opt_util__can_instr_branch_away(join_and_continue(_, _), yes).
opt_util__can_instr_branch_away(pragma_c(_, Components, _, _), BranchAway) :-
opt_util__can_components_branch_away(Components, BranchAway).
@@ -1050,6 +1076,10 @@
opt_util__can_instr_fall_through(discard_tickets_to(_), yes).
opt_util__can_instr_fall_through(incr_sp(_, _), yes).
opt_util__can_instr_fall_through(decr_sp(_), yes).
+opt_util__can_instr_fall_through(init_sync_term(_, _), yes).
+opt_util__can_instr_fall_through(fork(_, _, _), no).
+opt_util__can_instr_fall_through(join_and_terminate(_), no).
+opt_util__can_instr_fall_through(join_and_continue(_, _), no).
opt_util__can_instr_fall_through(pragma_c(_, _, _, _), yes).
% Check whether an instruction sequence can possibly fall through
@@ -1091,6 +1121,10 @@
opt_util__can_use_livevals(discard_tickets_to(_), no).
opt_util__can_use_livevals(incr_sp(_, _), no).
opt_util__can_use_livevals(decr_sp(_), no).
+opt_util__can_use_livevals(init_sync_term(_, _), no).
+opt_util__can_use_livevals(fork(_, _, _), no).
+opt_util__can_use_livevals(join_and_terminate(_), no).
+opt_util__can_use_livevals(join_and_continue(_, _), no).
opt_util__can_use_livevals(pragma_c(_, _, _, _), no).
% determine all the labels and code_addresses that are referenced by Instr
@@ -1149,6 +1183,10 @@
opt_util__instr_labels_2(discard_tickets_to(_), [], []).
opt_util__instr_labels_2(incr_sp(_, _), [], []).
opt_util__instr_labels_2(decr_sp(_), [], []).
+opt_util__instr_labels_2(init_sync_term(_, _), [], []).
+opt_util__instr_labels_2(fork(Child, Parent, _), [Child, Parent], []).
+opt_util__instr_labels_2(join_and_terminate(_), [], []).
+opt_util__instr_labels_2(join_and_continue(_, Label), [Label], []).
opt_util__instr_labels_2(pragma_c(_, _, _, MaybeLabel), Labels, []) :-
( MaybeLabel = yes(Label) ->
Labels = [Label]
@@ -1184,6 +1222,10 @@
opt_util__instr_rvals_and_lvals(discard_tickets_to(Rval), [Rval], []).
opt_util__instr_rvals_and_lvals(incr_sp(_, _), [], []).
opt_util__instr_rvals_and_lvals(decr_sp(_), [], []).
+opt_util__instr_rvals_and_lvals(init_sync_term(Lval, _), [], [Lval]).
+opt_util__instr_rvals_and_lvals(fork(_, _, _), [], []).
+opt_util__instr_rvals_and_lvals(join_and_terminate(Lval), [], [Lval]).
+opt_util__instr_rvals_and_lvals(join_and_continue(Lval, _), [], [Lval]).
opt_util__instr_rvals_and_lvals(pragma_c(_, Components, _, _), Rvals, Lvals) :-
pragma_c_components_get_rvals_and_lvals(Components, Rvals, Lvals).
@@ -1313,6 +1355,13 @@
opt_util__count_temps_rval(Rval, R0, R, F0, F).
opt_util__count_temps_instr(incr_sp(_, _), R, R, F, F).
opt_util__count_temps_instr(decr_sp(_), R, R, F, F).
+opt_util__count_temps_instr(init_sync_term(Lval, _), R0, R, F0, F) :-
+ opt_util__count_temps_lval(Lval, R0, R, F0, F).
+opt_util__count_temps_instr(fork(_, _, _), R, R, F, F).
+opt_util__count_temps_instr(join_and_terminate(Lval), R0, R, F0, F) :-
+ opt_util__count_temps_lval(Lval, R0, R, F0, F).
+opt_util__count_temps_instr(join_and_continue(Lval, _), R0, R, F0, F) :-
+ opt_util__count_temps_lval(Lval, R0, R, F0, F).
opt_util__count_temps_instr(pragma_c(_, _, _, _), R, R, F, F).
:- pred opt_util__count_temps_lval(lval, int, int, int, int).
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.224
diff -u -r1.224 options.m
--- options.m 1998/03/03 17:35:33 1.224
+++ options.m 1998/03/11 04:50:15
@@ -113,6 +113,7 @@
; gcc_global_registers
; asm_labels
; gc
+ ; parallel
; profiling % profile_time + profile_calls
; time_profiling % profile_time + profile_calls
; memory_profiling % profime_mem + profile_calls
@@ -140,6 +141,7 @@
% `--tags high' and doesn't specify
% `--num-tag-bits'.
; args
+ ; sync_term_size % in words
; type_layout
% Stack layout information required to do
% a stack trace.
@@ -386,6 +388,7 @@
gcc_global_registers - bool(yes),
asm_labels - bool(yes),
gc - string("conservative"),
+ parallel - bool(no),
profiling - bool_special,
time_profiling - special,
memory_profiling - special,
@@ -412,6 +415,10 @@
% above default with a value determined
% at configuration time
args - string("compact"),
+ sync_term_size - int(8),
+ % 8 is the size on linux (at the time
+ % of writing) - will usually be over-
+ % ridden by a value from configure.
type_layout - bool(yes),
basic_stack_layout - bool(no),
agc_stack_layout - bool(no),
@@ -695,6 +702,7 @@
long_option("asm-labels", asm_labels).
long_option("gc", gc).
long_option("garbage-collection", gc).
+long_option("parallel", parallel).
long_option("profiling", profiling).
long_option("time-profiling", time_profiling).
long_option("memory-profiling", memory_profiling).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.130
diff -u -r1.130 polymorphism.m
--- polymorphism.m 1998/03/03 17:35:37 1.130
+++ polymorphism.m 1998/03/11 04:50:16
@@ -757,6 +757,9 @@
polymorphism__process_goal_expr(conj(Goals0), GoalInfo,
conj(Goals) - GoalInfo) -->
polymorphism__process_goal_list(Goals0, Goals).
+polymorphism__process_goal_expr(par_conj(Goals0, SM), GoalInfo,
+ par_conj(Goals, SM) - GoalInfo) -->
+ polymorphism__process_goal_list(Goals0, Goals).
polymorphism__process_goal_expr(disj(Goals0, SM), GoalInfo,
disj(Goals, SM) - GoalInfo) -->
polymorphism__process_goal_list(Goals0, Goals).
Index: compiler/prog_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_data.m,v
retrieving revision 1.32
diff -u -r1.32 prog_data.m
--- prog_data.m 1998/03/03 17:35:40 1.32
+++ prog_data.m 1998/03/11 04:50:17
@@ -292,10 +292,12 @@
% clause/4 defined above
:- type goal == pair(goal_expr, term__context).
+
:- type goal_expr
---> (goal,goal)
; true
% could use conj(goals) instead
+ ; (goal & goal) % &/2 ie parallel-conj
; {goal;goal} % {...} quotes ';'/2.
; fail
% could use disj(goals) instead
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.11
diff -u -r1.11 prog_io_dcg.m
--- prog_io_dcg.m 1998/03/03 17:35:44 1.11
+++ prog_io_dcg.m 1998/03/11 04:50:17
@@ -206,6 +206,11 @@
parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet1, N1, Var1),
parse_dcg_goal(B0, VarSet1, N1, Var1, B, VarSet, N, Var).
+parse_dcg_goal_2("&", [A0, B0], Context, VarSet0, N0, Var0,
+ (A & B) - Context, VarSet, N, Var) :-
+ parse_dcg_goal(A0, VarSet0, N0, Var0, A, VarSet1, N1, Var1),
+ parse_dcg_goal(B0, VarSet1, N1, Var1, B, VarSet, N, Var).
+
% Disjunction or if-then-else (Prolog syntax).
parse_dcg_goal_2(";", [A0, B0], Context, VarSet0, N0, Var0,
Goal, VarSet, N, Var) :-
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.11
diff -u -r1.11 prog_io_goal.m
--- prog_io_goal.m 1998/03/03 17:35:45 1.11
+++ prog_io_goal.m 1998/03/11 04:50:17
@@ -136,6 +136,9 @@
parse_goal_2(",", [A0, B0], V0, (A, B), V) :-
parse_goal(A0, V0, A, V1),
parse_goal(B0, V1, B, V).
+parse_goal_2("&", [A0, B0], V0, (A & B), V) :-
+ parse_goal(A0, V0, A, V1),
+ parse_goal(B0, V1, B, V).
parse_goal_2(";", [A0, B0], V0, R, V) :-
(
A0 = term__functor(term__atom("->"), [X0, Y0], _Context)
Index: compiler/prog_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_util.m,v
retrieving revision 1.39
diff -u -r1.39 prog_util.m
--- prog_util.m 1998/03/03 17:35:53 1.39
+++ prog_util.m 1998/03/11 04:50:18
@@ -182,6 +182,10 @@
(GoalA, GoalB)) :-
prog_util__rename_in_goal(GoalA0, OldVar, NewVar, GoalA),
prog_util__rename_in_goal(GoalB0, OldVar, NewVar, GoalB).
+prog_util__rename_in_goal_expr((GoalA0 & GoalB0), OldVar, NewVar,
+ (GoalA & GoalB)) :-
+ prog_util__rename_in_goal(GoalA0, OldVar, NewVar, GoalA),
+ prog_util__rename_in_goal(GoalB0, OldVar, NewVar, GoalB).
prog_util__rename_in_goal_expr(true, _Var, _NewVar, true).
prog_util__rename_in_goal_expr((GoalA0; GoalB0), OldVar, NewVar,
(GoalA; GoalB)) :-
Index: compiler/purity.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/purity.m,v
retrieving revision 1.9
diff -u -r1.9 purity.m
--- purity.m 1998/03/03 17:35:55 1.9
+++ purity.m 1998/03/11 04:50:18
@@ -523,6 +523,10 @@
InClosure, Purity, NumErrors0, NumErrors) -->
compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
InClosure, pure, Purity, NumErrors0, NumErrors).
+compute_expr_purity(par_conj(Goals0, SM), par_conj(Goals, SM), _, PredInfo,
+ ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
+ compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
+ InClosure, pure, Purity, NumErrors0, NumErrors).
compute_expr_purity(call(PredId0,ProcId,Vars,BIState,UContext,Name0),
call(PredId,ProcId,Vars,BIState,UContext,Name), GoalInfo,
PredInfo, ModuleInfo, InClosure, ActualPurity,
Index: compiler/quantification.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/quantification.m,v
retrieving revision 1.60
diff -u -r1.60 quantification.m
--- quantification.m 1998/03/03 17:35:56 1.60
+++ quantification.m 1998/03/11 04:50:18
@@ -214,6 +214,9 @@
implicitly_quantify_goal_2(conj(List0), _, conj(List)) -->
implicitly_quantify_conj(List0, List).
+implicitly_quantify_goal_2(par_conj(List0, SM), _, par_conj(List, SM)) -->
+ implicitly_quantify_conj(List0, List).
+
implicitly_quantify_goal_2(disj(Goals0, SM), _, disj(Goals, SM)) -->
implicitly_quantify_disj(Goals0, Goals).
@@ -624,6 +627,9 @@
set__insert_list(Set0, ArgVars, Set).
quantification__goal_vars_2(conj(Goals), Set0, LambdaSet0, Set, LambdaSet) :-
+ goal_list_vars_2(Goals, Set0, LambdaSet0, Set, LambdaSet).
+
+quantification__goal_vars_2(par_conj(Goals, _SM), Set0, LambdaSet0, Set, LambdaSet) :-
goal_list_vars_2(Goals, Set0, LambdaSet0, Set, LambdaSet).
quantification__goal_vars_2(disj(Goals, _), Set0, LambdaSet0, Set, LambdaSet) :-
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/saved_vars.m,v
retrieving revision 1.15
diff -u -r1.15 saved_vars.m
--- saved_vars.m 1998/01/13 10:13:33 1.15
+++ saved_vars.m 1998/03/11 04:50:19
@@ -84,6 +84,13 @@
Goals, SlotInfo),
conj_list_to_goal(Goals, GoalInfo0, Goal)
;
+ GoalExpr0 = par_conj(Goals0, SM),
+ % saved_vars_in_disj treats its goal list as
+ % an independent list of goals, so we can use
+ % it to process the list of parallel conjuncts too.
+ saved_vars_in_disj(Goals0, SlotInfo0, Goals, SlotInfo),
+ Goal = par_conj(Goals, SM) - GoalInfo0
+ ;
GoalExpr0 = disj(Goals0, SM),
saved_vars_in_disj(Goals0, SlotInfo0, Goals, SlotInfo),
Goal = disj(Goals, SM) - GoalInfo0
@@ -301,6 +308,11 @@
saved_vars_delay_goal(Goals1, Construct, Var,
IsNonLocal, SlotInfo0, Goals, SlotInfo)
;
+ Goal0Expr = par_conj(_ParConj, _SM),
+ saved_vars_delay_goal(Goals0, Construct, Var,
+ IsNonLocal, SlotInfo0, Goals1, SlotInfo),
+ Goals = [Goal0|Goals1]
+ ;
Goal0Expr = some(SomeVars, SomeGoal0),
rename_var(SlotInfo0, Var, NewVar, Subst, SlotInfo1),
goal_util__rename_vars_in_goal(Construct, Subst,
@@ -437,6 +449,9 @@
Cases, SlotInfo).
%-----------------------------------------------------------------------------%
+
+ % saved_vars_in_disj does a saved_vars_in_goal on an list of independent
+ % goals, and is used to process disjunctions and parallel conjunctions.
:- pred saved_vars_in_disj(list(hlds_goal), slot_info,
list(hlds_goal), slot_info).
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.55
diff -u -r1.55 simplify.m
--- simplify.m 1998/03/03 17:35:58 1.55
+++ simplify.m 1998/03/11 04:50:19
@@ -281,6 +281,21 @@
)
).
+simplify__goal_2(par_conj(Goals0, SM), GoalInfo, Goal, GoalInfo, Info0, Info) :-
+ (
+ Goals0 = []
+ ->
+ Goal = conj([]),
+ Info = Info0
+ ;
+ Goals0 = [Goal0]
+ ->
+ simplify__goal(Goal0, Goal - _, Info0, Info)
+ ;
+ simplify__par_conj(Goals0, Goals, Info0, Info0, Info),
+ Goal = par_conj(Goals, SM)
+ ).
+
simplify__goal_2(disj(Disjuncts0, SM), GoalInfo0,
Goal, GoalInfo, Info0, Info) :-
( Disjuncts0 = [] ->
@@ -941,6 +956,18 @@
;
RevGoals = [Goal | RevGoals0]
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred simplify__par_conj(list(hlds_goal), list(hlds_goal),
+ simplify_info, simplify_info, simplify_info).
+:- mode simplify__par_conj(in, out, in, in, out) is det.
+
+simplify__par_conj([], [], _, Info, Info).
+simplify__par_conj([Goal0 |Goals0], [Goal | Goals], Info0, Info1, Info) :-
+ simplify__goal(Goal0, Goal, Info1, Info2),
+ simplify_info_post_branch_update(Info0, Info2, Info3),
+ simplify__par_conj(Goals0, Goals, Info0, Info3, Info).
%-----------------------------------------------------------------------------%
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/store_alloc.m,v
retrieving revision 1.59
diff -u -r1.59 store_alloc.m
--- store_alloc.m 1998/02/12 01:17:46 1.59
+++ store_alloc.m 1998/03/11 04:50:20
@@ -128,6 +128,11 @@
store_alloc_in_conj(Goals0, Liveness0, ResumeVars0, ModuleInfo,
Goals, Liveness).
+store_alloc_in_goal_2(par_conj(Goals0, SM), Liveness0, ResumeVars0, ModuleInfo,
+ par_conj(Goals, SM), Liveness) :-
+ store_alloc_in_par_conj(Goals0, Liveness0, ResumeVars0, ModuleInfo,
+ Goals, Liveness).
+
store_alloc_in_goal_2(disj(Goals0, FV), Liveness0, ResumeVars0, ModuleInfo,
disj(Goals, FV), Liveness) :-
store_alloc_in_disj(Goals0, Liveness0, ResumeVars0, ModuleInfo,
@@ -203,6 +208,20 @@
store_alloc_in_conj(Goals0, Liveness1, ResumeVars0, ModuleInfo,
Goals, Liveness)
).
+
+%-----------------------------------------------------------------------------%
+
+:- pred store_alloc_in_par_conj(list(hlds_goal), liveness_info, set(var),
+ module_info, list(hlds_goal), liveness_info).
+:- mode store_alloc_in_par_conj(in, in, in, in, out, out) is det.
+
+store_alloc_in_par_conj([], Liveness, _ResumeVars0, _ModuleInfo, [], Liveness).
+store_alloc_in_par_conj([Goal0 | Goals0], Liveness0, ResumeVars0, ModuleInfo,
+ [Goal | Goals], Liveness) :-
+ store_alloc_in_goal(Goal0, Liveness0, ResumeVars0, ModuleInfo,
+ Goal, Liveness),
+ store_alloc_in_par_conj(Goals0, Liveness0, ResumeVars0, ModuleInfo,
+ Goals, _Liveness1).
%-----------------------------------------------------------------------------%
Index: compiler/stratify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/stratify.m,v
retrieving revision 1.15
diff -u -r1.15 stratify.m
--- stratify.m 1998/02/12 01:17:48 1.15
+++ stratify.m 1998/03/11 04:50:20
@@ -155,6 +155,10 @@
ThisPredProcId, Error, Module0, Module) -->
first_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
Error, Module0, Module).
+first_order_check_goal(par_conj(Goals, _SM), _GoalInfo, Negated, WholeScc,
+ ThisPredProcId, Error, Module0, Module) -->
+ first_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ Error, Module0, Module).
first_order_check_goal(disj(Goals, _Follow), _GoalInfo, Negated,
WholeScc, ThisPredProcId, Error, Module0, Module) -->
first_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
@@ -339,6 +343,10 @@
ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
higher_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
HighOrderLoops, Error, Module0, Module).
+higher_order_check_goal(par_conj(Goals, _), _GoalInfo, Negated, WholeScc,
+ ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
+ higher_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
+ HighOrderLoops, Error, Module0, Module).
higher_order_check_goal(disj(Goals, _Follow), _GoalInfo, Negated, WholeScc,
ThisPredProcId, HighOrderLoops, Error, Module0, Module) -->
higher_order_check_goal_list(Goals, Negated, WholeScc, ThisPredProcId,
@@ -843,6 +851,9 @@
check_goal1(conj(Goals), Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO) :-
check_goal_list(Goals, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
+check_goal1(par_conj(Goals, _), Calls0, Calls, HasAT0, HasAT,
+ CallsHO0, CallsHO) :-
+ check_goal_list(Goals, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
check_goal1(disj(Goals, _Follow), Calls0, Calls, HasAT0, HasAT, CallsHO0,
CallsHO) :-
check_goal_list(Goals, Calls0, Calls, HasAT0, HasAT, CallsHO0, CallsHO).
@@ -938,6 +949,8 @@
Calls, Calls).
get_called_procs(conj(Goals), Calls0, Calls) :-
+ check_goal_list(Goals, Calls0, Calls).
+get_called_procs(par_conj(Goals, _), Calls0, Calls) :-
check_goal_list(Goals, Calls0, Calls).
get_called_procs(disj(Goals, _Follow), Calls0, Calls) :-
check_goal_list(Goals, Calls0, Calls).
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/switch_detection.m,v
retrieving revision 1.80
diff -u -r1.80 switch_detection.m
--- switch_detection.m 1998/02/12 01:17:49 1.80
+++ switch_detection.m 1998/03/11 04:50:20
@@ -147,6 +147,11 @@
VarTypes, ModuleInfo, conj(Goals)) :-
detect_switches_in_conj(Goals0, InstMap0, VarTypes, ModuleInfo, Goals).
+detect_switches_in_goal_2(par_conj(Goals0, SM), _GoalInfo, InstMap0,
+ VarTypes, ModuleInfo, par_conj(Goals, SM)) :-
+ detect_switches_in_par_conj(Goals0, InstMap0, VarTypes,
+ ModuleInfo, Goals).
+
detect_switches_in_goal_2(not(Goal0), _GoalInfo, InstMap0,
VarTypes, ModuleInfo, not(Goal)) :-
detect_switches_in_goal(Goal0, InstMap0, VarTypes, ModuleInfo, Goal).
@@ -325,6 +330,17 @@
detect_switches_in_goal(Goal0, InstMap, VarTypes, ModuleInfo, Goal),
Case = case(Functor, Goal),
detect_switches_in_cases(Cases0, InstMap, VarTypes, ModuleInfo, Cases).
+
+:- pred detect_switches_in_par_conj(list(hlds_goal), instmap, map(var, type),
+ module_info, list(hlds_goal)).
+:- mode detect_switches_in_par_conj(in, in, in, in, out) is det.
+
+detect_switches_in_par_conj([], _InstMap, _VarTypes, _ModuleInfo, []).
+detect_switches_in_par_conj([Goal0 | Goals0], InstMap, VarTypes, ModuleInfo,
+ [Goal | Goals]) :-
+ detect_switches_in_goal(Goal0, InstMap, VarTypes, ModuleInfo, Goal),
+ detect_switches_in_par_conj(Goals0, InstMap, VarTypes,
+ ModuleInfo, Goals).
:- pred detect_switches_in_conj(list(hlds_goal), instmap, map(var, type),
module_info, list(hlds_goal)).
Index: compiler/term_traversal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/term_traversal.m,v
retrieving revision 1.4
diff -u -r1.4 term_traversal.m
--- term_traversal.m 1998/03/03 17:36:15 1.4
+++ term_traversal.m 1998/03/11 04:51:02
@@ -159,6 +159,10 @@
list__reverse(Goals, RevGoals),
traverse_conj(RevGoals, Params, Info0, Info).
+traverse_goal_2(par_conj(Goals, _SM), _, Params, Info0, Info) :-
+ list__reverse(Goals, RevGoals),
+ traverse_conj(RevGoals, Params, Info0, Info).
+
traverse_goal_2(switch(_, _, Cases, _), _, Params, Info0, Info) :-
traverse_switch(Cases, Params, Info0, Info).
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.232
diff -u -r1.232 typecheck.m
--- typecheck.m 1998/03/03 17:36:25 1.232
+++ typecheck.m 1998/03/11 04:50:22
@@ -724,6 +724,9 @@
typecheck_goal_2(conj(List0), conj(List)) -->
checkpoint("conj"),
typecheck_goal_list(List0, List).
+typecheck_goal_2(par_conj(List0, SM), par_conj(List, SM)) -->
+ checkpoint("par_conj"),
+ typecheck_goal_list(List0, List).
typecheck_goal_2(disj(List0, SM), disj(List, SM)) -->
checkpoint("disj"),
typecheck_goal_list(List0, List).
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unique_modes.m,v
retrieving revision 1.46
diff -u -r1.46 unique_modes.m
--- unique_modes.m 1998/03/03 17:36:30 1.46
+++ unique_modes.m 1998/03/11 04:50:23
@@ -255,6 +255,16 @@
),
mode_checkpoint(exit, "conj").
+unique_modes__check_goal_2(par_conj(List0, SM), GoalInfo0,
+ par_conj(List, SM)) -->
+ mode_checkpoint(enter, "par_conj"),
+ { goal_info_get_nonlocals(GoalInfo0, NonLocals) },
+ mode_info_add_live_vars(NonLocals),
+ unique_modes__check_par_conj(List0, List, InstMapList),
+ instmap__unify(NonLocals, InstMapList),
+ mode_info_remove_live_vars(NonLocals),
+ mode_checkpoint(exit, "par_conj").
+
unique_modes__check_goal_2(disj(List0, SM), GoalInfo0, disj(List, SM)) -->
mode_checkpoint(enter, "disj"),
( { List0 = [] } ->
@@ -561,6 +571,28 @@
mode_info_remove_live_vars(NonLocals),
unique_modes__check_goal(Goal0, Goal),
unique_modes__check_conj(Goals0, Goals).
+
+%-----------------------------------------------------------------------------%
+
+:- pred unique_modes__check_par_conj(list(hlds_goal), list(hlds_goal),
+ list(pair(instmap, set(var))), mode_info, mode_info).
+:- mode unique_modes__check_par_conj(in, out, out,
+ mode_info_di, mode_info_uo) is det.
+
+ % Just process each conjunct in turn.
+ % Because we have already done modechecking, we know that
+ % there are no attempts to bind a variable in multiple
+ % parallel conjuncts, so we don't need to lock/unlock variables.
+
+unique_modes__check_par_conj([], [], []) --> [].
+unique_modes__check_par_conj([Goal0 | Goals0], [Goal | Goals],
+ [InstMap - NonLocals|InstMaps]) -->
+ { unique_modes__goal_get_nonlocals(Goal0, NonLocals) },
+ mode_info_dcg_get_instmap(InstMap0),
+ unique_modes__check_goal(Goal0, Goal),
+ mode_info_dcg_get_instmap(InstMap),
+ mode_info_set_instmap(InstMap0),
+ unique_modes__check_par_conj(Goals0, Goals, InstMaps).
%-----------------------------------------------------------------------------%
Index: compiler/unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.46
diff -u -r1.46 unused_args.m
--- unused_args.m 1998/03/03 17:36:32 1.46
+++ unused_args.m 1998/03/11 04:50:23
@@ -404,6 +404,10 @@
traverse_goal(ModuleInfo, conj(Goals), UseInf0, UseInf) :-
traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
+% handle parallel conjunction
+traverse_goal(ModuleInfo, par_conj(Goals, _SM), UseInf0, UseInf) :-
+ traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
+
% handle disjunction
traverse_goal(ModuleInfo, disj(Goals, _), UseInf0, UseInf) :-
traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf).
@@ -1183,6 +1187,12 @@
fixup_goal_expr(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
conj(Goals0) - GoalInfo, conj(Goals) - GoalInfo) :-
+ fixup_conjuncts(ModuleInfo, UnusedVars, ProcCallInfo, no,
+ Changed, Goals0, Goals).
+
+fixup_goal_expr(ModuleInfo, UnusedVars, ProcCallInfo, Changed,
+ par_conj(Goals0, SM) - GoalInfo,
+ par_conj(Goals, SM) - GoalInfo) :-
fixup_conjuncts(ModuleInfo, UnusedVars, ProcCallInfo, no,
Changed, Goals0, Goals).
Index: compiler/value_number.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/value_number.m,v
retrieving revision 1.90
diff -u -r1.90 value_number.m
--- value_number.m 1998/01/13 10:14:00 1.90
+++ value_number.m 1998/03/11 04:50:24
@@ -1092,6 +1092,10 @@
value_number__boundary_instr(discard_tickets_to(_), no).
value_number__boundary_instr(incr_sp(_, _), yes).
value_number__boundary_instr(decr_sp(_), yes).
+value_number__boundary_instr(init_sync_term(_, _), no).
+value_number__boundary_instr(fork(_, _, _), yes).
+value_number__boundary_instr(join_and_terminate(_), yes).
+value_number__boundary_instr(join_and_continue(_, _), yes).
value_number__boundary_instr(pragma_c(_, _, _, _), yes).
%-----------------------------------------------------------------------------%
Index: compiler/vn_block.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/vn_block.m,v
retrieving revision 1.52
diff -u -r1.52 vn_block.m
--- vn_block.m 1998/01/13 10:14:03 1.52
+++ vn_block.m 1998/03/11 04:50:24
@@ -357,6 +357,22 @@
_Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
SeenIncr, SeenIncr, Tuple, Tuple) :-
error("value numbering not supported for pragma_c").
+vn_block__handle_instr(init_sync_term(_, _),
+ _Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
+ SeenIncr, SeenIncr, Tuple, Tuple) :-
+ error("value numbering not supported for init_sync_term").
+vn_block__handle_instr(fork(_, _, _),
+ _Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
+ SeenIncr, SeenIncr, Tuple, Tuple) :-
+ error("value numbering not supported for fork").
+vn_block__handle_instr(join_and_terminate(_),
+ _Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
+ SeenIncr, SeenIncr, Tuple, Tuple) :-
+ error("value numbering not supported for join_and_terminate").
+vn_block__handle_instr(join_and_continue(_, _),
+ _Livemap, _Params, VnTables, VnTables, Liveset, Liveset,
+ SeenIncr, SeenIncr, Tuple, Tuple) :-
+ error("value numbering not supported for join_and_continue").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -891,6 +907,10 @@
vn_block__is_ctrl_instr(discard_tickets_to(_), yes).
vn_block__is_ctrl_instr(incr_sp(_, _), yes).
vn_block__is_ctrl_instr(decr_sp(_), yes).
+vn_block__is_ctrl_instr(init_sync_term(_, _), no).
+vn_block__is_ctrl_instr(fork(_, _, _), yes).
+vn_block__is_ctrl_instr(join_and_terminate(_), yes).
+vn_block__is_ctrl_instr(join_and_continue(_, _), yes).
vn_block__is_ctrl_instr(pragma_c(_, _, _, _), no).
%-----------------------------------------------------------------------------%
Index: compiler/vn_cost.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/vn_cost.m,v
retrieving revision 1.31
diff -u -r1.31 vn_cost.m
--- vn_cost.m 1998/01/13 10:14:06 1.31
+++ vn_cost.m 1998/03/11 04:50:24
@@ -183,6 +183,18 @@
;
Uinstr = pragma_c(_, _, _, _),
error("pragma_c found in vn_block_cost")
+ ;
+ Uinstr = init_sync_term(_, _),
+ error("init_sync_term found in vn_block_cost")
+ ;
+ Uinstr = fork(_, _, _),
+ error("fork found in vn_block_cost")
+ ;
+ Uinstr = join_and_terminate(_),
+ error("join_and_terminate found in vn_block_cost")
+ ;
+ Uinstr = join_and_continue(_, _),
+ error("join_and_continue found in vn_block_cost")
).
vn_cost__lval_cost(Lval, Params, Cost) :-
Index: compiler/vn_filter.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/vn_filter.m,v
retrieving revision 1.15
diff -u -r1.15 vn_filter.m
--- vn_filter.m 1998/01/13 10:14:09 1.15
+++ vn_filter.m 1998/03/11 04:50:24
@@ -156,6 +156,14 @@
vn_filter__user_instr(decr_sp(_), no).
vn_filter__user_instr(pragma_c(_, _, _, _), _):-
error("inappropriate instruction in vn__filter").
+vn_filter__user_instr(init_sync_term(_, _), _):-
+ error("init_sync_term instruction in vn__filter").
+vn_filter__user_instr(fork(_, _, _), _):-
+ error("fork instruction in vn__filter").
+vn_filter__user_instr(join_and_terminate(_), _):-
+ error("join_and_terminate instruction in vn__filter").
+vn_filter__user_instr(join_and_continue(_, _), _):-
+ error("join_and_continue instruction in vn__filter").
% vn_filter__replace_in_user_instr(Instr0, Old, New, Instr):
% Given that Instr0 refers to the values of some locations,
@@ -218,6 +226,14 @@
error("non-user instruction in vn_filter__replace_in_user_instr").
vn_filter__replace_in_user_instr(pragma_c(_, _, _, _), _, _, _):-
error("inappropriate instruction in vn__filter").
+vn_filter__replace_in_user_instr(init_sync_term(_, _), _, _, _):-
+ error("init_sync_term instruction in vn__filter").
+vn_filter__replace_in_user_instr(fork(_, _, _), _, _, _):-
+ error("fork instruction in vn__filter").
+vn_filter__replace_in_user_instr(join_and_terminate(_), _, _, _):-
+ error("join_and_terminate instruction in vn__filter").
+vn_filter__replace_in_user_instr(join_and_continue(_, _), _, _, _):-
+ error("join_and_continue instruction in vn__filter").
% Check whether this instruction defines the value of any lval.
@@ -250,6 +266,14 @@
vn_filter__defining_instr(decr_sp(_), no).
vn_filter__defining_instr(pragma_c(_, _, _, _), _):-
error("inappropriate instruction in vn__filter").
+vn_filter__defining_instr(init_sync_term(_, _), _):-
+ error("init_sync_term instruction in vn__filter").
+vn_filter__defining_instr(fork(_, _, _), _):-
+ error("fork instruction in vn__filter").
+vn_filter__defining_instr(join_and_terminate(_), _):-
+ error("join_and_terminate instruction in vn__filter").
+vn_filter__defining_instr(join_and_continue(_, _), _):-
+ error("join_and_continue instruction in vn__filter").
% vn_filter__replace_in_defining_instr(Instr0, Old, New, Instr):
% Given that Instr0 defines the value of a location,
@@ -308,6 +332,14 @@
error("non-def instruction in vn_filter__replace_in_defining_instr").
vn_filter__replace_in_defining_instr(decr_sp(_), _, _, _) :-
error("non-def instruction in vn_filter__replace_in_defining_instr").
+vn_filter__replace_in_defining_instr(init_sync_term(_, _), _, _, _):-
+ error("init_sync_term instruction in vn_filter__replace_in_defining_instr").
+vn_filter__replace_in_defining_instr(fork(_, _, _), _, _, _):-
+ error("fork instruction in vn_filter__replace_in_defining_instr").
+vn_filter__replace_in_defining_instr(join_and_terminate(_), _, _, _):-
+ error("join_and_terminate instruction in vn_filter__replace_in_defining_instr").
+vn_filter__replace_in_defining_instr(join_and_continue(_, _), _, _, _):-
+ error("join_and_continue instruction in vn_filter__replace_in_defining_instr").
vn_filter__replace_in_defining_instr(pragma_c(_, _, _, _), _, _, _):-
error("inappropriate instruction in vn__filter").
%-----------------------------------------------------------------------------%
% Copyright (C) 1995 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: par_conj.m:
%
% Main authors: conway.
%
% The predicates of this module generate code for parallel conjunctions.
%
%---------------------------------------------------------------------------%
%
% Notes on parallel conjunction:
%
% A parallel conjunction (A & B) denotes that the goals `A' and `B' should
% be executed concurrently. Ideally, parallel conjunction should have exactly
% the same declarative semantics as normal conjunction; in practice this is
% not quite the case for a couple of reasons:
% - `,'/2 does not quite behave as *logical* conjunction; by default,
% if `--no-reorder-conj' is set, there is an implied ordering
% in the code: conjunctions must not be reordered beyond the
% minimum necessary for mode correctness.
% This is justified for reasons performance modeling and ensuring
% predicatble termination properties.
% Parallel conjunction does not of itself suggest any information
% about which order two goals should be executed, however if
% coroutining (not currently implemented) is being used, then the
% data dependancies between the two goals will constrain the order
% of execution at runtime.
% - `,'/2 has a *sequential* behaviour `A, B' proves `A' *then*
% proves `B'. Mode analysis only allows unidirectional data-
% dependancies for conjunction. In independant and-parallelism,
% for the goal `A & B', mode analysis requires that `A' and `B'
% bind disjoint sets of free variables (or when mode analysis
% supports it properly, disjoint sets of type-nodes), and that
% `A' does not require any bindings made in `B' and vice versa.
% In dependant and-parallelism, mode analysis requires that each
% variable (or type-node) have a unique producer (as in independant
% and-parallelism), but an and-parallel goal may use bindings made
% in conjoined goals which may lead to coroutining.
%
% The current implementation only supports independant and-parallelism.
% The syntax for parallel conjunction is `&'/2 which behaves like `,'/2
% in that sequences get flattened (ie A & (B & C) <=> (A & B) & C).
%
% Type checking works exactly the same for parallel conjunction as it does
% for sequential conjunction.
%
% Mode analysis schedules a parallel conjunction if all the conjuncts can
% be scheduled independantly, and they bind disjoint sets of variables
% (type-nodes). This is done by mode checking each conjunct with the same
% initial instmap and `locking' (as is done for the nonlocal variables of a
% negation[1]) any variables that get bound in that conjunct before
% recursively processing the rest of the parallel conjunction. At the end of
% the conjunction the final instmaps from the conjuncts are merged by unifying
% them. Since the variable `locking' ensures that the variables bound by each
% conjunct are distinct from those bound by the other conjuncts, the
% unification of the instmaps is guarenteed to succeed.
%
% In principal, the determinism of a parallel conjunction is derived from
% its conjuncts in the same way as the determinism of a conjunction but
% because the current runtime implementation only allows model_det parallel
% conjunction, determinism analysis works by inferring the determinism of
% each conjunct and reporting an error if it is not a model_det determinism.
%
% XXX Unique modes
%
% The code generated for a parallel conjunction consists of a piece of
% initialization code which creates a term on the heap to be used for
% controlling the synchronization of the conjuncts and the code for the
% conjuncts each proceeded by a command to start the conjunct as a new
% thead of execution (except the last which executes in the "parent"
% thread), and each succeeded by a command that signals that the execution
% of the conjunct has completed and terminates the thread (except for
% the "parent" thread which suspends till all the other parallel conjuncts
% have terminated, when it will be woken up). The synchronization terms
% are refered to in the code as 'sync_term's.
%
% The runtime support for parallel conjunction is documented in the runtime
% directory in context.mod.
%
%---------------------------------------------------------------------------%
:- module par_conj_gen.
:- interface.
:- import_module hlds_goal, llds, code_info.
:- import_module list.
:- pred par_conj_gen__generate_det_par_conj(list(hlds_goal), hlds_goal_info,
code_tree, code_info, code_info).
:- mode par_conj_gen__generate_det_par_conj(in, in, out, in, out) is det.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module hlds_data, code_gen, code_util, options, globals, prog_data.
:- import_module hlds_module, (inst), instmap, mode_util, code_info.
:- import_module set, term, tree, list, map, std_util, require, int.
%---------------------------------------------------------------------------%
par_conj_gen__generate_det_par_conj(Goals, GoalInfo, Code) -->
code_info__get_globals(Globals),
{ globals__lookup_int_option(Globals, sync_term_size, STSize) },
code_info__get_known_variables(Vars),
code_info__save_variables_on_stack(Vars, SaveCode),
{ goal_info_get_nonlocals(GoalInfo, Nonlocals) },
{ set__to_sorted_list(Nonlocals, Variables) },
code_info__get_instmap(Initial),
{ goal_info_get_instmap_delta(GoalInfo, Delta) },
{ instmap__apply_instmap_delta(Initial, Delta, Final) },
code_info__get_module_info(ModuleInfo),
{ par_conj_gen__find_outputs(Variables, Initial, Final, ModuleInfo,
[], Outputs) },
{ list__length(Goals, NumGoals) },
code_info__acquire_reg(r, RegLval),
code_info__acquire_temp_slot(sync_term, SyncSlot),
code_info__acquire_temp_slot(lval(sp), SpSlot),
{ MakeTerm = node([
assign(SpSlot, lval(sp)) - "save the parent stack pointer",
incr_hp(RegLval, no, const(int_const(STSize)),
"synchronization vector")
- "allocate a synchronization vector",
init_sync_term(RegLval, NumGoals) - "initialize sync term",
assign(SyncSlot, lval(RegLval))
- "store the sync-term on the stack"
]) },
code_info__release_reg(RegLval),
code_info__clear_all_registers,
par_conj_gen__generate_det_par_conj_2(Goals, 0, SyncSlot, SpSlot,
Initial, GoalCode),
code_info__release_temp_slot(SyncSlot),
{ Code = tree(tree(SaveCode, MakeTerm), GoalCode) },
code_info__clear_all_registers,
par_conj_gen__place_all_outputs(Outputs).
:- pred par_conj_gen__generate_det_par_conj_2(list(hlds_goal), int, lval, lval,
instmap, code_tree, code_info, code_info).
:- mode par_conj_gen__generate_det_par_conj_2(in, in, in, in, in,
out, in, out) is det.
par_conj_gen__generate_det_par_conj_2([], _N, _SyncTerm, _SpSlot, _Initial,
empty) --> [].
par_conj_gen__generate_det_par_conj_2([Goal|Goals], N, SyncTerm, SpSlot,
Initial, Code) -->
code_info__grab_code_info(CodeInfo0),
code_info__get_next_label(ThisConjunct),
code_info__get_next_label(NextConjunct),
code_gen__generate_goal(model_det, Goal, ThisGoalCode),
code_info__get_stack_slots(AllSlots),
code_info__get_known_variables(Variables),
{ set__list_to_set(Variables, LiveVars) },
{ map__select(AllSlots, LiveVars, StoreMap) },
code_info__generate_branch_end(model_det, StoreMap, SaveCode),
{ Goal = _GoalExpr - GoalInfo },
{ goal_info_get_instmap_delta(GoalInfo, Delta) },
{ instmap__apply_instmap_delta(Initial, Delta, Final) },
code_info__get_module_info(ModuleInfo),
{ par_conj_gen__find_outputs(Variables, Initial, Final, ModuleInfo,
[], TheseOutputs) },
par_conj_gen__copy_outputs(TheseOutputs, SpSlot, CopyCode),
(
{ Goals = [_|_] }
->
code_info__slap_code_info(CodeInfo0),
code_info__get_total_stackslot_count(NumSlots),
{ ForkCode = node([
fork(ThisConjunct, NextConjunct, NumSlots)
- "fork off a child",
label(ThisConjunct) - "child thread"
]) },
{ JoinCode = node([
join_and_terminate(SyncTerm) - "finish",
label(NextConjunct) - "start of the next conjunct"
]) }
;
code_info__get_next_label(ContLab),
{ ForkCode = empty },
{ JoinCode = node([
join_and_continue(SyncTerm, ContLab)
- "sync with children then continue",
label(ContLab) - "end of parallel conjunction"
]) }
),
{ ThisCode = tree(
ForkCode,
tree(ThisGoalCode, tree(tree(SaveCode, CopyCode), JoinCode))
) },
{ N1 is N + 1 },
par_conj_gen__generate_det_par_conj_2(Goals, N1, SyncTerm, SpSlot,
Initial, RestCode),
{ Code = tree(ThisCode, RestCode) }.
:- pred par_conj_gen__find_outputs(list(var), instmap, instmap, module_info,
list(var), list(var)).
:- mode par_conj_gen__find_outputs(in, in, in, in, in, out) is det.
par_conj_gen__find_outputs([], _Initial, _Final, _ModuleInfo,
Outputs, Outputs).
par_conj_gen__find_outputs([Var|Vars], Initial, Final, ModuleInfo,
Outputs0, Outputs) :-
instmap__lookup_var(Initial, Var, InitialInst),
instmap__lookup_var(Final, Var, FinalInst),
(
mode_is_output(ModuleInfo, (InitialInst -> FinalInst))
->
Outputs1 = [Var|Outputs0]
;
Outputs1 = Outputs0
),
par_conj_gen__find_outputs(Vars, Initial, Final, ModuleInfo,
Outputs1, Outputs).
:- pred par_conj_gen__copy_outputs(list(var), lval, code_tree,
code_info, code_info).
:- mode par_conj_gen__copy_outputs(in, in, out, in, out) is det.
par_conj_gen__copy_outputs([], _, empty) --> [].
par_conj_gen__copy_outputs([Var|Vars], SpSlot, Code) -->
code_info__get_variable_slot(Var, SrcSlot),
(
{ SrcSlot = stackvar(SlotNum) }
->
{ NegSlotNum is (- SlotNum) },
{ DestSlot = field(yes(0), lval(SpSlot),
const(int_const(NegSlotNum))) }
;
{ error("par conj in model non procedure!") }
),
{ ThisCode = node([
assign(DestSlot, lval(SrcSlot))
- "copy result to parent stackframe"
]) },
{ Code = tree(ThisCode, RestCode) },
par_conj_gen__copy_outputs(Vars, SpSlot, RestCode).
:- pred par_conj_gen__place_all_outputs(list(var), code_info, code_info).
:- mode par_conj_gen__place_all_outputs(in, in, out) is det.
par_conj_gen__place_all_outputs([]) --> [].
par_conj_gen__place_all_outputs([Var|Vars]) -->
code_info__variable_locations(VarLocations),
code_info__get_variable_slot(Var, Slot),
(
{ map__search(VarLocations, Var, Locations) },
{ set__member(lval(Slot), Locations) }
->
[]
;
code_info__set_var_location(Var, Slot)
),
par_conj_gen__place_all_outputs(Vars).
More information about the developers
mailing list