[m-dev.] diff: MLDS back-end: implement nondet pragma c_code
Fergus Henderson
fjh at cs.mu.OZ.AU
Wed Feb 9 03:00:07 AEDT 2000
Estimated hours taken: 4
Some improvements to the MLDS back-end's handling
of `pragma c_code'.
compiler/ml_code_gen.m:
Implement nondet pragma c_code.
compiler/ml_code_gen.m:
runtime/mercury_types.h:
Fix some bugs with semidet pragma c_code.
The `SUCCESS_INDICATOR' macro was not being
correctly `#define'd and `#undef'ed.
Workspace: /mnt/local/ender2/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.27
diff -u -d -r1.27 ml_code_gen.m
--- compiler/ml_code_gen.m 2000/01/26 02:04:25 1.27
+++ compiler/ml_code_gen.m 2000/02/08 15:53:47
@@ -1302,32 +1302,203 @@
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
;
- { PragmaImpl = nondet( _, _, _, _, _, _, _, _, _) },
- { sorry("nondet pragma c_code") }
- /*
{ PragmaImpl = nondet(
- Fields, FieldsContext, First, FirstContext,
- Later, LaterContext, Treat, Shared, SharedContext) },
+ LocalVarsDecls, LocalVarsContext,
+ FirstCode, FirstContext, LaterCode, LaterContext,
+ _Treatment, SharedCode, SharedContext) },
ml_gen_nondet_pragma_c_code(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- Fields, FieldsContext, First, FirstContext,
- Later, LaterContext, Treat, Shared, SharedContext,
- MLDS_Decls, MLDS_Statements)
- */
+ OuterContext, LocalVarsDecls, LocalVarsContext,
+ FirstCode, FirstContext, LaterCode, LaterContext,
+ SharedCode, SharedContext, MLDS_Decls, MLDS_Statements)
).
ml_gen_goal_expr(bi_implication(_, _), _, _, _, _) -->
% these should have been expanded out by now
{ error("ml_gen_goal_expr: unexpected bi_implication") }.
+:- pred ml_gen_nondet_pragma_c_code(code_model, pragma_c_code_attributes,
+ pred_id, proc_id, list(prog_var),
+ list(maybe(pair(string, mode))), list(prog_type), prog_context,
+ string, maybe(prog_context), string, maybe(prog_context),
+ string, maybe(prog_context), string, maybe(prog_context),
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_nondet_pragma_c_code(in, in, in, in, in, in, in, in,
+ in, in, in, in, in, in, in, in, out, out, in, out) is det.
+
+ % For model_non pragma c_code,
+ % we generate code of the following form:
+ %
+ % {
+ % <declaration of one local variable for each arg>
+ % struct {
+ % <user's local_vars decls>
+ % } MR_locals;
+ % bool MR_done = FALSE;
+ % bool MR_succeeded = FALSE;
+ %
+ % #define FAIL (MR_done = TRUE)
+ % #define SUCCEED (MR_succeeded = TRUE)
+ % #define SUCCEED_LAST (MR_succeeded = TRUE, \
+ % MR_done = TRUE)
+ % #define LOCALS (&MR_locals)
+ %
+ % <assign input args>
+ % <obtain global lock>
+ % <user's first_code C code>
+ % while (true) {
+ % <user's shared_code C code>
+ % <release global lock>
+ % if (MR_succeeded) {
+ % <assign output args>
+ % CONT();
+ % }
+ % if (MR_done) break;
+ % <obtain global lock>
+ % <user's later_code C code>
+ % }
+ %
+ % #undef FAIL
+ % #undef SUCCEED
+ % #undef SUCCEED_LAST
+ % #undef LOCALS
+ % }
+ %
+ml_gen_nondet_pragma_c_code(CodeModel, Attributes,
+ PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes, Context,
+ LocalVarsDecls, _LocalVarsContext, FirstCode, _FirstContext,
+ LaterCode, _LaterContext, SharedCode, _SharedContext,
+ MLDS_Decls, MLDS_Statements) -->
+ %
+ % Combine all the information about the each arg
+ %
+ { ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes,
+ ArgList) },
+
+ %
+ % Generate <declaration of one local variable for each arg>
+ %
+ { ml_gen_pragma_c_decls(ArgList, ArgDeclsList) },
+
+ %
+ % Generate definitions of the FAIL, SUCCEED, SUCCEED_LAST,
+ % and LOCALS macros
+ %
+ { string__append_list([
+" #define FAIL (MR_done = TRUE)\n",
+" #define SUCCEED (MR_succeeded = TRUE)\n",
+" #define SUCCEED_LAST (MR_succeeded = TRUE, MR_done = TRUE)\n",
+" #define LOCALS (&MR_locals)\n"
+ ], HashDefines) },
+ { string__append_list([
+ " #undef FAIL\n",
+ " #undef SUCCEED\n",
+ " #undef SUCCEED_LAST\n",
+ " #undef LOCALS\n"
+ ], HashUndefs) },
+
+ %
+ % Generate code to set the values of the input variables.
+ %
+ list__map_foldl(ml_gen_pragma_c_input_arg, ArgList, AssignInputsList),
+
+ %
+ % Generate code to assign the values of the output variables.
+ %
+ list__map_foldl(ml_gen_pragma_c_output_arg, ArgList, AssignOutputsList),
+
+ %
+ % Generate code fragments to obtain and release the global lock
+ % (this is used for ensuring thread safety in a concurrent
+ % implementation)
+ % XXX we should only generate these if the `parallel' option
+ % was enabled
+ %
+ =(MLDSGenInfo),
+ { thread_safe(Attributes, ThreadSafe) },
+ { ThreadSafe = thread_safe ->
+ ObtainLock = "",
+ ReleaseLock = ""
+ ;
+ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_name(PredInfo, Name),
+ llds_out__quote_c_string(Name, MangledName),
+ string__append_list(["\tMR_OBTAIN_GLOBAL_LOCK(""",
+ MangledName, """);\n"], ObtainLock),
+ string__append_list(["\tMR_RELEASE_GLOBAL_LOCK(""",
+ MangledName, """);\n"], ReleaseLock)
+ },
+
+ %
+ % Put it all together
+ %
+ { string__append_list(ArgDeclsList, ArgDecls) },
+ { string__append_list(AssignInputsList, AssignInputsCode) },
+ { string__append_list(AssignOutputsList, AssignOutputsCode) },
+ { string__append_list([
+ "{\n",
+ ArgDecls,
+ "\tstruct {\n",
+ LocalVarsDecls, "\n",
+ "\t} MR_locals;\n",
+ "\tbool MR_succeeded = FALSE;\n",
+ "\tbool MR_done = FALSE;\n",
+ "\n",
+ HashDefines,
+ "\n",
+ AssignInputsCode,
+ ObtainLock,
+ "\t{\n",
+ FirstCode,
+ "\n\t;}\n",
+ "\twhile (1) {\n",
+ "\t\t{\n",
+ SharedCode,
+ "\n\t\t;}\n",
+ ReleaseLock,
+ "\t\tif (MR_succeeded) {\n",
+ AssignOutputsCode],
+ Starting_C_Code) },
+ ( { CodeModel = model_non } ->
+ ml_gen_call_current_success_cont(Context, CallCont)
+ ;
+ { error("ml_gen_nondet_pragma_c_code: unexpected code model") }
+ ),
+ { string__append_list([
+ "\t\t}\n",
+ "\t\tif (MR_done) break;\n",
+ ObtainLock,
+ "\t\t{\n",
+ LaterCode,
+ "\n\t\t;}\n",
+ "\t}\n",
+ "\n",
+ HashUndefs,
+ "}\n"],
+ Ending_C_Code) },
+ { Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
+ { Starting_C_Code_Statement = mlds__statement(
+ atomic(Starting_C_Code_Stmt), mlds__make_context(Context)) },
+ { Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
+ { Ending_C_Code_Statement = mlds__statement(
+ atomic(Ending_C_Code_Stmt), mlds__make_context(Context)) },
+ { MLDS_Statements = [
+ Starting_C_Code_Statement,
+ CallCont,
+ Ending_C_Code_Statement] },
+ { MLDS_Decls = [] }.
+
:- pred ml_gen_ordinary_pragma_c_code(code_model, pragma_c_code_attributes,
- pred_id, proc_id, list(prog_var), list(maybe(pair(string, mode))),
- list(prog_type), string, prog_context,
+ pred_id, proc_id, list(prog_var),
+ list(maybe(pair(string, mode))), list(prog_type),
+ string, prog_context,
mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
:- mode ml_gen_ordinary_pragma_c_code(in, in, in, in, in, in,
in, in, in, out, out, in, out) is det.
- % We generate code of the following form:
+ % For ordinary (not model_non) pragma c_code,
+ % we generate code of the following form:
%
% model_det pragma_c_code:
%
@@ -1354,6 +1525,8 @@
% if (SUCCESS_INDICATOR) {
% <assign output args>
% }
+ %
+ % #undef SUCCESS_INDICATOR
% }
%
% Note that we generate this code directly as
@@ -1436,12 +1609,12 @@
ml_success_lval(SucceededLval),
{ ml_gen_c_code_for_rval(lval(SucceededLval), SucceededVar) },
{ DefineSuccessIndicator = string__format(
- "#define SUCCESS_INDICATOR = %s\n",
+ "\t#define SUCCESS_INDICATOR %s\n",
[s(SucceededVar)]) },
{ MaybeAssignOutputsCode = string__format(
- "\tif (SUCCESS_INDICATOR) {\n%s\n\t}",
+ "\tif (SUCCESS_INDICATOR) {\n%s\n\t}\n",
[s(AssignOutputsCode)]) },
- { UndefSuccessIndicator = "#undef SUCCESS_INDICATOR" },
+ { UndefSuccessIndicator = "\t#undef SUCCESS_INDICATOR\n" },
{ string__append_list([
"{\n",
ArgDecls,
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.19
diff -u -d -r1.19 mercury_types.h
--- runtime/mercury_types.h 1999/11/08 22:28:05 1.19
+++ runtime/mercury_types.h 2000/02/08 15:12:52
@@ -91,15 +91,17 @@
typedef Char *String;
typedef const Char *ConstString;
-/* continuation function type, for --high-level-C option */
+/* continuation function type, for --high-level-code option */
typedef void (*MR_NestedCont) (void); /* for --gcc-nested-functions */
typedef void (*MR_Cont) (void *); /* for --no-gcc-nested-functions */
-/*
-** semidet predicates indicate success or failure by leaving nonzero or zero
-** respectively in register r1
-** (should this #define go in some other header file?)
-*/
-#define SUCCESS_INDICATOR r1
+#ifndef MR_HIGHLEVEL_CODE
+ /*
+ ** semidet predicates indicate success or failure by leaving nonzero or zero
+ ** respectively in register r1
+ ** (should this #define go in some other header file?)
+ */
+ #define SUCCESS_INDICATOR r1
+#endif
#endif /* not MERCURY_TYPES_H */
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list