[m-rev.] for review: MLDS->C accurate GC part 2
Fergus Henderson
fjh at cs.mu.OZ.AU
Sun Dec 30 00:15:29 AEDT 2001
Branches: main
Estimated hours taken: 50
Another substantial step towards supporting accurate garbage
collection for the MLDS->C back-end: generate code for the
GC tracing functions.
compiler/mlds.m:
Add new fields to store, with each local variable or argument
declaration, the code for the GC to trace that local variable
or argument.
compiler/ml_code_util.m:
Add a new procedure ml_gen_maybe_gc_trace_code to generate the
code for GC tracing a variable. The generated MLDS code calls
private_builtin:gc_trace/1, passing the variable's address and
the type_info for that variable. This code is generated by
invoking polymorphism__make_type_info_var to generate HLDS code
to build the type_infos needed, and then calling ml_code_gen.m
to convert that to MLDS.
library/private_builtin.m:
Add a new procedure gc_trace, which calls MR_agc_deep_copy().
This gets invoked by the code generated by ml_code_util.m.
compiler/polymorphism.m:
Export polymorphism__make_type_info_var, for use by ml_code_util.m.
compiler/mercury_compile.m:
Invoke the chain_gc_stack_frames pass before invoking the
hoist_nested_functions pass, since otherwise it doesn't work.
compiler/handle_options.m
Add a couple of checks for options that are not supported
in combination with `--gc accurate'.
compiler/ml_call_gen.m:
compiler/ml_code_gen.m:
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_string_switch.m:
compiler/ml_tailcall.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_csharp.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/mlds_to_mcpp.m:
compiler/rtti_to_mlds.m:
Various changes to handle the GC trace code field for variable and
argument declarations.
Workspace: /home/earth/fjh/ws-earth3/mercury
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.228
diff -u -d -r1.228 mercury_compile.m
--- compiler/mercury_compile.m 7 Dec 2001 07:53:39 -0000 1.228
+++ compiler/mercury_compile.m 29 Dec 2001 10:55:33 -0000
@@ -3261,36 +3261,39 @@
%
% Note that we call ml_elim_nested twice --
- % the first time to flatten nested functions,
- % and the second time to chain the stack frames
- % together, for accurate GC.
+ % the first time to chain the stack frames together, for accurate GC,
+ % and the second time to flatten nested functions.
% These two passes are quite similar,
% but must be done separately.
+ % Currently chaining the stack frames together for accurate GC
+ % needs to be done first, because the code for doing that
+ % can't handle the env_ptr references that the other pass
+ % generates.
%
- globals__io_lookup_bool_option(gcc_nested_functions, NestedFuncs),
- ( { NestedFuncs = no } ->
+ globals__io_get_gc_method(GC),
+ ( { GC = accurate } ->
maybe_write_string(Verbose,
- "% Flattening nested functions...\n"),
- ml_elim_nested(hoist_nested_funcs, MLDS20, MLDS30),
+ "% Threading GC stack frames...\n"),
+ ml_elim_nested(chain_gc_stack_frames, MLDS20, MLDS30),
maybe_write_string(Verbose, "% done.\n")
;
{ MLDS30 = MLDS20 }
),
maybe_report_stats(Stats),
- mercury_compile__maybe_dump_mlds(MLDS30, "30", "nested_funcs"),
+ mercury_compile__maybe_dump_mlds(MLDS30, "30", "gc_frames"),
- globals__io_get_gc_method(GC),
- ( { GC = accurate } ->
+ globals__io_lookup_bool_option(gcc_nested_functions, NestedFuncs),
+ ( { NestedFuncs = no } ->
maybe_write_string(Verbose,
- "% Threading GC stack frames...\n"),
- ml_elim_nested(chain_gc_stack_frames, MLDS30, MLDS35),
+ "% Flattening nested functions...\n"),
+ ml_elim_nested(hoist_nested_funcs, MLDS30, MLDS35),
maybe_write_string(Verbose, "% done.\n")
;
{ MLDS35 = MLDS30 }
),
maybe_report_stats(Stats),
- mercury_compile__maybe_dump_mlds(MLDS35, "35", "gc_frames"),
+ mercury_compile__maybe_dump_mlds(MLDS35, "35", "nested_funcs"),
globals__io_lookup_bool_option(optimize, Optimize),
( { Optimize = yes } ->
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.26
diff -u -d -r1.26 ml_call_gen.m
--- compiler/ml_call_gen.m 3 Aug 2001 12:07:24 -0000 1.26
+++ compiler/ml_call_gen.m 29 Dec 2001 12:51:18 -0000
@@ -142,9 +142,13 @@
%
% insert the `closure_arg' parameter
%
+ % XXX The GC handling for `closure_arg' here is wrong
+ { GC_TraceCode = no }, % XXX wrong
{ ClosureArgType = mlds__generic_type },
- { ClosureArg = data(var(var_name("closure_arg", no))) -
- ClosureArgType },
+ { ClosureArg = mlds__argument(
+ data(var(var_name("closure_arg", no))),
+ ClosureArgType,
+ GC_TraceCode) },
{ Params0 = mlds__func_params(ArgParams0, RetParam) },
{ Params = mlds__func_params([ClosureArg | ArgParams0], RetParam) },
{ Signature = mlds__get_func_signature(Params) },
@@ -206,8 +210,11 @@
ml_gen_info_new_conv_var(ConvVarNum),
{ FuncVarName = var_name(
string__format("func_%d", [i(ConvVarNum)]), no) },
+ % the function address is always a pointer to code,
+ % not to the heap, so the GC doesn't need to trace it
+ { GC_TraceCode = no },
{ FuncVarDecl = ml_gen_mlds_var_decl(var(FuncVarName),
- FuncType, mlds__make_context(Context)) },
+ FuncType, GC_TraceCode, mlds__make_context(Context)) },
ml_gen_var_lval(FuncVarName, FuncType, FuncVarLval),
{ AssignFuncVar = ml_gen_assign(FuncVarLval, FuncRval, Context) },
{ FuncVarRval = lval(FuncVarLval) },
@@ -308,6 +315,8 @@
%
% Compute the function signature
%
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId) },
{ Signature = mlds__get_func_signature(Params) },
@@ -319,8 +328,6 @@
%
% Compute the callee's Mercury argument types and modes
%
- =(MLDSGenInfo),
- { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
PredInfo, ProcInfo) },
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
@@ -510,7 +517,22 @@
ml_gen_cont_params_2([], _, []) --> [].
ml_gen_cont_params_2([Type | Types], ArgNum, [Argument | Arguments]) -->
{ ArgName = ml_gen_arg_name(ArgNum) },
- { Argument = data(var(ArgName)) - Type },
+ % XXX Figuring out the correct GC code here is difficult,
+ % since doing that requires knowing the HLDS types, but
+ % here we only have the MLDS types.
+ % Fortunately this code should only get executed
+ % if --nondet-copy-out is enabled, which is not normally
+ % the case when --gc accurate is enabled, so handling this
+ % is not very important.
+ ml_gen_info_get_globals(Globals),
+ { globals__get_gc_method(Globals, GC) },
+ ( { GC = accurate } ->
+ { sorry(this_file, "--gc accurate & --nondet-copy-out") }
+ ;
+ { Maybe_GC_TraceCode = no }
+ ),
+ { Argument = mlds__argument(data(var(ArgName)), Type,
+ Maybe_GC_TraceCode) },
ml_gen_cont_params_2(Types, ArgNum + 1, Arguments).
:- pred ml_gen_copy_args_to_locals(list(mlds__lval), list(mlds__type),
@@ -553,7 +575,7 @@
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
PredLabel, PredModule) },
- { Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId) },
+ ml_gen_proc_params(PredId, ProcId, Params),
{ Signature = mlds__get_func_signature(Params) },
{ QualifiedProcLabel = qual(PredModule, PredLabel - ProcId) },
{ CodeAddrRval = const(code_addr_const(proc(QualifiedProcLabel,
@@ -820,10 +842,7 @@
{ ArgVarName = mlds__var_name(string__format(
"conv%d_%s", [i(ConvVarNum), s(VarNameStr)]),
MaybeNum) },
- =(Info),
- { ml_gen_info_get_module_info(Info, ModuleInfo) },
- { ArgVarDecl = ml_gen_var_decl(ArgVarName, CalleeType,
- mlds__make_context(Context), ModuleInfo) },
+ ml_gen_var_decl(ArgVarName, CalleeType, Context, ArgVarDecl),
{ ConvDecls = [ArgVarDecl] },
% create the lval for the variable and use it for the
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.105
diff -u -d -r1.105 ml_code_gen.m
--- compiler/ml_code_gen.m 6 Nov 2001 15:20:59 -0000 1.105
+++ compiler/ml_code_gen.m 29 Dec 2001 12:26:04 -0000
@@ -727,7 +727,7 @@
:- import_module hlds_module, hlds_goal.
:- import_module code_model.
:- import_module mlds, ml_code_util.
-:- import_module io.
+:- import_module io, map.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -769,6 +769,12 @@
ml_gen_info, ml_gen_info).
:- mode ml_gen_wrap_goal(in, in, in, in, out, in, out) is det.
+ % Generate declarations for a list of local variables.
+ %
+:- pred ml_gen_local_var_decls(prog_varset::in, map(prog_var, prog_type)::in,
+ prog_context::in, prog_vars::in, mlds__defns::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -784,7 +790,7 @@
:- import_module passes_aux, modules.
:- import_module globals, options.
-:- import_module assoc_list, bool, string, list, map.
+:- import_module assoc_list, bool, string, list.
:- import_module int, set, term, require, std_util.
%-----------------------------------------------------------------------------%
@@ -1015,8 +1021,22 @@
Type = mlds__generic_type,
Initializer = init_obj(const(null(Type))),
proc_info_context(ProcInfo, Context),
+ (
+ module_info_globals(ModuleInfo, Globals),
+ globals__get_gc_method(Globals, GC_Method),
+ GC_Method = accurate
+ ->
+ % XXX To handle this case properly, the GC would
+ % need to trace through the global variable
+ % that we generate for the table pointer.
+ % Support for this is not yet implemented.
+ sorry(this_file, "tabling and `--gc accurate'")
+ ;
+ GC_TraceCode = no
+ ),
TablePointerVarDefn = ml_gen_mlds_var_decl(
- Var, Type, Initializer, mlds__make_context(Context)),
+ Var, Type, Initializer, GC_TraceCode,
+ mlds__make_context(Context)),
Defns = [TablePointerVarDefn | Defns0]
;
Defns = Defns0
@@ -1074,7 +1094,6 @@
goal_info_get_context(GoalInfo, Context),
MLDSGenInfo0 = ml_gen_info_init(ModuleInfo, PredId, ProcId),
- MLDS_Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
( ImportStatus = external(_) ->
%
@@ -1086,7 +1105,9 @@
% is declared as `extern' rather than `static'.
%
FunctionBody = external,
- ExtraDefns = []
+ ExtraDefns = [],
+ ml_gen_proc_params(PredId, ProcId, MLDS_Params,
+ MLDSGenInfo0, _MLDSGenInfo)
;
% Set up the initial success continuation, if any.
% Also figure out which output variables are returned by
@@ -1103,17 +1124,18 @@
% This would generate all the local variables at the top of
% the function:
- % MLDS_LocalVars = ml_gen_all_local_var_decls(Goal,
- % VarSet, VarTypes, HeadVars, ModuleInfo),
+ % ml_gen_all_local_var_decls(Goal,
+ % VarSet, VarTypes, HeadVars, MLDS_LocalVars,
+ % MLDSGenInfo1, MLDSGenInfo2)
% But instead we now generate them locally for each goal.
% We just declare the `succeeded' var here, plus locals
% for any output arguments that are returned by value
% (e.g. if --nondet-copy-out is enabled, or for det function
% return values).
- MLDS_Context = mlds__make_context(Context),
( CopiedOutputVars = [] ->
% optimize common case
- OutputVarLocals = []
+ OutputVarLocals = [],
+ MLDSGenInfo2 = MLDSGenInfo1
;
proc_info_varset(ProcInfo, VarSet),
proc_info_vartypes(ProcInfo, VarTypes),
@@ -1121,16 +1143,20 @@
% the procedure interface, not from the procedure body
HeadVarTypes = map__from_corresponding_lists(HeadVars,
ArgTypes),
- OutputVarLocals = ml_gen_local_var_decls(VarSet,
+ ml_gen_local_var_decls(VarSet,
map__overlay(VarTypes, HeadVarTypes),
- MLDS_Context, ModuleInfo, CopiedOutputVars)
+ Context, CopiedOutputVars, OutputVarLocals,
+ MLDSGenInfo1, MLDSGenInfo2)
),
+ MLDS_Context = mlds__make_context(Context),
MLDS_LocalVars = [ml_gen_succeeded_var_decl(MLDS_Context) |
OutputVarLocals],
ml_gen_proc_body(CodeModel, HeadVars, ArgTypes,
CopiedOutputVars, Goal,
MLDS_Decls0, MLDS_Statements,
- MLDSGenInfo1, MLDSGenInfo),
+ MLDSGenInfo2, MLDSGenInfo3),
+ ml_gen_proc_params(PredId, ProcId, MLDS_Params,
+ MLDSGenInfo3, MLDSGenInfo),
ml_gen_info_get_extra_defns(MLDSGenInfo, ExtraDefns),
MLDS_Decls = list__append(MLDS_LocalVars, MLDS_Decls0),
MLDS_Statement = ml_gen_block(MLDS_Decls, MLDS_Statements,
@@ -1226,41 +1252,37 @@
% generate local declarations for all the variables used in
% each sub-goal.
%
-:- func ml_gen_all_local_var_decls(hlds_goal, prog_varset,
- map(prog_var, prog_type), list(prog_var), module_info) =
- mlds__defns.
-ml_gen_all_local_var_decls(Goal, VarSet, VarTypes, HeadVars, ModuleInfo) =
- MLDS_LocalVars :-
- Goal = _ - GoalInfo,
- goal_info_get_context(GoalInfo, Context),
- goal_util__goal_vars(Goal, AllVarsSet),
- set__delete_list(AllVarsSet, HeadVars, LocalVarsSet),
- set__to_sorted_list(LocalVarsSet, LocalVars),
- MLDS_Context = mlds__make_context(Context),
- MLDS_LocalVars0 = ml_gen_local_var_decls(VarSet, VarTypes,
- MLDS_Context, ModuleInfo, LocalVars),
- MLDS_SucceededVar = ml_gen_succeeded_var_decl(MLDS_Context),
- MLDS_LocalVars = [MLDS_SucceededVar | MLDS_LocalVars0].
+:- pred ml_gen_all_local_var_decls(hlds_goal::in, prog_varset::in,
+ map(prog_var, prog_type)::in, list(prog_var)::in,
+ mlds__defns::out, ml_gen_info::in, ml_gen_info::out) is det.
+ml_gen_all_local_var_decls(Goal, VarSet, VarTypes, HeadVars, MLDS_LocalVars) -->
+ { Goal = _ - GoalInfo },
+ { goal_info_get_context(GoalInfo, Context) },
+ { goal_util__goal_vars(Goal, AllVarsSet) },
+ { set__delete_list(AllVarsSet, HeadVars, LocalVarsSet) },
+ { set__to_sorted_list(LocalVarsSet, LocalVars) },
+ ml_gen_local_var_decls(VarSet, VarTypes, Context, LocalVars,
+ MLDS_LocalVars0),
+ { MLDS_Context = mlds__make_context(Context) },
+ { MLDS_SucceededVar = ml_gen_succeeded_var_decl(MLDS_Context) },
+ { MLDS_LocalVars = [MLDS_SucceededVar | MLDS_LocalVars0] }.
% Generate declarations for a list of local variables.
%
-:- func ml_gen_local_var_decls(prog_varset, map(prog_var, prog_type),
- mlds__context, module_info, prog_vars) = mlds__defns.
-ml_gen_local_var_decls(VarSet, VarTypes, Context, ModuleInfo, Vars) =
- LocalDecls :-
- list__filter_map(ml_gen_local_var_decl(VarSet, VarTypes, Context,
- ModuleInfo), Vars, LocalDecls).
-
- % Generate a declaration for a local variable.
- %
-:- pred ml_gen_local_var_decl(prog_varset, map(prog_var, prog_type),
- mlds__context, module_info, prog_var, mlds__defn).
-:- mode ml_gen_local_var_decl(in, in, in, in, in, out) is semidet.
-ml_gen_local_var_decl(VarSet, VarTypes, Context, ModuleInfo, Var, MLDS_Defn) :-
- map__lookup(VarTypes, Var, Type),
- not type_util__is_dummy_argument_type(Type),
- VarName = ml_gen_var_name(VarSet, Var),
- MLDS_Defn = ml_gen_var_decl(VarName, Type, Context, ModuleInfo).
+ml_gen_local_var_decls(_VarSet, _VarTypes, _Context, [], []) --> [].
+ml_gen_local_var_decls(VarSet, VarTypes, Context, [Var|Vars], MLDS_Defns) -->
+ { map__lookup(VarTypes, Var, Type) },
+ ( { type_util__is_dummy_argument_type(Type) } ->
+ % no declaration needed for this variable
+ ml_gen_local_var_decls(VarSet, VarTypes, Context, Vars,
+ MLDS_Defns)
+ ;
+ { VarName = ml_gen_var_name(VarSet, Var) },
+ ml_gen_var_decl(VarName, Type, Context, MLDS_Defn),
+ ml_gen_local_var_decls(VarSet, VarTypes, Context, Vars,
+ MLDS_Defns0),
+ { MLDS_Defns = [MLDS_Defn | MLDS_Defns0] }
+ ).
% Generate the code for a procedure body.
%
@@ -1432,6 +1454,7 @@
%
ml_gen_goal(CodeModel, Goal, MLDS_Decls, MLDS_Statements) -->
{ Goal = GoalExpr - GoalInfo },
+ { goal_info_get_context(GoalInfo, Context) },
%
% Generate the local variables for this goal.
% We need to declare any variables which
@@ -1447,14 +1470,12 @@
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
{ ml_gen_info_get_var_types(MLDSGenInfo, VarTypes) },
- { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
- { VarDecls = ml_gen_local_var_decls(VarSet, VarTypes,
- mlds__make_context(Context), ModuleInfo, VarsList) },
+ ml_gen_local_var_decls(VarSet, VarTypes,
+ Context, VarsList, VarDecls),
%
% Generate code for the goal in its own code model.
%
- { goal_info_get_context(GoalInfo, Context) },
{ goal_info_get_code_model(GoalInfo, GoalCodeModel) },
ml_gen_goal_expr(GoalExpr, GoalCodeModel, Context,
GoalDecls, GoalStatements0),
@@ -1919,10 +1940,10 @@
{ OutputVarName = mlds__var_name(OutputVarNameStr, MaybeNum) },
{ LocalVarName = mlds__var_name(
string__append("local_", OutputVarNameStr), MaybeNum) },
-
ml_gen_type(Type, MLDS_Type),
+ ml_gen_maybe_gc_trace_code(LocalVarName, Type, Context, GC_TraceCode),
{ LocalVarDefn = ml_gen_mlds_var_decl(var(LocalVarName), MLDS_Type,
- mlds__make_context(Context)) },
+ GC_TraceCode, mlds__make_context(Context)) },
%
% Generate code to assign from the local var to the output var
@@ -1943,7 +1964,7 @@
%
:- func ml_gen_commit_var_decl(mlds__context, mlds__var_name) = mlds__defn.
ml_gen_commit_var_decl(Context, VarName) =
- ml_gen_mlds_var_decl(var(VarName), mlds__commit_type, Context).
+ ml_gen_mlds_var_decl(var(VarName), mlds__commit_type, no, Context).
% Generate MLDS code for the different kinds of HLDS goals.
%
@@ -2352,7 +2373,7 @@
SuccessIndicatorDecl = ml_gen_mlds_var_decl(
var(SuccessIndicatorVarName),
mlds__native_bool_type,
- no_initializer, MLDSContext),
+ no_initializer, no, MLDSContext),
SuccessIndicatorLval = var(qual(MLDSModuleName,
SuccessIndicatorVarName), mlds__native_bool_type),
SuccessIndicatorStatement = ml_gen_assign(SucceededLval,
@@ -2485,9 +2506,13 @@
lval(var(QualVarName, MLDSType))),
Box0 = Box
),
+ % XXX Accurate GC is not supported for IL foreign code;
+ % this would only be useful if interfacing to
+ % IL when compiling to C, which is not yet supported.
+ GC_TraceCode = no,
MLDS_Defn = ml_gen_mlds_var_decl(
var(NonMangledVarName), MLDSType,
- Initializer, MLDSContext)
+ Initializer, GC_TraceCode, MLDSContext)
), ArgVars, VarLocals, [], BoxStatements) },
{ OutlineStmt = inline_target_code(lang_il, [
@@ -3324,9 +3349,12 @@
attribute_to_mlds_attribute(ModuleInfo, custom(Type)) =
custom(mercury_type_to_mlds_type(ModuleInfo, Type)).
+%-----------------------------------------------------------------------------%
:- func this_file = string.
-this_file = "mlds_to_c.m".
+this_file = "ml_code_gen.m".
+
+:- end_module ml_code_gen.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.48
diff -u -d -r1.48 ml_code_util.m
--- compiler/ml_code_util.m 8 Nov 2001 11:47:57 -0000 1.48
+++ compiler/ml_code_util.m 29 Dec 2001 11:54:41 -0000
@@ -143,10 +143,19 @@
% Routines for generating function declarations (i.e. mlds__func_params).
%
+% Note that when generating function *definitions*,
+% the versions that take an ml_gen_info pair should be used,
+% since those are the only ones that will generate the
+% correct GC tracing code for the parameters.
+
% Generate the function prototype for a given procedure.
%
:- func ml_gen_proc_params(module_info, pred_id, proc_id) = mlds__func_params.
+:- pred ml_gen_proc_params(pred_id, proc_id, mlds__func_params,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_proc_params(in, in, out, in, out) is det.
+
:- func ml_gen_proc_params_from_rtti(module_info, rtti_proc_label) =
mlds__func_params.
@@ -156,6 +165,11 @@
:- func ml_gen_params(module_info, list(mlds__var_name), list(prog_type),
list(mode), pred_or_func, code_model) = mlds__func_params.
+:- pred ml_gen_params(list(mlds__var_name), list(prog_type),
+ list(mode), pred_or_func, code_model, mlds__func_params,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_params(in, in, in, in, in, out, in, out) is det.
+
% Given a list of variables and their corresponding modes,
% return a list containing only those variables which have
% an output mode.
@@ -261,19 +275,22 @@
% Generate a declaration for an MLDS variable, given its HLDS type.
%
-:- func ml_gen_var_decl(var_name, prog_type, mlds__context, module_info) =
- mlds__defn.
+:- pred ml_gen_var_decl(var_name, prog_type, prog_context, mlds__defn,
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_var_decl(in, in, in, out, in, out) is det.
- % Generate a declaration for an MLDS variable, given its MLDS type.
+ % Generate a declaration for an MLDS variable, given its MLDS type
+ % and the code to trace it for accurate GC (if needed).
%
-:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__context) =
- mlds__defn.
+:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type,
+ maybe(mlds__statement), mlds__context) = mlds__defn.
% Generate a declaration for an MLDS variable, given its MLDS type
- % and initializer.
+ % and initializer, and given the code to trace it for accurate GC
+ % (if needed).
%
:- func ml_gen_mlds_var_decl(mlds__data_name, mlds__type, mlds__initializer,
- mlds__context) = mlds__defn.
+ maybe(mlds__statement), mlds__context) = mlds__defn.
% Generate declaration flags for a local variable
%
@@ -462,14 +479,26 @@
:- pred ml_get_env_ptr(mlds__rval, ml_gen_info, ml_gen_info).
:- mode ml_get_env_ptr(out, in, out) is det.
- % Return an rval for a pointer to the current environment
+ % Return an mlds__argument for a pointer to the current environment
% (the set of local variables in the containing procedure).
-:- pred ml_declare_env_ptr_arg(pair(mlds__entity_name, mlds__type),
- ml_gen_info, ml_gen_info).
+:- pred ml_declare_env_ptr_arg(mlds__argument, ml_gen_info, ml_gen_info).
:- mode ml_declare_env_ptr_arg(out, in, out) is det.
%-----------------------------------------------------------------------------%
%
+% Code to handle accurate GC
+%
+
+ % If accurate GC is enabled, and the specified
+ % variable might contain pointers, generate code to call
+ % `private_builtin__gc_trace_var' to trace the variable.
+ %
+:- pred ml_gen_maybe_gc_trace_code(var_name, prog_type, prog_context,
+ maybe(mlds__statement), ml_gen_info, ml_gen_info).
+:- mode ml_gen_maybe_gc_trace_code(in, in, in, out, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%
% Magic numbers relating to the representation of
% typeclass_infos, base_typeclass_infos, and closures.
%
@@ -718,13 +747,15 @@
:- implementation.
-:- import_module ml_call_gen.
+:- import_module prog_data.
+:- import_module hlds_goal, (inst), instmap, polymorphism.
:- import_module foreign.
:- import_module prog_util, type_util, mode_util, special_pred, error_util.
:- import_module code_util. % XXX for `code_util__compiler_generated'.
+:- import_module ml_code_gen, ml_call_gen.
:- import_module globals, options.
-:- import_module stack, string, require, term, varset.
+:- import_module stack, string, require, set, term, varset.
%-----------------------------------------------------------------------------%
%
@@ -1016,6 +1047,20 @@
FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes,
HeadModes, PredOrFunc, CodeModel).
+ml_gen_proc_params(PredId, ProcId, FuncParams, MLGenInfo0, MLGenInfo) :-
+ ModuleInfo = MLGenInfo0 ^ module_info,
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo),
+ proc_info_varset(ProcInfo, VarSet),
+ proc_info_headvars(ProcInfo, HeadVars),
+ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
+ pred_info_arg_types(PredInfo, HeadTypes),
+ proc_info_argmodes(ProcInfo, HeadModes),
+ proc_info_interface_code_model(ProcInfo, CodeModel),
+ HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
+ ml_gen_params(HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
+ CodeModel, FuncParams, MLGenInfo0, MLGenInfo).
+
% As above, but from the rtti_proc_id rather than
% from the module_info, pred_id, and proc_id.
%
@@ -1027,8 +1072,8 @@
PredOrFunc = RttiProcId^pred_or_func,
CodeModel = RttiProcId^proc_interface_code_model,
HeadVarNames = ml_gen_var_names(VarSet, HeadVars),
- FuncParams = ml_gen_params_base(ModuleInfo, HeadVarNames,
- ArgTypes, ArgModes, PredOrFunc, CodeModel).
+ ml_gen_params_base(ModuleInfo, HeadVarNames, ArgTypes, ArgModes,
+ PredOrFunc, CodeModel, FuncParams, no, _).
% Generate the function prototype for a procedure with the
% given argument types, modes, and code model.
@@ -1036,18 +1081,35 @@
ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
CodeModel) = FuncParams :-
modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes),
- FuncParams = ml_gen_params_base(ModuleInfo, HeadVarNames,
- HeadTypes, ArgModes, PredOrFunc, CodeModel).
+ ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, ArgModes,
+ PredOrFunc, CodeModel, FuncParams, no, _).
-:- func ml_gen_params_base(module_info, list(mlds__var_name), list(prog_type),
- list(arg_mode), pred_or_func, code_model) = mlds__func_params.
+ml_gen_params(HeadVarNames, HeadTypes, HeadModes, PredOrFunc,
+ CodeModel, FuncParams, MLGenInfo0, MLGenInfo) :-
+ ModuleInfo = MLGenInfo0 ^ module_info,
+ modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes),
+ ml_gen_params_base(ModuleInfo, HeadVarNames,
+ HeadTypes, ArgModes, PredOrFunc, CodeModel, FuncParams,
+ yes(MLGenInfo0), MaybeMLGenInfo),
+ ( MaybeMLGenInfo = yes(MLGenInfo1) ->
+ MLGenInfo = MLGenInfo1
+ ;
+ error("ml_gen_params: missing ml_gen_info")
+ ).
+
+:- pred ml_gen_params_base(module_info, list(mlds__var_name), list(prog_type),
+ list(arg_mode), pred_or_func, code_model, mlds__func_params,
+ maybe(ml_gen_info), maybe(ml_gen_info)).
+:- mode ml_gen_params_base(in, in, in, in, in, in, out, in, out) is det.
ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
- PredOrFunc, CodeModel) = FuncParams :-
+ PredOrFunc, CodeModel, FuncParams,
+ MaybeMLGenInfo0, MaybeMLGenInfo) :-
module_info_globals(ModuleInfo, Globals),
CopyOut = get_copy_out_option(Globals, CodeModel),
ml_gen_arg_decls(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
- CopyOut, FuncArgs0, RetTypes0),
+ CopyOut, FuncArgs0, RetTypes0,
+ MaybeMLGenInfo0, MaybeMLGenInfo),
(
CodeModel = model_det,
%
@@ -1062,8 +1124,9 @@
pred_args_to_func_args(HeadTypes, _, ResultType),
\+ type_util__is_dummy_argument_type(ResultType)
->
- pred_args_to_func_args(FuncArgs0, FuncArgs,
- _RetArgName - RetTypePtr),
+ pred_args_to_func_args(FuncArgs0, FuncArgs, RetArg),
+ RetArg = mlds__argument(_RetArgName, RetTypePtr,
+ _GC_TraceCode),
( RetTypePtr = mlds__ptr_type(RetType) ->
RetTypes = [RetType]
;
@@ -1094,19 +1157,29 @@
RetTypes = RetTypes0
),
ContName = data(var(var_name("cont", no))),
- ContArg = ContName - ContType,
+ % The cont variable always points to code, not to the heap,
+ % so the GC never needs to trace it.
+ ContGCTraceCode = no,
+ ContArg = mlds__argument(ContName, ContType, ContGCTraceCode),
ContEnvType = mlds__generic_env_ptr_type,
ContEnvName = data(var(var_name("cont_env_ptr", no))),
- ContEnvArg = ContEnvName - ContEnvType,
+ % The cont_env_ptr always points to the stack,
+ % since continuation environments are always allocated
+ % on the stack (unless put_nondet_env_on_heap is true,
+ % which won't be the case when doing our own GC --
+ % this is enforced in handle_options.m).
+ % So the GC doesn't need to trace it.
+ ContEnvGCTraceCode = no,
+ ContEnvArg = mlds__argument(ContEnvName, ContEnvType,
+ ContEnvGCTraceCode),
globals__lookup_bool_option(Globals, gcc_nested_functions,
NestedFunctions),
(
NestedFunctions = yes
->
- FuncArgs = list__append(FuncArgs0, [ContArg])
+ FuncArgs = FuncArgs0 ++ [ContArg]
;
- FuncArgs = list__append(FuncArgs0,
- [ContArg, ContEnvArg])
+ FuncArgs = FuncArgs0 ++ [ContArg, ContEnvArg]
)
),
FuncParams = mlds__func_params(FuncArgs, RetTypes).
@@ -1116,22 +1189,25 @@
% and return types.
%
:- pred ml_gen_arg_decls(module_info, list(mlds__var_name), list(prog_type),
- list(arg_mode), bool, mlds__arguments, mlds__return_types).
-:- mode ml_gen_arg_decls(in, in, in, in, in, out, out) is det.
+ list(arg_mode), bool, mlds__arguments, mlds__return_types,
+ maybe(ml_gen_info), maybe(ml_gen_info)).
+:- mode ml_gen_arg_decls(in, in, in, in, in, out, out, in, out) is det.
ml_gen_arg_decls(ModuleInfo, HeadVars, HeadTypes, HeadModes, CopyOut,
- FuncArgs, RetTypes) :-
+ FuncArgs, RetTypes, MaybeMLGenInfo0, MaybeMLGenInfo) :-
(
HeadVars = [], HeadTypes = [], HeadModes = []
->
- FuncArgs = [], RetTypes = []
+ FuncArgs = [], RetTypes = [],
+ MaybeMLGenInfo = MaybeMLGenInfo0
;
HeadVars = [Var | Vars],
HeadTypes = [Type | Types],
HeadModes = [Mode | Modes]
->
ml_gen_arg_decls(ModuleInfo, Vars, Types, Modes, CopyOut,
- FuncArgs0, RetTypes0),
+ FuncArgs0, RetTypes0,
+ MaybeMLGenInfo0, MaybeMLGenInfo1),
(
%
% exclude types such as io__state, etc.
@@ -1139,7 +1215,8 @@
type_util__is_dummy_argument_type(Type)
->
FuncArgs = FuncArgs0,
- RetTypes = RetTypes0
+ RetTypes = RetTypes0,
+ MaybeMLGenInfo = MaybeMLGenInfo1
;
%
% for by-value outputs, generate a return type
@@ -1149,13 +1226,15 @@
->
RetType = mercury_type_to_mlds_type(ModuleInfo, Type),
RetTypes = [RetType | RetTypes0],
- FuncArgs = FuncArgs0
+ FuncArgs = FuncArgs0,
+ MaybeMLGenInfo = MaybeMLGenInfo1
;
%
% for inputs and by-reference outputs,
% generate argument
%
- ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, FuncArg),
+ ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, FuncArg,
+ MaybeMLGenInfo1, MaybeMLGenInfo),
FuncArgs = [FuncArg | FuncArgs0],
RetTypes = RetTypes0
)
@@ -1167,10 +1246,11 @@
% generate an MLDS argument declaration for it.
%
:- pred ml_gen_arg_decl(module_info, var_name, prog_type, arg_mode,
- pair(mlds__entity_name, mlds__type)).
-:- mode ml_gen_arg_decl(in, in, in, in, out) is det.
+ mlds__argument, maybe(ml_gen_info), maybe(ml_gen_info)).
+:- mode ml_gen_arg_decl(in, in, in, in, out, in, out) is det.
-ml_gen_arg_decl(ModuleInfo, Var, Type, ArgMode, FuncArg) :-
+ml_gen_arg_decl(ModuleInfo, Var, Type, ArgMode, FuncArg,
+ MaybeMLGenInfo0, MaybeMLGenInfo) :-
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
( ArgMode \= top_in ->
MLDS_ArgType = mlds__ptr_type(MLDS_Type)
@@ -1178,7 +1258,17 @@
MLDS_ArgType = MLDS_Type
),
Name = data(var(Var)),
- FuncArg = Name - MLDS_ArgType.
+ ( MaybeMLGenInfo0 = yes(MLGenInfo0) ->
+ % XXX We should fill in this Context properly
+ term__context_init(Context),
+ ml_gen_maybe_gc_trace_code(Var, Type, Context,
+ Maybe_GC_TraceCode, MLGenInfo0, MLGenInfo),
+ MaybeMLGenInfo = yes(MLGenInfo)
+ ;
+ Maybe_GC_TraceCode = no,
+ MaybeMLGenInfo = no
+ ),
+ FuncArg = mlds__argument(Name, MLDS_ArgType, Maybe_GC_TraceCode).
ml_is_output_det_function(ModuleInfo, PredId, ProcId, RetArgVar) :-
@@ -1478,22 +1568,28 @@
% Generate a declaration for an MLDS variable, given its HLDS type.
%
-ml_gen_var_decl(VarName, Type, Context, ModuleInfo) =
- ml_gen_mlds_var_decl(var(VarName),
- mercury_type_to_mlds_type(ModuleInfo, Type), Context).
+ml_gen_var_decl(VarName, Type, Context, MLDS_Defn) -->
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ ml_gen_maybe_gc_trace_code(VarName, Type, Context, GC_TraceCode),
+ { MLDS_Defn = ml_gen_mlds_var_decl(var(VarName),
+ mercury_type_to_mlds_type(ModuleInfo, Type),
+ GC_TraceCode, mlds__make_context(Context)) }.
% Generate a declaration for an MLDS variable, given its MLDS type.
%
-ml_gen_mlds_var_decl(DataName, MLDS_Type, Context) =
- ml_gen_mlds_var_decl(DataName, MLDS_Type, no_initializer, Context).
+ml_gen_mlds_var_decl(DataName, MLDS_Type, GC_TraceCode, Context) =
+ ml_gen_mlds_var_decl(DataName, MLDS_Type, no_initializer, GC_TraceCode,
+ Context).
% Generate a declaration for an MLDS variable, given its MLDS type
% and initializer.
%
-ml_gen_mlds_var_decl(DataName, MLDS_Type, Initializer, Context) = MLDS_Defn :-
+ml_gen_mlds_var_decl(DataName, MLDS_Type, Initializer, GC_TraceCode, Context) =
+ MLDS_Defn :-
Name = data(DataName),
- Defn = data(MLDS_Type, Initializer),
+ Defn = data(MLDS_Type, Initializer, GC_TraceCode),
DeclFlags = ml_gen_local_var_decl_flags,
MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
@@ -1503,7 +1599,11 @@
ml_gen_static_const_defn(ConstName, ConstType, Access, Initializer, Context) =
MLDS_Defn :-
Name = data(var(ConstName)),
- Defn = data(ConstType, Initializer),
+ % The GC never needs to trace static constants,
+ % because they can never point into the heap
+ % (only to other static constants).
+ GC_TraceCode = no,
+ Defn = data(ConstType, Initializer, GC_TraceCode),
DeclFlags = mlds__set_access(ml_static_const_decl_flags, Access),
MLDS_Context = mlds__make_context(Context),
MLDS_Defn = mlds__defn(Name, MLDS_Context, DeclFlags, Defn).
@@ -1549,7 +1649,6 @@
string__format("%s_%d", [s(Var), i(Num)]).
ml_var_name_to_string(var_name(Var, no)) = Var.
-
%-----------------------------------------------------------------------------%
%
% Code for dealing with fields
@@ -1645,7 +1744,7 @@
%
ml_gen_succeeded_var_decl(Context) =
ml_gen_mlds_var_decl(var(var_name("succeeded", no)),
- mlds__native_bool_type, Context).
+ mlds__native_bool_type, no, Context).
% Return the lval for the `succeeded' flag.
% (`succeeded' is a boolean variable used to record
@@ -1680,7 +1779,7 @@
ml_gen_cond_var_decl(CondVar, Context) =
ml_gen_mlds_var_decl(var(ml_gen_cond_var_name(CondVar)),
- mlds__native_bool_type, Context).
+ mlds__native_bool_type, no, Context).
ml_cond_var_lval(CondVar, CondVarLval) -->
ml_gen_var_lval(ml_gen_cond_var_name(CondVar), mlds__native_bool_type,
@@ -1799,7 +1898,7 @@
ml_gen_cont_params(ArgTypes0, InnerFuncParams0),
{ InnerFuncParams0 = func_params(InnerArgs0, Rets) },
{ InnerArgRvals = list__map(
- (func(Data - Type)
+ (func(mlds__argument(Data, Type, _GC) )
= lval(var(qual(MLDS_Module, VarName), Type)) :-
( Data = data(var(VarName0)) ->
VarName = VarName0
@@ -1810,10 +1909,14 @@
InnerArgs0) },
{ InnerFuncArgType = mlds__cont_type(ArgTypes0) },
{ PassedContVarName = mlds__var_name("passed_cont", no) },
+ % The passed_cont variable always points to code, not to heap,
+ % so the GC never needs to trace it.
+ { PassedContGCTraceCode = no },
+ { PassedContArg = mlds__argument(data(var(PassedContVarName)),
+ InnerFuncArgType, PassedContGCTraceCode) },
{ InnerFuncRval = lval(var(qual(MLDS_Module, PassedContVarName),
InnerFuncArgType)) },
- { InnerFuncParams = func_params(
- [data(var(PassedContVarName)) - InnerFuncArgType | InnerArgs0],
+ { InnerFuncParams = func_params([PassedContArg | InnerArgs0],
Rets) },
{ InnerMLDS_Stmt = call(Signature, InnerFuncRval, ObjectRval,
@@ -1866,8 +1969,240 @@
% Return an rval for a pointer to the current environment
% (the set of local variables in the containing procedure).
-ml_declare_env_ptr_arg(Name - mlds__generic_env_ptr_type) -->
- { Name = data(var(mlds__var_name("env_ptr_arg", no))) }.
+ml_declare_env_ptr_arg(mlds__argument(Name, Type, GC_TraceCode)) -->
+ { Name = data(var(mlds__var_name("env_ptr_arg", no))) },
+ { Type = mlds__generic_env_ptr_type },
+ % The env_ptr_arg always points to the stack,
+ % since continuation environments are always allocated
+ % on the stack (unless put_nondet_env_on_heap is true,
+ % which won't be the case when doing our own GC --
+ % this is enforced in handle_options.m).
+ % So the GC doesn't need to trace it.
+ { GC_TraceCode = no }.
+
+%-----------------------------------------------------------------------------%
+%
+% Code to handle accurate GC
+%
+
+ % If accurate GC is enabled, and the specified
+ % variable might contain pointers, generate code to call
+ % `private_builtin__gc_trace_var' to trace the variable.
+ %
+ml_gen_maybe_gc_trace_code(VarName, Type, Context, Maybe_GC_TraceCode) -->
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__get_gc_method(Globals, GC) },
+ (
+ { GC = accurate },
+ { MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type) },
+ { ml_type_might_contain_pointers(MLDS_Type) = yes },
+ % check that the Type is not `constraint(...)',
+ % which is a special case
+ % XXX maybe there is a better way of handling this...
+ % XXX FIXME this doesn't work, since it doesn't
+ % catch types which _contain_ `constraint(...)'.
+ { Type = term__variable(_)
+ ; type_to_type_id(Type, _, _)
+ }
+ ->
+ ml_gen_gc_trace_code(VarName, Type, Context, GC_TraceCode),
+ { Maybe_GC_TraceCode = yes(GC_TraceCode) }
+ ;
+ { Maybe_GC_TraceCode = no }
+ ).
+
+ % Return `yes' if the type needs to be traced by
+ % the accurate garbage collector, i.e. if it might
+ % contain pointers.
+ %
+ % It's always safe to return `yes' here, so if in doubt, we do.
+ %
+ % For floats, we can return `no' even though they might
+ % get boxed in some circumstances, because if they are
+ % boxed then they will be represented as mlds__generic_type.
+ %
+ % Note that with --gcc-nested-functions,
+ % cont_type will be a function pointer that
+ % may point to a trampoline function,
+ % which might in fact contain pointers.
+ % But the pointers will only be pointers to
+ % code and pointers to the stack, not pointers
+ % to the heap, so we don't need to trace them
+ % for accurate GC.
+ % Hence we can return `no' here for mlds__cont_type.
+
+:- func ml_type_might_contain_pointers(mlds__type) = bool.
+
+ml_type_might_contain_pointers(mercury_type(_Type, TypeCategory, _)) =
+ ml_type_category_might_contain_pointers(TypeCategory).
+ml_type_might_contain_pointers(mercury_array_type(_)) = yes.
+ml_type_might_contain_pointers(mlds__native_int_type) = no.
+ml_type_might_contain_pointers(mlds__native_float_type) = no.
+ml_type_might_contain_pointers(mlds__native_bool_type) = no.
+ml_type_might_contain_pointers(mlds__native_char_type) = no.
+ml_type_might_contain_pointers(mlds__foreign_type(_, _)) = yes.
+ml_type_might_contain_pointers(mlds__class_type(_, _, Category)) =
+ (if Category = mlds__enum then no else yes).
+ml_type_might_contain_pointers(mlds__ptr_type(_)) = yes.
+ml_type_might_contain_pointers(mlds__array_type(_)) = yes.
+ml_type_might_contain_pointers(mlds__func_type(_)) = no.
+ml_type_might_contain_pointers(mlds__generic_type) = yes.
+ml_type_might_contain_pointers(mlds__generic_env_ptr_type) = yes.
+ml_type_might_contain_pointers(mlds__pseudo_type_info_type) = yes.
+ml_type_might_contain_pointers(mlds__cont_type(_)) = no.
+ml_type_might_contain_pointers(mlds__commit_type) = no.
+ml_type_might_contain_pointers(mlds__rtti_type(_)) = yes.
+ml_type_might_contain_pointers(mlds__unknown_type) = yes.
+
+:- func ml_type_category_might_contain_pointers(builtin_type) = bool.
+ml_type_category_might_contain_pointers(int_type) = no.
+ml_type_category_might_contain_pointers(char_type) = no.
+ml_type_category_might_contain_pointers(str_type) = yes.
+ml_type_category_might_contain_pointers(float_type) = no.
+ml_type_category_might_contain_pointers(pred_type) = yes.
+ml_type_category_might_contain_pointers(tuple_type) = yes.
+ml_type_category_might_contain_pointers(enum_type) = no.
+ml_type_category_might_contain_pointers(polymorphic_type) = yes.
+ml_type_category_might_contain_pointers(user_type) = yes.
+
+
+ % Generate code to call to `private_builtin__gc_trace_var'
+ % to trace the specified variable.
+ %
+:- pred ml_gen_gc_trace_code(var_name, prog_type, prog_context,
+ mlds__statement, ml_gen_info, ml_gen_info).
+:- mode ml_gen_gc_trace_code(in, in, in, out, in, out) is det.
+
+ml_gen_gc_trace_code(VarName, Type, Context, GC_TraceCode) -->
+ % Build HLDS code to construct the type_info for this type.
+ ml_gen_make_type_info_var(Type, Context,
+ TypeInfoVar, HLDS_TypeInfoGoals),
+ { NonLocalsList = list__map(
+ (func(_G - GI) = NL :- goal_info_get_nonlocals(GI, NL)),
+ HLDS_TypeInfoGoals) },
+ { NonLocals = set__union_list(NonLocalsList) },
+ { instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, none)],
+ InstMapDelta) },
+ { goal_info_init(NonLocals, InstMapDelta, det, GoalInfo) },
+ { conj_list_to_goal(HLDS_TypeInfoGoals, GoalInfo, Conj) },
+
+ % Convert this HLDS code to MLDS
+ ml_gen_goal(model_det, Conj, MLDS_TypeInfoStatement),
+
+ % Build MLDS code to trace the variable
+ ml_gen_trace_var(VarName, Type, TypeInfoVar, Context,
+ MLDS_TraceStatement),
+
+ % Generate declarations for any type_info variables used.
+ %
+ % Note: this will generate local declarations even for
+ % type_info variables which are not local to this goal.
+ % However, fortunately ml_elim_nested.m will transform
+ % the GC code to use the original definitions, which will
+ % get put in the GC frame, rather than these declarations,
+ % which will get ignored.
+ % XXX This is not a very robust way of doing things...
+ =(MLGenInfo),
+ { ml_gen_info_get_module_info(MLGenInfo, ModuleInfo) },
+ { ml_gen_info_get_varset(MLGenInfo, VarSet) },
+ { ml_gen_info_get_var_types(MLGenInfo, VarTypes) },
+ { MLDS_Context = mlds__make_context(Context) },
+ { GenLocalVarDecl =
+ (func(Var) = MLDS_Defn :-
+ LocalVarName = ml_gen_var_name(VarSet, Var),
+ map__lookup(VarTypes, Var, LocalVarType),
+ MLDS_Defn = ml_gen_mlds_var_decl(var(LocalVarName),
+ mercury_type_to_mlds_type(ModuleInfo,
+ LocalVarType),
+ no, MLDS_Context)
+ ) },
+ { set__to_sorted_list(NonLocals, VarList) },
+ { MLDS_VarDecls = list__map(GenLocalVarDecl, VarList) },
+
+ % Combine the MLDS code fragments together.
+ { GC_TraceCode = ml_gen_block(MLDS_VarDecls,
+ [MLDS_TypeInfoStatement] ++ [MLDS_TraceStatement],
+ Context) }.
+
+ % Generate a call to `private_builtin__gc_trace_var'
+ % for the specified variable, given the variable's name, type,
+ % and the already-constructed type_info variable for that type.
+ %
+:- pred ml_gen_trace_var(var_name::in, prog_type::in, prog_var::in,
+ prog_context::in, mlds__statement::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_trace_var(VarName, Type, TypeInfoVar, Context, MLDS_TraceStatement) -->
+ %
+ % Generate lvals for the Var and TypeInfoVar
+ %
+ =(MLGenInfo),
+ { ml_gen_info_get_module_info(MLGenInfo, ModuleInfo) },
+ { MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type) },
+ ml_gen_var_lval(VarName, MLDS_Type, VarLval),
+ ml_gen_var(TypeInfoVar, TypeInfoLval),
+ %
+ % Generate the address of `private_builtin__gc_trace_var/1#0'
+ %
+ { PredName = "gc_trace_var" },
+ { PredOrigArity = 1 },
+ { Pred = pred((predicate), no, PredName, PredOrigArity, model_det,
+ no) },
+ { hlds_pred__initial_proc_id(ProcId) },
+ { mercury_private_builtin_module(PredModule) },
+ { MLDS_Module = mercury_module_name_to_mlds(PredModule) },
+ { Proc = qual(MLDS_Module, Pred - ProcId) },
+ { ArgTypes = [mlds__pseudo_type_info_type,
+ mlds__ptr_type(mlds__generic_type)] },
+ { Signature = mlds__func_signature(ArgTypes, []) },
+ { FuncAddr = const(code_addr_const(proc(Proc, Signature))) },
+ %
+ % Generate the call `private_builtin__gc_trace_var(TypeInfoVar, &Var)'
+ %
+ { MLDS_TraceStatement = mlds__statement(
+ call(Signature, FuncAddr, no,
+ [lval(TypeInfoLval), mem_addr(VarLval)], [], call
+ ), mlds__make_context(Context)) }.
+
+ % Generate HLDS code to construct the type_info for this type.
+ %
+:- pred ml_gen_make_type_info_var(prog_type::in, prog_context::in,
+ prog_var::out, hlds_goals::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_make_type_info_var(Type, Context, TypeInfoVar, TypeInfoGoals,
+ MLGenInfo0, MLGenInfo) :-
+ %
+ % Extract the relevant information from the ml_gen_info
+ %
+ ModuleInfo0 = MLGenInfo0 ^ module_info,
+ PredId = MLGenInfo0 ^ pred_id,
+ ProcId = MLGenInfo0 ^ proc_id,
+ module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
+ PredInfo0, ProcInfo0),
+
+ %
+ % Call polymorphism.m to generate the HLDS code to
+ % create the type_infos.
+ %
+ create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0),
+ polymorphism__make_type_info_var(Type, Context,
+ TypeInfoVar, TypeInfoGoals, PolyInfo0, PolyInfo),
+ poly_info_extract(PolyInfo, PredInfo0, PredInfo,
+ ProcInfo0, ProcInfo, ModuleInfo1),
+
+ %
+ % Save the new information back in the ml_gen_info
+ %
+ module_info_set_pred_proc_info(ModuleInfo1, PredId, ProcId,
+ PredInfo, ProcInfo, ModuleInfo),
+ proc_info_varset(ProcInfo, VarSet),
+ proc_info_vartypes(ProcInfo, VarTypes),
+ MLGenInfo = (((MLGenInfo0 ^ module_info := ModuleInfo)
+ ^ varset := VarSet)
+ ^ var_types := VarTypes).
%-----------------------------------------------------------------------------%
%
@@ -1888,6 +2223,11 @@
---> ml_gen_info(
%
% these fields remain constant for each procedure
+ %
+ % (unless accurate GC is enabled, in which case the
+ % varset and var_types may get updated if we create
+ % fresh variables for type_info variables needed
+ % for calls to private_builtin__gc_trace)
%
module_info :: module_info,
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.45
diff -u -d -r1.45 ml_elim_nested.m
--- compiler/ml_elim_nested.m 12 Dec 2001 09:40:41 -0000 1.45
+++ compiler/ml_elim_nested.m 29 Dec 2001 12:57:39 -0000
@@ -149,9 +149,21 @@
% and chain these structs together. At GC time, we traverse the chain
% of structs. This allows us to accurately scan the C stack.
%
-% XXX Currently the only part which is implemented is the code to chain
-% the stack frames together; we don't yet generate the code to
-% traverse the stack frames. Doing that here is tricky...
+% XXX Accurate GC is still not yet fully implemented.
+% TODO:
+% - add call to GC_check at start of every possibly-recursive function
+% that might allocate memory (probably via a separate MLDS pass)
+% - fix problem with undeclared local vars for some test cases
+% (e.g. tests/valid/agc_unbound_typevars*).
+% - fix problem with type classes & `constraint(...)' types
+% (the compiler goes into an infinite loop and runs out of
+% stack space for test cases using type classes)
+% - handle `pragma export'
+% - support higher-order code: fix problems with tracing closures
+%
+% There are also some things that could be done to improve efficiency,
+% e.g.
+% - optimize away temporary variables
%
%-----------------------------------------------------------------------------%
%
@@ -173,7 +185,7 @@
% void (*trace)(void *this_frame);
% };
%
-% XXX Currently, rather than using a nested structure,
+% Actually, rather than using a nested structure,
% we just put these fields directly in the <function_name>_frame struct.
% (This turned out to be a little easier.)
%
@@ -233,15 +245,18 @@
% ...
% };
%
-% /*
-% ** XXX Generation of the *_trace() functions is
-% ** not yet implemented.
-% */
% static void
% foo_trace(void *this_frame) {
% struct foo_frame *frame = (struct foo_frame *)this_frame;
-% MR_GC_TRAVERSE(<TypeInfo for type of arg1>, &frame->arg1);
-% MR_GC_TRAVERSE(<TypeInfo for type of local1>, &frame->local1);
+%
+% ... code to construct TypeInfo for type of arg1 ...
+% mercury__private_builtin__gc_trace_1_p_0(
+% <TypeInfo for type of arg1>, &frame->arg1);
+%
+% ... code to construct TypeInfo for type of local1 ...
+% mercury__private_builtin__gc_trace_1_p_0(
+% <TypeInfo for type of local1>, &frame->local1);
+%
% ...
% }
%
@@ -297,9 +312,6 @@
% This implicitly zeros out the remaining fields.
% Only the non-null fields, i.e. the arguments and the trace
% field, need to be explicitly assigned using assignment statements.
-% XXX Currently we leave the trace field as null,
-% since the code to generate the *_trace functions is
-% not yet implemented.
%
% The code in the Mercury runtime to traverse the stack frames would
% look something like this:
@@ -370,20 +382,20 @@
% Or handle accurate GC:
% put all variables that might contain pointers in structs
% and chain these structs together into a "shadow stack".
+ % Extract out the code to trace these variables,
+ % putting it in a function whose address is stored in
+ % the shadow stack frame.
%
:- func ml_elim_nested_defns(action, mlds_module_name, globals, outervars,
mlds__defn) = list(mlds__defn).
ml_elim_nested_defns(Action, ModuleName, Globals, OuterVars, Defn0)
= Defns :-
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
- ( DefnBody0 = mlds__function(PredProcId, Params,
+ ( DefnBody0 = mlds__function(PredProcId, Params0,
defined_here(FuncBody0), Attributes) ->
EnvName = ml_env_name(Name, Action),
- % XXX this should be optimized to generate
- % EnvTypeName from just EnvName
- ml_create_env(Action, EnvName, [], Context, ModuleName, Globals,
- _EnvTypeDefn, EnvTypeName, _EnvDecls, _InitEnv),
-
+ EnvTypeName = ml_create_env_type_name(EnvName,
+ ModuleName, Globals),
EnvPtrTypeName = ml_make_env_ptr_type(Globals, EnvTypeName),
%
@@ -396,11 +408,13 @@
%
ElimInfo0 = elim_info_init(Action, ModuleName,
OuterVars, EnvTypeName, EnvPtrTypeName),
- Params = mlds__func_params(Arguments, RetValues),
- ml_maybe_add_args(Arguments, FuncBody0, ModuleName,
+ Params0 = mlds__func_params(Arguments0, RetValues),
+ ml_maybe_add_args(Arguments0, FuncBody0, ModuleName,
Context, ElimInfo0, ElimInfo1),
- flatten_statement(FuncBody0, FuncBody1, ElimInfo1, ElimInfo),
+ flatten_arguments(Arguments0, Arguments, ElimInfo1, ElimInfo2),
+ flatten_statement(FuncBody0, FuncBody1, ElimInfo2, ElimInfo),
elim_info_finish(ElimInfo, NestedFuncs0, Locals),
+ Params = mlds__func_params(Arguments, RetValues),
%
% Split the locals that we need to process
@@ -432,19 +446,22 @@
% Create a struct to hold the local variables,
% and initialize the environment pointers for
% both the containing function and the nested
- % functions
+ % functions. Also generate the GC tracing function,
+ % if Action = chain_gc_stack_frames.
%
- ml_create_env(Action, EnvName, LocalVars, Context,
- ModuleName, Globals, EnvTypeDefn,
- _EnvTypeName, EnvDecls, InitEnv),
+ ml_create_env(Action, EnvName, EnvTypeName, LocalVars,
+ Context, ModuleName, Name, Globals,
+ EnvTypeDefn, EnvDecls, InitEnv,
+ GCTraceFuncDefns),
list__map_foldl(
- ml_insert_init_env(EnvTypeName, ModuleName,
- Globals), NestedFuncs0, NestedFuncs,
+ ml_insert_init_env(Action, EnvTypeName,
+ ModuleName, Globals),
+ NestedFuncs0, NestedFuncs,
no, InsertedEnv),
% Hoist out the local statics and the nested functions
- HoistedDefns0 = list__append(HoistedStatics,
- NestedFuncs),
+ HoistedDefns0 = HoistedStatics ++ GCTraceFuncDefns ++
+ NestedFuncs,
%
% When hoisting nested functions,
@@ -555,12 +572,13 @@
ml_maybe_add_args([Arg|Args], FuncBody, ModuleName, Context) -->
=(ElimInfo),
(
- { Arg = data(var(VarName)) - Type },
- { ml_should_add_local_data(ElimInfo, VarName, Type,
+ { Arg = mlds__argument(data(var(VarName)), _Type,
+ GC_TraceCode) },
+ { ml_should_add_local_data(ElimInfo, VarName, GC_TraceCode,
[], [FuncBody]) }
->
{ ml_conv_arg_to_var(Context, Arg, ArgToCopy) },
- elim_info_add_local_data(ArgToCopy)
+ elim_info_add_and_flatten_local_data(ArgToCopy)
;
[]
),
@@ -582,8 +600,9 @@
EnvPtrTypeName, Context, ArgsToCopy0, CodeToCopyArgs0),
ModuleName = elim_info_get_module_name(ElimInfo),
(
- Arg = data(var(VarName)) - FieldType,
- ml_should_add_local_data(ElimInfo, VarName, FieldType,
+ Arg = mlds__argument(data(var(VarName)), FieldType,
+ GC_TraceCode),
+ ml_should_add_local_data(ElimInfo, VarName, GC_TraceCode,
[], [FuncBody])
->
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
@@ -599,8 +618,9 @@
FieldName = named_field(qual(EnvModuleName, FieldNameString),
EnvPtrTypeName),
Tag = yes(0),
+ EnvPtrName = env_name_base(ElimInfo ^ action) ++ "_ptr",
EnvPtr = lval(var(qual(ModuleName,
- mlds__var_name("env_ptr", no)),
+ mlds__var_name(EnvPtrName, no)),
EnvPtrTypeName)),
EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
EnvPtrTypeName),
@@ -615,6 +635,22 @@
CodeToCopyArgs = CodeToCopyArgs0
).
+ % Create the environment struct type.
+:- func ml_create_env_type_name(mlds__class_name, mlds_module_name, globals) =
+ mlds__type.
+ml_create_env_type_name(EnvClassName, ModuleName, Globals) = EnvTypeName :-
+ % If we're allocating it on the heap, then we need to use
+ % a class type rather than a struct (value type).
+ % This is needed for verifiable code on the IL back-end.
+ globals__lookup_bool_option(Globals, put_nondet_env_on_heap, OnHeap),
+ ( OnHeap = yes ->
+ EnvTypeKind = mlds__class
+ ;
+ EnvTypeKind = mlds__struct
+ ),
+ EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0,
+ EnvTypeKind).
+
% Create the environment struct type,
% the declaration of the environment variable,
% and the declaration and initializer for the environment
@@ -627,19 +663,24 @@
% struct <EnvClassName> *env_ptr;
% env_ptr = &env;
%
-:- pred ml_create_env(action, mlds__class_name, list(mlds__defn), mlds__context,
- mlds_module_name, globals, mlds__defn, mlds__type,
- list(mlds__defn), list(mlds__statement)).
-:- mode ml_create_env(in, in, in, in, in, in, out, out, out, out) is det.
+:- pred ml_create_env(action, mlds__class_name, mlds__type, list(mlds__defn),
+ mlds__context, mlds_module_name, mlds__entity_name, globals,
+ mlds__defn, list(mlds__defn), list(mlds__statement),
+ list(mlds__defn)).
+:- mode ml_create_env(in, in, in, in, in, in, in, in, out, out, out, out)
+ is det.
-ml_create_env(Action, EnvClassName, LocalVars, Context, ModuleName, Globals,
- EnvTypeDefn, EnvTypeName, EnvDecls, InitEnv) :-
+ml_create_env(Action, EnvClassName, EnvTypeName, LocalVars, Context,
+ ModuleName, FuncName, Globals, EnvTypeDefn, EnvDecls, InitEnv,
+ GCTraceFuncDefns) :-
%
% generate the following type:
%
% struct <EnvClassName> {
% #ifdef ACCURATE_GC
- % struct MR_StackChain fixed_fields;
+ % /* these fixed fields match `struct MR_StackChain' */
+ % void *prev;
+ % void (*trace)(...);
% #endif
% <LocalVars>
% };
@@ -655,69 +696,35 @@
EnvTypeKind = mlds__struct,
BaseClasses = []
),
- EnvTypeName = class_type(qual(ModuleName, EnvClassName), 0,
- EnvTypeKind),
EnvTypeEntityName = type(EnvClassName, 0),
EnvTypeFlags = env_type_decl_flags,
Fields0 = list__map(convert_local_to_field, LocalVars),
- ( Action = chain_gc_stack_frames ->
- %
- % insert the fixed fields:
- % void *prev;
- % void (*trace)(...);
- %
- PrevFieldName = data(var(var_name("prev", no))),
- PrevFieldFlags = ml_gen_public_field_decl_flags,
- PrevFieldType = mlds__generic_env_ptr_type,
- PrevFieldDefnBody = mlds__data(PrevFieldType, no_initializer),
- PrevFieldDecl = mlds__defn(PrevFieldName, Context,
- PrevFieldFlags, PrevFieldDefnBody),
-
- TraceFieldName = data(var(var_name("trace", no))),
- TraceFieldFlags = ml_gen_public_field_decl_flags,
- TraceFieldType = mlds__generic_type, % XXX
- TraceFieldDefnBody = mlds__data(TraceFieldType, no_initializer),
- TraceFieldDecl = mlds__defn(TraceFieldName, Context,
- TraceFieldFlags, TraceFieldDefnBody),
-
- Fields = [PrevFieldDecl, TraceFieldDecl | Fields0],
-
- %
- % Set the initializer for the `prev' field
- % to the global stack chain.
- %
- % Since there no values for the remaining fields in the
- % initializer, this means the remaining fields will get
- % initialized to zero (C99 6.7.8 #21).
- %
- % XXX This uses a non-const initializer, which is a
- % feature that is only supported in C99 and GNU C;
- % it won't work in C89. We should just generate
- % a bunch of assignments to all the fields,
- % rather than relying on initializers like this.
- %
- % XXX We should initialize the `trace' field.
- %
- StackChain = ml_stack_chain_var,
- EnvInitializer = init_struct([init_obj(lval(StackChain))]),
+ %
+ % Extract the GC tracing code from the fields
+ %
+ list__map2(extract_gc_trace_code, Fields0, Fields1,
+ GC_TraceStatements0),
+ GC_TraceStatements = list__condense(GC_TraceStatements0),
- %
- % Generate code to set the global stack chain
- % to point to the current environment.
- % stack_chain = env_ptr;
- %
- EnvPtrTypeName = ml_make_env_ptr_type(Globals, EnvTypeName),
- EnvPtr = lval(var(qual(ModuleName,
- mlds__var_name("env_ptr", no)),
- EnvPtrTypeName)),
- AssignToStackChain = assign(StackChain, EnvPtr),
- LinkStackChain = [mlds__statement(atomic(AssignToStackChain),
- Context)]
+ ( Action = chain_gc_stack_frames ->
+ ml_chain_stack_frames(Fields1, GC_TraceStatements,
+ EnvTypeName, Context, FuncName, ModuleName, Globals,
+ Fields, EnvInitializer, LinkStackChain,
+ GCTraceFuncDefns),
+ GC_TraceEnv = no
;
- Fields = Fields0,
+ ( GC_TraceStatements = [] ->
+ GC_TraceEnv = no
+ ;
+ GC_TraceEnv = yes(
+ ml_block([], GC_TraceStatements, Context)
+ )
+ ),
+ Fields = Fields1,
EnvInitializer = no_initializer,
- LinkStackChain = []
+ LinkStackChain = [],
+ GCTraceFuncDefns = []
),
Imports = [],
@@ -733,17 +740,18 @@
%
% struct <EnvClassName> env; // = { ... }
%
- EnvVarName = data(var(var_name("env", no))),
+ EnvVarName = var_name(env_name_base(Action), no),
+ EnvVarEntityName = data(var(EnvVarName)),
EnvVarFlags = ml_gen_local_var_decl_flags,
- EnvVarDefnBody = mlds__data(EnvTypeName, EnvInitializer),
- EnvVarDecl = mlds__defn(EnvVarName, Context, EnvVarFlags,
+ EnvVarDefnBody = mlds__data(EnvTypeName, EnvInitializer, GC_TraceEnv),
+ EnvVarDecl = mlds__defn(EnvVarEntityName, Context, EnvVarFlags,
EnvVarDefnBody),
%
% declare the `env_ptr' var, and
% initialize the `env_ptr' with the address of `env'
%
- EnvVar = qual(ModuleName, mlds__var_name("env", no)),
+ EnvVar = qual(ModuleName, EnvVarName),
%
% generate code to initialize the environment pointer,
@@ -761,11 +769,188 @@
EnvVarAddr = mem_addr(var(EnvVar, EnvTypeName)),
NewObj = []
),
- ml_init_env(EnvTypeName, EnvVarAddr, Context, ModuleName,
+ ml_init_env(Action, EnvTypeName, EnvVarAddr, Context, ModuleName,
Globals, EnvPtrVarDecl, InitEnv0),
EnvDecls = [EnvVarDecl, EnvPtrVarDecl],
InitEnv = NewObj ++ [InitEnv0] ++ LinkStackChain.
+:- pred ml_chain_stack_frames(mlds__defns, mlds__statements, mlds__type,
+ mlds__context, mlds__entity_name, mlds_module_name, globals,
+ mlds__defns, mlds__initializer, mlds__statements, mlds__defns).
+:- mode ml_chain_stack_frames(in, in, in, in, in, in, in, out, out, out, out)
+ is det.
+
+ml_chain_stack_frames(Fields0, GCTraceStatements, EnvTypeName, Context,
+ FuncName, ModuleName, Globals, Fields,
+ EnvInitializer, LinkStackChain, GCTraceFuncDefns) :-
+ %
+ % Generate code to declare and initialize the
+ % environment pointer for the GC trace function
+ % from that function's `this_frame' parameter:
+ %
+ % struct foo_frame *frame;
+ % frame = (struct foo_frame *) this_frame;
+ %
+ ThisFrameName = qual(ModuleName, var_name("this_frame", no)),
+ ThisFrameRval = lval(var(ThisFrameName,
+ mlds__generic_type)),
+ CastThisFrameRval = unop(cast(mlds__ptr_type(EnvTypeName)),
+ ThisFrameRval),
+ ml_init_env(chain_gc_stack_frames, EnvTypeName, CastThisFrameRval,
+ Context, ModuleName, Globals, FramePtrDecl, InitFramePtr),
+
+ %
+ % Put the environment pointer declaration and initialization
+ % and the GC tracing code in a function:
+ %
+ % void foo_trace(void *this_frame) {
+ % struct foo_frame *frame;
+ % frame = (struct foo_frame *) this_frame;
+ % <GCTraceStatements>
+ % }
+ %
+ gen_gc_trace_func(FuncName, ModuleName,
+ FramePtrDecl, [InitFramePtr | GCTraceStatements],
+ Context, GCTraceFuncAddr, GCTraceFuncParams,
+ GCTraceFuncDefn),
+ GCTraceFuncDefns = [GCTraceFuncDefn],
+
+ %
+ % insert the fixed fields in the struct <EnvClassName>:
+ % void *prev;
+ % void (*trace)(...);
+ %
+ PrevFieldName = data(var(var_name("prev", no))),
+ PrevFieldFlags = ml_gen_public_field_decl_flags,
+ PrevFieldType = mlds__generic_env_ptr_type,
+ PrevFieldDefnBody = mlds__data(PrevFieldType,
+ no_initializer, no),
+ PrevFieldDecl = mlds__defn(PrevFieldName, Context,
+ PrevFieldFlags, PrevFieldDefnBody),
+
+ TraceFieldName = data(var(var_name("trace", no))),
+ TraceFieldFlags = ml_gen_public_field_decl_flags,
+ TraceFieldType = mlds__func_type(GCTraceFuncParams),
+ TraceFieldDefnBody = mlds__data(TraceFieldType,
+ no_initializer, no),
+ TraceFieldDecl = mlds__defn(TraceFieldName, Context,
+ TraceFieldFlags, TraceFieldDefnBody),
+
+ Fields = [PrevFieldDecl, TraceFieldDecl | Fields0],
+
+ %
+ % Set the initializer so that the `prev' field
+ % is initialized to the global stack chain,
+ % and the `trace' field is initialized to the
+ % address of the GC tracing function:
+ %
+ % ... = { stack_chain, foo_trace };
+ %
+ % Since there no values for the remaining fields in the
+ % initializer, this means the remaining fields will get
+ % initialized to zero (C99 6.7.8 #21).
+ %
+ % XXX This uses a non-const initializer, which is a
+ % feature that is only supported in C99 and GNU C;
+ % it won't work in C89. We should just generate
+ % a bunch of assignments to all the fields,
+ % rather than relying on initializers like this.
+ %
+ StackChain = ml_stack_chain_var,
+ EnvInitializer = init_struct([
+ init_obj(lval(StackChain)),
+ init_obj(const(code_addr_const(GCTraceFuncAddr)))
+ ]),
+
+ %
+ % Generate code to set the global stack chain
+ % to point to the current environment:
+ %
+ % stack_chain = frame_ptr;
+ %
+ EnvPtrTypeName = ml_make_env_ptr_type(Globals, EnvTypeName),
+ EnvPtr = lval(var(qual(ModuleName,
+ mlds__var_name("frame_ptr", no)),
+ EnvPtrTypeName)),
+ AssignToStackChain = assign(StackChain, EnvPtr),
+ LinkStackChain = [mlds__statement(atomic(AssignToStackChain),
+ Context)].
+
+:- pred gen_gc_trace_func(mlds__entity_name, mlds_module_name,
+ mlds__defn, list(mlds__statement), mlds__context,
+ mlds__code_addr, mlds__func_params, mlds__defn).
+:- mode gen_gc_trace_func(in, in, in, in, in, out, out, out) is det.
+
+gen_gc_trace_func(FuncName, PredModule, FramePointerDecl, GCTraceStatements,
+ Context, GCTraceFuncAddr, FuncParams, GCTraceFuncDefn) :-
+ %
+ % Compute the signature of the GC tracing function
+ %
+ ArgName = data(var(var_name("this_frame", no))),
+ ArgType = mlds__generic_type,
+ Argument = mlds__argument(ArgName, ArgType, no),
+ FuncParams = mlds__func_params([Argument], []),
+ Signature = mlds__get_func_signature(FuncParams),
+ %
+ % Compute the name of the GC tracing function
+ %
+ % To compute the name, we just take the name of the original function
+ % and add 100000 to the original function's sequence number.
+ % XXX This is a bit of a hack; maybe we should add
+ % another field to the `function' ctor for mlds__entity_name.
+ %
+ ( FuncName = function(PredLabel, ProcId, MaybeSeqNum, PredId) ->
+ ( MaybeSeqNum = yes(SeqNum)
+ ; MaybeSeqNum = no, SeqNum = 0
+ ),
+ NewSeqNum = SeqNum + 100000,
+ GCTraceFuncName = function(PredLabel, ProcId, yes(NewSeqNum),
+ PredId),
+ ProcLabel = qual(PredModule, PredLabel - ProcId),
+ GCTraceFuncAddr = internal(ProcLabel, NewSeqNum, Signature)
+ ;
+ error("gen_gc_trace_func: not a function")
+ ),
+ %
+ % Construct the function definition
+ %
+ Statement = mlds__statement(
+ block([FramePointerDecl], GCTraceStatements),
+ Context),
+ DeclFlags = ml_gen_gc_trace_func_decl_flags,
+ MaybePredProcId = no,
+ Attributes = [],
+ FuncDefn = function(MaybePredProcId, FuncParams,
+ defined_here(Statement), Attributes),
+ GCTraceFuncDefn = mlds__defn(GCTraceFuncName, Context, DeclFlags,
+ FuncDefn).
+
+ % Return the declaration flags appropriate for a procedure definition.
+ %
+:- func ml_gen_gc_trace_func_decl_flags = mlds__decl_flags.
+ml_gen_gc_trace_func_decl_flags = MLDS_DeclFlags :-
+ Access = private,
+ PerInstance = one_copy,
+ Virtuality = non_virtual,
+ Finality = overridable,
+ Constness = modifiable,
+ Abstractness = concrete,
+ MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
+ Virtuality, Finality, Constness, Abstractness).
+
+:- pred extract_gc_trace_code(mlds__defn, mlds__defn, mlds__statements).
+:- mode extract_gc_trace_code(in, out, out) is det.
+
+extract_gc_trace_code(mlds__defn(Name, Context, Flags, Body0),
+ mlds__defn(Name, Context, Flags, Body), GCTraceStmts) :-
+ ( Body0 = data(Type, Init, yes(GCTraceStmt)) ->
+ Body = data(Type, Init, no),
+ GCTraceStmts = [GCTraceStmt]
+ ;
+ Body = Body0,
+ GCTraceStmts = []
+ ).
+
% When converting local variables into fields of the
% environment struct, we need to change `local' access
% into something else, since `local' is only supposed to be
@@ -813,10 +998,11 @@
% If we perform this transformation, set Init to "yes",
% otherwise leave it unchanged.
%
-:- pred ml_insert_init_env(mlds__type, mlds_module_name, globals,
+:- pred ml_insert_init_env(action, mlds__type, mlds_module_name, globals,
mlds__defn, mlds__defn, bool, bool).
-:- mode ml_insert_init_env(in, in, in, in, out, in, out) is det.
-ml_insert_init_env(TypeName, ModuleName, Globals, Defn0, Defn, Init0, Init) :-
+:- mode ml_insert_init_env(in, in, in, in, in, out, in, out) is det.
+ml_insert_init_env(Action, TypeName, ModuleName, Globals, Defn0, Defn,
+ Init0, Init) :-
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds__function(PredProcId, Params,
@@ -834,8 +1020,8 @@
% environment type for this procedure.
CastEnvPtrVal = unop(cast(EnvPtrVarType), EnvPtrVal),
- ml_init_env(TypeName, CastEnvPtrVal, Context, ModuleName,
- Globals, EnvPtrDecl, InitEnvPtr),
+ ml_init_env(Action, TypeName, CastEnvPtrVal, Context,
+ ModuleName, Globals, EnvPtrDecl, InitEnvPtr),
FuncBody = mlds__statement(block([EnvPtrDecl],
[InitEnvPtr, FuncBody0]), Context),
DefnBody = mlds__function(PredProcId, Params,
@@ -863,24 +1049,30 @@
% struct <EnvClassName> *env_ptr;
% env_ptr = <EnvPtrVal>;
%
-:- pred ml_init_env(mlds__type, mlds__rval,
+:- pred ml_init_env(action, mlds__type, mlds__rval,
mlds__context, mlds_module_name, globals,
mlds__defn, mlds__statement).
-:- mode ml_init_env(in, in, in, in, in, out, out) is det.
+:- mode ml_init_env(in, in, in, in, in, in, out, out) is det.
-ml_init_env(EnvTypeName, EnvPtrVal, Context, ModuleName, Globals,
+ml_init_env(Action, EnvTypeName, EnvPtrVal, Context, ModuleName, Globals,
EnvPtrVarDecl, InitEnvPtr) :-
%
% generate the following variable declaration:
%
% <EnvTypeName> *env_ptr;
%
- EnvPtrVarName = data(var(mlds__var_name("env_ptr", no))),
+ EnvPtrVarName = mlds__var_name(env_name_base(Action) ++ "_ptr", no),
+ EnvPtrVarEntityName = data(var(EnvPtrVarName)),
EnvPtrVarFlags = ml_gen_local_var_decl_flags,
EnvPtrVarType = ml_make_env_ptr_type(Globals, EnvTypeName),
- EnvPtrVarDefnBody = mlds__data(EnvPtrVarType, no_initializer),
- EnvPtrVarDecl = mlds__defn(EnvPtrVarName, Context, EnvPtrVarFlags,
- EnvPtrVarDefnBody),
+ % The env_ptr never needs to be traced by the GC,
+ % since the environment that it points to will always
+ % be on the stack, not into the heap.
+ GC_TraceCode = no,
+ EnvPtrVarDefnBody = mlds__data(EnvPtrVarType, no_initializer,
+ GC_TraceCode),
+ EnvPtrVarDecl = mlds__defn(EnvPtrVarEntityName, Context,
+ EnvPtrVarFlags, EnvPtrVarDefnBody),
%
% generate the following statement:
@@ -890,7 +1082,7 @@
% (note that the caller of this routine is responsible
% for inserting a cast in <EnvPtrVal> if needed).
%
- EnvPtrVar = qual(ModuleName, mlds__var_name("env_ptr", no)),
+ EnvPtrVar = qual(ModuleName, EnvPtrVarName),
AssignEnvPtr = assign(var(EnvPtrVar, EnvPtrVarType), EnvPtrVal),
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
@@ -899,13 +1091,13 @@
% struct field. We need to do this so as to include function
% parameter in the environment struct.
%
-:- pred ml_conv_arg_to_var(mlds__context, pair(entity_name, mlds__type),
- mlds__defn).
+:- pred ml_conv_arg_to_var(mlds__context, mlds__argument, mlds__defn).
:- mode ml_conv_arg_to_var(in, in, out) is det.
-ml_conv_arg_to_var(Context, Name - Type, LocalVar) :-
+ml_conv_arg_to_var(Context, Arg, LocalVar) :-
+ Arg = mlds__argument(Name, Type, GC_TraceCode),
Flags = ml_gen_local_var_decl_flags,
- DefnBody = mlds__data(Type, no_initializer),
+ DefnBody = mlds__data(Type, no_initializer, GC_TraceCode),
LocalVar = mlds__defn(Name, Context, Flags, DefnBody).
% Return the declaration flags appropriate for an environment struct
@@ -963,7 +1155,7 @@
error("ml_env_name: expected function, got data").
ml_env_name(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
Action) = ClassName :-
- Base = (if Action = chain_gc_stack_frames then "locals" else "env"),
+ Base = env_name_base(Action),
PredLabelString = ml_pred_label_name(PredLabel),
proc_id_to_int(ProcId, ModeNum),
( MaybeSeqNum = yes(SeqNum) ->
@@ -978,6 +1170,10 @@
ml_env_name(export(_), _) = _ :-
error("ml_env_name: expected function, got export").
+:- func env_name_base(action) = string.
+env_name_base(chain_gc_stack_frames) = "frame".
+env_name_base(hoist_nested_funcs) = "env".
+
:- func ml_pred_label_name(mlds__pred_label) = string.
ml_pred_label_name(pred(PredOrFunc, MaybeDefiningModule, Name, Arity,
@@ -1017,8 +1213,10 @@
%-----------------------------------------------------------------------------%
%
-% flatten_maybe_statement:
+% flatten_arguments:
+% flatten_argument:
% flatten_function_body:
+% flatten_maybe_statement:
% flatten_statements:
% flatten_statement:
% Recursively process the statement(s), calling fixup_var on every
@@ -1027,6 +1225,22 @@
% variables and nested functions).
%
+:- pred flatten_arguments(mlds__arguments, mlds__arguments,
+ elim_info, elim_info).
+:- mode flatten_arguments(in, out, in, out) is det.
+
+flatten_arguments(Arguments0, Arguments) -->
+ list__map_foldl(flatten_argument, Arguments0, Arguments).
+
+:- pred flatten_argument(mlds__argument, mlds__argument,
+ elim_info, elim_info).
+:- mode flatten_argument(in, out, in, out) is det.
+
+flatten_argument(Argument0, Argument) -->
+ { Argument0 = mlds__argument(Name, Type, MaybeGCTraceCode0) },
+ { Argument = mlds__argument(Name, Type, MaybeGCTraceCode) },
+ flatten_maybe_statement(MaybeGCTraceCode0, MaybeGCTraceCode).
+
:- pred flatten_function_body(function_body, function_body,
elim_info, elim_info).
:- mode flatten_function_body(in, out, in, out) is det.
@@ -1176,36 +1390,44 @@
%
% mark the function as private / one_copy,
% rather than as local / per_instance,
- % since we're about to hoist it out to the top level
+ % if we're about to hoist it out to the top level
%
- { Flags1 = set_access(Flags0, private) },
- { Flags = set_per_instance(Flags1, one_copy) },
-
- { DefnBody = mlds__function(PredProcId, Params, FuncBody,
- Attributes) },
+ =(ElimInfo),
+ { Action = ElimInfo ^ action },
+ ( { Action = hoist_nested_funcs } ->
+ { Flags1 = set_access(Flags0, private) },
+ { Flags = set_per_instance(Flags1, one_copy) }
+ ;
+ { Flags = Flags0 }
+ ),
+ { DefnBody = mlds__function(PredProcId, Params,
+ FuncBody, Attributes) },
{ Defn = mlds__defn(Name, Context, Flags, DefnBody) },
+ ( { Action = hoist_nested_funcs } ->
+ % Note that we assume that we can safely hoist stuff
+ % inside nested functions into the containing function.
+ % If that wasn't the case, we'd need code something
+ % like this:
+ /***************
+ { LocalVars = elim_info_get_local_data(ElimInfo) },
+ { OuterVars0 = elim_info_get_outer_vars(ElimInfo) },
+ { OuterVars = [LocalVars | OuterVars0] },
+ { FlattenedDefns = ml_elim_nested_defns(ModuleName,
+ OuterVars, Defn0) },
+ list__foldl(elim_info_add_nested_func, FlattenedDefns),
+ ***************/
- % Note that we assume that we can safely hoist stuff
- % inside nested functions into the containing function.
- % If that wasn't the case, we'd need code something
- % like this:
- /***************
- { LocalVars = elim_info_get_local_data(ElimInfo) },
- { OuterVars0 = elim_info_get_outer_vars(ElimInfo) },
- { OuterVars = [LocalVars | OuterVars0] },
- { FlattenedDefns = ml_elim_nested_defns(ModuleName,
- OuterVars, Defn0) },
- list__foldl(elim_info_add_nested_func, FlattenedDefns),
- ***************/
-
- %
- % strip out the now flattened nested function,
- % and store it in the elim_info
- %
- elim_info_add_nested_func(Defn),
- { Defns = [] }
+ %
+ % strip out the now flattened nested function,
+ % and store it in the elim_info
+ %
+ elim_info_add_nested_func(Defn),
+ { Defns = [] }
+ ;
+ { Defns = [Defn] }
+ )
;
- { DefnBody0 = mlds__data(Type, _) },
+ { DefnBody0 = mlds__data(Type, Init, MaybeGCTraceCode0) },
%
% for local variable definitions, if they are
% referenced by any nested functions, then
@@ -1225,14 +1447,19 @@
;
{ Name = data(var(VarName)) },
{ ml_should_add_local_data(ElimInfo,
- VarName, Type,
+ VarName, MaybeGCTraceCode0,
FollowingDefns, FollowingStatements) }
)
->
- elim_info_add_local_data(Defn0),
+ elim_info_add_and_flatten_local_data(Defn0),
{ Defns = [] }
;
- { Defns = [Defn0] }
+ flatten_maybe_statement(MaybeGCTraceCode0,
+ MaybeGCTraceCode),
+ { DefnBody = mlds__data(Type, Init, MaybeGCTraceCode) },
+ { Defn = mlds__defn(Name, Context, Flags0, DefnBody) },
+
+ { Defns = [Defn] }
)
;
{ DefnBody0 = mlds__class(_) },
@@ -1252,16 +1479,16 @@
% it should be added to the environment struct
% (if it's a variable) or hoisted out to the top level
% (if it's a static const).
-:- pred ml_should_add_local_data(elim_info, mlds__var_name, mlds__type,
- mlds__defns, mlds__statements).
+:- pred ml_should_add_local_data(elim_info, mlds__var_name,
+ mlds__maybe_gc_trace_code, mlds__defns, mlds__statements).
:- mode ml_should_add_local_data(in, in, in, in, in) is semidet.
-ml_should_add_local_data(ElimInfo, VarName, Type,
+ml_should_add_local_data(ElimInfo, VarName, MaybeGCTraceCode,
FollowingDefns, FollowingStatements) :-
Action = ElimInfo ^ action,
(
Action = chain_gc_stack_frames,
- ml_type_might_contain_pointers(Type) = yes
+ MaybeGCTraceCode = yes(_)
;
Action = hoist_nested_funcs,
ml_need_to_hoist(ElimInfo ^ module_name, VarName,
@@ -1282,6 +1509,9 @@
% so to keep things simple we do the same for the
% C back-end to, i.e. we always hoist all static constants.
%
+ % XXX Do we need to check for references from the GC_TraceCode
+ % fields here?
+ %
:- pred ml_need_to_hoist(mlds_module_name, mlds__var_name,
mlds__defns, mlds__statements).
:- mode ml_need_to_hoist(in, in, in, in) is semidet.
@@ -1301,64 +1531,40 @@
defn_contains_var(FollowingDefn, QualVarName)
;
FollowingDefn = mlds__defn(_, _, _,
- mlds__data(_, Initializer)),
+ mlds__data(_, Initializer, _)),
ml_decl_is_static_const(FollowingDefn),
initializer_contains_var(Initializer, QualVarName)
).
- % Return `yes' if the type needs to be traced by
- % the accurate garbage collector, i.e. if it might
- % contain pointers.
%
- % It's always safe to return `yes' here, so if in doubt, we do.
+ % Add the variable definition to the
+ % local_data field of the elim_info,
+ % fix up any references inside the GC tracing code,
+ % and then update the GC tracing code in the
+ % local_data.
%
- % For floats, we can return `no' even though they might
- % get boxed in some circumstances, because if they are
- % boxed then they will be represented as mlds__generic_type.
+ % Note that we need to add the variable definition
+ % to the local_data *before* we fix up the GC tracing
+ % code, otherwise references to the variable itself
+ % in the GC tracing code won't get fixed.
%
- % Note that with --gcc-nested-functions,
- % cont_type will be a function pointer that
- % may point to a trampoline function,
- % which might in fact contain pointers.
- % But the pointers will only be pointers to
- % code and pointers to the stack, not pointers
- % to the heap, so we don't need to trace them
- % for accurate GC.
- % Hence we can return `no' here for mlds__cont_type.
-
-:- func ml_type_might_contain_pointers(mlds__type) = bool.
-
-ml_type_might_contain_pointers(mercury_type(_Type, TypeCategory, _)) =
- ml_type_category_might_contain_pointers(TypeCategory).
-ml_type_might_contain_pointers(mercury_array_type(_)) = yes.
-ml_type_might_contain_pointers(mlds__native_int_type) = no.
-ml_type_might_contain_pointers(mlds__native_float_type) = no.
-ml_type_might_contain_pointers(mlds__native_bool_type) = no.
-ml_type_might_contain_pointers(mlds__native_char_type) = no.
-ml_type_might_contain_pointers(mlds__foreign_type(_, _)) = yes.
-ml_type_might_contain_pointers(mlds__class_type(_, _, Category)) =
- (if Category = mlds__enum then no else yes).
-ml_type_might_contain_pointers(mlds__ptr_type(_)) = yes.
-ml_type_might_contain_pointers(mlds__array_type(_)) = yes.
-ml_type_might_contain_pointers(mlds__func_type(_)) = no.
-ml_type_might_contain_pointers(mlds__generic_type) = yes.
-ml_type_might_contain_pointers(mlds__generic_env_ptr_type) = yes.
-ml_type_might_contain_pointers(mlds__pseudo_type_info_type) = yes.
-ml_type_might_contain_pointers(mlds__cont_type(_)) = no.
-ml_type_might_contain_pointers(mlds__commit_type) = no.
-ml_type_might_contain_pointers(mlds__rtti_type(_)) = yes.
-ml_type_might_contain_pointers(mlds__unknown_type) = yes.
+:- pred elim_info_add_and_flatten_local_data(mlds__defn::in,
+ elim_info::in, elim_info::out) is det.
-:- func ml_type_category_might_contain_pointers(builtin_type) = bool.
-ml_type_category_might_contain_pointers(int_type) = no.
-ml_type_category_might_contain_pointers(char_type) = no.
-ml_type_category_might_contain_pointers(str_type) = yes.
-ml_type_category_might_contain_pointers(float_type) = no.
-ml_type_category_might_contain_pointers(pred_type) = yes.
-ml_type_category_might_contain_pointers(tuple_type) = yes.
-ml_type_category_might_contain_pointers(enum_type) = no.
-ml_type_category_might_contain_pointers(polymorphic_type) = yes.
-ml_type_category_might_contain_pointers(user_type) = yes.
+elim_info_add_and_flatten_local_data(Defn0) -->
+ (
+ { Defn0 = mlds__defn(Name, Context, Flags, DefnBody0) },
+ { DefnBody0 = mlds__data(Type, Init, MaybeGCTraceCode0) }
+ ->
+ elim_info_add_local_data(Defn0),
+ flatten_maybe_statement(MaybeGCTraceCode0, MaybeGCTraceCode),
+ { DefnBody = mlds__data(Type, Init, MaybeGCTraceCode) },
+ { Defn = mlds__defn(Name, Context, Flags, DefnBody) },
+ elim_info_remove_local_data(Defn0),
+ elim_info_add_local_data(Defn)
+ ;
+ elim_info_add_local_data(Defn0)
+ ).
%-----------------------------------------------------------------------------%
@@ -1513,6 +1719,7 @@
Locals = elim_info_get_local_data(ElimInfo),
ClassType = elim_info_get_env_type_name(ElimInfo),
EnvPtrVarType = elim_info_get_env_ptr_type_name(ElimInfo),
+ Action = ElimInfo ^ action,
(
%
% Check for references to local variables
@@ -1523,13 +1730,13 @@
IsLocalVar = (pred(VarType::out) is nondet :-
list__member(Var, Locals),
Var = mlds__defn(data(var(ThisVarName)), _, _,
- data(VarType, _)),
+ data(VarType, _, _)),
\+ ml_decl_is_static_const(Var)
),
solutions(IsLocalVar, [FieldType])
->
EnvPtr = lval(var(qual(ModuleName,
- mlds__var_name("env_ptr", no)),
+ mlds__var_name(env_name_base(Action) ++ "_ptr", no)),
EnvPtrVarType)),
EnvModuleName = ml_env_module_name(ClassType),
ThisVarFieldName = ml_var_name_to_string(ThisVarName),
@@ -1542,6 +1749,7 @@
% For those, the code generator will have left the
% type as mlds__unknown_type, and we need to fill
% it in here.
+ Action = hoist_nested_funcs,
ThisVarName = mlds__var_name("env_ptr", no),
ThisVarType = mlds__unknown_type
->
@@ -1662,7 +1870,7 @@
:- pred defn_body_contains_defn(mlds__entity_defn, mlds__defn).
:- mode defn_body_contains_defn(in, out) is nondet.
-% defn_body_contains_defn(mlds__data(_Type, _Initializer), _Defn) :- fail.
+% defn_body_contains_defn(mlds__data(_Type, _Initializer, _), _Defn) :- fail.
defn_body_contains_defn(mlds__function(_PredProcId, _Params, FunctionBody,
_Attrs), Name) :-
function_body_contains_defn(FunctionBody, Name).
@@ -1798,7 +2006,8 @@
:- pred defn_body_contains_var(mlds__entity_defn, mlds__var).
:- mode defn_body_contains_var(in, in) is semidet.
-defn_body_contains_var(mlds__data(_Type, Initializer), Name) :-
+ % XXX Should we include variables in the GC_TraceCode field here?
+defn_body_contains_var(mlds__data(_Type, Initializer, _GC_TraceCode), Name) :-
initializer_contains_var(Initializer, Name).
defn_body_contains_var(mlds__function(_PredProcId, _Params, FunctionBody,
_Attrs), Name) :-
@@ -2195,6 +2404,15 @@
:- mode elim_info_add_local_data(in, in, out) is det.
elim_info_add_local_data(LocalVar, ElimInfo,
ElimInfo ^ local_data := [LocalVar | ElimInfo ^ local_data]).
+
+:- pred elim_info_remove_local_data(mlds__defn, elim_info, elim_info).
+:- mode elim_info_remove_local_data(in, in, out) is det.
+elim_info_remove_local_data(LocalVar, ElimInfo0, ElimInfo) :-
+ ( list__delete_first(ElimInfo0 ^ local_data, LocalVar, LocalData) ->
+ ElimInfo = ElimInfo0 ^ local_data := LocalData
+ ;
+ error("elim_info_remove_local_data: not found")
+ ).
:- pred elim_info_finish(elim_info, list(mlds__defn), list(mlds__defn)).
:- mode elim_info_finish(in, out, out) is det.
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.13
diff -u -d -r1.13 ml_optimize.m
--- compiler/ml_optimize.m 24 Aug 2001 15:44:52 -0000 1.13
+++ compiler/ml_optimize.m 10 Dec 2001 08:52:04 -0000
@@ -85,7 +85,7 @@
Attributes),
Defn = mlds__defn(Name, Context, Flags, DefnBody)
;
- DefnBody0 = mlds__data(_, _),
+ DefnBody0 = mlds__data(_, _, _),
Defn = Defn0
;
DefnBody0 = mlds__class(ClassDefn0),
@@ -241,8 +241,8 @@
generate_assign_args(_, [], [_|_], [], []) :-
error("generate_assign_args: length mismatch").
generate_assign_args(_, [], [], [], []).
-generate_assign_args(OptInfo,
- [Name - Type | Rest], [Arg | Args], Statements, TempDefns) :-
+generate_assign_args(OptInfo, [mlds__argument(Name, Type, GC_TraceCode) | Rest],
+ [Arg | Args], Statements, TempDefns) :-
(
%
% extract the variable name
@@ -282,7 +282,8 @@
TempName),
Initializer = init_obj(Arg),
TempDefn = ml_gen_mlds_var_decl(var(TempName),
- Type, Initializer, OptInfo ^ context),
+ Type, Initializer, GC_TraceCode,
+ OptInfo ^ context),
Statement = statement(
atomic(assign(
@@ -447,7 +448,7 @@
\+ (
list__member(OtherDefn, FollowingDefns),
OtherDefn = mlds__defn(data(var(OtherVarName)),
- _, _, data(_Type, OtherInitializer)),
+ _, _, data(_Type, OtherInitializer, _GC)),
( rval_contains_var(RHS, qual(Qualifier, OtherVarName))
; initializer_contains_var(OtherInitializer, ThisVar)
)
@@ -484,9 +485,9 @@
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
(
Name = data(var(VarName)),
- DefnBody0 = mlds__data(Type, _OldInitializer)
+ DefnBody0 = mlds__data(Type, _OldInitializer, GC_TraceCode)
->
- DefnBody = mlds__data(Type, init_obj(Rval)),
+ DefnBody = mlds__data(Type, init_obj(Rval), GC_TraceCode),
Defn = mlds__defn(Name, Context, Flags, DefnBody),
Defns = Defns0
;
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.8
diff -u -d -r1.8 ml_string_switch.m
--- compiler/ml_string_switch.m 24 Oct 2001 07:09:53 -0000 1.8
+++ compiler/ml_string_switch.m 10 Dec 2001 07:43:41 -0000
@@ -57,16 +57,21 @@
{ SlotVarName = mlds__var_name(
string__format("slot_%d", [i(SlotVarSeq)]), no) },
{ SlotVarType = mlds__native_int_type },
+ { SlotVarGCTraceCode = no }, % never need to trace ints
{ SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName), SlotVarType,
- MLDS_Context) },
+ SlotVarGCTraceCode, MLDS_Context) },
ml_gen_var_lval(SlotVarName, SlotVarType, SlotVarLval),
ml_gen_info_new_cond_var(StringVarSeq),
{ StringVarName = mlds__var_name(
string__format("str_%d", [i(StringVarSeq)]), no) },
{ StringVarType = ml_string_type },
+ % This variable always points to an element of the string_table array,
+ % which are all static constants; it can never point into the heap.
+ % So the GC never needs to trace it
+ { StringVarGCTraceCode = no },
{ StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
- StringVarType, MLDS_Context) },
+ StringVarType, StringVarGCTraceCode, MLDS_Context) },
ml_gen_var_lval(StringVarName, StringVarType, StringVarLval),
%
Index: compiler/ml_tailcall.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_tailcall.m,v
retrieving revision 1.11
diff -u -d -r1.11 ml_tailcall.m
--- compiler/ml_tailcall.m 24 Aug 2001 15:44:52 -0000 1.11
+++ compiler/ml_tailcall.m 11 Dec 2001 16:58:33 -0000
@@ -132,7 +132,7 @@
Attributes),
Defn = mlds__defn(Name, Context, Flags, DefnBody)
;
- DefnBody0 = mlds__data(_, _),
+ DefnBody0 = mlds__data(_, _, _),
Defn = Defn0
;
DefnBody0 = mlds__class(ClassDefn0),
@@ -539,7 +539,7 @@
;
Locals = params(Params),
list__member(Param, Params),
- Param = Name - _Type
+ Param = mlds__argument(Name, _, _)
).
%-----------------------------------------------------------------------------%
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.19
diff -u -d -r1.19 ml_type_gen.m
--- compiler/ml_type_gen.m 4 Nov 2001 14:30:35 -0000 1.19
+++ compiler/ml_type_gen.m 10 Dec 2001 08:37:58 -0000
@@ -186,7 +186,7 @@
mlds__defn(data(var(mlds__var_name("value", no))),
mlds__make_context(Context),
ml_gen_member_decl_flags,
- mlds__data(mlds__native_int_type, no_initializer)).
+ mlds__data(mlds__native_int_type, no_initializer, no)).
:- func ml_gen_enum_constant(prog_context, cons_tag_values, constructor) =
mlds__defn.
@@ -213,7 +213,7 @@
MLDS_Defn = mlds__defn(data(var(mlds__var_name(UnqualifiedName, no))),
mlds__make_context(Context),
ml_gen_enum_constant_decl_flags,
- mlds__data(mlds__native_int_type, init_obj(ConstValue))).
+ mlds__data(mlds__native_int_type, init_obj(ConstValue), no)).
%-----------------------------------------------------------------------------%
%
@@ -402,7 +402,7 @@
mlds__defn(data(var(mlds__var_name(Name, no))),
mlds__make_context(Context),
ml_gen_member_decl_flags,
- mlds__data(mlds__native_int_type, no_initializer)).
+ mlds__data(mlds__native_int_type, no_initializer, no)).
:- func ml_gen_tag_constant(prog_context, cons_tag_values, constructor) =
mlds__defns.
@@ -428,7 +428,7 @@
mlds__make_context(Context),
ml_gen_enum_constant_decl_flags,
mlds__data(mlds__native_int_type,
- init_obj(ConstValue))),
+ init_obj(ConstValue), no)),
MLDS_Defns = [MLDS_Defn]
;
MLDS_Defns = []
@@ -751,10 +751,10 @@
% Get the name and type from the field definition,
% for use as a constructor argument name and type.
-:- func make_arg(mlds__defn) = pair(mlds__entity_name, mlds__type) is det.
-make_arg(mlds__defn(Name, _Context, _Flags, Defn)) = Name - Type :-
- ( Defn = data(Type0, _Init) ->
- Type = Type0
+:- func make_arg(mlds__defn) = mlds__argument is det.
+make_arg(mlds__defn(Name, _Context, _Flags, Defn)) = Arg :-
+ ( Defn = data(Type, _Init, GC_TraceCode) ->
+ Arg = mlds__argument(Name, Type, GC_TraceCode)
;
unexpected(this_file, "make_arg: non-data member")
).
@@ -764,7 +764,7 @@
= mlds__statement is det.
gen_init_field(BaseClassId, ClassType, ClassQualifier, Member) = Statement :-
Member = mlds__defn(EntityName, Context, _Flags, Defn),
- ( Defn = data(Type0, _Init) ->
+ ( Defn = data(Type0, _Init, _GC_TraceCode) ->
Type = Type0
;
unexpected(this_file, "gen_init_field: non-data member")
@@ -859,7 +859,9 @@
ml_gen_mlds_field_decl(DataName, MLDS_Type, Context) = MLDS_Defn :-
Name = data(DataName),
- Defn = data(MLDS_Type, no_initializer),
+ % We only need GC tracing code for top-level variables, not for fields
+ GC_TraceCode = no,
+ Defn = data(MLDS_Type, no_initializer, GC_TraceCode),
DeclFlags = ml_gen_public_field_decl_flags,
MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn).
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.48
diff -u -d -r1.48 ml_unify_gen.m
--- compiler/ml_unify_gen.m 8 Nov 2001 11:47:58 -0000 1.48
+++ compiler/ml_unify_gen.m 29 Dec 2001 12:31:22 -0000
@@ -711,6 +711,7 @@
%
% allocate some fresh type variables to use as the Mercury types
% of the boxed arguments
+ % XXX The accurate GC handling for closures arguments is wrong
%
{ ProcBoxedArgTypes = ml_make_boxed_types(ProcArity) },
@@ -736,13 +737,17 @@
},
{ WrapperHeadVarNames = ml_gen_wrapper_head_var_names(1,
list__length(WrapperHeadVars)) },
- { WrapperParams0 = ml_gen_params(ModuleInfo, WrapperHeadVarNames,
- WrapperBoxedArgTypes, WrapperArgModes, PredOrFunc, CodeModel) },
+ ml_gen_params(WrapperHeadVarNames, WrapperBoxedArgTypes,
+ WrapperArgModes, PredOrFunc, CodeModel, WrapperParams0),
% then insert the `closure_arg' parameter
{ ClosureArgType = mlds__generic_type },
- { ClosureArg = data(var(
- var_name("closure_arg", no))) - ClosureArgType },
+ % XXX FIXME The GC handling for closures is wrong
+ { GC_TraceCode = no },
+ { ClosureArg = mlds__argument(
+ data(var(var_name("closure_arg", no))),
+ ClosureArgType,
+ GC_TraceCode) },
{ WrapperParams0 = mlds__func_params(WrapperArgs0, WrapperRetType) },
{ WrapperParams = mlds__func_params([ClosureArg | WrapperArgs0],
WrapperRetType) },
@@ -770,8 +775,10 @@
{ ClosureArgName = mlds__var_name("closure_arg", no) },
{ MLDS_Context = mlds__make_context(Context) },
{ ClosureType = mlds__generic_type },
+ % XXX FIXME The GC handling for closures is wrong
+ { GC_TraceCode = no },
{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
- ClosureType, MLDS_Context) },
+ ClosureType, GC_TraceCode, MLDS_Context) },
ml_gen_var_lval(ClosureName, ClosureType, ClosureLval),
ml_gen_var_lval(ClosureArgName, ClosureArgType, ClosureArgLval),
{ InitClosure = ml_gen_assign(ClosureLval, lval(ClosureArgLval),
@@ -1016,10 +1023,7 @@
%
% Generate a declaration for a corresponding local variable.
%
- =(MLDSGenInfo),
- { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
- { LocalVarDefn = ml_gen_var_decl(VarName, Type,
- mlds__make_context(Context), ModuleInfo) }.
+ ml_gen_var_decl(VarName, Type, Context, LocalVarDefn).
%-----------------------------------------------------------------------------%
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.14
diff -u -d -r1.14 ml_util.m
--- compiler/ml_util.m 24 Aug 2001 15:44:52 -0000 1.14
+++ compiler/ml_util.m 10 Dec 2001 06:41:43 -0000
@@ -306,13 +306,13 @@
defn_is_type_ctor_info(Defn) :-
Defn = mlds__defn(_Name, _Context, _Flags, Body),
- Body = mlds__data(Type, _),
+ Body = mlds__data(Type, _, _),
Type = mlds__rtti_type(RttiName),
RttiName = type_ctor_info.
defn_is_commit_type_var(Defn) :-
Defn = mlds__defn(_Name, _Context, _Flags, Body),
- Body = mlds__data(Type, _),
+ Body = mlds__data(Type, _, _),
Type = mlds__commit_type.
defn_is_public(Defn) :-
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.77
diff -u -d -r1.77 mlds.m
--- compiler/mlds.m 8 Nov 2001 11:47:59 -0000 1.77
+++ compiler/mlds.m 11 Dec 2001 17:06:48 -0000
@@ -291,7 +291,7 @@
:- import_module prog_data, builtin_ops, rtti, code_model.
:- import_module foreign, type_util.
-:- import_module bool, list, assoc_list, std_util, map.
+:- import_module bool, list, std_util, map.
%-----------------------------------------------------------------------------%
@@ -449,7 +449,11 @@
% constants or variables
---> mlds__data(
mlds__type,
- mlds__initializer
+ mlds__initializer,
+ % If accurate GC is enabled, we associate
+ % with each variable the code needed to
+ % trace that variable when doing GC.
+ mlds__maybe_gc_trace_code
)
% functions
; mlds__function(
@@ -464,6 +468,14 @@
mlds__class_defn
).
+ % If accurate GC is enabled, we associate with each variable
+ % (including function parameters) the code needed to trace that
+ % variable when doing GC.
+ % `no' here indicates that no GC tracing code is needed,
+ % e.g. because accurate GC isn't enabled, or because the
+ % variable can never contain pointers to objects on the heap.
+:- type mlds__maybe_gc_trace_code == maybe(mlds__statement).
+
% It is possible for the function to be defined externally
% (i.e. the original Mercury procedure was declared `:- external').
% (If you want to generate an abstract body consider adding another
@@ -486,11 +498,19 @@
mlds__arguments, % names and types of arguments (inputs)
mlds__return_types % types of return values (outputs)
).
-
-:- type mlds__arguments == assoc_list(mlds__entity_name, mlds__type).
+:- type mlds__arguments == list(mlds__argument).
+:- type mlds__argument
+ ---> mlds__argument(
+ mlds__entity_name, % argument name
+ mlds__type, % argument type
+ mlds__maybe_gc_trace_code % GC tracing code for this
+ % argument, if needed
+ ).
:- type mlds__arg_types == list(mlds__type).
:- type mlds__return_types == list(mlds__type).
+:- func mlds__get_arg_types(mlds__arguments) = list(mlds__type).
+
% An mlds__func_signature is like an mlds__func_params
% except that it only includes the function's type, not
% the parameter names.
@@ -1594,7 +1614,11 @@
mlds__get_func_signature(func_params(Parameters, RetTypes)) =
func_signature(ParamTypes, RetTypes) :-
- assoc_list__values(Parameters, ParamTypes).
+ ParamTypes = mlds__get_arg_types(Parameters).
+
+mlds__get_arg_types(Parameters) = ArgTypes :-
+ GetArgType = (func(mlds__argument(_, Type, _)) = Type),
+ ArgTypes = list__map(GetArgType, Parameters).
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.110
diff -u -d -r1.110 mlds_to_c.m
--- compiler/mlds_to_c.m 10 Dec 2001 04:16:30 -0000 1.110
+++ compiler/mlds_to_c.m 29 Dec 2001 12:51:25 -0000
@@ -723,11 +723,11 @@
%
% Output a fully qualified name preceded by a cast.
%
-:- pred mlds_output_name_with_cast(mlds_module_name::in,
- pair(mlds__entity_name, mlds__type)::in,
+:- pred mlds_output_name_with_cast(mlds_module_name::in, mlds__argument::in,
io__state::di, io__state::uo) is det.
-mlds_output_name_with_cast(ModuleName, Name - Type) -->
+mlds_output_name_with_cast(ModuleName, Arg) -->
+ { Arg = mlds__argument(Name, Type, _GC_TraceCode) },
mlds_output_cast(Type),
mlds_output_fully_qualified_name(qual(ModuleName, Name)).
@@ -746,7 +746,8 @@
error("det_func_signature: function missing return value?")
),
(
- ReturnArg = _ReturnArgName - mlds__ptr_type(ReturnArgType0)
+ ReturnArg = mlds__argument(_ReturnArgName,
+ mlds__ptr_type(ReturnArgType0), _GC_TraceCode)
->
ReturnArgType = ReturnArgType0
;
@@ -828,11 +829,10 @@
globals__io_lookup_bool_option(highlevel_data, HighLevelData),
(
{ HighLevelData = yes },
- { DefnBody = mlds__function(_, Signature, _, _) }
+ { DefnBody = mlds__function(_, Params, _, _) }
->
- { Signature = mlds__func_params(Parameters,
- _RetTypes) },
- { assoc_list__values(Parameters, ParamTypes) },
+ { Params = mlds__func_params(Arguments, _RetTypes) },
+ { ParamTypes = mlds__get_arg_types(Arguments) },
mlds_output_type_forward_decls(Indent, ParamTypes)
;
[]
@@ -881,7 +881,7 @@
mlds_type_contains_type(mlds__ptr_type(Type), Type).
mlds_type_contains_type(mlds__func_type(Parameters), Type) :-
Parameters = mlds__func_params(Arguments, RetTypes),
- ( list__member(_Name - Type, Arguments)
+ ( list__member(mlds__argument(_Name, Type, _GC_TraceCode), Arguments)
; list__member(Type, RetTypes)
).
@@ -916,7 +916,7 @@
mlds_output_defn(Indent, ModuleName, Defn) -->
{ Defn = mlds__defn(Name, Context, Flags, DefnBody) },
- ( { DefnBody \= mlds__data(_, _) } ->
+ ( { DefnBody \= mlds__data(_, _, _) } ->
io__nl
;
[]
@@ -932,8 +932,9 @@
mlds_output_decl_body(Indent, Name, Context, DefnBody) -->
(
- { DefnBody = mlds__data(Type, Initializer) },
- mlds_output_data_decl(Name, Type, initializer_array_size(Initializer))
+ { DefnBody = mlds__data(Type, Initializer, _GC_TraceCode) },
+ mlds_output_data_decl(Name, Type,
+ initializer_array_size(Initializer))
;
{ DefnBody = mlds__function(MaybePredProcId, Signature,
_MaybeBody, _Attrs) },
@@ -951,8 +952,11 @@
mlds_output_defn_body(Indent, Name, Context, DefnBody) -->
(
- { DefnBody = mlds__data(Type, Initializer) },
- mlds_output_data_defn(Name, Type, Initializer)
+ { DefnBody = mlds__data(Type, Initializer,
+ Maybe_GC_TraceCode) },
+ mlds_output_data_defn(Name, Type, Initializer),
+ mlds_output_maybe_gc_trace_code(Indent, Name,
+ Maybe_GC_TraceCode, "")
;
{ DefnBody = mlds__function(MaybePredProcId, Signature,
MaybeBody, _Attributes) },
@@ -963,6 +967,25 @@
mlds_output_class(Indent, Name, Context, ClassDefn)
).
+:- pred mlds_output_maybe_gc_trace_code(indent::in,
+ mlds__qualified_entity_name::in,
+ maybe(mlds__statement)::in, string::in,
+ io__state::di, io__state::uo) is det.
+mlds_output_maybe_gc_trace_code(Indent, Name, Maybe_GC_TraceCode,
+ MaybeNewLine) -->
+ (
+ { Maybe_GC_TraceCode = no }
+ ;
+ { Maybe_GC_TraceCode = yes(GC_TraceCode) },
+ io__write_string(MaybeNewLine),
+ io__write_string("#if 0 /* GC trace code */\n"),
+ % XXX this value for FuncInfo is bogus
+ % However, this output is only for debugging anyway,
+ % so it doesn't really matter.
+ { FuncInfo = func_info(Name) },
+ mlds_output_statement(Indent, FuncInfo, GC_TraceCode),
+ io__write_string("#endif\n")
+ ).
%-----------------------------------------------------------------------------%
%
@@ -1073,8 +1096,12 @@
BaseName = mlds__var_name(string__format("base_%d", [i(BaseNum0)]),
no),
Type = ClassId,
+ % We only need GC tracing code for top-level variables,
+ % not for base classes.
+ GC_TraceCode = no,
MLDS_Defn = mlds__defn(data(var(BaseName)), Context,
- ml_gen_public_field_decl_flags, data(Type, no_initializer)),
+ ml_gen_public_field_decl_flags,
+ data(Type, no_initializer, GC_TraceCode)),
BaseNum = BaseNum0 + 1.
% Output the definitions of the enumeration constants
@@ -1113,7 +1140,7 @@
mlds_output_enum_constant(Indent, EnumModuleName, Defn) -->
{ Defn = mlds__defn(Name, Context, _Flags, DefnBody) },
(
- { DefnBody = data(Type, Initializer) }
+ { DefnBody = data(Type, Initializer, _GC_TraceCode) }
->
mlds_indent(Context, Indent),
mlds_output_fully_qualified_name(qual(EnumModuleName, Name)),
@@ -1252,9 +1279,9 @@
mlds_indent(Context, Indent),
io__write_string("{\n"),
- { FuncInfo = func_info(Name, Signature) },
mlds_maybe_output_time_profile_instr(Context, Indent + 1, Name),
+ { FuncInfo = func_info(Name) },
mlds_output_statement(Indent + 1, FuncInfo, Body),
mlds_indent(Context, Indent),
@@ -1320,17 +1347,20 @@
io__write_char(')').
:- pred mlds_output_param(output_type, output_type,
- indent, mlds_module_name, mlds__context,
- pair(mlds__entity_name, mlds__type), io__state, io__state).
-:- mode mlds_output_param(in(output_type), in(output_type),
- in, in, in, in, di, uo) is det.
+ indent, mlds_module_name, mlds__context, mlds__argument,
+ io__state, io__state).
+:- mode mlds_output_param(in(output_type), in(output_type), in, in, in, in,
+ di, uo) is det.
-mlds_output_param(OutputPrefix, OutputSuffix, Indent,
- ModuleName, Context, Name - Type) -->
+mlds_output_param(OutputPrefix, OutputSuffix, Indent, ModuleName, Context,
+ Arg) -->
+ { Arg = mlds__argument(Name, Type, Maybe_GC_TraceCode) },
+ { QualName = qual(ModuleName, Name) },
mlds_indent(Context, Indent),
- mlds_output_data_decl_ho(OutputPrefix, OutputSuffix,
- qual(ModuleName, Name), Type).
+ mlds_output_data_decl_ho(OutputPrefix, OutputSuffix, QualName, Type),
+ mlds_output_maybe_gc_trace_code(Indent, QualName, Maybe_GC_TraceCode,
+ "\n").
:- pred mlds_output_func_type_prefix(func_params, io__state, io__state).
:- mode mlds_output_func_type_prefix(in, di, uo) is det.
@@ -1369,11 +1399,10 @@
),
io__write_char(')').
-:- pred mlds_output_param_type(pair(mlds__entity_name, mlds__type),
- io__state, io__state).
+:- pred mlds_output_param_type(mlds__argument, io__state, io__state).
:- mode mlds_output_param_type(in, di, uo) is det.
-mlds_output_param_type(_Name - Type) -->
+mlds_output_param_type(mlds__argument(_Name, Type, _GC_TraceCode)) -->
mlds_output_type(Type).
%-----------------------------------------------------------------------------%
@@ -1925,7 +1954,7 @@
%
:- type func_info
- ---> func_info(mlds__qualified_entity_name, mlds__func_params).
+ ---> func_info(mlds__qualified_entity_name).
:- pred mlds_output_statements(indent, func_info, list(mlds__statement),
io__state, io__state).
@@ -1953,7 +1982,7 @@
mlds_indent(Indent),
io__write_string("{\n"),
( { Defns \= [] } ->
- { FuncInfo = func_info(FuncName, _) },
+ { FuncInfo = func_info(FuncName) },
{ FuncName = qual(ModuleName, _) },
% output forward declarations for any nested functions
@@ -2118,7 +2147,7 @@
mlds_output_stmt(Indent, CallerFuncInfo, Call, Context) -->
{ Call = call(_Signature, FuncRval, MaybeObject, CallArgs,
Results, IsTailCall) },
- { CallerFuncInfo = func_info(Name, _Params) },
+ { CallerFuncInfo = func_info(Name) },
%
% Optimize general tail calls.
% We can't really do much here except to insert `return'
@@ -2493,7 +2522,7 @@
mlds_indent(Indent),
io__write_string("{\n"),
- { FuncInfo = func_info(FuncName, _) },
+ { FuncInfo = func_info(FuncName) },
mlds_maybe_output_heap_profile_instr(Context, Indent + 1, Args,
FuncName, MaybeCtorName),
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.19
diff -u -d -r1.19 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m 6 Nov 2001 15:21:03 -0000 1.19
+++ compiler/mlds_to_csharp.m 10 Dec 2001 08:45:32 -0000
@@ -419,7 +419,7 @@
write_csharp_defn_decl(Defn) -->
{ Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
(
- { DefnBody = data(Type, _Initializer) },
+ { DefnBody = data(Type, _Initializer, _GC_TraceCode) },
{ Name = data(var(VarName)) }
->
write_csharp_parameter_type(Type),
@@ -531,10 +531,10 @@
write_il_type_modifier_as_csharp_type(volatile) -->
io__write_string("volatile").
-:- pred write_input_arg_as_csharp_type(
- pair(mlds__entity_name, mlds__type)::in,
+:- pred write_input_arg_as_csharp_type(mlds__argument::in,
io__state::di, io__state::uo) is det.
-write_input_arg_as_csharp_type(EntityName - Type) -->
+write_input_arg_as_csharp_type(Arg) -->
+ { Arg = mlds__argument(EntityName, Type, _GC_TraceCode) },
get_il_data_rep(DataRep),
write_il_type_as_csharp_type(mlds_type_to_ilds_type(DataRep, Type)),
io__write_string(" "),
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.55
diff -u -d -r1.55 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 6 Nov 2001 15:21:03 -0000 1.55
+++ compiler/mlds_to_gcc.m 10 Dec 2001 08:45:45 -0000
@@ -769,7 +769,7 @@
gen_defn_body(Name, Context, Flags, DefnBody, GlobalInfo0, GlobalInfo) -->
(
- { DefnBody = mlds__data(Type, Initializer) },
+ { DefnBody = mlds__data(Type, Initializer, _GC_TraceCode) },
{ LocalVars = map__init },
{ LabelTable = map__init },
{ DefnInfo = defn_info(GlobalInfo0, Name, LocalVars,
@@ -807,7 +807,7 @@
build_local_defn_body(Name, DefnInfo, _Context, Flags, DefnBody, GCC_Defn) -->
(
- { DefnBody = mlds__data(Type, Initializer) },
+ { DefnBody = mlds__data(Type, Initializer, _GC_TraceCode) },
build_local_data_defn(Name, Flags, Type,
Initializer, DefnInfo, GCC_Defn)
;
@@ -833,7 +833,7 @@
build_field_defn_body(Name, _Context, Flags, DefnBody, GlobalInfo, GCC_Defn) -->
(
- { DefnBody = mlds__data(Type, Initializer) },
+ { DefnBody = mlds__data(Type, Initializer, _GC_TraceCode) },
build_field_data_defn(Name, Type, Initializer, GlobalInfo,
GCC_Defn),
add_field_decl_flags(Flags, GCC_Defn)
@@ -1354,8 +1354,12 @@
mlds_make_base_class(Context, ClassId, MLDS_Defn, BaseNum0, BaseNum) :-
BaseName = string__format("base_%d", [i(BaseNum0)]),
Type = ClassId,
+ % We only need GC tracing code for top-level variables,
+ % not for base classes.
+ GC_TraceCode = no,
MLDS_Defn = mlds__defn(data(var(var_name(BaseName, no))), Context,
- ml_gen_public_field_decl_flags, data(Type, no_initializer)),
+ ml_gen_public_field_decl_flags,
+ data(Type, no_initializer, GC_TraceCode)),
BaseNum = BaseNum0 + 1.
/***********
@@ -1641,7 +1645,7 @@
ParamTypes, ParamDecls, SymbolTable) -->
build_param_types_and_decls(Args, ModuleName, GlobalInfo,
ParamTypes0, ParamDecls0, SymbolTable0),
- { Arg = ArgName - Type },
+ { Arg = mlds__argument(ArgName, Type, _GC_TraceCode) },
build_type(Type, GlobalInfo, GCC_Type),
( { ArgName = data(var(ArgVarName)) } ->
{ GCC_ArgVarName = ml_var_name_to_string(ArgVarName) },
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.92
diff -u -d -r1.92 mlds_to_il.m
--- compiler/mlds_to_il.m 21 Nov 2001 03:49:29 -0000 1.92
+++ compiler/mlds_to_il.m 11 Dec 2001 17:07:29 -0000
@@ -293,7 +293,7 @@
list__filter((pred(D::in) is semidet :-
( D = mlds__defn(_, _, _, mlds__function(_, _, _, _))
- ; D = mlds__defn(_, _, _, mlds__data(_, _))
+ ; D = mlds__defn(_, _, _, mlds__data(_, _, _))
)
), MLDS0 ^ defns ++ ExportDefns, MercuryCodeMembers, Others),
WrapperClass = wrapper_class(list__map(rename_defn, MercuryCodeMembers)),
@@ -318,8 +318,9 @@
rename_defn(defn(Name, Context, Flags, Entity0))
= defn(Name, Context, Flags, Entity) :-
- ( Entity0 = data(Type, Initializer),
- Entity = data(Type, rename_initializer(Initializer))
+ ( Entity0 = data(Type, Initializer, GC_TraceCode),
+ Entity = data(Type, rename_initializer(Initializer),
+ rename_maybe_statement(GC_TraceCode))
; Entity0 = function(MaybePredProcId, Params, FunctionBody0,
Attributes),
( FunctionBody0 = defined_here(Stmt),
@@ -337,6 +338,11 @@
list__map(rename_defn, Members)))
).
+:- func rename_maybe_statement(maybe(mlds__statement)) = maybe(mlds__statement).
+
+rename_maybe_statement(no) = no.
+rename_maybe_statement(yes(Stmt)) = yes(rename_statement(Stmt)).
+
:- func rename_statement(mlds__statement) = mlds__statement.
rename_statement(statement(block(Defns, Stmts), Context))
@@ -346,14 +352,10 @@
rename_statement(statement(while(Rval, Loop, IterateOnce), Context))
= statement(while(rename_rval(Rval),
rename_statement(Loop), IterateOnce), Context).
-rename_statement(statement(if_then_else(Rval, Then, MaybeElse0), Context))
+rename_statement(statement(if_then_else(Rval, Then, MaybeElse), Context))
= statement(if_then_else(rename_rval(Rval),
- rename_statement(Then), MaybeElse), Context) :-
- ( MaybeElse0 = no,
- MaybeElse = no
- ; MaybeElse0 = yes(Else),
- MaybeElse = yes(rename_statement(Else))
- ).
+ rename_statement(Then),
+ rename_maybe_statement(MaybeElse)), Context).
rename_statement(statement(switch(Type, Rval, Range, Cases, Default0), Context))
= statement(switch(Type, rename_rval(Rval), Range,
list__map(rename_switch_case, Cases), Default),
@@ -502,7 +504,7 @@
% data definitions, but they're not part of the CLS.
% Since they are not part of the CLS, we don't generate them,
% and so there's no need to handle them here.
-mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags, data(_Type, _Init)),
+mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags, data(_Type, _Init, _GC)),
_Decl, Info, Info) :-
sorry(this_file, "top level data definition!").
mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags,
@@ -800,7 +802,7 @@
generate_method(ClassName, _, defn(Name, Context, Flags, Entity),
ClassMember) -->
- { Entity = data(Type, DataInitializer) },
+ { Entity = data(Type, DataInitializer, _GC_TraceCode) },
{ FieldName = entity_name_to_ilds_id(Name) },
@@ -1235,8 +1237,13 @@
list__map_foldl(
(pred(RT::in, RV - Lval::out, N0::in, N0 + 1::out) is det :-
VN = var_name("returnval" ++ int_to_string(N0), no),
+ % We don't need to worry about tracing variables for
+ % accurate GC in the IL back-end -- the .NET runtime
+ % system itself provides accurate GC.
+ GC_TraceCode = no,
RV = ml_gen_mlds_var_decl(
- var(VN), RT, no_initializer, Context),
+ var(VN), RT, no_initializer, GC_TraceCode,
+ Context),
Lval = var(qual(ModuleName, VN), RT)
), RetTypes, ReturnVars, 0, _),
@@ -1247,9 +1254,10 @@
error("exported method has argument without var name")
)
),
- ArgTypes = assoc_list__values(Inputs),
+ ArgTypes = mlds__get_arg_types(Inputs),
ArgRvals = list__map(
- (func(EntName - Type) = lval(var(VarName, Type)) :-
+ (func(mlds__argument(EntName, Type, _GC_TraceCode)) =
+ lval(var(VarName, Type)) :-
VarName = EntNameToVarName(EntName)
), Inputs),
ReturnVarDecls = assoc_list__keys(ReturnVars),
@@ -1305,7 +1313,7 @@
Tree0, Tree) -->
(
{ Name = data(DataName) },
- { Entity = mlds__data(MLDSType, Initializer) }
+ { Entity = mlds__data(MLDSType, Initializer, _GC_TraceCode) }
->
( { Initializer = no_initializer } ->
{ Tree = Tree0 }
@@ -2806,9 +2814,9 @@
func_signature(Args, _Returns), Params) :-
Params = list__map(mlds_type_to_ilds_type(DataRep), Args).
-:- func mlds_arg_to_il_arg(pair(mlds__entity_name, mlds__type)) =
- pair(ilds__id, mlds__type).
-mlds_arg_to_il_arg(EntityName - Type) = Id - Type :-
+:- func mlds_arg_to_il_arg(mlds__argument) = pair(ilds__id, mlds__type).
+mlds_arg_to_il_arg(mlds__argument(EntityName, Type, _GC_TraceCode)) =
+ Id - Type :-
mangle_entity_name(EntityName, Id).
@@ -2846,10 +2854,10 @@
),
ILSignature = signature(call_conv(no, default), Param, ILInputTypes).
-:- func input_param_to_ilds_type(il_data_rep, mlds_module_name,
- pair(entity_name, mlds__type)) = ilds__param.
-input_param_to_ilds_type(DataRep, _ModuleName, EntityName - MldsType)
- = ILType - yes(Id) :-
+:- func input_param_to_ilds_type(il_data_rep, mlds_module_name, mlds__argument)
+ = ilds__param.
+input_param_to_ilds_type(DataRep, _ModuleName, Arg) = ILType - yes(Id) :-
+ Arg = mlds__argument(EntityName, MldsType, _GC_TraceCode),
mangle_entity_name(EntityName, Id),
ILType = mlds_type_to_ilds_type(DataRep, MldsType).
@@ -3607,8 +3615,10 @@
defn_to_local(ModuleName,
mlds__defn(Name, _Context, _DeclFlags, Entity), Id - MLDSType) :-
- ( Name = data(DataName),
- Entity = mlds__data(MLDSType0, _Initializer) ->
+ (
+ Name = data(DataName),
+ Entity = mlds__data(MLDSType0, _Initializer, _GC_TraceCode)
+ ->
mangle_dataname(DataName, MangledDataName),
mangle_mlds_var(qual(ModuleName,
var_name(MangledDataName, no)), Id),
@@ -4063,7 +4073,7 @@
il_info_new_class(ClassDefn) -->
{ ClassDefn = class_defn(_, _, _, _, _, Members) },
{ list__filter_map((pred(M::in, S::out) is semidet :-
- M = mlds__defn(Name, _, _, data(_, _)),
+ M = mlds__defn(Name, _, _, data(_, _, _)),
S = entity_name_to_ilds_id(Name)
), Members, FieldNames)
},
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.16
diff -u -d -r1.16 mlds_to_java.m
--- compiler/mlds_to_java.m 25 Oct 2001 08:35:39 -0000 1.16
+++ compiler/mlds_to_java.m 11 Dec 2001 17:08:13 -0000
@@ -58,8 +58,7 @@
:- import_module rtti_to_mlds. % for mlds_rtti_type_name.
:- import_module hlds_pred. % for pred_proc_id.
:- import_module modules. % for mercury_std_library_name.
-:- import_module ml_code_util. % for ml_gen_mlds_var_decl, which is used by
- % the code that handles derived classes
+:- import_module ml_code_util. % for ml_gen_local_var_decl_flags.
:- import_module ml_type_gen. % for ml_gen_type_name
:- import_module export. % for export__type_to_type_string
:- import_module globals, options, passes_aux.
@@ -121,7 +120,7 @@
defn_is_rtti_data(Defn) :-
Defn = mlds__defn(_Name, _Context, _Flags, Body),
- Body = mlds__data(Type, _),
+ Body = mlds__data(Type, _, _),
Type = mlds__rtti_type(_).
% Succeeds iff this type is a enumeration.
@@ -440,8 +439,11 @@
% Create new argument.
% There is only one as "call" takes an array of Object.
%
- Arg = data(var(var_name("args", no))) -
- mlds__array_type(mlds__generic_type),
+ GC_TraceCode = no, % GC tracing code not needed for java
+ Arg = mlds__argument(
+ data(var(var_name("args", no))),
+ mlds__array_type(mlds__generic_type),
+ GC_TraceCode),
Args = [Arg],
%
% Create new declarations for old arguments and assign
@@ -484,7 +486,7 @@
generate_wrapper_decls(_, _, [], _, []).
generate_wrapper_decls(ModuleName, Context, [Arg | Args],
Count, [Defn | Defns]) :-
- Arg = Name - Type,
+ Arg = mlds__argument(Name, Type, GC_TraceCode),
Flags = ml_gen_local_var_decl_flags,
ArrayIndex = const(int_const(Count)),
NewVarName = qual(mercury_module_name_to_mlds(ModuleName),
@@ -497,7 +499,7 @@
%
Initializer = binop(array_index(elem_type_generic),
lval(NewArgLval), ArrayIndex),
- Body = mlds__data(Type, init_obj(Initializer)),
+ Body = mlds__data(Type, init_obj(Initializer), GC_TraceCode),
Defn = mlds__defn(Name, Context, Flags, Body),
%
% Recursively call ourself to process the next argument.
@@ -630,7 +632,7 @@
mlds__context, mlds__entity_defn, io__state, io__state).
:- mode output_defn_body(in, in, in, in, di, uo) is det.
-output_defn_body(_, Name, _, mlds__data(Type, Initializer)) -->
+output_defn_body(_, Name, _, mlds__data(Type, Initializer, _GCTraceCode)) -->
output_data_defn(Name, Type, Initializer).
output_defn_body(Indent, Name, Context,
mlds__function(MaybePredProcId, Signature, MaybeBody,
@@ -809,7 +811,7 @@
output_enum_constant(Indent, EnumModuleName, Defn) -->
{ Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
(
- { DefnBody = data(Type, Initializer) }
+ { DefnBody = data(Type, Initializer, _GC_TraceCode) }
->
indent_line(Indent),
io__write_string("public static final int "),
@@ -1041,10 +1043,11 @@
io__write_char(')').
:- pred output_param(indent, mlds_module_name, mlds__context,
- pair(mlds__entity_name, mlds__type), io__state, io__state).
+ mlds__argument, io__state, io__state).
:- mode output_param(in, in, in, in, di, uo) is det.
-output_param(Indent, ModuleName, Context, Name - Type) -->
+output_param(Indent, ModuleName, Context, Arg) -->
+ { Arg = mlds__argument(Name, Type, _GC_TraceCode) },
indent_line(Context, Indent),
output_type(Type),
io__write_char(' '),
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.23
diff -u -d -r1.23 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 6 Nov 2001 15:21:05 -0000 1.23
+++ compiler/mlds_to_mcpp.m 10 Dec 2001 07:17:16 -0000
@@ -507,8 +507,9 @@
:- mode write_managed_cpp_defn_decl(in, di, uo) is det.
write_managed_cpp_defn_decl(Defn) -->
{ Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
- ( { DefnBody = data(Type, _Initializer) },
- { Name = data(var(VarName)) }
+ (
+ { DefnBody = data(Type, _Initializer, _GC_TraceCode) },
+ { Name = data(var(VarName)) }
->
write_managed_cpp_type(Type),
io__write_string(" "),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.217
diff -u -d -r1.217 polymorphism.m
--- compiler/polymorphism.m 6 Aug 2001 06:20:29 -0000 1.217
+++ compiler/polymorphism.m 12 Dec 2001 19:15:19 -0000
@@ -233,6 +233,12 @@
term__context, list(prog_var), list(hlds_goal), poly_info, poly_info).
:- mode polymorphism__make_type_info_vars(in, in, out, out, in, out) is det.
+% Likewise, but for a single type.
+
+:- pred polymorphism__make_type_info_var(type,
+ term__context, prog_var, list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__make_type_info_var(in, in, out, out, in, out) is det.
+
% polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index,
% ModuleInfo, Goals, TypeInfoVar, ...):
%
@@ -2600,10 +2606,6 @@
ExtraVars2, ExtraGoals2, Info1, Info),
ExtraVars = [Var | ExtraVars2],
list__append(ExtraGoals1, ExtraGoals2, ExtraGoals).
-
-:- pred polymorphism__make_type_info_var(type, prog_context,
- prog_var, list(hlds_goal), poly_info, poly_info).
-:- mode polymorphism__make_type_info_var(in, in, out, out, in, out) is det.
polymorphism__make_type_info_var(Type, Context, Var, ExtraGoals,
Info0, Info) :-
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.21
diff -u -d -r1.21 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 31 Oct 2001 17:58:58 -0000 1.21
+++ compiler/rtti_to_mlds.m 29 Dec 2001 09:10:56 -0000
@@ -77,6 +77,11 @@
Exported = rtti_name_is_exported(RttiName),
Flags = rtti_data_decl_flags(Exported),
+ % The GC never needs to trace these definitions,
+ % because they are static constants, and can point
+ % only to other static constants, not to the heap.
+ GC_TraceCode = no,
+
%
% Generate the declaration body,
% i.e. the type and the initializer
@@ -85,7 +90,7 @@
module_info_name(ModuleInfo, ModuleName),
gen_init_rtti_data_defn(RttiData, ModuleName, ModuleInfo,
Initializer, ExtraDefns),
- DefnBody = mlds__data(MLDS_Type, Initializer),
+ DefnBody = mlds__data(MLDS_Type, Initializer, GC_TraceCode),
%
% put it all together
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.84
diff -u -d -r1.84 private_builtin.m
--- library/private_builtin.m 13 Dec 2001 09:06:09 -0000 1.84
+++ library/private_builtin.m 13 Dec 2001 09:09:40 -0000
@@ -1036,6 +1036,20 @@
:- pred free_heap(_T).
:- mode free_heap(di) is det.
+ % gc_trace/1 is used for accurate garbage collection in the
+ % the MLDS->C backend. It takes as parameters a pointer to
+ % a variable (normally on the stack) and, implicitly,
+ % a type_info which describes the type of that variable.
+ % It traverses the heap object(s) pointed to by that variable,
+ % copying them to the new heap area, and updating the
+ % variable to point to the new copy. This is done by calling
+ % MR_agc_deep_copy() (from runtime/mercury_deep_copy*).
+
+:- type mutvar(T) ---> mutvar(c_pointer).
+ % a no_tag type, i.e. the representation is just a c_pointer.
+
+:- impure pred gc_trace(mutvar(T)::in) is det.
+
% mark_hp/1 and restore_hp/1 are used by the MLDS back-end,
% to implement heap reclamation on failure.
% (The LLDS back-end does not use these; instead it inserts
@@ -1061,6 +1075,26 @@
:- pragma foreign_decl("C", "
#include ""mercury_heap.h"" /* for MR_free_heap() */
+").
+
+% default (Mercury) implementation for gc_trace/1
+% This should be overridden by the appropriate foreign language implementation.
+gc_trace(_::in) :-
+ sorry("private_builtin__gc_trace/1").
+
+:- pragma foreign_proc("C", gc_trace(Pointer::in),
+ [will_not_call_mercury, thread_safe],
+"
+#ifdef NATIVE_GC
+ *(MR_Word *)Pointer =
+ MR_agc_deep_copy((MR_Word *) Pointer,
+ (MR_TypeInfo) TypeInfo_for_T,
+ MR_ENGINE(heap_zone2->min),
+ MR_ENGINE(heap_zone2->hardmax));
+#else
+ MR_fatal_error(""private_builtin__gc_trace/2: ""
+ ""called when accurate GC not enabled"");
+#endif
").
% default (Mercury) implementation for free_heap/1
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
The University of Melbourne | of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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