[m-rev.] for review: MLDS back-end: generate closure layouts
Fergus Henderson
fjh at cs.mu.OZ.AU
Sat Mar 2 00:50:59 AEDT 2002
Here's the new full diff.
Estimated hours taken: 20
Branches: main
Generate closure layouts for the MLDS back-end.
compiler/ml_unify_gen.m:
Add code to generate closure layouts.
XXX Note that we still don't fill in the MR_closure_id field yet.
compiler/stack_layout.m:
Export stack_layout__represent_locn_as_int,
for use by ml_unify_gen.m.
compiler/mercury_compile.m:
Invoke the arg_info.m pass for the MLDS back-end, since the
arg_infos are needed by the code in continuation_info.m which
ml_unify_gen.m calls to generate closure layouts.
compiler/ml_elim_nested.m:
compiler/ml_util.m:
compiler/ml_code_util.m:
Fix a bug, exposed by the changes above, which led to some
dangling references. The bug was that it was not hoisting out
local static RTTI data even when this data was referred to by
other static constants were being hoisted, because it was only
checking for references via `var(mlds__var)' lvals, not via
`data_addr_const(data_addr)' rvals. The fix was to change the code
for *_contains_var so that it accepts a data_name rather than
a var_name, and counts references via data_addr_consts,
and to change the code for ml_decl_is_static_const so that
it just checks for `data(_)' rather than `data(var(_))'.
compiler/rtti_to_mlds.m:
Mark RTTI definitions as `final', and document why.
compiler/ml_optimize.m:
Update to reflect the interface changes in ml_util.m.
runtime/mercury_deep_copy_body.h:
Delete a call to MR_fatal_error(), since it is no longer needed.
tests/hard_coded/Mmakefile:
Re-enable the copy_pred and copy_pred_2 test cases for the
MLDS back-end, since they now pass.
Workspace: /home/ceres/fjh/mercury
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.235
diff -u -d -r1.235 mercury_compile.m
--- compiler/mercury_compile.m 27 Feb 2002 07:30:10 -0000 1.235
+++ compiler/mercury_compile.m 27 Feb 2002 17:43:40 -0000
@@ -3233,7 +3233,15 @@
HLDS60),
mercury_compile__maybe_dump_hlds(HLDS60, "60", "mark_static"),
- { HLDS = HLDS60 },
+ % We need to do map_args_to_regs, even though that module is meant
+ % for the LLDS back-end, because with the MLDS back-end the arg_infos
+ % that map_args_to_regs generates are used by continuation_info.m,
+ % which is used by ml_unify_gen.m when outputting closure layout
+ % structs.
+ mercury_compile__map_args_to_regs(HLDS60, Verbose, Stats, HLDS70),
+ mercury_compile__maybe_dump_hlds(HLDS70, "70", "args_to_regs"),
+
+ { HLDS = HLDS70 },
mercury_compile__maybe_dump_hlds(HLDS, "99", "final"),
maybe_write_string(Verbose, "% Converting HLDS to MLDS...\n"),
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.55
diff -u -d -r1.55 ml_code_util.m
--- compiler/ml_code_util.m 18 Feb 2002 07:00:55 -0000 1.55
+++ compiler/ml_code_util.m 1 Mar 2002 13:42:34 -0000
@@ -962,7 +962,7 @@
%
ml_decl_is_static_const(Defn) :-
Defn = mlds__defn(Name, _Context, Flags, _DefnBody),
- Name = data(var(_)),
+ Name = data(_),
Flags = ml_static_const_decl_flags.
% Given a function label and the statement which will comprise
@@ -1672,6 +1672,8 @@
% Return the declaration flags appropriate for an
% initialized local static constant.
+ % Note that rtti_decl_flags, in rtti_to_mlds.m,
+ % must be the same as this apart from the access.
%
ml_static_const_decl_flags = MLDS_DeclFlags :-
Access = local,
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.53
diff -u -d -r1.53 ml_elim_nested.m
--- compiler/ml_elim_nested.m 11 Feb 2002 16:48:19 -0000 1.53
+++ compiler/ml_elim_nested.m 27 Feb 2002 19:35:51 -0000
@@ -625,8 +625,8 @@
(
{ Arg = mlds__argument(data(var(VarName)), _Type,
GC_TraceCode) },
- { ml_should_add_local_data(ElimInfo, VarName, GC_TraceCode,
- [], [FuncBody]) }
+ { ml_should_add_local_data(ElimInfo, var(VarName),
+ GC_TraceCode, [], [FuncBody]) }
->
{ ml_conv_arg_to_var(Context, Arg, ArgToCopy) },
elim_info_add_and_flatten_local_data(ArgToCopy)
@@ -653,7 +653,7 @@
(
Arg = mlds__argument(data(var(VarName)), FieldType,
GC_TraceCode),
- ml_should_add_local_data(ElimInfo, VarName, GC_TraceCode,
+ ml_should_add_local_data(ElimInfo, var(VarName), GC_TraceCode,
[], [FuncBody])
->
ml_conv_arg_to_var(Context, Arg, ArgToCopy),
@@ -1072,7 +1072,7 @@
DefnBody0 = mlds__function(PredProcId, Params,
defined_here(FuncBody0), Attributes),
statement_contains_var(FuncBody0, qual(ModuleName,
- mlds__var_name("env_ptr", no)))
+ var(mlds__var_name("env_ptr", no))))
->
EnvPtrVal = lval(var(qual(ModuleName,
mlds__var_name("env_ptr_arg", no)),
@@ -1589,9 +1589,10 @@
{ InitStatements = [] }
;
% Hoist ordinary local variables
- { Name = data(var(VarName)) },
+ { Name = data(DataName) },
+ { DataName = var(VarName) },
{ ml_should_add_local_data(ElimInfo,
- VarName, MaybeGCTraceCode0,
+ DataName, MaybeGCTraceCode0,
FollowingDefns, FollowingStatements) }
->
% we need to strip out the initializer (if any)
@@ -1647,11 +1648,11 @@
% 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,
+:- pred ml_should_add_local_data(elim_info, mlds__data_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, MaybeGCTraceCode,
+ml_should_add_local_data(ElimInfo, DataName, MaybeGCTraceCode,
FollowingDefns, FollowingStatements) :-
Action = ElimInfo ^ action,
(
@@ -1659,7 +1660,7 @@
MaybeGCTraceCode = yes(_)
;
Action = hoist_nested_funcs,
- ml_need_to_hoist(ElimInfo ^ module_name, VarName,
+ ml_need_to_hoist(ElimInfo ^ module_name, DataName,
FollowingDefns, FollowingStatements)
).
@@ -1680,13 +1681,13 @@
% 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,
+:- pred ml_need_to_hoist(mlds_module_name, mlds__data_name,
mlds__defns, mlds__statements).
:- mode ml_need_to_hoist(in, in, in, in) is semidet.
-ml_need_to_hoist(ModuleName, VarName,
+ml_need_to_hoist(ModuleName, DataName,
FollowingDefns, FollowingStatements) :-
- QualVarName = qual(ModuleName, VarName),
+ QualDataName = qual(ModuleName, DataName),
(
list__member(FollowingDefn, FollowingDefns)
;
@@ -1696,12 +1697,12 @@
(
FollowingDefn = mlds__defn(_, _, _,
mlds__function(_, _, _, _)),
- defn_contains_var(FollowingDefn, QualVarName)
+ defn_contains_var(FollowingDefn, QualDataName)
;
FollowingDefn = mlds__defn(_, _, _,
mlds__data(_, Initializer, _)),
ml_decl_is_static_const(FollowingDefn),
- initializer_contains_var(Initializer, QualVarName)
+ initializer_contains_var(Initializer, QualDataName)
).
%
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_optimize.m
--- compiler/ml_optimize.m 11 Feb 2002 11:27:05 -0000 1.16
+++ compiler/ml_optimize.m 27 Feb 2002 19:44:01 -0000
@@ -522,6 +522,7 @@
AssignStatement = statement(atomic(assign(LHS, RHS)), _),
LHS = var(ThisVar, _ThisType),
ThisVar = qual(Qualifier, VarName),
+ ThisData = qual(Qualifier, var(VarName)),
Qualifier = OptInfo ^ module_name,
list__takewhile(isnt(var_defn(VarName)), Defns0,
_PrecedingDefns, [_VarDefn | FollowingDefns]),
@@ -532,13 +533,13 @@
% We must also check that the initializers (if any)
% of the variables that follow this one don't
% refer to this variable.
- \+ rval_contains_var(RHS, ThisVar),
+ \+ rval_contains_var(RHS, ThisData),
\+ (
list__member(OtherDefn, FollowingDefns),
- OtherDefn = mlds__defn(data(var(OtherVarName)),
+ OtherDefn = mlds__defn(data(OtherVarName),
_, _, data(_Type, OtherInitializer, _GC)),
( rval_contains_var(RHS, qual(Qualifier, OtherVarName))
- ; initializer_contains_var(OtherInitializer, ThisVar)
+ ; initializer_contains_var(OtherInitializer, ThisData)
)
)
->
@@ -781,7 +782,9 @@
% Statement0. Only if we are sure that Statement0
% can't modify the variable's value is it safe to go
% on and look for the initial value in Statements0.
- \+ statement_contains_var(Statement0, VarName),
+ VarName = qual(Mod, UnqualVarName),
+ DataName = qual(Mod, var(UnqualVarName)),
+ \+ statement_contains_var(Statement0, DataName),
\+ (
statement_contains_statement(Statement0, Label),
Label = mlds__statement(label(_), _)
@@ -802,7 +805,9 @@
% delete the assignment, by replacing it with an empty block
Stmt = block([], [])
; Stmt0 = block(Defns0, SubStatements0) ->
- \+ defns_contains_var(Defns0, Var),
+ Var = qual(Mod, UnqualVarName),
+ Data = qual(Mod, var(UnqualVarName)),
+ \+ defns_contains_var(Defns0, Data),
find_initial_val_in_statements(Var, SubStatements0,
Rval, SubStatements),
Stmt = block(Defns0, SubStatements)
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.52
diff -u -d -r1.52 ml_unify_gen.m
--- compiler/ml_unify_gen.m 20 Feb 2002 03:14:13 -0000 1.52
+++ compiler/ml_unify_gen.m 1 Mar 2002 13:35:07 -0000
@@ -88,12 +88,18 @@
:- import_module hlds_out, builtin_ops.
:- import_module ml_code_gen, ml_call_gen, ml_type_gen.
:- import_module prog_util, type_util, mode_util.
-:- import_module rtti, error_util.
-:- import_module code_util. % XXX needed for `code_util__cons_id_to_tag'.
+:- import_module pseudo_type_info, rtti, rtti_to_mlds, error_util.
:- import_module globals, options.
+% XXX The following modules depend on the LLDS,
+% so ideally they should not be used here.
+:- import_module code_util. % needed for `cons_id_to_tag'.
+:- import_module continuation_info. % needed for `generate_closure_layout'
+:- import_module stack_layout. % needed for `represent_locn_as_int'
+:- import_module llds. % needed for `layout_locn'
+
:- import_module bool, int, string, list, map, require, std_util, term, varset.
-:- import_module assoc_list.
+:- import_module assoc_list, set.
%-----------------------------------------------------------------------------%
@@ -404,17 +410,7 @@
ml_gen_constant(type_ctor_info_constant(ModuleName0, TypeName, TypeArity),
VarType, Rval) -->
ml_gen_type(VarType, MLDS_VarType),
- %
- % Although the builtin types `int', `float', etc. are treated as part
- % of the `builtin' module, for historical reasons they don't have
- % any qualifiers at this point, so we need to add the `builtin'
- % qualifier now.
- %
- { ModuleName0 = unqualified("") ->
- mercury_public_builtin_module(ModuleName)
- ;
- ModuleName = ModuleName0
- },
+ { ModuleName = fixup_builtin_module(ModuleName0) },
{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
{ RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity) },
{ DataAddr = data_addr(MLDS_Module,
@@ -478,6 +474,20 @@
ml_gen_constant(pred_closure_tag(_, _, _), _, _) -->
{ error("ml_gen_constant: pred_closure_tag") }.
+ %
+ % Although the builtin types `int', `float', etc. are treated as part
+ % of the `builtin' module, for historical reasons they don't have
+ % any qualifiers at this point, so we need to add the `builtin'
+ % qualifier now.
+ %
+:- func fixup_builtin_module(module_name) = module_name.
+fixup_builtin_module(ModuleName0) = ModuleName :-
+ ( ModuleName0 = unqualified("") ->
+ mercury_public_builtin_module(ModuleName)
+ ;
+ ModuleName = ModuleName0
+ ).
+
%-----------------------------------------------------------------------------%
% Generate an MLDS rval for a given reserved address,
@@ -559,16 +569,13 @@
),
%
- % Generate a dummy value for the closure layout
- % (we do this just to match the structure used
- % by the LLDS closure representation)
+ % Generate a value for the closure layout;
+ % this is a static constant that holds information
+ % about how the structure of this closure.
%
- { mercury_private_builtin_module(PrivateBuiltinModule) },
- { MLDS_PrivateBuiltinModule = mercury_module_name_to_mlds(
- PrivateBuiltinModule) },
- { ClosureLayoutType = mlds__class_type(qual(MLDS_PrivateBuiltinModule,
- "closure_layout"), 0, mlds__class) },
- { ClosureLayoutRval = const(null(ClosureLayoutType)) },
+ ml_gen_closure_layout(PredId, ProcId, Context,
+ ClosureLayoutRval, ClosureLayoutType,
+ ClosureLayoutDecls),
%
% Generate a wrapper function which just unboxes the
@@ -592,14 +599,6 @@
{ NumArgsType0 = mlds__native_int_type },
%
- % the pointer will not be tagged (i.e. the tag will be zero)
- %
- { MaybeConsId = no },
- { MaybeConsName = no },
- { PrimaryTag = 0 },
- { MaybeSecondaryTag = no },
-
- %
% put all the extra arguments of the closure together
% Note that we need to box these arguments, except for
% the closure layout, which is already a reference type.
@@ -612,13 +611,250 @@
{ ExtraArgTypes = [ClosureLayoutType, WrapperFuncType, NumArgsType] },
%
+ % the pointer will not be tagged (i.e. the tag will be zero)
+ %
+ { MaybeConsId = no },
+ { MaybeConsName = no },
+ { PrimaryTag = 0 },
+ { MaybeSecondaryTag = no },
+
+ %
% generate a `new_object' statement (or static constant)
% for the closure
%
ml_gen_new_object(MaybeConsId, PrimaryTag, MaybeSecondaryTag,
MaybeConsName, Var, ExtraArgRvals, ExtraArgTypes, ArgVars,
ArgModes, HowToConstruct, Context,
- MLDS_Decls, MLDS_Statements).
+ MLDS_Decls0, MLDS_Statements),
+ { MLDS_Decls = ClosureLayoutDecls ++ MLDS_Decls0 }.
+
+ %
+ % Generate a value for the closure layout struct.
+ % See MR_Closure_Layout in ../runtime/mercury_ho_call.h.
+ %
+ % Note that the code here is similar to code in stack_layout.m;
+ % any changes here may need to be reflected there, and vice versa.
+ %
+:- pred ml_gen_closure_layout(pred_id::in, proc_id::in, prog_context::in,
+ mlds__rval::out, mlds__type::out, mlds__defns::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+ml_gen_closure_layout(PredId, ProcId, Context,
+ ClosureLayoutRval, ClosureLayoutType,
+ ClosureLayoutDefns) -->
+ =(Info),
+ { ml_gen_info_get_module_info(Info, ModuleInfo) },
+ { continuation_info__generate_closure_layout(
+ ModuleInfo, PredId, ProcId, ClosureLayoutInfo) },
+
+ { ml_gen_closure_proc_id(ModuleInfo, Context,
+ InitProcId, ProcIdType, ClosureProcIdDefns) },
+
+ { ClosureLayoutInfo = closure_layout_info(ClosureArgs, TVarLocnMap) },
+ { ml_stack_layout_construct_closure_args(ModuleInfo, ClosureArgs,
+ InitClosureArgs, ClosureArgTypes, ClosureArgDefns) },
+ ml_gen_info_new_const(TvarVectorSeqNum),
+ ml_format_static_const_name("typevar_vector", TvarVectorSeqNum,
+ TvarVectorName),
+ { ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorName,
+ Context, TVarLocnMap, TVarVectorRval, TVarVectorType,
+ TVarDefns) },
+ { InitTVarVector = init_obj(unop(box(TVarVectorType),
+ TVarVectorRval)) },
+ { Inits = [InitProcId, InitTVarVector | InitClosureArgs] },
+ { _ArgTypes = [ProcIdType, TVarVectorType | ClosureArgTypes] },
+
+ ml_gen_info_new_const(LayoutSeqNum),
+ ml_format_static_const_name("closure_layout", LayoutSeqNum, Name),
+ { Access = local },
+ { Initializer = init_array(Inits) },
+ % XXX there's no way in C to properly represent this type,
+ % since it is a struct that ends with a variable-length array.
+ % For now we just treat the whole struct as an array.
+ { ClosureLayoutType = mlds__array_type(mlds__generic_type) },
+ { ClosureLayoutDefn = ml_gen_static_const_defn(Name, ClosureLayoutType,
+ Access, Initializer, Context) },
+ { ClosureLayoutDefns = ClosureProcIdDefns ++ TVarDefns ++
+ ClosureArgDefns ++ [ClosureLayoutDefn] },
+ { module_info_name(ModuleInfo, ModuleName) },
+ { MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
+ { ClosureLayoutRval = lval(var(qual(MLDS_ModuleName, Name),
+ ClosureLayoutType)) }.
+
+:- pred ml_gen_closure_proc_id(module_info::in, prog_context::in,
+ mlds__initializer::out, mlds__type::out,
+ mlds__defns::out) is det.
+ml_gen_closure_proc_id(_ModuleInfo, _Context, InitProcId, ProcIdType,
+ ClosureProcIdDefns) :-
+ % XXX currently we don't fill in the ProcId field!
+ InitProcId = init_obj(const(null(ProcIdType))),
+ ProcIdType = mlds__generic_type,
+ ClosureProcIdDefns = [].
+/*
+ { module_info_name(ModuleInfo, ModuleName) },
+ { term__context_file(Context, FileName) },
+ { term__context_line(Context, LineNumber) },
+ % XXX We don't have the GoalInfo here,
+ % so we can't compute the goal path correctly
+ % { goal_info_get_goal_path(GoalInfo, GoalPath) },
+ % { trace__path_to_string(GoalPath, GoalPathStr) },
+ { GoalPathStr = "" },
+ % DataAddr = layout_addr(
+ % closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel)),
+ % Data = layout_data(closure_proc_id_data(CallerProcLabel, SeqNo,
+ % ClosureProcLabel, ModuleName, FileName, LineNumber, GoalPath)),
+ % InitProcId = init_obj(const(data_addr_const(DataAddr))),
+ % ProcIdType = ...
+*/
+
+:- pred ml_stack_layout_construct_closure_args(module_info::in,
+ list(closure_arg_info)::in, list(mlds__initializer)::out,
+ list(mlds__type)::out, mlds__defns::out) is det.
+
+ml_stack_layout_construct_closure_args(ModuleInfo, ClosureArgs,
+ ClosureArgInits, ClosureArgTypes, MLDS_Defns) :-
+ list__map_foldl(ml_stack_layout_construct_closure_arg_rval(ModuleInfo),
+ ClosureArgs, ArgInitsAndTypes, [], MLDS_Defns),
+ assoc_list__keys(ArgInitsAndTypes, ArgInits),
+ assoc_list__values(ArgInitsAndTypes, ArgTypes),
+ Length = list__length(ArgInits),
+ LengthRval = const(int_const(Length)),
+ LengthType = mlds__native_int_type,
+ CastLengthRval = unop(box(LengthType), LengthRval),
+ ClosureArgInits = [init_obj(CastLengthRval) | ArgInits],
+ ClosureArgTypes = [LengthType | ArgTypes].
+
+:- pred ml_stack_layout_construct_closure_arg_rval(module_info::in,
+ closure_arg_info::in, pair(mlds__initializer, mlds__type)::out,
+ mlds__defns::in, mlds__defns::out) is det.
+
+ml_stack_layout_construct_closure_arg_rval(ModuleInfo, ClosureArg,
+ ArgInit - ArgType, MLDS_Defns0, MLDS_Defns) :-
+ ClosureArg = closure_arg_info(Type, _Inst),
+
+ % For a stack layout, we can treat all type variables as
+ % universally quantified. This is not the argument of a
+ % constructor, so we do not need to distinguish between type
+ % variables that are and aren't in scope; we can take the
+ % variable number directly from the procedure's tvar set.
+ ExistQTvars = [],
+ NumUnivQTvars = -1,
+
+ pseudo_type_info__construct_pseudo_type_info(Type, NumUnivQTvars,
+ ExistQTvars, Pseudo),
+ ( Pseudo = type_var(N) ->
+ % type variables are represented just as integers
+ ArgRval = const(int_const(N)),
+ ArgType = mlds__native_int_type,
+ MLDS_Defns = MLDS_Defns0
+ ;
+ ( Pseudo = type_ctor_info(RttiTypeId0) ->
+ % for zero-arity types, we just generate a
+ % reference to the already-existing type_ctor_info
+ RttiName = type_ctor_info,
+ RttiTypeId0 = rtti_type_id(ModuleName0, _, _),
+ ModuleName = fixup_builtin_module(ModuleName0),
+ RttiTypeId = RttiTypeId0,
+ MLDS_Defns = MLDS_Defns0
+ ;
+ % for other types, we need to generate a definition
+ % of the pseudo_type_info for that type,
+ % in the the current module
+ module_info_name(ModuleInfo, ModuleName),
+ RttiData = pseudo_type_info(Pseudo),
+ rtti_data_to_name(RttiData, RttiTypeId, RttiName),
+ RttiDefns0 = rtti_data_list_to_mlds(ModuleInfo,
+ [RttiData]),
+ % rtti_data_list_to_mlds assumes that the result
+ % will be at file scope, but here we're generating it
+ % as a local, so we need to convert the access
+ % to `local'
+ RttiDefns = list__map(convert_to_local, RttiDefns0),
+ MLDS_Defns = RttiDefns ++ MLDS_Defns0
+ ),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ ArgRval = const(data_addr_const(data_addr(MLDS_ModuleName,
+ rtti(RttiTypeId, RttiName)))),
+ ArgType = mlds__rtti_type(RttiName)
+ ),
+ CastArgRval = unop(box(ArgType), ArgRval),
+ ArgInit = init_obj(CastArgRval).
+
+:- func convert_to_local(mlds__defn) = mlds__defn.
+convert_to_local(mlds__defn(Name, Context, Flags0, Body)) =
+ mlds__defn(Name, Context, Flags, Body) :-
+ Flags = set_access(Flags0, local).
+
+:- pred ml_stack_layout_construct_tvar_vector(module_info::in,
+ mlds__var_name::in, prog_context::in, map(tvar, set(layout_locn))::in,
+ mlds__rval::out, mlds__type::out, mlds__defns::out) is det.
+
+ml_stack_layout_construct_tvar_vector(ModuleInfo, TvarVectorName, Context,
+ TVarLocnMap, MLDS_Rval, PtrType, MLDS_Defns) :-
+ PtrType = mlds__ptr_type(mlds__native_int_type),
+ ArrayType = mlds__array_type(mlds__native_int_type),
+ ( map__is_empty(TVarLocnMap) ->
+ MLDS_Rval = const(null(PtrType)),
+ MLDS_Defns = []
+ ;
+ Access = local,
+ ml_stack_layout_construct_tvar_rvals(TVarLocnMap,
+ Vector, _VectorTypes),
+ Initializer = init_array(Vector),
+ MLDS_Defn = ml_gen_static_const_defn(TvarVectorName, ArrayType,
+ Access, Initializer, Context),
+ MLDS_Defns = [MLDS_Defn],
+ module_info_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ MLDS_Rval = lval(var(qual(MLDS_ModuleName, TvarVectorName),
+ PtrType))
+ ).
+
+:- pred ml_stack_layout_construct_tvar_rvals(map(tvar, set(layout_locn))::in,
+ list(mlds__initializer)::out, list(mlds__type)::out) is det.
+
+ml_stack_layout_construct_tvar_rvals(TVarLocnMap, Vector, VectorTypes) :-
+ map__to_assoc_list(TVarLocnMap, TVarLocns),
+ ml_stack_layout_construct_type_param_locn_vector(TVarLocns, 1,
+ TypeParamLocs),
+ list__length(TypeParamLocs, TypeParamsLength),
+ LengthRval = const(int_const(TypeParamsLength)),
+ Vector = [init_obj(LengthRval) | TypeParamLocs],
+ VectorTypes = list__duplicate(TypeParamsLength + 1,
+ mlds__native_int_type).
+
+ % Given a association list of type variables and their locations
+ % sorted on the type variables, represent them in an array of
+ % location descriptions indexed by the type variable. The next
+ % slot to fill is given by the second argument.
+
+:- pred ml_stack_layout_construct_type_param_locn_vector(
+ assoc_list(tvar, set(layout_locn))::in,
+ int::in, list(mlds__initializer)::out) is det.
+
+ml_stack_layout_construct_type_param_locn_vector([], _, []).
+ml_stack_layout_construct_type_param_locn_vector([TVar - Locns | TVarLocns],
+ CurSlot, Vector) :-
+ term__var_to_int(TVar, TVarNum),
+ NextSlot is CurSlot + 1,
+ ( TVarNum = CurSlot ->
+ ( set__remove_least(Locns, LeastLocn, _) ->
+ Locn = LeastLocn
+ ;
+ error("tvar has empty set of locations")
+ ),
+ stack_layout__represent_locn_as_int(Locn, LocnAsInt),
+ Rval = const(int_const(LocnAsInt)),
+ ml_stack_layout_construct_type_param_locn_vector(TVarLocns,
+ NextSlot, VectorTail),
+ Vector = [init_obj(Rval) | VectorTail]
+ ; TVarNum > CurSlot ->
+ % This slot will never be referred to.
+ ml_stack_layout_construct_type_param_locn_vector(
+ [TVar - Locns | TVarLocns], NextSlot, VectorTail),
+ Vector = [init_obj(const(int_const(0))) | VectorTail]
+ ;
+ error("unsorted tvars in construct_type_param_locn_vector")
+ ).
%
% ml_gen_closure_wrapper:
@@ -2472,3 +2708,6 @@
this_file = "ml_unify_gen.m".
:- end_module ml_unify_gen.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.16
diff -u -d -r1.16 ml_util.m
--- compiler/ml_util.m 7 Feb 2002 03:55:45 -0000 1.16
+++ compiler/ml_util.m 27 Feb 2002 19:46:27 -0000
@@ -49,7 +49,7 @@
% succeeds iff this statement contains a reference to the
% specified variable
-:- pred statement_contains_var(mlds__statement, mlds__var).
+:- pred statement_contains_var(mlds__statement, mlds__data).
:- mode statement_contains_var(in, in) is semidet.
:- pred has_foreign_languages(mlds__statement, list(foreign_language)).
@@ -102,12 +102,12 @@
% Succeeds iff these definitions contains a reference to
% the specified variable.
-:- pred defns_contains_var(mlds__defns, mlds__var).
+:- pred defns_contains_var(mlds__defns, mlds__data).
:- mode defns_contains_var(in, in) is semidet.
% Succeeds iff this definition contains a reference to
% the specified variable.
-:- pred defn_contains_var(mlds__defn, mlds__var).
+:- pred defn_contains_var(mlds__defn, mlds__data).
:- mode defn_contains_var(in, in) is semidet.
%-----------------------------------------------------------------------------%
@@ -126,22 +126,22 @@
% the specified variable.
%
-:- pred initializer_contains_var(mlds__initializer, mlds__var).
+:- pred initializer_contains_var(mlds__initializer, mlds__data).
:- mode initializer_contains_var(in, in) is semidet.
-:- pred rvals_contains_var(list(mlds__rval), mlds__var).
+:- pred rvals_contains_var(list(mlds__rval), mlds__data).
:- mode rvals_contains_var(in, in) is semidet.
-:- pred maybe_rval_contains_var(maybe(mlds__rval), mlds__var).
+:- pred maybe_rval_contains_var(maybe(mlds__rval), mlds__data).
:- mode maybe_rval_contains_var(in, in) is semidet.
-:- pred rval_contains_var(mlds__rval, mlds__var).
+:- pred rval_contains_var(mlds__rval, mlds__data).
:- mode rval_contains_var(in, in) is semidet.
-:- pred lvals_contains_var(list(mlds__lval), mlds__var).
+:- pred lvals_contains_var(list(mlds__lval), mlds__data).
:- mode lvals_contains_var(in, in) is semidet.
-:- pred lval_contains_var(mlds__lval, mlds__var).
+:- pred lval_contains_var(mlds__lval, mlds__data).
:- mode lval_contains_var(in, in) is semidet.
%-----------------------------------------------------------------------------%
@@ -292,14 +292,14 @@
% Succeeds iff the specified construct contains a reference to
% the specified variable.
-:- pred statements_contains_var(mlds__statements, mlds__var).
+:- pred statements_contains_var(mlds__statements, mlds__data).
:- mode statements_contains_var(in, in) is semidet.
statements_contains_var(Statements, Name) :-
list__member(Statement, Statements),
statement_contains_var(Statement, Name).
-:- pred maybe_statement_contains_var(maybe(mlds__statement), mlds__var).
+:- pred maybe_statement_contains_var(maybe(mlds__statement), mlds__data).
:- mode maybe_statement_contains_var(in, in) is semidet.
% maybe_statement_contains_var(no, _) :- fail.
@@ -311,7 +311,7 @@
Statement = mlds__statement(Stmt, _Context),
stmt_contains_var(Stmt, Name).
-:- pred stmt_contains_var(mlds__stmt, mlds__var).
+:- pred stmt_contains_var(mlds__stmt, mlds__data).
:- mode stmt_contains_var(in, in) is semidet.
stmt_contains_var(Stmt, Name) :-
@@ -370,7 +370,7 @@
atomic_stmt_contains_var(AtomicStmt, Name)
).
-:- pred cases_contains_var(list(mlds__switch_case), mlds__var).
+:- pred cases_contains_var(list(mlds__switch_case), mlds__data).
:- mode cases_contains_var(in, in) is semidet.
cases_contains_var(Cases, Name) :-
@@ -378,7 +378,7 @@
Case = _MatchConds - Statement,
statement_contains_var(Statement, Name).
-:- pred default_contains_var(mlds__switch_default, mlds__var).
+:- pred default_contains_var(mlds__switch_default, mlds__data).
:- mode default_contains_var(in, in) is semidet.
% default_contains_var(default_do_nothing, _) :- fail.
@@ -386,7 +386,7 @@
default_contains_var(default_case(Statement), Name) :-
statement_contains_var(Statement, Name).
-:- pred atomic_stmt_contains_var(mlds__atomic_statement, mlds__var).
+:- pred atomic_stmt_contains_var(mlds__atomic_statement, mlds__data).
:- mode atomic_stmt_contains_var(in, in) is semidet.
% atomic_stmt_contains_var(comment(_), _Name) :- fail.
@@ -410,7 +410,7 @@
list__member(Component, Components),
target_code_component_contains_var(Component, Name).
-:- pred trail_op_contains_var(trail_op, mlds__var).
+:- pred trail_op_contains_var(trail_op, mlds__data).
:- mode trail_op_contains_var(in, in) is semidet.
trail_op_contains_var(store_ticket(Lval), Name) :-
@@ -424,7 +424,7 @@
trail_op_contains_var(prune_tickets_to(Rval), Name) :-
rval_contains_var(Rval, Name).
-:- pred target_code_component_contains_var(target_code_component, mlds__var).
+:- pred target_code_component_contains_var(target_code_component, mlds__data).
:- mode target_code_component_contains_var(in, in) is semidet.
%target_code_component_contains_var(raw_target_code(_Code), _Name) :-
@@ -435,9 +435,11 @@
rval_contains_var(Rval, Name).
target_code_component_contains_var(target_code_output(Lval), Name) :-
lval_contains_var(Lval, Name).
-target_code_component_contains_var(name(EntityName), VarName) :-
- EntityName = qual(ModuleName, data(var(UnqualVarName))),
- VarName = qual(ModuleName, UnqualVarName).
+target_code_component_contains_var(name(EntityName), DataName) :-
+ EntityName = qual(ModuleName, data(UnqualDataName)),
+ DataName = qual(ModuleName, UnqualDataName),
+ % this is a place where we can succeed
+ true.
has_foreign_languages(Statement, Langs) :-
GetTargetCode = (pred(Lang::out) is nondet :-
@@ -508,7 +510,7 @@
defn_contains_var(mlds__defn(_Name, _Context, _Flags, DefnBody), Name) :-
defn_body_contains_var(DefnBody, Name).
-:- pred defn_body_contains_var(mlds__entity_defn, mlds__var).
+:- pred defn_body_contains_var(mlds__entity_defn, mlds__data).
:- mode defn_body_contains_var(in, in) is semidet.
% XXX Should we include variables in the GC_TraceCode field here?
@@ -524,7 +526,7 @@
; defns_contains_var(CtorDefns, Name)
).
-:- pred function_body_contains_var(function_body, mlds__var).
+:- pred function_body_contains_var(function_body, mlds__data).
:- mode function_body_contains_var(in, in) is semidet.
% function_body_contains_var(external, _) :- fail.
@@ -569,7 +571,12 @@
lval_contains_var(Lval, Name).
rval_contains_var(mkword(_Tag, Rval), Name) :-
rval_contains_var(Rval, Name).
-% rval_contains_var(const(_Const), _Name) :- fail.
+rval_contains_var(const(Const), QualDataName) :-
+ Const = data_addr_const(DataAddr),
+ DataAddr = data_addr(ModuleName, DataName),
+ QualDataName = qual(ModuleName, DataName),
+ /* this is a place where we can succeed */
+ true.
rval_contains_var(unop(_Op, Rval), Name) :-
rval_contains_var(Rval, Name).
rval_contains_var(binop(_Op, X, Y), Name) :-
@@ -587,6 +594,9 @@
rval_contains_var(Rval, Name).
lval_contains_var(mem_ref(Rval, _Type), Name) :-
rval_contains_var(Rval, Name).
-lval_contains_var(var(Name, _Type), Name). /* this is where we can succeed! */
+lval_contains_var(var(qual(ModuleName, Name), _Type),
+ qual(ModuleName, var(Name))) :-
+ /* this is another place where we can succeed */
+ true.
%-----------------------------------------------------------------------------%
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.24
diff -u -d -r1.24 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 25 Jan 2002 08:22:53 -0000 1.24
+++ compiler/rtti_to_mlds.m 1 Mar 2002 13:41:02 -0000
@@ -101,6 +101,8 @@
% Return the declaration flags appropriate for an rtti_data.
+ % Note that this must be the same as ml_static_const_decl_flags,
+ % except for the access, so that ml_decl_is_static_const works.
%
:- func rtti_data_decl_flags(bool) = mlds__decl_flags.
rtti_data_decl_flags(Exported) = MLDS_DeclFlags :-
@@ -111,7 +113,7 @@
),
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Finality = final,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.61
diff -u -d -r1.61 stack_layout.m
--- compiler/stack_layout.m 20 Feb 2002 03:14:19 -0000 1.61
+++ compiler/stack_layout.m 27 Feb 2002 14:40:23 -0000
@@ -42,6 +42,8 @@
create_arg_types::out, comp_gen_c_data::out,
counter::in, counter::out) is det.
+:- pred stack_layout__represent_locn_as_int(layout_locn::in, int::out) is det.
+
:- implementation.
:- import_module globals, options, llds_out, trace_params, trace.
@@ -1214,8 +1216,6 @@
stack_layout__represent_locn_as_int_rval(Locn, Rval) :-
stack_layout__represent_locn_as_int(Locn, Word),
Rval = const(int_const(Word)).
-
-:- pred stack_layout__represent_locn_as_int(layout_locn::in, int::out) is det.
stack_layout__represent_locn_as_int(direct(Lval), Word) :-
stack_layout__represent_lval(Lval, Word).
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.47
diff -u -d -r1.47 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 24 Feb 2002 11:53:31 -0000 1.47
+++ runtime/mercury_deep_copy_body.h 27 Feb 2002 18:30:25 -0000
@@ -510,10 +510,6 @@
for (i = 0; i < args; i++) {
MR_PseudoTypeInfo arg_pseudo_type_info;
-#ifdef MR_HIGHLEVEL_CODE
- /* the closure_layout is NULL */
- MR_fatal_error("Sorry, not implemented: copying closures");
-#endif
arg_pseudo_type_info =
closure_layout->MR_closure_arg_pseudo_type_info[i];
new_closure->MR_closure_hidden_args_0[i] =
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.143
diff -u -d -r1.143 Mmakefile
--- tests/hard_coded/Mmakefile 30 Jan 2002 05:09:08 -0000 1.143
+++ tests/hard_coded/Mmakefile 27 Feb 2002 18:36:46 -0000
@@ -140,15 +140,10 @@
write_reg1 \
write_reg2
-# Deep profiling cannot yet handle exceptions being caught, which the
-# user_defined_equality test case does.
-
-ifeq "$(findstring profdeep,$(GRADE))" ""
- EXCEPTION_PROGS = \
- user_defined_equality
-else
- EXCEPTION_PROGS =
-endif
+# These test require the implementation to support closure layouts
+CLOSURE_LAYOUT_PROGS = \
+ copy_pred \
+ copy_pred_2
# We do not pass the following tests at all:
#
@@ -160,11 +155,18 @@
#
# XXX needs_init doesn't work yet in profiling grades.
-# The following tests are passed only in some grades:
-#
-# XXX copy_pred and copy_pred_2 do not work in the hl* grades (e.g. hlc.gc),
-# because the MLDS back-end doesn't generate the closure layout
-# information needed to copy closures.
+# The following tests are passed only in some grades.
+
+# Deep profiling cannot yet handle exceptions being caught, which the
+# user_defined_equality test case does.
+
+ifeq "$(findstring profdeep,$(GRADE))" ""
+ EXCEPTION_PROGS = \
+ user_defined_equality
+else
+ EXCEPTION_PROGS =
+endif
+
#
# factt_non does not work in the hl* grades (e.g. hlc.gc),
# because the code for nondet fact tables assumes that
@@ -179,14 +181,10 @@
ifeq "$(findstring hl,$(GRADE))" ""
ifeq "$(findstring profdeep,$(GRADE))" ""
BACKEND_PROGS = \
- copy_pred \
- copy_pred_2 \
factt_non \
type_tables
else
BACKEND_PROGS = \
- copy_pred \
- copy_pred_2 \
type_tables
endif
else
@@ -207,7 +205,8 @@
endif
endif
-PROGS = $(ORDINARY_PROGS) $(EXCEPTION_PROGS) $(BACKEND_PROGS) $(NONDET_C_PROGS)
+PROGS = $(ORDINARY_PROGS) $(CLOSURE_LAYOUT_PROGS) $(EXCEPTION_PROGS) \
+ $(BACKEND_PROGS) $(NONDET_C_PROGS)
# --split-c-files does not work in the hl* grades (e.g. hlc.gc),
# because it hasn't yet been implemented yet.
--
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