for review: Aditi [4]
Simon Taylor
stayl at cs.mu.OZ.AU
Tue Jul 7 13:43:47 AEST 1998
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.14
diff -u -t -u -r1.14 prog_io_pragma.m
--- prog_io_pragma.m 1998/05/15 07:07:32 1.14
+++ prog_io_pragma.m 1998/05/28 02:10:51
@@ -433,10 +433,19 @@
ErrorTerm, _VarSet, Result) :-
parse_tabling_pragma(ModuleName, "memo", eval_memo,
PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "no_memo",
+ PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "no_memo",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = no_memo(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
parse_pragma_type(ModuleName, "loop_check", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
parse_tabling_pragma(ModuleName, "loop_check", eval_loop_check,
PragmaTerms, ErrorTerm, Result).
+
parse_pragma_type(ModuleName, "minimal_model", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
parse_tabling_pragma(ModuleName, "minimal_model", eval_minimal,
@@ -524,6 +533,64 @@
error(
"wrong number of arguments in pragma fact_table(..., ...) declaration",
ErrorTerm)
+ ).
+
+parse_pragma_type(ModuleName, "aditi", PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "aditi",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = aditi(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "base_relation", PragmaTerms,
+ ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "base_relation",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = base_relation(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "naive", PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "naive",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = naive(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "psn", PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "psn",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = psn(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "supp_magic",
+ PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "supp_magic",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = supp_magic(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "context",
+ PragmaTerms, ErrorTerm, _, Result) :-
+ parse_simple_pragma(ModuleName, "context",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = context(Name, Arity)),
+ PragmaTerms, ErrorTerm, Result).
+
+parse_pragma_type(ModuleName, "owner",
+ PragmaTerms, ErrorTerm, _, Result) :-
+ ( PragmaTerms = [SymNameAndArityTerm, OwnerTerm] ->
+ ( OwnerTerm = term__functor(term__atom(Owner), [], _) ->
+ parse_simple_pragma(ModuleName, "owner",
+ lambda([Name::in, Arity::in, Pragma::out] is det,
+ Pragma = owner(Name, Arity, Owner)),
+ [SymNameAndArityTerm], ErrorTerm, Result)
+ ;
+ string__append_list(["expected owner name for
+ `pragma owner(...)' declaration"], ErrorMsg),
+ Result = error(ErrorMsg, OwnerTerm)
+ )
+ ;
+ string__append_list(["wrong number of arguments in
+ `pragma owner(...)' declaration"], ErrorMsg),
+ Result = error(ErrorMsg, ErrorTerm)
).
parse_pragma_type(ModuleName, "promise_pure", PragmaTerms,
Index: compiler/prog_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/prog_out.m,v
retrieving revision 1.38
diff -u -t -u -r1.38 prog_out.m
--- prog_out.m 1998/03/05 05:24:47 1.38
+++ prog_out.m 1998/03/20 03:42:51
@@ -57,6 +57,10 @@
:- pred prog_out__write_module_list(list(module_name), io__state, io__state).
:- mode prog_out__write_module_list(in, di, uo) is det.
+:- pred prog_out__write_list(list(T), pred(T, io__state, io__state),
+ io__state, io__state).
+:- mode prog_out__write_list(in, pred(in, di, uo) is det, di, uo) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -195,22 +199,27 @@
%-----------------------------------------------------------------------------%
-prog_out__write_module_list([Import1, Import2, Import3 | Imports]) -->
- io__write_string("`"),
- prog_out__write_sym_name(Import1),
- io__write_string("', "),
- write_module_list([Import2, Import3 | Imports]).
-prog_out__write_module_list([Import1, Import2]) -->
- io__write_string("`"),
- prog_out__write_sym_name(Import1),
- io__write_string("' and `"),
- prog_out__write_sym_name(Import2),
- io__write_string("'").
-prog_out__write_module_list([Import]) -->
+prog_out__write_module_list(Modules) -->
+ prog_out__write_list(Modules, write_module).
+
+:- pred write_module(module_name::in, io__state::di, io__state::uo) is det.
+
+write_module(Module) -->
io__write_string("`"),
- prog_out__write_sym_name(Import),
+ prog_out__write_sym_name(Module),
io__write_string("'").
-prog_out__write_module_list([]) -->
+
+prog_out__write_list([Import1, Import2, Import3 | Imports], Writer) -->
+ call(Writer, Import1),
+ io__write_string(", "),
+ prog_out__write_list([Import2, Import3 | Imports], Writer).
+prog_out__write_list([Import1, Import2], Writer) -->
+ call(Writer, Import1),
+ io__write_string(" and "),
+ call(Writer, Import2).
+prog_out__write_list([Import], Writer) -->
+ call(Writer, Import).
+prog_out__write_list([], _) -->
{ error("prog_out__write_module_list") }.
%-----------------------------------------------------------------------------%
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.61
diff -u -t -u -r1.61 simplify.m
--- simplify.m 1998/06/17 05:13:53 1.61
+++ simplify.m 1998/06/29 06:00:56
@@ -40,6 +40,10 @@
module_info, module_info, proc_info, proc_info, io__state, io__state).
:- mode simplify__proc(in, in, in, in, out, in, out, di, uo) is det.
+:- pred simplify__proc_2(list(simplification), pred_id, proc_id, module_info,
+ module_info, proc_info, proc_info, set(det_msg)).
+:- mode simplify__proc_2(in, in, in, in, out, in, out, out) is det.
+
:- pred simplify__process_goal(hlds_goal, hlds_goal,
simplify_info, simplify_info).
:- mode simplify__process_goal(in, out, in, out) is det.
@@ -93,8 +97,8 @@
;
Simplifications = Simplifications0
},
- simplify__procs(Simplifications, PredId, ProcIds, ModuleInfo0,
- ModuleInfo, PredInfo0, PredInfo, MaybeMsgs0, MaybeMsgs),
+ { simplify__procs(Simplifications, PredId, ProcIds, ModuleInfo0,
+ ModuleInfo, PredInfo0, PredInfo, MaybeMsgs0, MaybeMsgs) },
( { MaybeMsgs = yes(Msgs0 - Msgs1) } ->
{ set__union(Msgs0, Msgs1, Msgs2) },
{ set__to_sorted_list(Msgs2, Msgs) },
@@ -106,53 +110,45 @@
:- pred simplify__procs(list(simplification), pred_id, list(proc_id),
module_info, module_info, pred_info, pred_info,
- maybe(pair(set(det_msg))), maybe(pair(set(det_msg))),
- io__state, io__state).
+ maybe(pair(set(det_msg))), maybe(pair(set(det_msg)))).
:- mode simplify__procs(in, in, in, in, out, in, out,
- in, out, di, uo) is det.
+ in, out) is det.
simplify__procs(_, _, [], ModuleInfo, ModuleInfo, PredInfo, PredInfo,
- Msgs, Msgs) --> [].
+ Msgs, Msgs).
simplify__procs(Simplifications, PredId, [ProcId | ProcIds], ModuleInfo0,
- ModuleInfo, PredInfo0, PredInfo, MaybeMsgs0, MaybeMsgs) -->
- { pred_info_procedures(PredInfo0, Procs0) },
- { map__lookup(Procs0, ProcId, Proc0) },
+ ModuleInfo, PredInfo0, PredInfo, MaybeMsgs0, MaybeMsgs) :-
+ pred_info_procedures(PredInfo0, Procs0),
+ map__lookup(Procs0, ProcId, Proc0),
simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0,
- ModuleInfo1, Proc0, Proc, Msgs1),
- { map__det_update(Procs0, ProcId, Proc, Procs) },
- { pred_info_set_procedures(PredInfo0, Procs, PredInfo1) },
- { set__to_sorted_list(Msgs1, Msgs2) },
- { list__filter(lambda([Msg::in] is semidet,
+ ModuleInfo1, Proc0, Proc, Msgs1),
+ map__det_update(Procs0, ProcId, Proc, Procs),
+ pred_info_set_procedures(PredInfo0, Procs, PredInfo1),
+ set__to_sorted_list(Msgs1, Msgs2),
+ list__filter(lambda([Msg::in] is semidet,
det_msg_is_any_mode_msg(Msg, any_mode)),
- Msgs2, AnyModeMsgs1, AllModeMsgs1) },
- { set__sorted_list_to_set(AnyModeMsgs1, AnyModeMsgs2) },
- { set__sorted_list_to_set(AllModeMsgs1, AllModeMsgs2) },
- { MaybeMsgs0 = yes(AnyModeMsgs0 - AllModeMsgs0) ->
+ Msgs2, AnyModeMsgs1, AllModeMsgs1),
+ set__sorted_list_to_set(AnyModeMsgs1, AnyModeMsgs2),
+ set__sorted_list_to_set(AllModeMsgs1, AllModeMsgs2),
+ ( MaybeMsgs0 = yes(AnyModeMsgs0 - AllModeMsgs0) ->
set__union(AnyModeMsgs0, AnyModeMsgs2, AnyModeMsgs),
set__intersect(AllModeMsgs0, AllModeMsgs2, AllModeMsgs),
MaybeMsgs1 = yes(AllModeMsgs - AnyModeMsgs)
;
MaybeMsgs1 = yes(AnyModeMsgs2 - AllModeMsgs2)
- },
+ ),
simplify__procs(Simplifications, PredId, ProcIds, ModuleInfo1,
ModuleInfo, PredInfo1, PredInfo, MaybeMsgs1, MaybeMsgs).
simplify__proc(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo,
Proc0, Proc) -->
write_pred_progress_message("% Simplifying ", PredId, ModuleInfo0),
- simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0,
- ModuleInfo, Proc0, Proc, _).
-
-:- pred simplify__proc_2(list(simplification), pred_id, proc_id, module_info,
- module_info, proc_info, proc_info, set(det_msg),
- io__state, io__state).
-:- mode simplify__proc_2(in, in, in, in, out, in, out,
- out, di, uo) is det.
+ { simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0,
+ ModuleInfo, Proc0, Proc, _) }.
simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo,
- ProcInfo0, ProcInfo, Msgs, State0, State) :-
-
- globals__io_get_globals(Globals, State0, State),
+ ProcInfo0, ProcInfo, Msgs) :-
+ module_info_globals(ModuleInfo0, Globals),
det_info_init(ModuleInfo0, PredId, ProcId, Globals, DetInfo0),
proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0),
proc_info_varset(ProcInfo0, VarSet0),
@@ -616,7 +612,7 @@
%
simplify_info_get_module_info(Info1, ModuleInfo1),
module_info_pred_proc_info(ModuleInfo1, PredId, ProcId,
- _PredInfo1, ProcInfo1),
+ PredInfo1, ProcInfo1),
proc_info_headvars(ProcInfo1, HeadVars),
proc_info_argmodes(ProcInfo1, ArgModes),
simplify_info_get_common_info(Info1, CommonInfo1),
@@ -628,7 +624,10 @@
% should always terminate if they have a finite number
% of answers.
%
- \+ proc_info_eval_method(ProcInfo, eval_minimal)
+ \+ proc_info_eval_method(ProcInfo, eval_minimal),
+
+ % Don't warn about Aditi relations.
+ \+ hlds_pred__pred_info_is_aditi_relation(PredInfo1)
->
goal_info_get_context(GoalInfo0, Context2),
simplify_info_add_msg(Info1, warn_infinite_recursion(Context2),
Index: compiler/term_errors.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/term_errors.m,v
retrieving revision 1.12
diff -u -t -u -r1.12 term_errors.m
--- term_errors.m 1998/05/21 16:51:48 1.12
+++ term_errors.m 1998/06/19 06:05:32
@@ -144,16 +144,13 @@
{ get_context_from_scc(SCC, Module, Context) },
( { SCC = [PPId] } ->
{ Pieces0 = [words("Termination of")] },
- { term_errors__describe_one_proc_name(PPId, Module, PredName) },
+ { error_util__describe_one_proc_name(Module, PPId, PredName) },
{ list__append(Pieces0, [fixed(PredName)], Pieces1) },
{ Single = yes(PPId) }
;
{ Pieces0 = [words("Termination of the mutually recursive procedures")] },
- { term_errors__describe_several_proc_names(SCC, Module, Context,
- ProcNames) },
- { list__map(lambda([PN::in, FPN::out] is det,
- (FPN = fixed(PN))),
- ProcNames, ProcNamePieces) },
+ { error_util__describe_several_proc_names(Module, SCC,
+ ProcNamePieces) },
{ list__append(Pieces0, ProcNamePieces, Pieces1) },
{ Single = no }
),
@@ -187,17 +184,14 @@
{ get_context_from_scc(SCC, Module, Context) },
( { SCC = [PPId] } ->
{ Pieces0 = [words("Termination constant of")] },
- { term_errors__describe_one_proc_name(PPId, Module, ProcName) },
+ { error_util__describe_one_proc_name(Module, PPId, ProcName) },
{ list__append(Pieces0, [fixed(ProcName)], Pieces1) },
{ Single = yes(PPId) }
;
{ Pieces0 = [words("Termination constants"),
words("of the mutually recursive procedures")] },
- { term_errors__describe_several_proc_names(SCC, Module,
- Context, ProcNames) },
- { list__map(lambda([PN::in, FPN::out] is det,
- (FPN = fixed(PN))),
- ProcNames, ProcNamePieces) },
+ { error_util__describe_several_proc_names(Module, SCC,
+ ProcNamePieces) },
{ list__append(Pieces0, ProcNamePieces, Pieces1) },
{ Single = no }
),
@@ -279,12 +273,12 @@
Piece1 = words("It")
;
Single = no,
- term_errors__describe_one_proc_name(CallerPPId, Module,
+ error_util__describe_one_proc_name(Module, CallerPPId,
ProcName),
Piece1 = fixed(ProcName)
),
Piece2 = words("calls"),
- term_errors__describe_one_proc_name(CalleePPId, Module, CalleePiece),
+ error_util__describe_one_proc_name(Module, CalleePPId, CalleePiece),
Pieces3 = [words("with an unbounded increase"),
words("in the size of the input arguments.")],
Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
@@ -297,12 +291,12 @@
Piece1 = words("It")
;
Single = no,
- term_errors__describe_one_proc_name(CallerPPId, Module,
+ error_util__describe_one_proc_name(Module, CallerPPId,
ProcName),
Piece1 = fixed(ProcName)
),
Piece2 = words("calls"),
- term_errors__describe_one_proc_name(CalleePPId, Module, CalleePiece),
+ error_util__describe_one_proc_name(Module, CalleePPId, CalleePiece),
Pieces3 = [words("which could not be proven to terminate.")],
Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
@@ -319,12 +313,12 @@
Piece1 = words("It")
;
Single = no,
- term_errors__describe_one_proc_name(CallerPPId, Module,
+ error_util__describe_one_proc_name(Module, CallerPPId,
ProcName),
Piece1 = fixed(ProcName)
),
Piece2 = words("calls"),
- term_errors__describe_one_proc_name(CalleePPId, Module, CalleePiece),
+ error_util__describe_one_proc_name(Module, CalleePPId, CalleePiece),
Pieces3 = [words("with one or more higher order arguments.")],
Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
@@ -336,12 +330,12 @@
Piece1 = words("It")
;
Single = no,
- term_errors__describe_one_proc_name(CallerPPId, Module,
+ error_util__describe_one_proc_name(Module, CallerPPId,
ProcName),
Piece1 = fixed(ProcName)
),
Piece2 = words("calls"),
- term_errors__describe_one_proc_name(CalleePPId, Module, CalleePiece),
+ error_util__describe_one_proc_name(Module, CalleePPId, CalleePiece),
Pieces3 = [words("which has a termination constant of infinity.")],
Pieces = [Piece1, Piece2, fixed(CalleePiece) | Pieces3].
@@ -355,7 +349,7 @@
;
% XXX this should never happen (but it does)
% error("not_subset outside this SCC"),
- term_errors__describe_one_proc_name(ProcPPId, Module,
+ error_util__describe_one_proc_name(Module, ProcPPId,
PPIdPiece),
Pieces1 = [words("The set of"),
words("output supplier variables of"),
@@ -363,7 +357,7 @@
)
;
Single = no,
- term_errors__describe_one_proc_name(ProcPPId, Module,
+ error_util__describe_one_proc_name(Module, ProcPPId,
PPIdPiece),
Pieces1 = [words("The set of output supplier variables of"),
fixed(PPIdPiece)]
@@ -384,7 +378,7 @@
term_errors__description(cycle(_StartPPId, CallSites), _, Module, Pieces, no) :-
( CallSites = [DirectCall] ->
- term_errors__describe_one_call_site(DirectCall, Module, Site),
+ error_util__describe_one_call_site(Module, DirectCall, Site),
Pieces = [words("At the recursive call to"),
fixed(Site),
words("the arguments are"),
@@ -392,10 +386,8 @@
;
Pieces1 = [words("In the recursive cycle"),
words("through the calls to")],
- term_errors__describe_several_call_sites(CallSites, Module,
- Sites),
- list__map(lambda([S::in, FS::out] is det, (FS = fixed(S))),
- Sites, SitePieces),
+ error_util__describe_several_call_sites(Module, CallSites,
+ SitePieces),
Pieces2 = [words("the arguments are"),
words("not guaranteed to decrease in size.")],
list__condense([Pieces1, SitePieces, Pieces2], Pieces)
@@ -427,7 +419,7 @@
Piece2 = words("It")
;
Single = no,
- term_errors__describe_one_pred_name(PredId, Module,
+ error_util__describe_one_pred_name(Module, PredId,
Piece2Nodot),
string__append(Piece2Nodot, ".", Piece2Str),
Piece2 = fixed(Piece2Str)
@@ -473,105 +465,4 @@
).
%----------------------------------------------------------------------------%
-
-:- pred term_errors__describe_one_pred_name(pred_id::in, module_info::in,
- string::out) is det.
-
- % The code of this predicate duplicates the functionality of
- % hlds_out__write_pred_id. Changes here should be made there as well.
-
-term_errors__describe_one_pred_name(PredId, Module, Piece) :-
- module_info_pred_info(Module, PredId, PredInfo),
- pred_info_module(PredInfo, ModuleName),
- prog_out__sym_name_to_string(ModuleName, ModuleNameString),
- pred_info_name(PredInfo, PredName),
- pred_info_arity(PredInfo, Arity),
- pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
- (
- PredOrFunc = predicate,
- PredOrFuncPart = "predicate ",
- OrigArity = Arity
- ;
- PredOrFunc = function,
- PredOrFuncPart = "function ",
- OrigArity is Arity - 1
- ),
- string__int_to_string(OrigArity, ArityPart),
- string__append_list([
- PredOrFuncPart,
- ModuleNameString,
- ":",
- PredName,
- "/",
- ArityPart
- ], Piece).
-
-:- pred term_errors__describe_one_proc_name(pred_proc_id::in, module_info::in,
- string::out) is det.
-
-term_errors__describe_one_proc_name(proc(PredId, ProcId), Module, Piece) :-
- term_errors__describe_one_pred_name(PredId, Module, PredPiece),
- proc_id_to_int(ProcId, ProcIdInt),
- string__int_to_string(ProcIdInt, ProcIdPart),
- string__append_list([
- PredPiece,
- " mode ",
- ProcIdPart
- ], Piece).
-
-:- pred term_errors__describe_several_proc_names(list(pred_proc_id)::in,
- module_info::in, term__context::in, list(string)::out) is det.
-
-term_errors__describe_several_proc_names([], _, _, []).
-term_errors__describe_several_proc_names([PPId | PPIds], Module,
- Context, Pieces) :-
- term_errors__describe_one_proc_name(PPId, Module, Piece0),
- ( PPIds = [] ->
- Pieces = [Piece0]
- ; PPIds = [LastPPId] ->
- term_errors__describe_one_proc_name(LastPPId, Module,
- LastPiece),
- Pieces = [Piece0, "and", LastPiece]
- ;
- string__append(Piece0, ",", Piece),
- term_errors__describe_several_proc_names(PPIds, Module,
- Context, Pieces1),
- Pieces = [Piece | Pieces1]
- ).
-
-:- pred term_errors__describe_one_call_site(pair(pred_proc_id,
- term__context)::in, module_info::in, string::out) is det.
-
-term_errors__describe_one_call_site(PPId - Context, Module, Piece) :-
- term_errors__describe_one_proc_name(PPId, Module, ProcName),
- term__context_file(Context, FileName),
- term__context_line(Context, LineNumber),
- string__int_to_string(LineNumber, LineNumberPart),
- string__append_list([
- ProcName,
- " at ",
- FileName,
- ":",
- LineNumberPart
- ], Piece).
-
-:- pred term_errors__describe_several_call_sites(assoc_list(pred_proc_id,
- term__context)::in, module_info::in, list(string)::out) is det.
-
-term_errors__describe_several_call_sites([], _, []).
-term_errors__describe_several_call_sites([Site | Sites], Module, Pieces) :-
- term_errors__describe_one_call_site(Site, Module, Piece0),
- ( Sites = [] ->
- Pieces = [Piece0]
- ; Sites = [LastSite] ->
- term_errors__describe_one_call_site(LastSite, Module,
- LastPiece),
- Pieces = [Piece0, "and", LastPiece]
- ;
- string__append(Piece0, ",", Piece),
- term_errors__describe_several_call_sites(Sites, Module,
- Pieces1),
- Pieces = [Piece | Pieces1]
- ).
-
%----------------------------------------------------------------------------%
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.55
diff -u -t -u -r1.55 type_util.m
--- type_util.m 1998/06/23 05:42:14 1.55
+++ type_util.m 1998/06/29 00:46:26
@@ -43,6 +43,9 @@
:- pred type_id_is_higher_order(type_id, pred_or_func).
:- mode type_id_is_higher_order(in, out) is semidet.
+:- pred type_is_aditi_state(type).
+:- mode type_is_aditi_state(in) is semidet.
+
% Given a type, determine what sort of type it is.
:- pred classify_type(type, module_info, builtin_type).
@@ -276,6 +279,10 @@
Arity = 2,
PredOrFunc = function
).
+
+type_is_aditi_state(Type) :-
+ type_to_type_id(Type,
+ qualified(unqualified("aditi"), "state") - 0, []).
:- pred type_is_enumeration(type, module_info).
:- mode type_is_enumeration(in, in) is semidet.
Index: compiler/unused_args.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/unused_args.m,v
retrieving revision 1.51
diff -u -t -u -r1.51 unused_args.m
--- unused_args.m 1998/06/27 08:42:10 1.51
+++ unused_args.m 1998/06/29 00:46:28
@@ -963,12 +963,14 @@
pred_info_get_markers(PredInfo0, Markers),
pred_info_get_goal_type(PredInfo0, GoalType),
pred_info_get_class_context(PredInfo0, ClassContext),
+ pred_info_get_aditi_owner(PredInfo0, Owner),
map__init(EmptyProofs),
% *** This will need to be fixed when the condition
% field of the pred_info becomes used.
pred_info_init(PredModule, qualified(PredModule, Name), Arity, Tvars,
ArgTypes, true, Context, ClausesInfo, Status, Markers,
- GoalType, PredOrFunc, ClassContext, EmptyProofs, PredInfo1),
+ GoalType, PredOrFunc, ClassContext, EmptyProofs, Owner,
+ PredInfo1),
pred_info_set_typevarset(PredInfo1, TypeVars, PredInfo).
@@ -1007,9 +1009,9 @@
proc_call_info::in, proc_call_info::out,
module_info::in, module_info::out) is det.
- make_imported_unused_args_pred_infos([], ProcCallInfo, ProcCallInfo,
+make_imported_unused_args_pred_infos([], ProcCallInfo, ProcCallInfo,
ModuleInfo, ModuleInfo).
- make_imported_unused_args_pred_infos([OptProc | OptProcs],
+make_imported_unused_args_pred_infos([OptProc | OptProcs],
ProcCallInfo0, ProcCallInfo, ModuleInfo0, ModuleInfo) :-
module_info_unused_arg_info(ModuleInfo0, UnusedArgInfo),
map__lookup(UnusedArgInfo, OptProc, UnusedArgs),
@@ -1485,7 +1487,6 @@
)
;
{ WarnedPredIds1 = WarnedPredIds0 }
-
),
output_warnings_and_pragmas(ModuleInfo, UnusedArgInfo,
WriteOptPragmas, DoWarn, Rest, WarnedPredIds1).
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.20
diff -u -t -u -r1.20 compiler_design.html
--- compiler_design.html 1998/06/04 17:26:23 1.20
+++ compiler_design.html 1998/06/25 03:05:11
@@ -32,12 +32,12 @@
stages:
<ol>
-<li> parsing (source files -> HLDS)
-<li> semantic analysis and error checking (HLDS -> annotated HLDS)
-<li> high-level transformations (annotated HLDS -> annotated HLDS)
-<li> code generation (annotated HLDS -> LLDS)
-<li> low-level optimizations (LLDS -> LLDS)
-<li> output C code (LLDS -> C)
+<li> parsing (source files -> HLDS)
+<li> semantic analysis and error checking (HLDS -> annotated HLDS)
+<li> high-level transformations (annotated HLDS -> annotated HLDS)
+<li> code generation (annotated HLDS -> LLDS or RL)
+<li> low-level optimizations (LLDS -> LLDS or RL -> RL)
+<li> output code (LLDS -> C or RL -> bytecode)
</ol>
<p>
@@ -452,7 +452,7 @@
<li> issue warnings about unused arguments from predicates, and create
specialized versions without them (unused_args.m); type_infos are
- often unused
+ often unused.
<li> elimination of dead procedures (dead_proc_elim.m). Inlining, higher-order
specialization and the elimination of unused args can make procedures dead
@@ -462,6 +462,14 @@
<li> elimination of useless assignments, assignments that merely introduce
another name for an already existing variable (excess.m).
+<li> supplementary magic sets or supplementary context transformation of
+ Aditi procedures (magic.m, magic_util.m, context.m).
+ The magic sets or context transformations must be applied to convert the
+ program to a form for which Aditi-RL bytecode can be generated. These
+ transformations are defined for predicates whose definitions are in
+ disjunctive normal form. The module dnf.m translates definitions into DNF,
+ introducing auxiliary predicates as necessary.
+
<li> reducing the number of variables that have to be saved across
procedure calls (saved_vars.m). We do this by putting the code that
generates the value of a variable just before the use of that variable,
@@ -478,14 +486,6 @@
<p>
-Eventually we plan to make Mercury the programming language of the Aditi
-deductive database system. When this happens, we will need to be able to
-apply the magic set transformation, which is defined for predicates
-whose definitions are disjunctive normal form. The module dnf.m translates
-definitions into DNF, introducing auxiliary predicates as necessary.
-
-<p>
-
<h3> 4. Code generation </h3>
<p>
@@ -736,6 +736,47 @@
<li> Final generation of C code is done in llds_out.m.
</ul>
+
+<p>
+
+<h3> 7. Aditi-RL generation </h3>
+
+<ul>
+<li> rl.m contains the definition of the representation of Aditi-RL
+ used within the Mercury compiler. There are some slight differences
+ between rl.m and Aditi-RL to make optimization easier.
+
+<li> rl_dump.m writes the RL type defined in rl.m to <module>.rl_dump.
+
+<li> rl_gen.m converts HLDS to RL.
+ <ul>
+ <li> rl_exprn.m converts top down Mercury code to bytecode.
+ <li> rl_info.m defines a state type.
+ </ul>
+
+<li> rl_code.m contains the definition of the bytecodes interpreted
+ by Aditi.
+
+<li> rl_out.m converts from the instructions defined in rl.m
+ to bytecode either as character data in the <module>.c file or
+ to <module>.rlo and outputs a text representation to
+ <module>.rla.
+
+<li> rl_file.m contains routines to output the bytecodes defined in rl_code.m.
+</ul>
+
+<h3> 8. Aditi-RL optimization </h3>
+
+<ul>
+<li> rl_block.m converts an RL procedure into basic blocks, and performs
+ other tasks such as detecting the loops in those basic blocks.
+
+<li> rl_analyse.m contains a generic data-flow analysis procedure for
+ RL procedures.
+
+<li> rl_liveness.m uses rl_analyse.m to insert code to initialise relations
+ and clear references to them when they are no longer needed.
+</ul>
<hr>
<!-------------------------->
Index: library/eqvclass.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/eqvclass.m,v
retrieving revision 1.8
diff -u -t -u -r1.8 eqvclass.m
--- eqvclass.m 1998/01/23 12:33:15 1.8
+++ eqvclass.m 1998/02/06 00:07:49
@@ -61,6 +61,11 @@
:- pred eqvclass__same_eqvclass(eqvclass(T), T, T).
:- mode eqvclass__same_eqvclass(in, in, in) is semidet.
+ % Test if a list of elements are equivalent.
+
+:- pred eqvclass__same_eqvclass_list(eqvclass(T), list(T)).
+:- mode eqvclass__same_eqvclass_list(in, in) is semidet.
+
% Return the set of the partitions of the equivalence class.
:- pred eqvclass__partition_set(eqvclass(T), set(set(T))).
@@ -188,6 +193,21 @@
map__search(ElementMap0, Element1, Id1),
map__search(ElementMap0, Element2, Id2),
Id1 = Id2.
+
+eqvclass__same_eqvclass_list(_, []).
+eqvclass__same_eqvclass_list(EqvClass, [Element | Elements]) :-
+ EqvClass = eqvclass(_NextId, _PartitionMap, ElementMap),
+ map__search(ElementMap, Element, Id),
+ eqvclass__same_eqvclass_list_2(ElementMap, Elements, Id).
+
+:- pred eqvclass__same_eqvclass_list_2(map(T, partition_id),
+ list(T), partition_id).
+:- mode eqvclass__same_eqvclass_list_2(in, in, in) is semidet.
+
+eqvclass__same_eqvclass_list_2(_, [], _).
+eqvclass__same_eqvclass_list_2(ElementMap, [Element | Elements], Id) :-
+ map__search(ElementMap, Element, Id),
+ eqvclass__same_eqvclass_list_2(ElementMap, Elements, Id).
eqvclass__partition_set(EqvClass0, PartitionSet) :-
eqvclass__partition_ids(EqvClass0, Ids),
Index: library/io.nu.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.nu.nl,v
retrieving revision 1.60
diff -u -t -u -r1.60 io.nu.nl
--- io.nu.nl 1998/03/30 13:27:26 1.60
+++ io.nu.nl 1998/07/07 01:00:11
@@ -539,12 +539,7 @@
% The following routines work only under SICStus, not under NU-Prolog.
-io__tmpnam_2(Name) -->
- { use_module(library(system)) }, % for tmpnam/1
- { tmpnam(Atom) },
- { name(Atom, Name) }.
-
-io__tmpnam(Dir, Prefix, Name) -->
+io__make_temp(Dir, Prefix, Name) -->
{ use_module(library(system)) }, % for mktemp/2
{ dir__directory_separator(SepChar) },
{ string__char_to_string(SepChar, Sep) },
@@ -552,7 +547,13 @@
{ string__append_list([Dir, Sep, LeftPrefix, "XXXXXX"], TemplateName) },
{ name(TemplateAtom, TemplateName) },
{ mktemp(TemplateAtom, TmpAtom) },
- { name(TmpAtom, Name) }.
+ { name(TmpAtom, Name) },
+ io__open_output(Name, Res),
+ ( { Res = ok(Stream) } ->
+ io__close_output(Stream)
+ ;
+ { error("error opening temporary file") }
+ ).
io__rename_file_2(OldName, NewName, Result, ResultStr) -->
{ use_module(library(system)) }, % for rename_file/2
@@ -657,6 +658,11 @@
Status = -1
},
io__update_state.
+
+io__getenv(Var, Val) -->
+ { getenv(Var, Val) }.
+
+io__make_err_msg(Msg, Msg) --> [].
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: library/map.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/map.m,v
retrieving revision 1.62
diff -u -t -u -r1.62 map.m
--- map.m 1998/03/31 23:16:26 1.62
+++ map.m 1998/04/02 07:00:25
@@ -198,7 +198,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module std_util, require, string.
+:- import_module std_util, require, string, term.
%-----------------------------------------------------------------------------%
@@ -227,10 +227,31 @@
;
KeyType = type_name(type_of(K)),
ValueType = type_name(type_of(V)),
+ term__type_to_term(K, KT),
+ (
+ (
+ KT = term__functor(term__integer(Int), [], _),
+ string__int_to_string(Int, TString)
+ ;
+ KT = term__functor(term__float(Float), [], _),
+ string__float_to_string(Float, TString)
+ ;
+ KT = term__functor(term__string(TString),
+ [], _)
+ ;
+ KT = term__functor(term__atom(TString),
+ [], _)
+ )
+ ->
+ string__append("\n\tKey: ", TString, MaybeKey)
+ ;
+ MaybeKey = ""
+ ),
string__append_list(
["map__lookup: key not found\n",
"\tKey Type: ",
KeyType,
+ MaybeKey,
"\n\tValue Type: ",
ValueType
],
Index: library/sp_lib.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/sp_lib.nl,v
retrieving revision 1.25
diff -u -t -u -r1.25 sp_lib.nl
--- sp_lib.nl 1998/03/27 12:33:56 1.25
+++ sp_lib.nl 1998/06/05 02:02:49
@@ -114,6 +114,11 @@
duplicate(Term, Copy) :-
copy_term(Term, Copy).
+getenv(Var, Val) :-
+ use_module(library(system), []),
+ system:environ(Var, Val0),
+ atom_chars(Val0, Val).
+
%-----------------------------------------------------------------------------%
% Sheesh - do I really have to define these myself!
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_init.h,v
retrieving revision 1.3
diff -u -t -u -r1.3 mercury_init.h
--- mercury_init.h 1998/03/11 22:07:29 1.3
+++ mercury_init.h 1998/07/01 04:20:51
@@ -106,6 +106,17 @@
/* normally ML_DI_found_match (found_match/12) */
void ML_DI_read_request_from_socket(Word, Word *, Integer *);
+/*---------------------------------------------------------------------------*/
+
+/*
+** mercury__load_aditi_rl_code() is defined in the <module>_init.c file.
+** It uploads all the Aditi-RL code for the program to a database to
+** which the program currently has a connection, returning a status value
+** as described in src/api/aditi_err.h in the Aditi sources.
+*/
+extern int mercury__load_aditi_rl_code(void);
+
+/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_INIT_H */
Index: scripts/Mmake.rules
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/Mmake.rules,v
retrieving revision 1.63
diff -u -t -u -r1.63 Mmake.rules
--- Mmake.rules 1998/06/12 16:35:01 1.63
+++ Mmake.rules 1998/06/19 00:38:01
@@ -20,7 +20,8 @@
.date0 .date .date3 .optdate .trans_opt_date \
.c .nu .o .pic_o \
.i .s .pic_s \
- .ql .pl
+ .ql .pl \
+ .rlo
#-----------------------------------------------------------------------------#
#
@@ -169,6 +170,10 @@
$(cs_subdir)%.c : %.m
rm -f $(cs_subdir)$*.c
$(MCG) $(GRADEFLAGS) $(MCGFLAGS) $< > $*.err 2>&1
+
+$(rlos_subdir)%.rlo : %.m
+ rm -f $(rlos_subdir)$*.c
+ $(MCG) $(GRADEFLAGS) $(MCGFLAGS) --aditi-only $< > $*.err 2>&1
# If we are removing the .c files, we need to tell Make that we're
# generating the .o files directly from the .m files, but
Index: scripts/Mmake.vars.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/Mmake.vars.in,v
retrieving revision 1.19
diff -u -t -u -r1.19 Mmake.vars.in
--- Mmake.vars.in 1998/03/30 13:03:15 1.19
+++ Mmake.vars.in 1998/04/02 07:01:42
@@ -140,6 +140,7 @@
trans_opt_dates_subdir=$(SUBDIR)trans_opt_dates/
cs_subdir=$(SUBDIR)cs/
os_subdir=$(SUBDIR)os/
+rlos_subdir=$(SUBDIR)rlos/
dirs_subdir=$(SUBDIR)dirs/
else
@@ -163,6 +164,7 @@
trans_opt_dates_subdir=
cs_subdir=
os_subdir=
+rlos_subdir=
dirs_subdir=
endif
Index: scripts/c2init.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/c2init.in,v
retrieving revision 1.16
diff -u -t -u -r1.16 c2init.in
--- c2init.in 1998/07/03 02:35:49 1.16
+++ c2init.in 1998/07/07 02:36:20
@@ -19,6 +19,8 @@
Name: c2init - Create Mercury initialization file.
Usage: c2init [options] *.c *.init ...
Options:
+ -a, --aditi
+ Generate a function to upload Aditi-RL data to a database.
-c <n>, --max-calls <n>
Break up the initialization into groups of at most <n> function
calls. (Default value of <n> is 40.)
@@ -62,8 +64,13 @@
init_opt=""
library_opt=""
extra_inits_opt=""
+aditi_opt=""
while true; do
case "$1" in
+ -a|--aditi)
+ aditi_opt="-a"; shift;;
+ -a-|--no-aditi)
+ aditi_opt=""; shift;;
-c|--max-calls)
maxcalls="$2"; shift; shift;;
-i|--include-initialization-code)
@@ -93,10 +100,10 @@
done
case $# in
- 0) exec $MKINIT -c"$maxcalls" $init_opt $library_opt \
+ 0) exec $MKINIT $aditiopt -c"$maxcalls" $init_opt $library_opt \
-w"$defentry" $extra_inits_opt $MERCURY_MOD_LIB_MODS
;;
- *) exec $MKINIT -c"$maxcalls" $init_opt $library_opt \
+ *) exec $MKINIT $aditiopt -c"$maxcalls" $init_opt $library_opt \
-w"$defentry" $extra_inits_opt "$@" $MERCURY_MOD_LIB_MODS
;;
esac
Index: util/mkinit.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/util/mkinit.c,v
retrieving revision 1.35
diff -u -t -u -r1.35 mkinit.c
--- mkinit.c 1998/07/06 09:47:21 1.35
+++ mkinit.c 1998/07/07 02:13:35
@@ -32,6 +32,12 @@
#define MAXLINE 256 /* maximum number of characters per line */
/* (characters after this limit are ignored) */
+
+typedef struct String_List_ {
+ char *data;
+ struct String_List_ *next;
+ } String_List;
+
/* --- global variables --- */
static const char *progname = NULL;
@@ -43,11 +49,15 @@
static char **files;
static bool output_main_func = TRUE;
static bool c_files_contain_extra_inits = FALSE;
+static bool aditi = FALSE;
static bool need_initialization_code = FALSE;
static int num_modules = 0;
static int num_errors = 0;
+ /* List of names of Aditi-RL code constants. */
+static String_List *rl_data = NULL;
+
/* --- code fragments to put in the output file --- */
static const char header1[] =
"/*\n"
@@ -179,24 +189,27 @@
"}\n"
;
+static const char aditi_rl_data_str[] = "mercury__aditi_rl_data__";
static const char if_need_to_init[] =
"#if defined(MR_MAY_NEED_INITIALIZATION)\n\n"
;
-
/* --- function prototypes --- */
static void parse_options(int argc, char *argv[]);
static void usage(void);
static void output_headers(void);
static void output_sub_init_functions(void);
static void output_main_init_function(void);
+static void output_aditi_load_function(void);
static void output_main(void);
-static void process_file(char *filename);
-static void process_c_file(char *filename);
+static void process_file(const char *filename);
+static void process_c_file(const char *filename);
static void process_init_file(const char *filename);
static void output_init_function(const char *func_name);
static int getline(FILE *file, char *line, int line_max);
+static void *checked_malloc(size_t size);
+static void add_rl_data(char *data);
/*---------------------------------------------------------------------------*/
@@ -238,6 +251,11 @@
output_headers();
output_sub_init_functions();
output_main_init_function();
+
+ if (aditi) {
+ output_aditi_load_function();
+ }
+
output_main();
if (num_errors > 0) {
@@ -256,8 +274,12 @@
parse_options(int argc, char *argv[])
{
int c;
- while ((c = getopt(argc, argv, "c:ilw:x")) != EOF) {
+ while ((c = getopt(argc, argv, "ac:ilw:x")) != EOF) {
switch (c) {
+ case 'a':
+ aditi = TRUE;
+ break;
+
case 'c':
if (sscanf(optarg, "%d", &maxcalls) != 1)
usage();
@@ -293,7 +315,7 @@
usage(void)
{
fprintf(stderr,
- "Usage: mkinit [-c maxcalls] [-w entry] [-l] [-x] files...\n");
+ "Usage: mkinit [-a] [-c maxcalls] [-w entry] [-l] [-x] files...\n");
exit(1);
}
@@ -372,7 +394,7 @@
/*---------------------------------------------------------------------------*/
static void
-process_file(char *filename)
+process_file(const char *filename)
{
int len = strlen(filename);
/*
@@ -400,15 +422,11 @@
}
static void
-process_c_file(char *filename)
+process_c_file(const char *filename)
{
char func_name[1000];
-
char *position;
- /* remove the trailing ".c" */
- filename[strlen(filename) - 2] = '\0';
-
/* remove the directory name, if any */
if ((position = strrchr(filename, '/')) != NULL) {
filename = position + 1;
@@ -425,11 +443,30 @@
strncat(func_name, filename, position - filename);
filename = position + 1;
}
- strcat(func_name, "__");
- strcat(func_name, filename);
+ /*
+ ** The trailing stuff after the last `.' should just be the `c' suffix.
+ */
+
strcat(func_name, "__init");
output_init_function(func_name);
+
+ if (aditi) {
+ char *rl_data_name;
+ int module_name_size;
+ int mercury_len;
+
+ mercury_len = strlen("mercury__");
+ module_name_size =
+ strlen(func_name) - mercury_len - strlen("__init");
+ rl_data_name = checked_malloc(module_name_size +
+ strlen(aditi_rl_data_str) + 1);
+ strcpy(rl_data_name, aditi_rl_data_str);
+ strncat(rl_data_name, func_name + mercury_len,
+ module_name_size);
+ add_rl_data(rl_data_name);
+
+ }
}
static void
@@ -437,9 +474,12 @@
{
const char * const init_str = "INIT ";
const char * const endinit_str = "ENDINIT ";
+ const char * const aditi_init_str = "ADITI_DATA ";
const int init_strlen = strlen(init_str);
const int endinit_strlen = strlen(endinit_str);
+ const int aditi_init_strlen = strlen(aditi_init_str);
char line[MAXLINE];
+ char * rl_data_name;
FILE * cfile;
cfile = fopen(filename, "r");
@@ -451,22 +491,34 @@
}
while (getline(cfile, line, MAXLINE) > 0) {
- if (strncmp(line, init_str, init_strlen) == 0) {
- int j;
+ if (strncmp(line, init_str, init_strlen) == 0) {
+ int j;
- for (j = init_strlen; isalnum(line[j]) ||
- line[j] == '_'; j++)
- {
- /* VOID */
- }
- line[j] = '\0';
-
- output_init_function(line+init_strlen);
+ for (j = init_strlen; isalnum(line[j]) || line[j] == '_'; j++)
+ {
+ /* VOID */
}
+ line[j] = '\0';
- if (strncmp(line, endinit_str, endinit_strlen) == 0) {
- break;
+ output_init_function(line+init_strlen);
+ } else if (aditi
+ && strncmp(line, aditi_init_str, aditi_init_strlen) == 0) {
+ int j;
+
+ for (j = aditi_init_strlen;
+ isalnum(line[j]) || line[j] == '_'; j++)
+ {
+ /* VOID */
}
+ line[j] = '\0';
+
+ rl_data_name = checked_malloc(
+ strlen(line + aditi_init_strlen) + 1);
+ strcpy(rl_data_name, line + aditi_init_strlen);
+ add_rl_data(rl_data_name);
+ } else if (strncmp(line, endinit_str, endinit_strlen) == 0) {
+ break;
+ }
}
fclose(cfile);
@@ -494,6 +546,74 @@
/*---------------------------------------------------------------------------*/
+ /*
+ ** Load the Aditi-RL for each module into the database.
+ ** mercury__load_aditi_rl_code() is called by aditi__connect/6
+ ** in extras/aditi/aditi.m.
+ */
+static void
+output_aditi_load_function(void)
+{
+ int len;
+ int filenum;
+ char filename[1000];
+ int num_rl_modules;
+ String_List *node;
+
+ printf("\n/*\n** Load the Aditi-RL code for the program into the\n");
+ printf("** currently connected database.\n*/\n");
+ printf("#include \"aditi_clnt.h\"\n");
+
+ /*
+ ** Declare all the RL data constants.
+ ** Each RL data constant is named mercury___aditi_rl_data__<module>.
+ */
+ for (node = rl_data; node != NULL; node = node->next) {
+ printf("extern const char const %s[];\n", node->data);
+ printf("extern const int %s__length;\n", node->data);
+ }
+
+ printf("int mercury__load_aditi_rl_code(void)\n{\n"),
+
+ /* Build an array containing the addresses of the RL data constants. */
+ printf("\tstatic const char *rl_data[] = {\n\t\t");
+ for (node = rl_data; node != NULL; node = node->next) {
+ printf("%s,\n\t\t", node->data);
+ }
+ printf("NULL};\n");
+
+ /* Build an array containing the lengths of the RL data constants. */
+ printf("\tstatic const int * const rl_data_lengths[] = {\n\t\t");
+ num_rl_modules = 0;
+ for (node = rl_data; node != NULL; node = node->next) {
+ num_rl_modules++;
+ printf("&%s__length,\n\t\t", node->data);
+ }
+ printf("0};\n");
+
+ printf("\tconst int num_rl_modules = %d;\n", num_rl_modules);
+ printf("\tint status;\n");
+ printf("\tint i;\n\n");
+
+ /*
+ ** Output code to load the Aditi-RL for each module in turn.
+ */
+ printf("\tfor (i = 0; i < num_rl_modules; i++) {\n");
+ printf("\t\tif (*rl_data_lengths[i] != 0\n");
+
+ /* The ADITI_NAME macro puts a prefix on the function name. */
+ printf("\t\t && (status = ADITI_NAME(load_immed)"
+ "(*rl_data_lengths[i],\n");
+ printf("\t\t\t\trl_data[i])) != ADITI_OK) {\n");
+ printf("\t\t\treturn status;\n");
+ printf("\t\t}\n");
+ printf("\t}\n");
+ printf("\treturn ADITI_OK;\n");
+ printf("}\n");
+}
+
+/*---------------------------------------------------------------------------*/
+
static int
getline(FILE *file, char *line, int line_max)
{
@@ -513,6 +633,32 @@
line[num_chars] = '\0';
return num_chars;
+}
+
+/*---------------------------------------------------------------------------*/
+
+static void
+add_rl_data(char *data)
+{
+ String_List *new_node;
+
+ new_node = checked_malloc(sizeof(String_List));
+ new_node->data = data;
+ new_node->next = rl_data;
+ rl_data = new_node;
+}
+
+/*---------------------------------------------------------------------------*/
+
+static void *
+checked_malloc(size_t size)
+{
+ void *mem;
+ if ((mem = malloc(size)) == NULL) {
+ fprintf(stderr, "Out of memory\n");
+ exit(1);
+ }
+ return mem;
}
/*---------------------------------------------------------------------------*/
More information about the developers
mailing list