[m-rev.] for review: il as a foreign language
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Jul 11 02:14:17 AEST 2001
Hi,
You can now implement Mercury procedures in IL.
===================================================================
Estimated hours taken: 40
Branches: main
Add support for foreign_proc("il", ....)
To use it, you need to give the options
--use-foreign-language il
--backend-foreign-language il
compiler/foreign.m:
compiler/globals.m:
Handle the addition of il as a language option.
compiler/il_peephole.m:
compiler/ilasm.m:
Handle the addition of il_asm_code as inlineable code.
Handle the new handwritten_scope.
compiler/ilds.m:
Add a handwritten scope to the different scope types.
The handwritten scope is much live a normal scope, but it isn't
possible to eliminate unused local variables in a handwritten scope,
because they might be used by the handwritten code.
compiler/ml_code_gen.m:
Handle the generation of code for IL foreign language interfacing.
Put the max_stack_size attribute into IL foreign language code.
compiler/ml_code_util.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_simplify_switch.m:
compiler/ml_string_switch.m:
compiler/ml_tailcall.m:
compiler/ml_util.m:
Handle the new field in blocks indicating whether the block contains
handwritten code.
compiler/mlds.m:
Add a field in blocks, which is set to yes iff the block contains
handwritten foreign code.
Add lang_il as a possible target language.
Add attributes to target code (max_stack_size is the only one so far).
compiler/mlds_to_c.m:
compiler/mlds_to_csharp.m:
compiler/mlds_to_java.m:
compiler/mlds_to_mcpp.m:
Handle the addition of il as a language option.
compiler/mlds_to_il.m:
compiler/mlds_to_ilasm.m:
Generate inline code for foreign_proc using IL, and generate
handwritten_scope for code that contains handwritten code.
compiler/prog_data.m:
Add il as a language option.
Add extra attributes to the pragma_foreign_proc_attributes.
Currently there is just one extra attribute, max_stack_size.
compiler/prog_io_pragma.m:
Parse max_stack_size as an attribute on foreign_proc.
Improve error message output: previously we tried to parse the
third term of a foreign_proc, and then tried to parse the second term
(which we will accept for "c_code" but not foreign_proc).
But we should give the error message as if the "c_code" handling is
not present, as this will eventually go away.
Check for foreign_language attributes such as max_stack_size.
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.4
diff -u -r1.4 foreign.m
--- compiler/foreign.m 2001/05/02 11:36:34 1.4
+++ compiler/foreign.m 2001/07/10 16:05:48
@@ -77,7 +77,7 @@
:- import_module require.
:- import_module hlds_pred, hlds_module, type_util, mode_util.
-:- import_module code_model.
+:- import_module code_model, globals.
foreign__filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
list__filter((pred(foreign_decl_code(Lang, _, _)::in) is semidet :-
@@ -125,6 +125,8 @@
; ForeignLanguage = csharp,
error("unimplemented: calling C# foreign code from C backend")
+ ; ForeignLanguage = il,
+ error("unimplemented: calling IL foreign code from C backend")
; ForeignLanguage = c,
Impl = Impl0,
ModuleInfo = ModuleInfo0
@@ -137,6 +139,8 @@
ModuleInfo = ModuleInfo0
; ForeignLanguage = csharp,
error("unimplemented: calling C# foreign code from MC++ backend")
+ ; ForeignLanguage = il,
+ error("unimplemented: calling IL foreign code from MC++ backend")
; ForeignLanguage = c,
Impl = Impl0,
ModuleInfo = ModuleInfo0
@@ -149,7 +153,20 @@
ModuleInfo = ModuleInfo0
; ForeignLanguage = c,
error("unimplemented: calling C foreign code from MC++ backend")
+ ; ForeignLanguage = il,
+ error("unimplemented: calling IL foreign code from MC++ backend")
)
+ ; TargetLang = il ->
+ ( ForeignLanguage = managed_cplusplus,
+ error("unimplemented: calling MC++ foreign code from IL backend")
+ ; ForeignLanguage = csharp,
+ error("unimplemented: calling C# foreign code from MC++ backend")
+ ; ForeignLanguage = c,
+ error("unimplemented: calling C foreign code from MC++ backend")
+ ; ForeignLanguage = il,
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0
+ )
;
error("extrude_pragma_implementation: unsupported foreign language")
).
@@ -157,12 +174,9 @@
% XXX we haven't implemented these functions yet.
% What is here is only a guide
:- func make_pred_name(foreign_language, sym_name) = string.
-make_pred_name(c, SymName) =
- "mercury_c__" ++ make_pred_name_rest(c, SymName).
-make_pred_name(managed_cplusplus, SymName) =
- "mercury_cpp__" ++ make_pred_name_rest(managed_cplusplus, SymName).
-make_pred_name(csharp, SymName) =
- "mercury_csharp__" ++ make_pred_name_rest(managed_cplusplus, SymName).
+make_pred_name(Lang, SymName) =
+ "mercury_" ++ simple_foreign_language_string(Lang) ++ "__" ++
+ make_pred_name_rest(Lang, SymName).
:- func make_pred_name_rest(foreign_language, sym_name) = string.
make_pred_name_rest(c, _SymName) = "some_c_name".
@@ -170,6 +184,7 @@
make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
make_pred_name_rest(managed_cplusplus, unqualified(Name)) = Name.
make_pred_name_rest(csharp, _SymName) = "some_csharp_name".
+make_pred_name_rest(il, _SymName) = "some_il_name".
make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.43
diff -u -r1.43 globals.m
--- compiler/globals.m 2001/05/24 06:07:03 1.43
+++ compiler/globals.m 2001/07/10 16:05:48
@@ -204,14 +204,17 @@
convert_foreign_language_2("c#", csharp).
convert_foreign_language_2("csharp", csharp).
convert_foreign_language_2("c sharp", csharp).
+convert_foreign_language_2("il", il).
foreign_language_string(c) = "C".
foreign_language_string(managed_cplusplus) = "Managed C++".
foreign_language_string(csharp) = "C#".
+foreign_language_string(il) = "IL".
simple_foreign_language_string(c) = "c".
simple_foreign_language_string(managed_cplusplus) = "cpp". % XXX mcpp is better
simple_foreign_language_string(csharp) = "csharp".
+simple_foreign_language_string(il) = "il".
convert_gc_method("none", none).
convert_gc_method("conservative", conservative).
Index: compiler/il_peephole.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/il_peephole.m,v
retrieving revision 1.3
diff -u -r1.3 il_peephole.m
--- compiler/il_peephole.m 2001/05/29 13:06:27 1.3
+++ compiler/il_peephole.m 2001/07/10 16:05:48
@@ -426,6 +426,7 @@
can_call(callvirt(_)) = yes.
can_call(jmp(_)) = yes.
can_call(newobj(_)) = yes.
+can_call(il_asm_code(_, _)) = yes.
can_call(comment(_Comment)) = no.
can_call(label(_Label)) = no.
@@ -521,9 +522,12 @@
equivalent_to_nop(comment(_)) = yes.
equivalent_to_nop(start_block(scope(_), _)) = yes.
equivalent_to_nop(end_block(scope(_), _)) = yes.
+equivalent_to_nop(start_block(handwritten_scope(_), _)) = yes.
+equivalent_to_nop(end_block(handwritten_scope(_), _)) = yes.
equivalent_to_nop(nop) = yes.
equivalent_to_nop(context(_, _)) = yes.
+equivalent_to_nop(il_asm_code(_, _)) = no.
equivalent_to_nop(start_block(try, _)) = no.
equivalent_to_nop(end_block(try, _)) = no.
equivalent_to_nop(start_block(catch(_), _)) = no.
@@ -618,6 +622,11 @@
% These instructions can branch control flow.
:- func can_branch(instr) = bool.
+
+ % XXX we should refine what we mean by can_branch -- it seems to only
+ % mean local branching to local labels (which il_asm_code shouldn't do)
+ % but we will be conservative for now.
+can_branch(il_asm_code(_, _)) = yes.
can_branch(br(_)) = yes.
can_branch(brtrue(_)) = yes.
can_branch(brfalse(_)) = yes.
Index: compiler/ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilasm.m,v
retrieving revision 1.12
diff -u -r1.12 ilasm.m
--- compiler/ilasm.m 2001/07/08 19:52:45 1.12
+++ compiler/ilasm.m 2001/07/10 16:05:49
@@ -838,6 +838,9 @@
:- pred output_instr(instr::in, ilasm_info::in, ilasm_info::out,
io__state::di, io__state::uo) is det.
+output_instr(il_asm_code(Code, _MaxStack), I, I) -->
+ io__write_string(Code).
+
output_instr(comment(Comment), I, I) -->
output_comment_string(Comment).
@@ -845,6 +848,14 @@
output_label(Label),
io__write_string(":").
+output_instr(start_block(handwritten_scope(Locals), Id), Info0, Info) -->
+ io__write_string("{"),
+ io__write_string("\t// (handwritten) #"),
+ io__write_int(Id),
+ io__write_string("\n\t.locals ("),
+ ilasm__write_list(Locals, ", ", output_local, Info0, Info),
+ io__write_string(")\n").
+
output_instr(start_block(scope(Locals), Id), Info0, Info) -->
io__write_string("{"),
io__write_string("\t// #"),
@@ -866,6 +877,11 @@
io__write_int(Id).
output_instr(end_block(scope(_), Id), I, I) -->
+ io__write_string("}"),
+ io__write_string("\t// #"),
+ io__write_int(Id).
+
+output_instr(end_block(handwritten_scope(_), Id), I, I) -->
io__write_string("}"),
io__write_string("\t// #"),
io__write_int(Id).
Index: compiler/ilds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ilds.m,v
retrieving revision 1.6
diff -u -r1.6 ilds.m
--- compiler/ilds.m 2001/07/04 12:57:02 1.6
+++ compiler/ilds.m 2001/07/10 16:05:49
@@ -189,10 +189,17 @@
% This should probably be the same as params.
:- type locals == assoc_list(ilds__id, ilds__type).
- % blocks can be just scope for locals, or can
- % introduce try or catch code.
+ % blocks can be just scope for locals, can surround a block of
+ % handwritten code, or can introduce try or catch code.
:- type blocktype
+
+ % scope just introduces a scope for local variables
---> scope(locals)
+ % a handwritten_scope is just like scope, but the local
+ % variables should be assumed to be used in the handwritten
+ % code (and cannot, therefore, be eliminated if they appear
+ % to be unused elsewhere).
+ ; handwritten_scope(locals)
; try
; catch(class_name).
@@ -213,6 +220,9 @@
; end_block(blocktype, blockid) % end block
; context(string, int) % context of following
% code (filename, line)
+ ; il_asm_code(string, int) % a slab of handwritten
+ % IL assembler (with
+ % max stack size)
% BASE INSTRUCTIONS
@@ -374,8 +384,18 @@
calculate_max_stack_2([], _, Max) = Max.
calculate_max_stack_2([I | Instrs], Current, Max) =
calculate_max_stack_2(Instrs, NewCurrent, NewMax) :-
- NewCurrent = Current + get_stack_difference(I),
- NewMax = max(NewCurrent, Max).
+
+ % If there is handwritten code, it might increase the
+ % current stack height by its maximum, but it will then
+ % pop the stack leaving nothing on the stack (so Current
+ % remains the same).
+ ( I = il_asm_code(_, HandwrittenMax) ->
+ NewCurrent = Current,
+ NewMax = max(Current + HandwrittenMax, Max)
+ ;
+ NewCurrent = Current + get_stack_difference(I),
+ NewMax = max(NewCurrent, Max)
+ ).
% Return the difference in stack height after an instruction is
% executed.
@@ -387,6 +407,7 @@
get_stack_difference(start_block(_, _)) = 0.
get_stack_difference(context(_, _)) = 0.
get_stack_difference(label(_Label)) = 0.
+get_stack_difference(il_asm_code(_, _)) = 0.
get_stack_difference(add(_Overflow, _Signed)) = -1.
get_stack_difference((and)) = -1.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.89
diff -u -r1.89 ml_code_gen.m
--- compiler/ml_code_gen.m 2001/06/22 09:14:30 1.89
+++ compiler/ml_code_gen.m 2001/07/10 16:05:51
@@ -1051,11 +1051,11 @@
% them from the byref_output_vars field in the ml_gen_info.
( CodeModel = model_non ->
- ml_set_up_initial_succ_cont(ModuleInfo,
+ ml_set_up_initial_succ_cont(ModuleInfo,
CopiedOutputVars, MLDSGenInfo0, MLDSGenInfo1)
- ;
+ ;
ml_det_copy_out_vars(ModuleInfo,
- CopiedOutputVars, MLDSGenInfo0, MLDSGenInfo1)
+ CopiedOutputVars, MLDSGenInfo0, MLDSGenInfo1)
),
% This would generate all the local variables at the top of
@@ -1989,20 +1989,20 @@
MLDS_Decls, MLDS_Statements).
ml_gen_goal_expr(foreign_proc(Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
- (
- { PragmaImpl = ordinary(C_Code, _MaybeContext) },
- ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
- ;
- { PragmaImpl = nondet(
- LocalVarsDecls, LocalVarsContext,
+ (
+ { PragmaImpl = ordinary(C_Code, _MaybeContext) },
+ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
+ ;
+ { PragmaImpl = nondet(
+ LocalVarsDecls, LocalVarsContext,
FirstCode, FirstContext, LaterCode, LaterContext,
_Treatment, SharedCode, SharedContext) },
- ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
OuterContext, LocalVarsDecls, LocalVarsContext,
FirstCode, FirstContext, LaterCode, LaterContext,
SharedCode, SharedContext, MLDS_Decls, MLDS_Statements)
@@ -2010,10 +2010,10 @@
{ PragmaImpl = import(Name, HandleReturn, Vars, _Context) },
{ C_Code = string__append_list([HandleReturn, " ",
Name, "(", Vars, ");"]) },
- ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
- PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
- ).
+ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
+ ).
ml_gen_goal_expr(shorthand(_), _, _, _, _) -->
% these should have been expanded out by now
@@ -2153,30 +2153,31 @@
% Put it all together
%
{ Starting_C_Code = list__condense([
- [raw_target_code("{\n")],
+ [raw_target_code("{\n", [])],
HashDefine,
ArgDeclsList,
- [raw_target_code("\tstruct {\n"),
- user_target_code(LocalVarsDecls, LocalVarsContext),
- raw_target_code("\n"),
- raw_target_code("\t} MR_locals;\n"),
- raw_target_code("\tMR_Bool MR_succeeded = FALSE;\n"),
- raw_target_code("\tMR_Bool MR_done = FALSE;\n"),
- raw_target_code("\n"),
- raw_target_code(HashDefines),
- raw_target_code("\n")],
+ [raw_target_code("\tstruct {\n", []),
+ user_target_code(LocalVarsDecls, LocalVarsContext, []),
+ raw_target_code("\n", []),
+ raw_target_code("\t} MR_locals;\n", []),
+ raw_target_code("\tMR_Bool MR_succeeded = FALSE;\n",
+ []),
+ raw_target_code("\tMR_Bool MR_done = FALSE;\n", []),
+ raw_target_code("\n", []),
+ raw_target_code(HashDefines, []),
+ raw_target_code("\n", [])],
AssignInputsList,
- [raw_target_code(ObtainLock),
- raw_target_code("\t{\n"),
- user_target_code(FirstCode, FirstContext),
- raw_target_code("\n\t;}\n"),
- raw_target_code("\twhile (1) {\n"),
- raw_target_code("\t\t{\n"),
- user_target_code(SharedCode, SharedContext),
- raw_target_code("\n\t\t;}\n"),
- raw_target_code("#undef MR_PROC_LABEL\n"),
- raw_target_code(ReleaseLock),
- raw_target_code("\t\tif (MR_succeeded) {\n")],
+ [raw_target_code(ObtainLock, []),
+ raw_target_code("\t{\n", []),
+ user_target_code(FirstCode, FirstContext, []),
+ raw_target_code("\n\t;}\n", []),
+ raw_target_code("\twhile (1) {\n", []),
+ raw_target_code("\t\t{\n", []),
+ user_target_code(SharedCode, SharedContext, []),
+ raw_target_code("\n\t\t;}\n", []),
+ raw_target_code("#undef MR_PROC_LABEL\n", []),
+ raw_target_code(ReleaseLock, []),
+ raw_target_code("\t\tif (MR_succeeded) {\n", [])],
AssignOutputsList
]) },
=(MLDSGenInfo),
@@ -2204,16 +2205,16 @@
{ error("ml_gen_nondet_pragma_c_code: unexpected code model") }
),
{ Ending_C_Code = [
- raw_target_code("\t\t}\n"),
- raw_target_code("\t\tif (MR_done) break;\n"),
- raw_target_code(ObtainLock),
- raw_target_code("\t\t{\n"),
- user_target_code(LaterCode, LaterContext),
- raw_target_code("\n\t\t;}\n"),
- raw_target_code("\t}\n"),
- raw_target_code("\n"),
- raw_target_code(HashUndefs),
- raw_target_code("}\n")
+ raw_target_code("\t\t}\n", []),
+ raw_target_code("\t\tif (MR_done) break;\n", []),
+ raw_target_code(ObtainLock, []),
+ raw_target_code("\t\t{\n", []),
+ user_target_code(LaterCode, LaterContext, []),
+ raw_target_code("\n\t\t;}\n", []),
+ raw_target_code("\t}\n", []),
+ raw_target_code("\n", []),
+ raw_target_code(HashUndefs, []),
+ raw_target_code("}\n", [])
] },
{ Starting_C_Code_Stmt = inline_target_code(lang_C, Starting_C_Code) },
{ Starting_C_Code_Statement = mlds__statement(
@@ -2254,6 +2255,10 @@
ml_gen_ordinary_pragma_csharp_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
+ ; { Lang = il },
+ ml_gen_ordinary_pragma_il_proc(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
).
:- pred ml_gen_ordinary_pragma_csharp_proc(code_model,
@@ -2285,6 +2290,122 @@
] },
{ MLDS_Decls = [] }.
+:- pred ml_gen_ordinary_pragma_il_proc(code_model,
+ pragma_foreign_proc_attributes, 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_il_proc(in, in, in, in, in, in, in, in, in,
+ out, out, in, out) is det.
+
+ml_gen_ordinary_pragma_il_proc(_CodeModel, Attributes,
+ PredId, ProcId, ArgVars, _ArgDatas, OrigArgTypes,
+ ForeignCode, Context, MLDS_Decls, MLDS_Statements) -->
+
+ { MLDSContext = mlds__make_context(Context) },
+
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ { module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ _PredInfo, ProcInfo) },
+ { proc_info_varset(ProcInfo, VarSet) },
+% { proc_info_vartypes(ProcInfo, VarTypes) },
+ % note that for headvars we must use the types from
+ % the procedure interface, not from the procedure body
+ { HeadVarTypes = map__from_corresponding_lists(ArgVars,
+ OrigArgTypes) },
+ { ml_gen_info_get_byref_output_vars(MLDSGenInfo, ByRefOutputVars) },
+ { ml_gen_info_get_value_output_vars(MLDSGenInfo, CopiedOutputVars) },
+ { module_info_name(ModuleInfo, ModuleName) },
+ { MLDSModuleName = mercury_module_name_to_mlds(ModuleName) },
+
+ { list__filter_map(
+ (pred(Var::in, Statement::out) is semidet :-
+ map__lookup(HeadVarTypes, Var, Type),
+ not type_util__is_dummy_argument_type(Type),
+ VarName = mlds__var_name(VarNameString, _MangleInt),
+ MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type),
+
+ VarName = ml_gen_var_name(VarSet, Var),
+ QualVarName = qual(MLDSModuleName, VarName),
+ OutputVarLval = mem_ref(lval(
+ var(QualVarName, MLDSType)), MLDSType),
+
+ NonMangledVarName = mlds__var_name(VarNameString, no),
+ QualLocalVarName= qual(MLDSModuleName,
+ NonMangledVarName),
+ LocalVarLval = var(QualLocalVarName, MLDSType),
+
+ Statement = ml_gen_assign(OutputVarLval,
+ lval(LocalVarLval), Context)
+ ), ByRefOutputVars, ByRefAssignStatements) },
+
+ { list__filter_map(
+ (pred(Var::in, Statement::out) is semidet :-
+ map__lookup(HeadVarTypes, Var, Type),
+ not type_util__is_dummy_argument_type(Type),
+ VarName = mlds__var_name(VarNameString, _MangleInt),
+ MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type),
+
+ VarName = ml_gen_var_name(VarSet, Var),
+ QualVarName = qual(MLDSModuleName, VarName),
+ % this line differs from above
+ OutputVarLval = var(QualVarName, MLDSType),
+
+ NonMangledVarName = mlds__var_name(VarNameString, no),
+ QualLocalVarName= qual(MLDSModuleName,
+ NonMangledVarName),
+ LocalVarLval = var(QualLocalVarName, MLDSType),
+
+ Statement = ml_gen_assign(OutputVarLval,
+ lval(LocalVarLval), Context)
+ ), CopiedOutputVars, CopiedOutputStatements) },
+
+
+ { list__map(
+ (pred(Var::in, MLDS_Defn::out) is det :-
+ map__lookup(HeadVarTypes, Var, Type),
+ VarName = ml_gen_var_name(VarSet, Var),
+ VarName = mlds__var_name(VarNameString, _MangleInt),
+ NonMangledVarName = mlds__var_name(VarNameString, no),
+ % Dummy arguments are just mapped to integers,
+ % since they shouldn't be used in any
+ % way that requires them to have a real value.
+ ( type_util__is_dummy_argument_type(Type) ->
+ Initializer = no_initializer,
+ MLDSType = mlds__native_int_type
+ ; list__member(Var, ByRefOutputVars) ->
+ Initializer = no_initializer,
+ MLDSType = mercury_type_to_mlds_type(
+ ModuleInfo, Type)
+ ; list__member(Var, CopiedOutputVars) ->
+ Initializer = no_initializer,
+ MLDSType = mercury_type_to_mlds_type(
+ ModuleInfo, Type)
+ ;
+ MLDSType = mercury_type_to_mlds_type(
+ ModuleInfo, Type),
+ QualVarName = qual(MLDSModuleName, VarName),
+ Initializer = init_obj(
+ lval(var(QualVarName, MLDSType)))
+ ),
+ MLDS_Defn = ml_gen_mlds_var_decl(
+ var(NonMangledVarName), MLDSType,
+ Initializer, MLDSContext)
+ ), ArgVars, VarLocals) },
+
+ { OutlineStmt = inline_target_code(lang_il, [
+ user_target_code(ForeignCode, yes(Context),
+ get_target_code_attributes(il,
+ Attributes ^ extra_attributes))
+ ]) },
+
+ { ILCodeFragment = mlds__statement(atomic(OutlineStmt), MLDSContext) },
+ { MLDS_Statements = [statement(block(VarLocals, [
+ ILCodeFragment |
+ ByRefAssignStatements ++ CopiedOutputStatements
+ ], yes), mlds__make_context(Context))] },
+ { MLDS_Decls = [] }.
+
:- pred ml_gen_ordinary_pragma_c_proc(code_model,
pragma_foreign_proc_attributes,
@@ -2395,43 +2516,43 @@
%
( { CodeModel = model_det } ->
{ Starting_C_Code = list__condense([
- [raw_target_code("{\n")],
+ [raw_target_code("{\n", [])],
HashDefine,
ArgDeclsList,
- [raw_target_code("\n")],
+ [raw_target_code("\n", [])],
AssignInputsList,
- [raw_target_code(ObtainLock),
- raw_target_code("\t\t{\n"),
- user_target_code(C_Code, yes(Context)),
- raw_target_code("\n\t\t;}\n"),
- raw_target_code("#undef MR_PROC_LABEL\n"),
- raw_target_code(ReleaseLock)],
+ [raw_target_code(ObtainLock, []),
+ raw_target_code("\t\t{\n", []),
+ user_target_code(C_Code, yes(Context), []),
+ raw_target_code("\n\t\t;}\n", []),
+ raw_target_code("#undef MR_PROC_LABEL\n", []),
+ raw_target_code(ReleaseLock, [])],
AssignOutputsList
]) },
- { Ending_C_Code = [raw_target_code("}\n")] }
+ { Ending_C_Code = [raw_target_code("}\n", [])] }
; { CodeModel = model_semi } ->
ml_success_lval(SucceededLval),
{ Starting_C_Code = list__condense([
- [raw_target_code("{\n")],
+ [raw_target_code("{\n", [])],
HashDefine,
ArgDeclsList,
- [raw_target_code("\tMR_Bool SUCCESS_INDICATOR;\n"),
- raw_target_code("\n")],
+ [raw_target_code("\tMR_Bool SUCCESS_INDICATOR;\n", []),
+ raw_target_code("\n", [])],
AssignInputsList,
- [raw_target_code(ObtainLock),
- raw_target_code("\t\t{\n"),
- user_target_code(C_Code, yes(Context)),
- raw_target_code("\n\t\t;}\n"),
- raw_target_code("#undef MR_PROC_LABEL\n"),
- raw_target_code(ReleaseLock),
- raw_target_code("\tif (SUCCESS_INDICATOR) {\n")],
+ [raw_target_code(ObtainLock, []),
+ raw_target_code("\t\t{\n", []),
+ user_target_code(C_Code, yes(Context), []),
+ raw_target_code("\n\t\t;}\n", []),
+ raw_target_code("#undef MR_PROC_LABEL\n", []),
+ raw_target_code(ReleaseLock, []),
+ raw_target_code("\tif (SUCCESS_INDICATOR) {\n", [])],
AssignOutputsList
]) },
{ Ending_C_Code = [
- raw_target_code("\t}\n"),
+ raw_target_code("\t}\n", []),
target_code_output(SucceededLval),
- raw_target_code(" = SUCCESS_INDICATOR;\n"),
- raw_target_code("}\n")
+ raw_target_code(" = SUCCESS_INDICATOR;\n", []),
+ raw_target_code("}\n", [])
] }
;
{ error("ml_gen_ordinary_pragma_c_code: unexpected code model") }
@@ -2493,9 +2614,20 @@
{ ml_gen_info_get_proc_id(MLDSGenInfo, ProcId) },
{ ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name,
MLDS_Module) },
- { HashDefine = [raw_target_code("#define MR_PROC_LABEL "),
+ { HashDefine = [raw_target_code("#define MR_PROC_LABEL ", []),
name(qual(MLDS_Module, MLDS_Name)),
- raw_target_code("\n")] }.
+ raw_target_code("\n", [])] }.
+
+
+:- func get_target_code_attributes(foreign_language,
+ pragma_foreign_proc_extra_attributes) = target_code_attributes.
+get_target_code_attributes(_, []) = [].
+get_target_code_attributes(Lang, [max_stack_size(N) | Xs]) =
+ ( Lang = il ->
+ [max_stack_size(N) | get_target_code_attributes(Lang, Xs)]
+ ;
+ []
+ ).
%---------------------------------------------------------------------------%
@@ -2562,7 +2694,7 @@
% it can't be used, so we just ignore it
DeclString = ""
),
- Decl = raw_target_code(DeclString).
+ Decl = raw_target_code(DeclString, []).
%-----------------------------------------------------------------------------%
@@ -2647,9 +2779,9 @@
[s(ArgName), s(Cast)],
AssignToArgName) },
{ AssignInput = [
- raw_target_code(AssignToArgName),
+ raw_target_code(AssignToArgName, []),
target_code_input(ArgRval),
- raw_target_code(";\n")
+ raw_target_code(";\n", [])
] }
;
% if the variable doesn't occur in the ArgNames list,
@@ -2728,9 +2860,9 @@
AssignFromArgName) },
{ string__format("\t%s\n", [s(LHS_Cast)], AssignTo) },
{ AssignOutput = [
- raw_target_code(AssignTo),
+ raw_target_code(AssignTo, []),
target_code_output(ArgLval),
- raw_target_code(AssignFromArgName)
+ raw_target_code(AssignFromArgName, [])
] }
;
% if the variable doesn't occur in the ArgNames list,
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.40
diff -u -r1.40 ml_code_util.m
--- compiler/ml_code_util.m 2001/07/09 15:55:03 1.40
+++ compiler/ml_code_util.m 2001/07/10 16:05:51
@@ -750,7 +750,7 @@
(if VarDecls = [], Statements = [SingleStatement] then
SingleStatement
else
- mlds__statement(block(VarDecls, Statements),
+ mlds__statement(block(VarDecls, Statements, no),
mlds__make_context(Context))
).
@@ -1787,8 +1787,8 @@
MLDS_Stmt = call(ProxySignature, ProxyFuncRval, ObjectRval,
ProxyArgRvals, RetLvals, CallOrTailcall),
MLDS_Statement = mlds__statement(
- block([Defn], [statement(MLDS_Stmt, MLDS_Context)]),
- MLDS_Context)
+ block([Defn], [statement(MLDS_Stmt, MLDS_Context)],
+ no), MLDS_Context)
;
error("success continuation generated was not a function")
}.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.30
diff -u -r1.30 ml_elim_nested.m
--- compiler/ml_elim_nested.m 2001/07/09 15:55:04 1.30
+++ compiler/ml_elim_nested.m 2001/07/10 16:05:52
@@ -434,7 +434,7 @@
no, EnvTypeName, no, no, [], [])),
Context),
InitEnv = mlds__statement(block([],
- [NewObj, InitEnv0]), Context),
+ [NewObj, InitEnv0], no), Context),
EnvDecls = [EnvVarDecl, EnvPtrVarDecl]
;
EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
@@ -496,7 +496,7 @@
ml_init_env(TypeName, CastEnvPtrVal, Context, ModuleName,
Globals, EnvPtrDecl, InitEnvPtr),
FuncBody = mlds__statement(block([EnvPtrDecl],
- [InitEnvPtr, FuncBody0]), Context),
+ [InitEnvPtr, FuncBody0], no), Context),
DefnBody = mlds__function(PredProcId, Params, yes(FuncBody)),
Defn = mlds__defn(Name, Context, Flags, DefnBody),
Init = yes
@@ -592,7 +592,7 @@
(if VarDecls = [], Statements = [SingleStatement] then
SingleStatement
else
- mlds__statement(block(VarDecls, Statements), Context)
+ mlds__statement(block(VarDecls, Statements, no), Context)
).
%-----------------------------------------------------------------------------%
@@ -706,10 +706,10 @@
flatten_stmt(Stmt0, Stmt) -->
(
- { Stmt0 = block(Defns0, Statements0) },
+ { Stmt0 = block(Defns0, Statements0, IsHandwritten) },
flatten_nested_defns(Defns0, Statements0, Defns),
flatten_statements(Statements0, Statements),
- { Stmt = block(Defns, Statements) }
+ { Stmt = block(Defns, Statements, IsHandwritten) }
;
{ Stmt0 = while(Rval0, Statement0, Once) },
fixup_rval(Rval0, Rval),
@@ -975,10 +975,10 @@
target_code_component, elim_info, elim_info).
:- mode fixup_target_code_component(in, out, in, out) is det.
-fixup_target_code_component(raw_target_code(Code),
- raw_target_code(Code)) --> [].
-fixup_target_code_component(user_target_code(Code, Context),
- user_target_code(Code, Context)) --> [].
+fixup_target_code_component(raw_target_code(Code, Attrs),
+ raw_target_code(Code, Attrs)) --> [].
+fixup_target_code_component(user_target_code(Code, Context, Attrs),
+ user_target_code(Code, Context, Attrs)) --> [].
fixup_target_code_component(target_code_input(Rval0),
target_code_input(Rval)) -->
fixup_rval(Rval0, Rval).
@@ -1246,7 +1246,7 @@
stmt_contains_defn(Stmt, Defn) :-
(
- Stmt = block(Defns, Statements),
+ Stmt = block(Defns, Statements, _IsHandwritten),
( defns_contains_defn(Defns, Defn)
; statements_contains_defn(Statements, Defn)
)
@@ -1376,7 +1376,7 @@
stmt_contains_var(Stmt, Name) :-
(
- Stmt = block(Defns, Statements),
+ Stmt = block(Defns, Statements, _IsHandwritten),
( defns_contains_var(Defns, Name)
; statements_contains_var(Statements, Name)
)
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.11
diff -u -r1.11 ml_optimize.m
--- compiler/ml_optimize.m 2001/07/09 15:55:04 1.11
+++ compiler/ml_optimize.m 2001/07/10 16:05:52
@@ -126,12 +126,15 @@
Stmt0 = call(_, _, _, _, _, _),
Stmt = optimize_in_call_stmt(OptInfo, Stmt0)
;
- Stmt0 = block(Defns0, Statements0),
+ Stmt0 = block(Defns0, Statements0, no),
convert_assignments_into_initializers(Defns0, Statements0,
OptInfo, Defns, Statements1),
Statements = optimize_in_statements(OptInfo, Statements1),
- Stmt = block(Defns, Statements)
+ Stmt = block(Defns, Statements, no)
;
+ Stmt0 = block(_Defns0, _Statements0, yes),
+ Stmt = Stmt0
+ ;
Stmt0 = while(Rval, Statement0, Once),
Stmt = while(Rval, optimize_in_statement(OptInfo,
Statement0), Once)
@@ -206,14 +209,14 @@
generate_assign_args(OptInfo, FuncArgs, CallArgs,
AssignStatements, AssignDefns),
AssignVarsStatement = statement(block(AssignDefns,
- AssignStatements), OptInfo ^ context),
+ AssignStatements, no), OptInfo ^ context),
CallReplaceStatements = [
CommentStatement,
AssignVarsStatement,
GotoStatement
],
- Stmt = block([], CallReplaceStatements)
+ Stmt = block([], CallReplaceStatements, no)
;
Stmt = Stmt0
).
@@ -317,7 +320,7 @@
Label = label(tailcall_loop_label_name),
Stmt = block([], [statement(Comment, Context),
statement(Label, Context),
- statement(Stmt0, Context)])
+ statement(Stmt0, Context)], no)
;
Stmt = Stmt0
).
Index: compiler/ml_simplify_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_simplify_switch.m,v
retrieving revision 1.2
diff -u -r1.2 ml_simplify_switch.m
--- compiler/ml_simplify_switch.m 2001/01/20 15:42:47 1.2
+++ compiler/ml_simplify_switch.m 2001/07/10 16:05:52
@@ -76,7 +76,7 @@
FirstVal, LastVal, NeedRangeCheck,
Type, Rval, MLDS_Context,
MLDS_Decls, MLDS_Statements),
- { Stmt = block(MLDS_Decls, MLDS_Statements) },
+ { Stmt = block(MLDS_Decls, MLDS_Statements, no) },
{ Statement = mlds__statement(Stmt, MLDS_Context) }
;
%
@@ -269,10 +269,10 @@
{ InRange = binop(unsigned_le, Index,
const(int_const(Difference))) },
{ Else = yes(mlds__statement(
- block([], DefaultStatements),
+ block([], DefaultStatements, no),
MLDS_Context)) },
{ SwitchBody = mlds__statement(
- block([], [DoJump | CasesCode]),
+ block([], [DoJump | CasesCode], no),
MLDS_Context) },
{ DoSwitch = mlds__statement(
if_then_else(InRange, SwitchBody, Else),
@@ -420,10 +420,12 @@
MLDS_Statement :-
(
Default = default_do_nothing,
- MLDS_Statement = mlds__statement(block([],[]), MLDS_Context)
+ MLDS_Statement = mlds__statement(block([],[], no),
+ MLDS_Context)
;
Default = default_is_unreachable,
- MLDS_Statement = mlds__statement(block([],[]), MLDS_Context)
+ MLDS_Statement = mlds__statement(block([],[], no),
+ MLDS_Context)
;
Default = default_case(MLDS_Statement)
).
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.7
diff -u -r1.7 ml_string_switch.m
--- compiler/ml_string_switch.m 2001/07/08 16:40:08 1.7
+++ compiler/ml_string_switch.m 2001/07/10 16:05:52
@@ -156,7 +156,7 @@
MLDS_Context),
SwitchStatement,
GotoEndStatement
- ]),
+ ], no),
MLDS_Context),
LoopBody = ml_gen_block([], [
mlds__statement(atomic(comment(
@@ -284,7 +284,7 @@
atomic(comment(CommentString)),
MLDS_Context) },
{ CaseStatement = mlds__statement(
- block([], [Comment, GoalStatement]),
+ block([], [Comment, GoalStatement], no),
MLDS_Context) },
{ MLDS_Cases = [[match_value(const(int_const(Slot)))] -
CaseStatement] }
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.9
diff -u -r1.9 ml_tailcall.m
--- compiler/ml_tailcall.m 2001/07/09 15:55:04 1.9
+++ compiler/ml_tailcall.m 2001/07/10 16:05:52
@@ -204,12 +204,12 @@
% in that block. The statement list will be in a
% tail position iff the block is in a tail position.
%
- Stmt0 = block(Defns0, Statements0),
+ Stmt0 = block(Defns0, Statements0, IsHandwritten),
Defns = mark_tailcalls_in_defns(Defns0),
NewLocals = [defns(Defns) | Locals],
Statements = mark_tailcalls_in_statements(Statements0,
AtTail, NewLocals),
- Stmt = block(Defns, Statements)
+ Stmt = block(Defns, Statements, IsHandwritten)
;
%
% The statement in the body of a while loop is never
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.11
diff -u -r1.11 ml_util.m
--- compiler/ml_util.m 2001/06/22 09:14:34 1.11
+++ compiler/ml_util.m 2001/07/10 16:05:52
@@ -205,7 +205,7 @@
stmt_contains_statement(Stmt, SubStatement) :-
(
- Stmt = block(_Defns, Statements),
+ Stmt = block(_Defns, Statements, _IsHandwritten),
statements_contains_statement(Statements, SubStatement)
;
Stmt = while(_Rval, Statement, _Once),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.58
diff -u -r1.58 mlds.m
--- compiler/mlds.m 2001/07/10 12:51:03 1.58
+++ compiler/mlds.m 2001/07/10 16:05:53
@@ -726,7 +726,13 @@
%
% sequence
%
- block(mlds__defns, list(mlds__statement))
+ block(mlds__defns, list(mlds__statement), bool)
+ % the `bool' is yes iff the block contains
+ % handwritten foreign language code.
+ % If so, this block can be considered a boundary for
+ % optimization purposes -- the code within the block
+ % should not be optimized as the optimizer will not
+ % (in general) understand the foreign code.
%
% iteration
@@ -1103,15 +1109,17 @@
; lang_GNU_C
; lang_C_minus_minus
; lang_asm
+ ; lang_il
; lang_java_asm
; lang_java_bytecode
.
:- type target_code_component
- ---> user_target_code(string, maybe(prog_context))
+ ---> user_target_code(string, maybe(prog_context),
+ target_code_attributes)
% user_target_code holds C code from
% the user's `pragma c_code' declaration
- ; raw_target_code(string)
+ ; raw_target_code(string, target_code_attributes)
% raw_target_code holds C code that the
% compiler has generated. To ensure that
% following `#line' directives work OK,
@@ -1124,6 +1132,11 @@
; target_code_output(mlds__lval)
; name(mlds__qualified_entity_name)
.
+
+:- type target_code_attributes == list(target_code_attribute).
+
+:- type target_code_attribute
+ ---> max_stack_size(int).
%
% constructor id
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.93
diff -u -r1.93 mlds_to_c.m
--- compiler/mlds_to_c.m 2001/07/09 15:55:05 1.93
+++ compiler/mlds_to_c.m 2001/07/10 16:05:54
@@ -539,6 +539,8 @@
{ sorry(this_file, "foreign code other than C") }.
mlds_output_c_defn(_Indent, user_foreign_code(csharp, _, _)) -->
{ sorry(this_file, "foreign code other than C") }.
+mlds_output_c_defn(_Indent, user_foreign_code(il, _, _)) -->
+ { sorry(this_file, "foreign code other than C") }.
:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
mlds__pragma_export, io__state, io__state).
@@ -1868,7 +1870,7 @@
%
% sequence
%
-mlds_output_stmt(Indent, FuncInfo, block(Defns, Statements), Context) -->
+mlds_output_stmt(Indent, FuncInfo, block(Defns, Statements, _), Context) -->
mlds_indent(Indent),
io__write_string("{\n"),
( { Defns \= [] } ->
@@ -1928,7 +1930,7 @@
MaybeElse = yes(_),
Then0 = statement(if_then_else(_, _, no), ThenContext)
->
- Then = statement(block([], [Then0]), ThenContext)
+ Then = statement(block([], [Then0], no), ThenContext)
;
%
% For examples of the form
@@ -1946,7 +1948,7 @@
MaybeElse = no,
Then0 = statement(if_then_else(_, _, yes(_)), ThenContext)
->
- Then = statement(block([], [Then0]), ThenContext)
+ Then = statement(block([], [Then0], no), ThenContext)
;
Then = Then0
},
@@ -2184,7 +2186,7 @@
{
Stmt0 = statement(if_then_else(_, _, no), Context)
->
- Stmt = statement(block([], [Stmt0]), Context)
+ Stmt = statement(block([], [Stmt0], no), Context)
;
Stmt = Stmt0
},
@@ -2488,7 +2490,7 @@
:- mode mlds_output_target_code_component(in, in, di, uo) is det.
mlds_output_target_code_component(Context,
- user_target_code(CodeString, MaybeUserContext)) -->
+ user_target_code(CodeString, MaybeUserContext, _Attrs)) -->
( { MaybeUserContext = yes(UserContext) } ->
mlds_to_c__output_context(mlds__make_context(UserContext))
;
@@ -2496,7 +2498,8 @@
),
io__write_string(CodeString),
io__write_string("\n").
-mlds_output_target_code_component(Context, raw_target_code(CodeString)) -->
+mlds_output_target_code_component(Context, raw_target_code(CodeString,
+ _Attrs)) -->
mlds_to_c__output_context(Context),
io__write_string(CodeString).
mlds_output_target_code_component(Context, target_code_input(Rval)) -->
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.8
diff -u -r1.8 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m 2001/07/09 15:55:05 1.8
+++ compiler/mlds_to_csharp.m 2001/07/10 16:05:54
@@ -243,7 +243,7 @@
io__write_string(Code),
io__nl
;
- { Statement = block(Defns, Statements) }
+ { Statement = block(Defns, Statements, _IsHandwritten) }
->
io__write_list(Defns, "", write_csharp_defn_decl),
io__write_string("{\n"),
@@ -272,9 +272,9 @@
:- pred write_csharp_code_component(mlds__target_code_component,
io__state, io__state).
:- mode write_csharp_code_component(in, di, uo) is det.
-write_csharp_code_component(user_target_code(Code, _MaybeContext)) -->
+write_csharp_code_component(user_target_code(Code, _MaybeContext, _Attrrs)) -->
io__write_string(Code).
-write_csharp_code_component(raw_target_code(Code)) -->
+write_csharp_code_component(raw_target_code(Code, _Attrs)) -->
io__write_string(Code).
% XXX we don't handle name yet.
write_csharp_code_component(name(_)) --> [].
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.43
diff -u -r1.43 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 2001/07/09 15:55:06 1.43
+++ compiler/mlds_to_gcc.m 2001/07/10 16:05:55
@@ -364,7 +364,8 @@
qual(MLDS_ModuleName, Name),
SymbolTable, LabelTable) },
{ term__context_init(Context) },
- { FuncBody = mlds__statement(block([], []), mlds__make_context(Context)) },
+ { FuncBody = mlds__statement(block([], [], no),
+ mlds__make_context(Context)) },
gcc__start_function(GCC_FuncDecl),
gen_statement(DefnInfo, FuncBody),
gcc__end_function.
@@ -2348,7 +2349,7 @@
%
% sequence
%
-gen_stmt(DefnInfo0, block(Defns, Statements), _Context) -->
+gen_stmt(DefnInfo0, block(Defns, Statements, _IsHandwritten), _Context) -->
gcc__start_block,
{ FuncName = DefnInfo0 ^ func_name },
{ FuncName = qual(ModuleName, _) },
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.39
diff -u -r1.39 mlds_to_il.m
--- compiler/mlds_to_il.m 2001/07/10 12:51:03 1.39
+++ compiler/mlds_to_il.m 2001/07/10 16:05:57
@@ -289,9 +289,10 @@
:- func rename_statement(mlds__statement) = mlds__statement.
-rename_statement(statement(block(Defns, Stmts), Context))
+rename_statement(statement(block(Defns, Stmts, IsHandwritten), Context))
= statement(block(list__map(rename_defn, Defns),
- list__map(rename_statement, Stmts)), Context).
+ list__map(rename_statement, Stmts), IsHandwritten),
+ Context).
rename_statement(statement(while(Rval, Loop, IterateOnce), Context))
= statement(while(rename_rval(Rval),
rename_statement(Loop), IterateOnce), Context).
@@ -1022,7 +1023,8 @@
:- pred statement_to_il(mlds__statement, instr_tree, il_info, il_info).
:- mode statement_to_il(in, out, in, out) is det.
-statement_to_il(statement(block(Defns, Statements), Context), Instrs) -->
+statement_to_il(statement(block(Defns, Statements, IsHandwritten), Context),
+ Instrs) -->
il_info_get_module_name(ModuleName),
il_info_get_next_block_id(BlockId),
{ list__map(defn_to_local(ModuleName), Defns, Locals) },
@@ -1033,13 +1035,20 @@
DataRep =^ il_data_rep,
{ list__map((pred((K - V)::in, (K - W)::out) is det :-
W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals) },
+ {
+ IsHandwritten = yes
+ ->
+ Scope = handwritten_scope(ILLocals)
+ ;
+ Scope = scope(ILLocals)
+ },
{ Instrs = tree__list([
context_node(Context),
- instr_node(start_block(scope(ILLocals), BlockId)),
+ instr_node(start_block(Scope, BlockId)),
InitInstrsTree,
comment_node("block body"),
BlockInstrs,
- node([end_block(scope(ILLocals), BlockId)])
+ node([end_block(Scope, BlockId)])
]) },
il_info_remove_locals(Locals).
@@ -1326,7 +1335,8 @@
"outline foreign proc -- already called") }
).
-atomic_statement_to_il(inline_target_code(_Lang, _Code), node(Instrs)) -->
+ % XXX we assume lang_C is MC++
+atomic_statement_to_il(inline_target_code(lang_C, _Code), Instrs) -->
il_info_get_module_name(ModuleName),
( no =^ method_foreign_lang ->
% XXX we hardcode managed C++ here
@@ -1342,9 +1352,9 @@
% XXX this is incorrect for functions, which might
% return a useful value.
{ RetType = void ->
- StoreReturnInstr = []
+ StoreReturnInstr = empty
;
- StoreReturnInstr = [stloc(name("succeeded"))]
+ StoreReturnInstr = instr_node(stloc(name("succeeded")))
},
MethodName =^ method_name,
{ assoc_list__keys(Params, TypeParams) },
@@ -1352,16 +1362,28 @@
Num::in, Num + 1::out) is det :-
Instr = ldarg(index(Num))),
TypeParams, LoadInstrs, 0, _) },
- { list__condense(
- [[comment("inline target code -- call handwritten version")],
- LoadInstrs,
- [call(get_static_methodref(ClassName, MethodName,
- RetType, TypeParams))],
- StoreReturnInstr
- ], Instrs) }
+ { Instrs = tree__list([
+ comment_node("inline target code -- call handwritten version"),
+ node(LoadInstrs),
+ instr_node(call(get_static_methodref(ClassName,
+ MethodName, RetType, TypeParams))),
+ StoreReturnInstr
+ ]) }
;
- { Instrs = [comment("inline target code -- already called")] }
+ { Instrs = comment_node("inline target code -- already called") }
).
+atomic_statement_to_il(inline_target_code(lang_il, Code), Instrs) -->
+ { Instrs = inline_code_to_il_asm(Code) }.
+atomic_statement_to_il(inline_target_code(lang_java_bytecode, _), _) -->
+ { unexpected(this_file, "lang_java_bytecode") }.
+atomic_statement_to_il(inline_target_code(lang_java_asm, _), _) -->
+ { unexpected(this_file, "lang_java_asm") }.
+atomic_statement_to_il(inline_target_code(lang_asm, _), _) -->
+ { unexpected(this_file, "lang_asm") }.
+atomic_statement_to_il(inline_target_code(lang_GNU_C, _), _) -->
+ { unexpected(this_file, "lang_GNU_C") }.
+atomic_statement_to_il(inline_target_code(lang_C_minus_minus, _), _) -->
+ { unexpected(this_file, "lang_C_minus_minus") }.
atomic_statement_to_il(trail_op(_), node(Instrs)) -->
@@ -1510,6 +1532,49 @@
]) }
).
+:- func inline_code_to_il_asm(list(target_code_component)) = instr_tree.
+inline_code_to_il_asm([]) = empty.
+inline_code_to_il_asm([T | Ts]) = tree(Instrs, Rest) :-
+ (
+ T = user_target_code(Code, MaybeContext, Attrs),
+ ( yes(max_stack_size(N)) = get_max_stack_attribute(Attrs) ->
+ Instrs = tree__list([
+ ( MaybeContext = yes(Context) ->
+ context_node(mlds__make_context(
+ Context))
+ ;
+ empty
+ ),
+ instr_node(il_asm_code(Code, N))
+ ])
+ ;
+ error(this_file ++ ": max_stack_size not set")
+ )
+ ;
+ T = raw_target_code(Code, Attrs),
+ ( yes(max_stack_size(N)) = get_max_stack_attribute(Attrs) ->
+ Instrs = instr_node(il_asm_code(Code, N))
+ ;
+ error(this_file ++ ": max_stack_size not set")
+ )
+ ;
+ T = target_code_input(_),
+ Instrs = empty
+ ;
+ T = target_code_output(_),
+ Instrs = empty
+ ;
+ T = name(_ `with_type` mlds__qualified_entity_name),
+ Instrs = empty
+ ),
+ Rest = inline_code_to_il_asm(Ts).
+
+:- func get_max_stack_attribute(target_code_attributes) =
+ maybe(target_code_attribute).
+get_max_stack_attribute([]) = no.
+get_max_stack_attribute([X | _Xs]) = yes(X) :- X = max_stack_size(_).
+
+
:- pred get_all_load_store_lval_instrs(list(lval), instr_tree, instr_tree,
il_info, il_info).
:- mode get_all_load_store_lval_instrs(in, out, out, in, out) is det.
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.14
diff -u -r1.14 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 2001/05/08 16:46:37 1.14
+++ compiler/mlds_to_ilasm.m 2001/07/10 16:05:57
@@ -83,6 +83,8 @@
handle_foreign_lang(csharp, "__csharp_code.cs", output_csharp_code).
handle_foreign_lang(c, _, _) :-
sorry(this_file, "language C foreign code not supported").
+handle_foreign_lang(il, _, _) :-
+ sorry(this_file, "language IL foreign code not supported").
%
% Generate the `.il' file.
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.9
diff -u -r1.9 mlds_to_java.m
--- compiler/mlds_to_java.m 2001/07/09 15:55:07 1.9
+++ compiler/mlds_to_java.m 2001/07/10 16:05:58
@@ -425,7 +425,7 @@
MaybeStatements0),
MaybeStatements0 = yes(Statements0),
Statements0 = mlds__statement(
- block(BlockDefns0, _BlockList0), _)
+ block(BlockDefns0, _BlockList0, IsHandwritten), _)
->
%
% Create new method name
@@ -453,7 +453,7 @@
% to the original predicate and then return
% what it returns
%
- Block = block(BlockDefns, []),
+ Block = block(BlockDefns, [], IsHandwritten),
Statements = mlds__statement(Block, Context),
%
% Put it all together.
@@ -1406,7 +1406,8 @@
%
% sequence
%
-output_stmt(Indent, FuncInfo, block(Defns, Statements), Context) -->
+output_stmt(Indent, FuncInfo, block(Defns, Statements, _IsHandwritten),
+ Context) -->
indent_line(Indent),
io__write_string("{\n"),
( { Defns \= [] } ->
@@ -1465,7 +1466,7 @@
MaybeElse = yes(_),
Then0 = statement(if_then_else(_, _, no), ThenContext)
->
- Then = statement(block([], [Then0]), ThenContext)
+ Then = statement(block([], [Then0], no), ThenContext)
;
Then = Then0
},
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.9
diff -u -r1.9 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 2001/07/09 15:55:07 1.9
+++ compiler/mlds_to_mcpp.m 2001/07/10 16:05:58
@@ -280,7 +280,8 @@
io__write_list(CodeComponents, "\n",
write_managed_cpp_code_component)
;
- { Statement = statement(block(Defns, Statements), _) }
+ { Statement = statement(block(Defns, Statements,
+ _IsHandwritten), _) }
->
io__write_list(Defns, "", write_managed_cpp_defn_decl),
io__write_string("{\n"),
@@ -369,9 +370,10 @@
:- pred write_managed_cpp_code_component(mlds__target_code_component,
io__state, io__state).
:- mode write_managed_cpp_code_component(in, di, uo) is det.
-write_managed_cpp_code_component(user_target_code(Code, _MaybeContext)) -->
+write_managed_cpp_code_component(user_target_code(Code, _MaybeContext,
+ _Attrs)) -->
io__write_string(Code).
-write_managed_cpp_code_component(raw_target_code(Code)) -->
+write_managed_cpp_code_component(raw_target_code(Code, _Attrs)) -->
io__write_string(Code).
% XXX we don't handle name yet.
write_managed_cpp_code_component(name(_)) --> [].
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.68
diff -u -r1.68 prog_data.m
--- compiler/prog_data.m 2001/06/27 05:04:20 1.68
+++ compiler/prog_data.m 2001/07/10 16:05:58
@@ -100,7 +100,7 @@
; csharp
; managed_cplusplus
% ; java
-% ; il
+ ; il
.
:- type pred_or_func
@@ -537,6 +537,15 @@
pragma_foreign_proc_attributes).
:- mode set_tabled_for_io(in, in, out) is det.
+
+:- pred add_extra_attribute(pragma_foreign_proc_attributes,
+ pragma_foreign_proc_extra_attribute,
+ pragma_foreign_proc_attributes).
+:- mode add_extra_attribute(in, in, out) is det.
+
+:- func extra_attributes(pragma_foreign_proc_attributes)
+ = pragma_foreign_proc_extra_attributes.
+
% For pragma c_code, there are two different calling conventions,
% one for C code that may recursively call Mercury code, and another
% more efficient one for the case when we know that the C code will
@@ -562,6 +571,13 @@
% we explicitly store the name because we need the real
% name in code_gen
+
+:- type pragma_foreign_proc_extra_attribute
+ ---> max_stack_size(int).
+
+:- type pragma_foreign_proc_extra_attributes ==
+ list(pragma_foreign_proc_extra_attribute).
+
%-----------------------------------------------------------------------------%
%
% Goals
@@ -962,17 +978,22 @@
:- implementation.
+:- import_module string.
+
:- type pragma_foreign_proc_attributes
---> attributes(
foreign_language :: foreign_language,
may_call_mercury :: may_call_mercury,
thread_safe :: thread_safe,
- tabled_for_io :: tabled_for_io
+ tabled_for_io :: tabled_for_io,
+ extra_attributes ::
+ list(pragma_foreign_proc_extra_attribute)
).
+
default_attributes(Language,
attributes(Language, may_call_mercury, not_thread_safe,
- not_tabled_for_io)).
+ not_tabled_for_io, [])).
may_call_mercury(Attrs, Attrs ^ may_call_mercury).
@@ -998,7 +1019,8 @@
% We ignore Lang because it isn't an attribute that you can put
% in the attribute list -- the foreign language specifier string
% is at the start of the pragma.
- Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO),
+ Attrs = attributes(_Lang, MayCallMercury, ThreadSafe, TabledForIO,
+ ExtraAttributes),
(
MayCallMercury = may_call_mercury,
MayCallMercuryStr = "may_call_mercury"
@@ -1020,6 +1042,16 @@
TabledForIO = not_tabled_for_io,
TabledForIOStr = "not_tabled_for_io"
),
- StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr].
+ StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr] ++
+ list__map(extra_attribute_to_string, ExtraAttributes).
+
+add_extra_attribute(Attributes0, NewAttribute,
+ Attributes0 ^ extra_attributes :=
+ [NewAttribute | Attributes0 ^ extra_attributes]).
+
+:- func extra_attribute_to_string(pragma_foreign_proc_extra_attribute)
+ = string.
+extra_attribute_to_string(max_stack_size(Size)) =
+ "max_stack_size(" ++ string__int_to_string(Size) ++ ")".
%-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.32
diff -u -r1.32 prog_io_pragma.m
--- compiler/prog_io_pragma.m 2001/07/06 14:39:30 1.32
+++ compiler/prog_io_pragma.m 2001/07/10 16:05:59
@@ -327,10 +327,10 @@
PredAndVarsTerm)
)
;
- MaybeFlags = error(FlagsError, ErrorTerm),
+ MaybeFlags = error(FlagsError, FlagsErrorTerm),
ErrMsg = "-- invalid third argument: ",
Res = error(InvalidDeclStr ++ ErrMsg ++ FlagsError,
- ErrorTerm)
+ FlagsErrorTerm)
)
;
ErrMsg = "-- invalid fourth argument, expecting string containing foreign code",
@@ -516,16 +516,16 @@
parse_pragma_foreign_proc_attributes_term(ForeignLanguage,
FlagsTerm, MaybeFlags),
(
- MaybeFlags = ok(Flags)
- ->
+ MaybeFlags = ok(Flags),
parse_pragma_foreign_code(ModuleName, Flags,
PredAndVarsTerm, ordinary(Code, yes(Context)),
VarSet, Res)
;
+ MaybeFlags = error(FlagsErr, FlagsErrTerm),
parse_pragma_foreign_proc_attributes_term(
- ForeignLanguage, PredAndVarsTerm, MaybeFlags),
+ ForeignLanguage, PredAndVarsTerm, MaybeFlags2),
(
- MaybeFlags = ok(Flags),
+ MaybeFlags2 = ok(Flags),
% XXX we should issue a warning; this syntax is
% deprecated We will continue to accept this if
% c_code is used, but not with foreign_code
@@ -541,10 +541,10 @@
PredAndVarsTerm)
)
;
- MaybeFlags = error(FlagsErr, ErrTerm),
+ MaybeFlags2 = error(_, _),
ErrMsg = "-- invalid third argument: ",
Res = error(InvalidDeclStr ++ ErrMsg ++
- FlagsErr, ErrTerm)
+ FlagsErr, FlagsErrTerm)
)
)
;
@@ -1126,7 +1126,8 @@
---> may_call_mercury(may_call_mercury)
; thread_safe(thread_safe)
; tabled_for_io(tabled_for_io)
- ; aliasing.
+ ; aliasing
+ ; max_stack_size(int).
:- pred parse_pragma_foreign_proc_attributes_term(foreign_language, term,
maybe1(pragma_foreign_proc_attributes)).
@@ -1177,11 +1178,20 @@
AttrList)
->
set_tabled_for_io(Attributes2, tabled_for_io,
- Attributes)
+ Attributes3)
;
- Attributes = Attributes2
+ Attributes3 = Attributes2
),
- MaybeAttributes = ok(Attributes)
+ ExtraAttrs = list__filter_map(
+ attribute_to_extra_attribute, AttrList),
+ list__foldl(
+ (pred(EAttr::in, Attrs0::in,
+ Attrs::out) is det :-
+ add_extra_attribute(Attrs0, EAttr,
+ Attrs)),
+ ExtraAttrs, Attributes3, Attributes),
+ MaybeAttributes = check_required_attributes(
+ ForeignLanguage, Attributes, Term)
)
;
ErrMsg = "expecting a foreign proc attribute or list of attributes",
@@ -1189,7 +1199,32 @@
).
+ % Check whether all the required attributes have been set for
+ % a particular language
+:- func check_required_attributes(foreign_language,
+ pragma_foreign_proc_attributes, term)
+ = maybe1(pragma_foreign_proc_attributes).
+
+check_required_attributes(c, Attrs, _Term) = ok(Attrs).
+check_required_attributes(managed_cplusplus, Attrs, _Term) = ok(Attrs).
+check_required_attributes(csharp, Attrs, _Term) = ok(Attrs).
+check_required_attributes(il, Attrs, Term) = Res :-
+ ( [] = list__filter_map(
+ (func(X) = X is semidet :- X = max_stack_size(_)),
+ Attrs ^ extra_attributes)
+ ->
+ Res = error(
+ "expecting max_stack_size attribute for IL code", Term)
+ ;
+ Res = ok(Attrs)
+ ).
+
+:- func attribute_to_extra_attribute(collected_pragma_foreign_proc_attribute)
+ = pragma_foreign_proc_extra_attribute is semidet.
+attribute_to_extra_attribute(max_stack_size(Size)) = max_stack_size(Size).
+
+
:- pred parse_pragma_foreign_proc_attributes_term0(term,
list(collected_pragma_foreign_proc_attribute)).
:- mode parse_pragma_foreign_proc_attributes_term0(in, out) is semidet.
@@ -1224,6 +1259,8 @@
Flag = tabled_for_io(TabledForIo)
; parse_aliasing(Term) ->
Flag = aliasing
+ ; parse_max_stack_size(Term, Size) ->
+ Flag = max_stack_size(Size)
;
fail
).
@@ -1266,6 +1303,14 @@
parse_aliasing(term__functor(term__atom("no_aliasing"), [], _)).
parse_aliasing(term__functor(term__atom("unknown_aliasing"), [], _)).
parse_aliasing(term__functor(term__atom("alias"), [_Types, _Alias], _)).
+
+
+:- pred parse_max_stack_size(term::in, int::out) is semidet.
+
+parse_max_stack_size(term__functor(
+ term__atom("max_stack_size"), [SizeTerm], _), Size) :-
+ SizeTerm = term__functor(term__integer(Size), [], _).
+
% parse a pragma foreign_code declaration
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list