[m-dev.] for review: cleanup of type_ctor_infos, relative diff 1
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Mar 8 14:30:00 AEDT 2000
This is for Tyson; it is a relative diff that incorporates the suggestions
made in his and Fergus's reviews, as well as the improvement in the RTTI
structure that he and I discussed.
Zoltan.
diff -rub --exclude CVS ws15.base/Log /home/ender2/zs/ws15/Log
--- ws15.base/Log Sat Feb 26 11:52:09 2000
+++ /home/ender2/zs/ws15/Log Tue Feb 29 13:46:32 2000
@@ -14,6 +14,14 @@
using both the old and the new data structures, which are distinguished by
the type_ctor_info's version number.
+To minimize the disruption caused by such bootstrapping, this change also
+incorporates an improvement in the RTTI: for most pseudo_type_infos included
+in the RTTI, it records information that allows the runtime system to tell
+whether the pseudo_type_info is ground or not; if it is, then the runtime
+need not scan the pseudo_type_info looking for type parameters to expand.
+Based on statistics I have gathered, this will eliminate between half and two
+thirds of all such scans when we do unification and comparison by RTTI.
+
This change does not impact the structures of typeinfos, base_typeclass_infos
or typeclass_infos.
@@ -43,7 +51,7 @@
tie them to LLDS, mostly due to (a) the lack of a shared common
infrastructure between llds_out.m and mlds_to_c.m, and (b)
the continued use of the old representation of (pseudo-) typeinfos
- as rvals. These concerns will be addressed later.
+ as rvals. These concerns will be addressed in a future change.
compiler/llds.m:
Update the definition of the comp_gen_c_data and data_addr types
diff -rub --exclude CVS ws15.base/compiler/base_type_info.m /home/ender2/zs/ws15/compiler/base_type_info.m
--- ws15.base/compiler/base_type_info.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/base_type_info.m Tue Feb 29 14:07:43 2000
@@ -16,11 +16,11 @@
% In the first stage, it inserts type_ctor_gen_info structures describing the
% type_ctor_infos of all the locally-defined types into the HLDS; some of
% these type_ctor_gen_infos are later eliminated by dead_proc_elim.m. The
-% second stage then generates LLDS descriptions of type_ctor_infos from the
-% surviving type_ctor_gen_infos.
+% second stage then generates low-level descriptions of type_ctor_infos
+% for LLDS (or later MLDS) from the surviving type_ctor_gen_infos.
%
-% XXX See polymorphism.m for a description of the various ways to represent
-% type information, including a description of the type_ctor_info structures.
+% See runtime/mercury_type_info.h for a description of the data structures
+% we build in this module.
%
% WARNING: if you change this module, you will probably need to also
% change ml_base_type_info.m, which does the same thing for the MLDS
@@ -177,12 +177,13 @@
base_type_layout__gen_layout_info(ModuleName,
TypeName, TypeArity, HldsDefn, ModuleInfo0, ModuleInfo,
TypeCtorRep, NumFunctors, MaybeFunctors, MaybeLayout,
- TypeCtorTables)
+ NumPtags, TypeCtorTables)
;
% This is for measuring code size only; if this path
% is ever taken, the resulting executable will not
% work.
TypeCtorRep = unknown,
+ NumPtags = -1,
NumFunctors = -1,
MaybeFunctors = no_functors,
MaybeLayout = no_layout,
@@ -192,7 +193,7 @@
Version = type_ctor_info_rtti_version,
RttiTypeId = rtti_type_id(ModuleName, TypeName, TypeArity),
TypeCtorData = type_ctor_info(RttiTypeId, Unify, Index, Compare,
- TypeCtorRep, Solver, Init, Version, NumFunctors,
+ TypeCtorRep, Solver, Init, Version, NumPtags, NumFunctors,
MaybeFunctors, MaybeLayout, no, Pretty).
:- pred base_type_info__make_pred_addr(maybe(pred_proc_id)::in,
@@ -218,4 +219,5 @@
% version introduces.
:- func type_ctor_info_rtti_version = int.
+
type_ctor_info_rtti_version = 4.
diff -rub --exclude CVS ws15.base/compiler/base_type_layout.m /home/ender2/zs/ws15/compiler/base_type_layout.m
--- ws15.base/compiler/base_type_layout.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/base_type_layout.m Tue Feb 29 14:56:22 2000
@@ -35,12 +35,17 @@
% base_type_layout__construct_typed_pseudo_type_info(Type,
% NumUnivQTvars, ExistQVars, Rval, LldsType, LabelNum0, LabelNum)
%
- % Given a Mercury type (`Type'), this predicate returns an rval (`Rval')
- % giving the pseudo type info for that type, plus the llds_type
- % (`LldsType') of that rval. NumUnivQTvars is the number of universally
- % quantified type variables of the enclosing type and ExistQVars is the
- % list of existentially quantified type variables of the constructor in
- % question.
+ % Given a Mercury type (`Type'), this predicate returns an rval
+ % (`Rval') giving the pseudo type info for that type, plus the
+ % llds_type (`LldsType') of that rval.
+ %
+ % NumUnivQTvars is either the number of universally quantified type
+ % variables of the enclosing type (so that all universally quantified
+ % variables in the type have numbers in the range [1..NumUnivQTvars],
+ % or is the special value -1, meaning that all variables in the type
+ % are universally quantified. ExistQVars is the list of existentially
+ % quantified type variables of the constructor in question.
+ %
% The int arguments (`LabelNum0' and `LabelNum') are label numbers for
% generating `create' rvals with.
@@ -48,15 +53,12 @@
int::in, existq_tvars::in,
rval::out, llds_type::out, int::in, int::out) is det.
- % Maximum value of an integer representation of a variable.
-:- pred base_type_layout__pseudo_typeinfo_max_var(int::out) is det.
-
% Generate RTTI layout information for the named type.
:- pred base_type_layout__gen_layout_info(module_name::in,
string::in, int::in, hlds_type_defn::in,
module_info::in, module_info::out, type_ctor_rep::out, int::out,
type_ctor_functors_info::out, type_ctor_layout_info::out,
- list(rtti_data)::out) is det.
+ int::out, list(rtti_data)::out) is det.
:- implementation.
@@ -147,11 +149,15 @@
% XXX term__var_to_int doesn't guarantee anything
% about the ints returned (other than that they be
- % distinct for different variables), but we are relying
- % on more here.
+ % distinct for different variables), but here we are
+ % relying more, specifically, on the integers being
+ % allocated densely (i.e. the first N vars get integers
+ % 1 to N).
term__var_to_int(Var, VarInt0),
(
- VarInt0 =< NumUnivQTvars
+ ( VarInt0 =< NumUnivQTvars
+ ; NumUnivQTvars < 0
+ )
->
% This is a universally quantified variable.
VarInt = VarInt0
@@ -167,8 +173,7 @@
error("base_type_layout: var not in list")
)
),
- base_type_layout__pseudo_typeinfo_max_var(MaxVarInt),
- require(VarInt < MaxVarInt,
+ require(VarInt =< base_type_layout__pseudo_typeinfo_max_var,
"type_ctor_layout: type variable representation exceeds limit"),
Pseudo = const(int_const(VarInt)),
LldsType = integer,
@@ -190,11 +195,17 @@
%---------------------------------------------------------------------------%
-base_type_layout__pseudo_typeinfo_max_var(1024).
+ % This number corresponds to MR_PSEUDOTYPEINFO_MAX_VAR in
+ % runtime/mercury_type_info.h, and must be kept in sync with it.
+ % The documentation is located there as well.
+
+:- func base_type_layout__pseudo_typeinfo_max_var = int.
+
+base_type_layout__pseudo_typeinfo_max_var = 1024.
- % The base number from which we count existentially quantified
- % variables. Note that this number must be kept in synch with
- % MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in runtime/mercury_type_info.h
+ % This number corresponds to MR_PSEUDOTYPEINFO_EXIST_VAR_BASE in
+ % runtime/mercury_type_info.h, and must be kept in sync with it.
+ % The documentation is located there as well.
:- func base_type_layout__pseudo_typeinfo_exist_var_base = int.
base_type_layout__pseudo_typeinfo_exist_var_base = 512.
@@ -204,7 +215,7 @@
base_type_layout__gen_layout_info(ModuleName, TypeName, TypeArity, HldsDefn,
ModuleInfo0, ModuleInfo, TypeCtorRep, NumFunctors,
- FunctorsInfo, LayoutInfo, TypeTables) :-
+ FunctorsInfo, LayoutInfo, NumPtags, TypeTables) :-
hlds_data__get_type_defn_body(HldsDefn, TypeBody),
module_info_get_cell_count(ModuleInfo0, CellNumber0),
(
@@ -217,10 +228,15 @@
FunctorsInfo = no_functors,
LayoutInfo = no_layout,
TypeTables = [],
- CellNumber = CellNumber0
+ CellNumber = CellNumber0,
+ NumPtags = -1
;
TypeBody = eqv_type(Type),
- TypeCtorRep = equiv,
+ ( term__is_ground(Type) ->
+ TypeCtorRep = equiv(equiv_type_is_ground)
+ ;
+ TypeCtorRep = equiv(equiv_type_is_not_ground)
+ ),
NumFunctors = -1,
UnivTvars = TypeArity,
% There can be no existentially typed args to an
@@ -230,7 +246,8 @@
UnivTvars, ExistTvars, Rval, CellNumber0, CellNumber),
FunctorsInfo = no_functors,
LayoutInfo = equiv_layout(Rval),
- TypeTables = []
+ TypeTables = [],
+ NumPtags = -1
;
TypeBody = du_type(Ctors, ConsTagMap, Enum, EqualityPred),
(
@@ -248,15 +265,22 @@
base_type_layout__make_enum_tables(Ctors, ConsTagMap,
RttiTypeId, TypeTables,
FunctorsInfo, LayoutInfo),
- CellNumber = CellNumber0
+ CellNumber = CellNumber0,
+ NumPtags = -1
;
Enum = no,
( type_is_no_tag_type(Ctors, Name, ArgType) ->
- TypeCtorRep = notag(EqualityAxioms),
+ ( term__is_ground(ArgType) ->
+ Inst = equiv_type_is_ground
+ ;
+ Inst = equiv_type_is_not_ground
+ ),
+ TypeCtorRep = notag(EqualityAxioms, Inst),
base_type_layout__make_notag_tables(Name,
ArgType, RttiTypeId,
CellNumber0, CellNumber,
- TypeTables, FunctorsInfo, LayoutInfo)
+ TypeTables, FunctorsInfo, LayoutInfo),
+ NumPtags = -1
;
module_info_globals(ModuleInfo0, Globals),
globals__lookup_int_option(Globals,
@@ -267,7 +291,8 @@
base_type_layout__make_du_tables(Ctors,
ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo0, CellNumber0, CellNumber,
- TypeTables, FunctorsInfo, LayoutInfo)
+ TypeTables, NumPtags,
+ FunctorsInfo, LayoutInfo)
)
)
),
@@ -276,6 +301,8 @@
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
+% Make the functor and notag tables for a notag type.
+
:- pred base_type_layout__make_notag_tables(sym_name::in, (type)::in,
rtti_type_id::in, int::in, int::out, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
@@ -302,6 +329,8 @@
:- type name_sort_info == assoc_list(pair(string, int), rtti_name).
+% Make the functor and notag tables for an enum type.
+
:- pred base_type_layout__make_enum_tables(list(constructor)::in,
cons_tag_values::in, rtti_type_id::in, list(rtti_data)::out,
type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
@@ -325,6 +354,14 @@
TypeTables = [NameOrderedTable, ValueOrderedTable | FunctorDescs].
+% Create an enum_functor_desc structure for each functor in an enum type.
+% The functors are given to us in ordinal order (since that's how the HLDS
+% stored them), and that is how we return the list of rtti names of the
+% enum_functor_desc structures; that way, it is directly usable in the type
+% layout structure. We also return a structure that allows our caller to
+% sort this list on functor name, which is how the type functors structure
+% is constructed.
+
:- pred base_type_layout__make_enum_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in,
list(rtti_data)::out, list(rtti_name)::out,
@@ -362,14 +399,16 @@
:- type tag_map == map(int, pair(sectag_locn, map(int, rtti_name))).
:- type tag_list == assoc_list(int, pair(sectag_locn, map(int, rtti_name))).
+% Make the functor and notag tables for a du type.
+
:- pred base_type_layout__make_du_tables(list(constructor)::in,
cons_tag_values::in, int::in, rtti_type_id::in, module_info::in,
- int::in, int::out, list(rtti_data)::out, type_ctor_functors_info::out,
- type_ctor_layout_info::out) is det.
+ int::in, int::out, list(rtti_data)::out, int::out,
+ type_ctor_functors_info::out, type_ctor_layout_info::out) is det.
base_type_layout__make_du_tables(Ctors, ConsTagMap, MaxPtag, RttiTypeId,
ModuleInfo, CellNumber0, CellNumber,
- TypeTables, FunctorInfo, LayoutInfo) :-
+ TypeTables, NumPtags, FunctorInfo, LayoutInfo) :-
map__init(TagMap0),
base_type_layout__make_du_functor_tables(Ctors, 0, ConsTagMap,
RttiTypeId, ModuleInfo, CellNumber0, CellNumber,
@@ -383,11 +422,20 @@
FunctorInfo = du_functors(NameOrderedTableRttiName),
base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtag,
- RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables),
+ RttiTypeId, ValueOrderedTableRttiName, ValueOrderedTables,
+ NumPtags),
LayoutInfo = du_layout(ValueOrderedTableRttiName),
list__append([NameOrderedTable | FunctorDescs], ValueOrderedTables,
TypeTables).
+% Create an enum_functor_desc structure for each functor in a du type.
+% Besides returning a list of the rtti names of their du_functor_desc
+% structures, we return two other items of information. The SortInfo
+% enables our caller to sort these rtti names on functor name and then arity,
+% which is how the type functors structure is constructed. The TagMap
+% groups the rttis into groups depending on their primary tags; this is
+% how the type layout structure is constructed.
+
:- pred base_type_layout__make_du_functor_tables(list(constructor)::in,
int::in, cons_tag_values::in, rtti_type_id::in, module_info::in,
int::in, int::out, list(rtti_data)::out, name_sort_info::out,
@@ -426,10 +474,10 @@
error("unexpected cons_tag for du function symbol")
),
- base_type_layout__generate_pseudotypeinfo_vector(ModuleInfo,
+ base_type_layout__generate_arg_info_tables(ModuleInfo,
RttiTypeId, Ordinal, FunctorArgs, ExistTvars,
CellNumber0, CellNumber1, MaybeArgNames,
- ArgPseudoTypeInfoVector, FieldTables),
+ ArgPseudoTypeInfoVector, FieldTables, ContainsVarBitVector),
( ExistTvars = [] ->
MaybeExistInfo = no,
ExistTables = []
@@ -442,8 +490,8 @@
),
list__append(FieldTables, ExistTables, SubTables),
FunctorDesc = du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ArgPseudoTypeInfoVector, MaybeArgNames,
- MaybeExistInfo),
+ Locn, Ordinal, Arity, ContainsVarBitVector,
+ ArgPseudoTypeInfoVector, MaybeArgNames, MaybeExistInfo),
FunctorSortInfo = (FunctorName - Arity) - RttiName,
base_type_layout__make_du_functor_tables(Functors, Ordinal + 1,
ConsTagMap, RttiTypeId, ModuleInfo, CellNumber1, CellNumber,
@@ -451,19 +499,23 @@
list__append([FunctorDesc | SubTables], Tables1, Tables),
SortInfo = [FunctorSortInfo | SortInfo1].
-:- pred base_type_layout__generate_pseudotypeinfo_vector(module_info::in,
+% Generate the tables that describe the arguments of a functor.
+
+:- pred base_type_layout__generate_arg_info_tables(module_info::in,
rtti_type_id::in, int::in, list(constructor_arg)::in, existq_tvars::in,
int::in, int::out, maybe(rtti_name)::out, rval::out,
- list(rtti_data)::out) is det.
+ list(rtti_data)::out, int::out) is det.
-base_type_layout__generate_pseudotypeinfo_vector(
+base_type_layout__generate_arg_info_tables(
ModuleInfo, RttiTypeId, Ordinal,
Args, ExistTvars, CellNumber0, CellNumber,
- MaybeFieldNamesRttiName, Vector, Tables) :-
+ MaybeFieldNamesRttiName, Vector, Tables,
+ ContainsVarBitVector) :-
RttiTypeId = rtti_type_id(_TypeModule, _TypeName, TypeArity),
- base_type_layout__generate_pseudotypeinfos(Args, TypeArity, ExistTvars,
+ base_type_layout__generate_arg_infos(Args, TypeArity, ExistTvars,
ModuleInfo, CellNumber0, CellNumber1,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos),
+ MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
+ 0, 0, ContainsVarBitVector),
list__filter((lambda([MaybeName::in] is semidet, MaybeName = yes(_))),
MaybeArgNames, FieldNames),
(
@@ -483,18 +535,29 @@
Vector = create(0, MaybePseudoTypeInfos, initial(LldsTypes, none),
must_be_static, CN, "arg_types", Reuse).
-:- pred base_type_layout__generate_pseudotypeinfos(list(constructor_arg)::in,
+% For each argument of a functor, return three items of information:
+% its name (if any), a pseudotypeinfo describing its type (and the llds_type
+% that describes the pseudotypeinfo), and an indication whether the type
+% contains variables or not. The last item is encoded as an integer
+% which contains a 1 bit in the position given by 1 << N if argument N's type
+% contains variables (assuming that arguments are numbered starting from zero).
+% The number of bits in the integer is given by contains_var_bit_vector_size;
+% arguments beyond this limit do not contribute to this bit vector.
+
+:- pred base_type_layout__generate_arg_infos(list(constructor_arg)::in,
int::in, existq_tvars::in, module_info::in, int::in, int::out,
list(maybe(string))::out, initial_arg_types::out,
- list(maybe(rval))::out) is det.
+ list(maybe(rval))::out, int::in, int::in, int::out) is det.
-base_type_layout__generate_pseudotypeinfos([], _, _, _,
- CellNumber, CellNumber, [], [], []).
-base_type_layout__generate_pseudotypeinfos([MaybeArgSymName - ArgType | Args],
+base_type_layout__generate_arg_infos([], _, _, _,
+ CellNumber, CellNumber, [], [], [],
+ _, ContainsVarBitVector, ContainsVarBitVector).
+base_type_layout__generate_arg_infos([MaybeArgSymName - ArgType | Args],
NumUnivTvars, ExistTvars, ModuleInfo, CellNumber0, CellNumber,
[MaybeArgName | MaybeArgNames],
[1 - yes(LldsType) | LldsTypes],
- [yes(PseudoTypeInfo) | MaybePseudoTypeInfos]) :-
+ [yes(PseudoTypeInfo) | MaybePseudoTypeInfos],
+ ArgNum, ContainsVarBitVector0, ContainsVarBitVector) :-
(
MaybeArgSymName = yes(SymName),
unqualify_name(SymName, ArgName),
@@ -506,9 +569,30 @@
base_type_layout__construct_typed_pseudo_type_info(ArgType,
NumUnivTvars, ExistTvars, PseudoTypeInfo, LldsType,
CellNumber0, CellNumber1),
- base_type_layout__generate_pseudotypeinfos(Args, NumUnivTvars,
+ (
+ ( term__is_ground(ArgType)
+ ; ArgNum >= contains_var_bit_vector_size
+ )
+ ->
+ ContainsVarBitVector1 = ContainsVarBitVector0
+ ;
+ ContainsVarBitVector1 = ContainsVarBitVector0 + (1 << ArgNum)
+ ),
+ base_type_layout__generate_arg_infos(Args, NumUnivTvars,
ExistTvars, ModuleInfo, CellNumber1, CellNumber,
- MaybeArgNames, LldsTypes, MaybePseudoTypeInfos).
+ MaybeArgNames, LldsTypes, MaybePseudoTypeInfos,
+ ArgNum + 1, ContainsVarBitVector1, ContainsVarBitVector).
+
+% This function gives the size of the MR_du_functor_arg_type_contains_var
+% field of the C type MR_DuFunctorDesc in bits.
+
+:- func base_type_layout__contains_var_bit_vector_size = int.
+
+base_type_layout__contains_var_bit_vector_size = 16.
+
+% Construct the RTTI structures that record information about the locations
+% of the typeinfos describing the types of the existentially typed arguments
+% of a functor.
:- pred base_type_layout__generate_type_info_locns(list(tvar)::in,
list(class_constraint)::in, class_table::in, rtti_type_id::in, int::in,
@@ -602,58 +686,49 @@
).
:- pred base_type_layout__make_du_ptag_ordered_table(tag_map::in, int::in,
- rtti_type_id::in, rtti_name::out, list(rtti_data)::out) is det.
+ rtti_type_id::in, rtti_name::out, list(rtti_data)::out, int::out)
+ is det.
base_type_layout__make_du_ptag_ordered_table(TagMap, MaxPtagValue,
- RttiTypeId, PtagOrderedRttiName, Tables) :-
+ RttiTypeId, PtagOrderedRttiName, Tables, NumPtags) :-
map__to_assoc_list(TagMap, TagList),
- base_type_layout__make_du_ptag_layouts(0, MaxPtagValue, TagList,
- RttiTypeId, PtagLayoutsRttiNames, SubTables),
- PtagOrderedTable = du_ptag_ordered_table(RttiTypeId,
- PtagLayoutsRttiNames),
+ base_type_layout__make_du_ptag_layouts(TagList, 0, MaxPtagValue,
+ RttiTypeId, PtagLayouts, SubTables, NumPtags),
+ PtagOrderedTable = du_ptag_ordered_table(RttiTypeId, PtagLayouts),
PtagOrderedRttiName = du_ptag_ordered_table,
Tables = [PtagOrderedTable | SubTables].
-:- pred base_type_layout__make_du_ptag_layouts(int::in, int::in,
- tag_list::in, rtti_type_id::in, list(maybe(rtti_name))::out,
- list(rtti_data)::out) is det.
-
-base_type_layout__make_du_ptag_layouts(CurPtag, MaxPtag, TagList0,
- RttiTypeId, PtagLayoutAddrs, Tables) :-
- ( CurPtag =< MaxPtag ->
+:- pred base_type_layout__make_du_ptag_layouts(tag_list::in, int::in, int::in,
+ rtti_type_id::in, list(du_ptag_layout)::out, list(rtti_data)::out,
+ int::out) is det.
+
+base_type_layout__make_du_ptag_layouts(TagList0, CurPtag, MaxPtag,
+ RttiTypeId, PtagLayouts, Tables, NumPtags) :-
(
TagList0 = [],
- TagList = [],
- CurPtagLayoutAddr = no,
- CurTables = []
+ PtagLayouts = [],
+ Tables = [],
+ NumPtags = CurPtag
;
TagList0 = [Ptag - (Locn - StagMap) | TagList],
require(unify(CurPtag, Ptag),
"missing ptag value in make_du_ptag_layout"),
+ require(CurPtag =< MaxPtag,
+ "ptag value exceeds maximum"),
map__to_assoc_list(StagMap, StagList),
list__length(StagList, StagListLength),
- base_type_layout__make_du_stag_table(
- 0, StagListLength - 1, StagList,
- StagRttiNames),
+ base_type_layout__make_du_stag_table(0, StagListLength - 1,
+ StagList, StagRttiNames),
StagOrderedTable = du_stag_ordered_table(RttiTypeId,
Ptag, StagRttiNames),
StagOrderedAddr = du_stag_ordered_table(Ptag),
- PtagLayoutTable = du_ptag_layout(RttiTypeId, Ptag,
- StagListLength, Locn, StagOrderedAddr),
- PtagLayoutAddr = du_ptag_layout(Ptag),
- CurPtagLayoutAddr = yes(PtagLayoutAddr),
- CurTables = [PtagLayoutTable, StagOrderedTable]
- ),
- base_type_layout__make_du_ptag_layouts(
- CurPtag + 1, MaxPtag, TagList, RttiTypeId,
- PtagLayoutAddrs1, Tables1),
- PtagLayoutAddrs = [CurPtagLayoutAddr | PtagLayoutAddrs1],
- list__append(CurTables, Tables1, Tables)
- ;
- require(unify(TagList0, []),
- "leftover ptag values in make_du_ptag_layouts"),
- PtagLayoutAddrs = [],
- Tables = []
+ PtagLayout = du_ptag_layout(StagListLength, Locn,
+ StagOrderedAddr),
+ base_type_layout__make_du_ptag_layouts(TagList,
+ CurPtag + 1, MaxPtag, RttiTypeId,
+ PtagLayouts1, Tables1, NumPtags),
+ PtagLayouts = [PtagLayout | PtagLayouts1],
+ Tables = [StagOrderedTable | Tables1]
).
:- pred base_type_layout__make_du_stag_table(int::in, int::in,
diff -rub --exclude CVS ws15.base/compiler/dead_proc_elim.m /home/ender2/zs/ws15/compiler/dead_proc_elim.m
--- ws15.base/compiler/dead_proc_elim.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/dead_proc_elim.m Wed Mar 1 13:36:11 2000
@@ -656,7 +656,7 @@
TypeCtorGenInfo0 = type_ctor_gen_info(TypeId, ModuleName,
TypeName, Arity, Status, HldsDefn,
_MaybeUnify, _MaybeIndex, _MaybeCompare,
- MaybeSolver, MaybeInit, MaybePretty),
+ _MaybeSolver, _MaybeInit, _MaybePretty),
(
Entity = base_gen_info(ModuleName, TypeName, Arity),
map__search(Needed, Entity, _)
@@ -665,7 +665,7 @@
;
NeuteredTypeCtorGenInfo = type_ctor_gen_info(TypeId,
ModuleName, TypeName, Arity, Status, HldsDefn,
- no, no, no, MaybeSolver, MaybeInit, MaybePretty),
+ no, no, no, no, no, no),
TypeCtorGenInfos = [NeuteredTypeCtorGenInfo |
TypeCtorGenInfos1]
).
diff -rub --exclude CVS ws15.base/compiler/hlds_module.m /home/ender2/zs/ws15/compiler/hlds_module.m
--- ws15.base/compiler/hlds_module.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/hlds_module.m Wed Mar 1 13:36:44 2000
@@ -62,8 +62,8 @@
int, % type arity
import_status, % of the type
hlds_type_defn, % defn of type
- maybe(pred_proc_id), % unif, if not eliminated
- maybe(pred_proc_id), % inde, if not eliminated
+ maybe(pred_proc_id), % unify, if not eliminated
+ maybe(pred_proc_id), % index, if not eliminated
maybe(pred_proc_id), % compare, if not eliminated
maybe(pred_proc_id), % solver, if relevant
maybe(pred_proc_id), % init, if relevant
@@ -531,10 +531,10 @@
type_spec_info, module_sub_info).
:- mode module_sub_set_type_spec_info(in, in, out) is det.
-:- type module_info
- ---> module(
+:- type module_info --->
+ module(
module_sub_info :: module_sub_info,
- pred_table :: predicate_table,
+ predicate_table :: predicate_table,
proc_requests :: proc_requests,
special_pred_map :: special_pred_map,
partial_qualifier_info :: partial_qualifier_info,
@@ -554,14 +554,14 @@
% generated C code
).
-:- type module_sub_info
- ---> module_sub(
- module_name:: module_name,
- globals:: globals,
+:- type module_sub_info --->
+ module_sub(
+ module_name :: module_name,
+ globals :: globals,
c_header_info :: c_header_info,
c_body_info :: c_body_info,
maybe_dependency_info :: maybe(dependency_info),
- errors :: int,
+ num_errors :: int,
last_lambda_number :: int,
pragma_exported_procs :: list(pragma_exported_proc),
% list of the procs for which
@@ -638,7 +638,7 @@
module_sub_get_c_header_info(MI, MI^c_header_info).
module_sub_get_c_body_info(MI, MI^c_body_info).
module_sub_get_maybe_dependency_info(MI, MI^maybe_dependency_info).
-module_sub_get_num_errors(MI, MI^errors).
+module_sub_get_num_errors(MI, MI^num_errors).
module_sub_get_lambda_count(MI, MI^last_lambda_number).
module_sub_get_pragma_exported_procs(MI, MI^pragma_exported_procs).
module_sub_get_type_ctor_gen_infos(MI, MI^type_ctor_gen_infos).
@@ -657,7 +657,7 @@
module_sub_set_c_header_info(MI, CH, MI^c_header_info := CH).
module_sub_set_c_body_info(MI, CB, MI^c_body_info := CB).
module_sub_set_maybe_dependency_info(MI, MD, MI^maybe_dependency_info := MD).
-module_sub_set_num_errors(MI, E, MI^errors := E).
+module_sub_set_num_errors(MI, E, MI^num_errors := E).
module_sub_set_lambda_count(MI, LLC, MI^last_lambda_number := LLC).
module_sub_set_pragma_exported_procs(MI, PE, MI^pragma_exported_procs := PE).
module_sub_set_type_ctor_gen_infos(MI, TCG, MI^type_ctor_gen_infos := TCG).
@@ -676,7 +676,7 @@
% Various predicates which access the module_info data structure.
module_info_get_sub_info(MI, MI^module_sub_info).
-module_info_get_predicate_table(MI, MI^pred_table).
+module_info_get_predicate_table(MI, MI^predicate_table).
module_info_get_proc_requests(MI, MI^proc_requests).
module_info_get_special_pred_map(MI, MI^special_pred_map).
module_info_get_partial_qualifier_info(MI, MI^partial_qualifier_info).
@@ -696,7 +696,7 @@
% Various predicates which modify the module_info data structure.
module_info_set_sub_info(MI, SMI, MI^module_sub_info := SMI).
-module_info_set_predicate_table(MI, PT, MI^pred_table := PT).
+module_info_set_predicate_table(MI, PT, MI^predicate_table := PT).
module_info_set_proc_requests(MI, PR, MI^proc_requests := PR).
module_info_set_special_pred_map(MI, SPM, MI^special_pred_map := SPM).
module_info_set_partial_qualifier_info(MI, PQ,
diff -rub --exclude CVS ws15.base/compiler/llds_common.m /home/ender2/zs/ws15/compiler/llds_common.m
--- ws15.base/compiler/llds_common.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/llds_common.m Tue Feb 29 16:07:32 2000
@@ -153,9 +153,9 @@
llds_common__process_rval(ArgType0, ArgType, Info0, Info).
llds_common__process_rtti_data(
du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag, Locn,
- Ordinal, Arity, Args0, Names, Exist),
+ Ordinal, Arity, BitVector, Args0, Names, Exist),
du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag, Locn,
- Ordinal, Arity, Args, Names, Exist),
+ Ordinal, Arity, BitVector, Args, Names, Exist),
Info0, Info) :-
llds_common__process_rval(Args0, Args, Info0, Info).
llds_common__process_rtti_data(
@@ -179,16 +179,12 @@
du_ptag_ordered_table(RttiTypeId, Functors),
Info, Info).
llds_common__process_rtti_data(
- du_ptag_layout(RttiTypeId, Ptag, NumSharers, Locn, Table),
- du_ptag_layout(RttiTypeId, Ptag, NumSharers, Locn, Table),
- Info, Info).
-llds_common__process_rtti_data(
type_ctor_info(RttiTypeId, Unify, Index, Compare, Rep, Solver,
- Init, Version, NumFunctors, Functors, Layout0,
- HashCons, PrettyPrint),
+ Init, Version, NumPtags, NumFunctors, Functors,
+ Layout0, HashCons, PrettyPrint),
type_ctor_info(RttiTypeId, Unify, Index, Compare, Rep, Solver,
- Init, Version, NumFunctors, Functors, Layout,
- HashCons, PrettyPrint),
+ Init, Version, NumPtags, NumFunctors, Functors,
+ Layout, HashCons, PrettyPrint),
Info0, Info) :-
llds_common__process_layout_info(Layout0, Layout, Info0, Info).
diff -rub --exclude CVS ws15.base/compiler/llds_out.m /home/ender2/zs/ws15/compiler/llds_out.m
--- ws15.base/compiler/llds_out.m Sat Feb 26 11:50:25 2000
+++ /home/ender2/zs/ws15/compiler/llds_out.m Wed Mar 1 13:59:09 2000
@@ -18,7 +18,7 @@
:- interface.
:- import_module llds, builtin_ops, prog_data, hlds_data, rl_file.
-:- import_module llds_util, globals.
+:- import_module globals.
:- import_module set_bbbtree, bool, io, std_util.
% Given a 'c_file' structure, output the LLDS code inside it
@@ -31,19 +31,31 @@
io__state, io__state).
:- mode output_llds(in, in, in, di, uo) is det.
+ % output_rval_decls(Rval, FirstIndent, LaterIndent, N0, N,
+ % DeclSet0, DeclSet) outputs the declarations of any static constants,
+ % etc. that need to be declared before output_rval(Rval) is called.
+ % FirstIndent is output before the first declaration, while
+ % LaterIndent is output before all later declaration; N0 and N
+ % give the number of declarations output before and after this call.
+ %
+ % Every time we emit a declaration for a symbol, we insert it into the
+ % set of symbols we've already declared. That way, we avoid generating
+ % the same symbol twice, which would cause an error in the C code.
+
:- pred output_rval_decls(rval, string, string, int, int, decl_set, decl_set,
io__state, io__state).
:- mode output_rval_decls(in, in, in, in, out, in, out, di, uo) is det.
% output an rval (not converted to any particular type,
% but instead output as its "natural" type)
- %
+
:- pred output_rval(rval, io__state, io__state).
:- mode output_rval(in, di, uo) is det.
-% output_code_addr_decls(CodeAddr, ...) outputs the declarations of any
-% extern symbols, etc. that need to be declared before
-% output_code_addr(CodeAddr) is called.
+ % output_code_addr_decls(CodeAddr, ...) outputs the declarations of any
+ % extern symbols, etc. that need to be declared before
+ % output_code_addr(CodeAddr) is called. The meanings of the other
+ % arguments are as above.
:- pred output_code_addr_decls(code_addr, string, string, int, int,
decl_set, decl_set, io__state, io__state).
@@ -52,17 +64,22 @@
:- pred output_code_addr(code_addr, io__state, io__state).
:- mode output_code_addr(in, di, uo) is det.
+ % output_data_addr_decls(DataAddr, ...) outputs the declarations of
+ % any static constants, etc. that need to be declared before
+ % output_data_addr(DataAddr) is called. The meanings of the other
+ % arguments are as above.
+
+:- pred output_data_addr_decls(data_addr::in, string::in, string::in,
+ int::in, int::out, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
:- pred output_data_addr(data_addr::in, io__state::di, io__state::uo) is det.
% All the C data structures we generate which are either fully static
% or static after initialization should have this prefix.
:- func mercury_data_prefix = string.
-:- pred output_data_addr_decls(data_addr::in, string::in, string::in,
- int::in, int::out, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
-
- % Given the default linkage of a data item, and a bool sayinng whether
+ % Given the default linkage of a data item, and a bool saying whether
% it is being defined, return a C string that gives its storage class.
:- pred c_data_linkage_string(globals::in, linkage::in, bool::in, string::out)
@@ -185,6 +202,44 @@
:- pred llds_out__trace_port_to_num(trace_port, int).
:- mode llds_out__trace_port_to_num(in, out) is det.
+ % The following are exported to rtti_out. It may be worthwhile
+ % to put these in a new module (maybe llds_out_util).
+
+:- type decl_id ---> create_label(int)
+ ; float_label(string)
+ ; code_addr(code_addr)
+ ; data_addr(data_addr)
+ ; pragma_c_struct(string).
+
+:- type decl_set.
+
+% Every time we emit a declaration for a symbol, we insert it into the
+% set of symbols we've already declared. That way, we avoid generating
+% the same symbol twice, which would cause an error in the C code.
+
+:- pred decl_set_init(decl_set::out) is det.
+
+:- pred decl_set_insert(decl_set::in, decl_id::in, decl_set::out) is det.
+
+:- pred decl_set_is_member(decl_id::in, decl_set::in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
+%
+% Note that we need to know the linkage not just at the definition,
+% but also at every use, because if the use is prior to the definition,
+% then we need to declare the name first, and the linkage used in that
+% declaration must be consistent with the linkage in the definition.
+% For this reason, the field in c_data (which holds the information about
+% the definition) which says whether or not a data name is exported
+% is not useful. Instead, we need to determine whether or not something
+% is exported from its `data_name'.
+%
+
+:- type linkage ---> extern ; static.
+
+%-----------------------------------------------------------------------------%
+
:- implementation.
:- import_module rtti, rtti_out, options.
@@ -199,6 +254,19 @@
%-----------------------------------------------------------------------------%
+:- type decl_set == map(decl_id, unit).
+
+decl_set_init(DeclSet) :-
+ map__init(DeclSet).
+
+decl_set_insert(DeclSet0, DeclId, DeclSet) :-
+ map__set(DeclSet0, DeclId, unit, DeclSet).
+
+decl_set_is_member(DeclId, DeclSet) :-
+ map__search(DeclSet, DeclId, _).
+
+%-----------------------------------------------------------------------------%
+
output_llds(C_File, StackLayoutLabels, MaybeRLFile) -->
globals__io_lookup_bool_option(split_c_files, SplitFiles),
( { SplitFiles = yes } ->
@@ -1985,14 +2053,6 @@
[]
).
-% output_rval_decls(Rval, ...) outputs the declarations of any
-% static constants, etc. that need to be declared before
-% output_rval(Rval) is called.
-
-% Every time we emit a declaration for a symbol, we insert it into the
-% set of symbols we've already declared. That way, we avoid generating
-% the same symbol twice, which would cause an error in the C code.
-
output_rval_decls(lval(Lval), FirstIndent, LaterIndent, N0, N,
DeclSet0, DeclSet) -->
output_lval_decls(Lval, FirstIndent, LaterIndent, N0, N,
@@ -2792,11 +2852,11 @@
{ N is N0 + 1 },
(
{ DataAddr = data_addr(ModuleName, DataVarName) },
- output_data_addr_scope_type_name(ModuleName, DataVarName, no,
+ output_data_addr_storage_type_name(ModuleName, DataVarName, no,
LaterIndent)
;
{ DataAddr = rtti_addr(RttiTypeId, RttiVarName) },
- output_rtti_addr_scope_type_name(RttiTypeId, RttiVarName, no)
+ output_rtti_addr_storage_type_name(RttiTypeId, RttiVarName, no)
),
io__write_string(";\n").
@@ -2835,10 +2895,16 @@
ConstStr = "const "
).
-:- pred output_data_addr_scope_type_name(module_name::in, data_name::in,
+ % This predicate outputs the storage class, type and name
+ % of the variable specified by the first two arguments.
+ % The third argument should be true if the variable is being
+ % defined, and false if it is only being declared (since the
+ % storage class "extern" is needed only on declarations).
+
+:- pred output_data_addr_storage_type_name(module_name::in, data_name::in,
bool::in, string::in, io__state::di, io__state::uo) is det.
-output_data_addr_scope_type_name(ModuleName, DataVarName, BeingDefined,
+output_data_addr_storage_type_name(ModuleName, DataVarName, BeingDefined,
LaterIndent) -->
{ data_name_linkage(DataVarName, Linkage) },
globals__io_get_globals(Globals),
@@ -3105,30 +3171,32 @@
LabelName
], Name).
- % Output a list of maybe data addresses, with a `no' meaning NULL.
+ % Output a maybe data address, with a `no' meaning NULL.
-:- pred output_maybe_data_addrs(list(maybe(data_addr))::in,
+:- pred output_maybe_data_addr(maybe(data_addr)::in,
io__state::di, io__state::uo) is det.
-output_maybe_data_addrs([]) --> [].
-output_maybe_data_addrs([MaybeDataAddr | DataAddrs]) -->
- io__write_string("\t"),
+output_maybe_data_addr(MaybeDataAddr) -->
(
{ MaybeDataAddr = yes(DataAddr) },
output_data_addr(DataAddr)
;
{ MaybeDataAddr = no },
io__write_string("NULL")
- ),
- (
- { DataAddrs = [] },
- io__write_string("\n")
- ;
- { DataAddrs = [_|_] },
- io__write_string(",\n"),
- output_maybe_data_addrs(DataAddrs)
).
+ % Output a list of maybe data addresses, with a `no' meaning NULL.
+
+:- pred output_maybe_data_addrs(list(maybe(data_addr))::in,
+ io__state::di, io__state::uo) is det.
+
+output_maybe_data_addrs([]) --> [].
+output_maybe_data_addrs([MaybeDataAddr | MaybeDataAddrs]) -->
+ io__write_string("\t"),
+ io__write_list([MaybeDataAddr | MaybeDataAddrs], ",\n\t",
+ output_maybe_data_addr),
+ io__write_string("\n").
+
% Output a list of data addresses.
:- pred output_data_addrs(list(data_addr)::in, io__state::di, io__state::uo)
@@ -3137,15 +3205,9 @@
output_data_addrs([]) --> [].
output_data_addrs([DataAddr | DataAddrs]) -->
io__write_string("\t"),
- output_data_addr(DataAddr),
- (
- { DataAddrs = [] },
- io__write_string("\n")
- ;
- { DataAddrs = [_|_] },
- io__write_string(",\n"),
- output_data_addrs(DataAddrs)
- ).
+ io__write_list([DataAddr | DataAddrs], ",\n\t",
+ output_data_addr),
+ io__write_string("\n").
% Output a data address.
diff -rub --exclude CVS ws15.base/compiler/notes/compiler_design.html /home/ender2/zs/ws15/compiler/notes/compiler_design.html
--- ws15.base/compiler/notes/compiler_design.html Sat Feb 26 11:50:27 2000
+++ /home/ender2/zs/ws15/compiler/notes/compiler_design.html Thu Mar 2 16:10:00 2000
@@ -733,7 +733,8 @@
<p>
-The result of code generation is the Low Level Data Structure (llds.m).
+The result of code generation is the Low Level Data Structure (llds.m),
+which may also contains some data structures whose types are defined in rtti.m.
The code for each procedure is generated as a tree of code fragments
which is then flattened (tree.m).
@@ -873,7 +874,8 @@
acceptable to various C compilers. Currently computed gotos can have
their maximum size limited to avoid a fixed limit in lcc.
-<li> Final generation of C code is done in llds_out.m.
+<li> Final generation of C code is done in llds_out.m, which subcontracts the
+ output of RTTI structures to rtti_out.m.
</ul>
<p>
diff -rub --exclude CVS ws15.base/compiler/opt_debug.m /home/ender2/zs/ws15/compiler/opt_debug.m
--- ws15.base/compiler/opt_debug.m Sat Feb 26 11:50:26 2000
+++ /home/ender2/zs/ws15/compiler/opt_debug.m Sat Feb 26 20:19:31 2000
@@ -777,9 +777,6 @@
opt_debug__dump_rtti_name(du_stag_ordered_table(Ptag), Str) :-
string__int_to_string(Ptag, Ptag_str),
string__append("du_stag_ordered_table_", Ptag_str, Str).
-opt_debug__dump_rtti_name(du_ptag_layout(Ptag), Str) :-
- string__int_to_string(Ptag, Ptag_str),
- string__append("du_ptag_layout_", Ptag_str, Str).
opt_debug__dump_rtti_name(du_ptag_ordered_table, Str) :-
Str = "du_ptag_ordered_table".
opt_debug__dump_rtti_name(type_ctor_info, Str) :-
diff -rub --exclude CVS ws15.base/compiler/rtti.m /home/ender2/zs/ws15/compiler/rtti.m
--- ws15.base/compiler/rtti.m Sat Feb 26 11:50:27 2000
+++ /home/ender2/zs/ws15/compiler/rtti.m Tue Feb 29 15:37:43 2000
@@ -5,7 +5,9 @@
%-----------------------------------------------------------------------------%
%
% Definitions of data structures for representing run-time type information
-% within the compiler.
+% within the compiler. When output by rtti_out.m, values of most these types
+% will correspond to the types defined in runtime/mercury_type_info.h;
+% the documentation of those types can be found there.
%
% Eventually, this module will be independent of whether we are compiling
% to LLDS or MLDS. For the time being, it depends on LLDS.
@@ -21,15 +23,25 @@
:- import_module llds, prog_data.
:- import_module bool, list, std_util.
+ % For a given du type and a primary tag value, this says where,
+ % if anywhere, the secondary tag is.
:- type sectag_locn
---> sectag_none
; sectag_local
; sectag_remote.
+ % For a given du family type, this says whether the user has defined
+ % their own unification predicate.
:- type equality_axioms
---> standard
; user_defined.
+ % For a notag or equiv type, this says whether the target type
+ % contains variables or not.
+:- type equiv_type_inst
+ ---> equiv_type_is_ground
+ ; equiv_type_is_not_ground.
+
% The compiler is concerned with the type constructor representations
% of only the types it generates RTTI information for; it need not and
% does not know about the type_ctor_reps of types which have
@@ -37,10 +49,14 @@
:- type type_ctor_rep
---> enum(equality_axioms)
; du(equality_axioms)
- ; notag(equality_axioms)
- ; equiv
+ ; notag(equality_axioms, equiv_type_inst)
+ ; equiv(equiv_type_inst)
; unknown.
+ % Different kinds of types have different type_layout information
+ % generated for them, and some have no type_layout info at all.
+ % This type represents values that will be put into the type_layout
+ % field of a MR_TypeCtorInfo.
:- type type_ctor_layout_info
---> enum_layout(
rtti_name
@@ -56,6 +72,10 @@
)
; no_layout.
+ % Different kinds of types have different type_functors information
+ % generated for them, and some have no type_functors info at all.
+ % This type represents values that will be put into the type_functors
+ % field of a MR_TypeCtorInfo.
:- type type_ctor_functors_info
---> enum_functors(
rtti_name
@@ -68,6 +88,7 @@
)
; no_functors.
+ % This type corresponds to the C type MR_DuExistLocn.
:- type exist_typeinfo_locn
---> plain_typeinfo(
int % The typeinfo is stored
@@ -86,6 +107,20 @@
% macro.
).
+ % This type corresponds to the MR_DuPtagTypeLayout C type.
+:- type du_ptag_layout
+ ---> du_ptag_layout(
+ int, % number of function symbols
+ % sharing this primary tag
+ sectag_locn,
+ rtti_name % a vector of size num_sharers;
+ % element N points to the
+ % functor descriptor for the
+ % functor with secondary tag S;
+ % if sectag_locn is none, S=0
+ ).
+
+ % Values of this type uniquely identify a type in the program.
:- type rtti_type_id
---> rtti_type_id(
module_name, % module name
@@ -95,7 +130,8 @@
% Global data generated by the compiler. Usually readonly,
% with one exception: data containing code addresses must
- % be initialized.
+ % be initialized at runtime in grades that don't support static
+ % code initializers.
:- type rtti_data
---> exist_locns(
rtti_type_id, % identifies the type
@@ -140,7 +176,7 @@
% The remaining arguments of this function symbol
% correspond one-to-one to the fields of
- % MR_NotagFunctorDesc.
+ % the MR_NotagFunctorDesc C type.
string, % functor name
rval % pseudo typeinfo of argument
@@ -150,7 +186,7 @@
% The remaining arguments of this function symbol
% correspond one-to-one to the fields of
- % MR_DuFunctorDesc.
+ % the MR_DuFunctorDesc C type.
string, % functor name
int, % functor primary tag
@@ -158,7 +194,15 @@
sectag_locn,
int, % ordinal number of functor
% in type definition
- arity, % the functor's arity
+ arity, % the functor's visible arity
+ int, % a bit vector of size at most
+ % contains_var_bit_vector_size
+ % which contains a 1 bit in the
+ % position given by 1 << N if
+ % the type of argument N
+ % contains variables (assuming
+ % that arguments are numbered
+ % from zero)
rval, % a vector of length arity
% containing the pseudo
% typeinfos of the arguments
@@ -205,31 +249,14 @@
list(rtti_name)
)
- ; du_ptag_layout(
- rtti_type_id, % identifies the type
- int, % primary tag value
-
- % The rest of the arguments of this function symbol
- % correspond one-to-one to the fields of the
- % MR_DuPtagTypeLayout C type.
-
- int, % number of function symbols
- % sharing this primary tag
- sectag_locn,
- rtti_name % a vector of size num_sharers;
- % element N points to the
- % functor descriptor for the
- % functor with secondary tag S;
- % if sectag_locn is none, S=0
- )
; du_ptag_ordered_table(
rtti_type_id, % identifies the type
% The remaining argument of this function symbol
% corresponds to the elements of the MR_DuTypeLayout
- % C type. A `no' represents a NULL pointer.
+ % C type.
- list(maybe(rtti_name))
+ list(du_ptag_layout)
)
; type_ctor_info(
% The arguments of this function symbol correspond
@@ -244,6 +271,8 @@
maybe(code_addr), % solver
maybe(code_addr), % init
int, % RTTI version number
+ int, % num of ptags used if ctor_rep
+ % is DU or DUUSEREQ
int, % number of functors in type
type_ctor_functors_info,% the functor layout
type_ctor_layout_info, % the layout table
@@ -262,95 +291,27 @@
; enum_value_ordered_table
; du_name_ordered_table
; du_stag_ordered_table(int) % primary tag
- ; du_ptag_layout(int) % primary tag
; du_ptag_ordered_table
; type_ctor_info
; type_hashcons_pointer.
- % Create a C variable name for a record of the locations of the
- % typeinfos for a functor's existentially typed arguments.
-
-:- pred rtti__make_exist_locns_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for a summary record of a functor's
- % existentially typed arguments.
-
-:- pred rtti__make_exist_info_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for the array listing the names
- % of the fields of a function symbol.
-
-:- pred rtti__make_field_names_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for an enum functor descriptor.
-
-:- pred rtti__make_enum_functor_desc_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for a notag functor descriptor.
-
-:- pred rtti__make_notag_functor_desc_name(rtti_type_id::in,
- string::out) is det.
+ % Return the C variable name of the RTTI data structure identified
+ % by the input arguments.
- % Create a C variable name for a du functor descriptor.
-
-:- pred rtti__make_du_functor_desc_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for a list of enum functor descriptors
- % ordered on name.
-
-:- pred rtti__make_enum_name_ordered_table_name(rtti_type_id::in,
- string::out) is det.
-
- % Create C variable a name for a list of enum functor descriptors
- % ordered on value.
-
-:- pred rtti__make_enum_value_ordered_table_name(rtti_type_id::in,
- string::out) is det.
-
- % Create a C variable name for a list of du functor descriptors
- % ordered on name.
-
-:- pred rtti__make_du_name_ordered_table_name(rtti_type_id::in,
- string::out) is det.
-
- % Create C variable a name for a list of du functor descriptors
- % sharing a primary tag ordered on value.
-
-:- pred rtti__make_du_stag_ordered_table_name(rtti_type_id::in,
- int::in, string::out) is det.
-
- % Create C variable a name for a list of du_ptag_layouts.
-
-:- pred rtti__make_du_ptag_ordered_table_name(rtti_type_id::in,
- string::out) is det.
-
- % Create a C variable name for a du_ptag_layout
-
-:- pred rtti__make_du_ptag_layout_name(rtti_type_id::in, int::in,
- string::out) is det.
-
- % Create a C variable name for a type_ctor_info
-
-:- pred rtti__make_type_ctor_info_name(rtti_type_id::in,
- string::out) is det.
-
- % Create a C variable name for a hashcons pointer
-
-:- pred rtti__make_type_hashcons_pointer_name(rtti_type_id::in,
- string::out) is det.
-
-:- pred rtti_addr_to_string(rtti_type_id::in, rtti_name::in, string::out)
+:- pred rtti__addr_to_string(rtti_type_id::in, rtti_name::in, string::out)
is det.
+ % Return the C representation of a secondary tag location.
+
:- pred rtti__sectag_locn_to_string(sectag_locn::in, string::out) is det.
+ % Return the C representation of a type_ctor_rep value.
+
:- pred rtti__type_ctor_rep_to_string(type_ctor_rep::in, string::out) is det.
+ % Return true iff the given type of RTTI data structure includes
+ % code addresses.
+
:- pred rtti__name_would_include_code_address(rtti_name::in, bool::out) is det.
:- implementation.
@@ -358,169 +319,69 @@
:- import_module llds_out.
:- import_module string.
-rtti__make_exist_locns_name(RttiTypeId, Ordinal, Str) :-
+rtti__addr_to_string(RttiTypeId, RttiName, Str) :-
RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
llds_out__sym_name_mangle(ModuleName0, ModuleName),
llds_out__name_mangle(TypeName0, TypeName),
string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__exist_locns_", TypeName,
- "_", A_str, "_", O_str], Str).
-
-rtti__make_exist_info_name(RttiTypeId, Ordinal, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__exist_info_", TypeName,
- "_", A_str, "_", O_str], Str).
-
-rtti__make_field_names_name(RttiTypeId, Ordinal, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__field_names_", TypeName,
- "_", A_str, "_", O_str], Str).
-
-rtti__make_enum_functor_desc_name(RttiTypeId, Ordinal, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__enum_functor_desc_", TypeName,
- "_", A_str, "_", O_str], Str).
-
-rtti__make_notag_functor_desc_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__notag_functor_desc_", TypeName,
- "_", A_str], Str).
-
-rtti__make_du_functor_desc_name(RttiTypeId, Ordinal, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ordinal, O_str),
- string__append_list([ModuleName, "__du_functor_desc_", TypeName,
- "_", A_str, "_", O_str], Str).
-
-rtti__make_enum_name_ordered_table_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__enum_name_ordered_", TypeName,
- "_", A_str], Str).
-
-rtti__make_enum_value_ordered_table_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__enum_value_ordered_", TypeName,
- "_", A_str], Str).
-
-rtti__make_du_name_ordered_table_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__du_name_ordered_", TypeName,
- "_", A_str], Str).
-
-rtti__make_du_stag_ordered_table_name(RttiTypeId, Ptag, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ptag, P_str),
- string__append_list([ModuleName, "__du_stag_ordered_", TypeName,
- "_", A_str, "_", P_str], Str).
-
-rtti__make_du_ptag_ordered_table_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__du_ptag_ordered_", TypeName,
- "_", A_str], Str).
-
-rtti__make_du_ptag_layout_name(RttiTypeId, Ptag, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__int_to_string(Ptag, P_str),
- string__append_list([ModuleName, "__du_ptag_layout_", TypeName,
- "_", A_str, "_", P_str], Str).
-
-rtti__make_type_ctor_info_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__type_ctor_info_", TypeName,
- "_", A_str], Str).
-
-rtti__make_type_hashcons_pointer_name(RttiTypeId, Str) :-
- RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
- llds_out__sym_name_mangle(ModuleName0, ModuleName),
- llds_out__name_mangle(TypeName0, TypeName),
- string__int_to_string(TypeArity, A_str),
- string__append_list([ModuleName, "__hashcons_ptr_", TypeName,
- "_", A_str], Str).
-
-rtti_addr_to_string(RttiTypeId, RttiName, Str) :-
(
RttiName = exist_locns(Ordinal),
- rtti__make_exist_locns_name(RttiTypeId, Ordinal, Str)
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__exist_locns_",
+ TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = exist_info(Ordinal),
- rtti__make_exist_info_name(RttiTypeId, Ordinal, Str)
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__exist_info_",
+ TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = field_names(Ordinal),
- rtti__make_field_names_name(RttiTypeId, Ordinal, Str)
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__field_names_",
+ TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = enum_functor_desc(Ordinal),
- rtti__make_enum_functor_desc_name(RttiTypeId, Ordinal, Str)
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__enum_functor_desc_",
+ TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = notag_functor_desc,
- rtti__make_notag_functor_desc_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__notag_functor_desc_",
+ TypeName, "_", A_str], Str)
;
RttiName = du_functor_desc(Ordinal),
- rtti__make_du_functor_desc_name(RttiTypeId, Ordinal, Str)
+ string__int_to_string(Ordinal, O_str),
+ string__append_list([ModuleName, "__du_functor_desc_",
+ TypeName, "_", A_str, "_", O_str], Str)
;
RttiName = enum_name_ordered_table,
- rtti__make_enum_name_ordered_table_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__enum_name_ordered_",
+ TypeName, "_", A_str], Str)
;
RttiName = enum_value_ordered_table,
- rtti__make_enum_value_ordered_table_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__enum_value_ordered_",
+ TypeName, "_", A_str], Str)
;
RttiName = du_name_ordered_table,
- rtti__make_du_name_ordered_table_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__du_name_ordered_",
+ TypeName, "_", A_str], Str)
;
RttiName = du_stag_ordered_table(Ptag),
- rtti__make_du_stag_ordered_table_name(RttiTypeId, Ptag,
- Str)
- ;
- RttiName = du_ptag_layout(Ptag),
- rtti__make_du_ptag_layout_name(RttiTypeId, Ptag, Str)
+ string__int_to_string(Ptag, P_str),
+ string__append_list([ModuleName, "__du_stag_ordered_",
+ TypeName, "_", A_str, "_", P_str], Str)
;
RttiName = du_ptag_ordered_table,
- rtti__make_du_ptag_ordered_table_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__du_ptag_ordered_",
+ TypeName, "_", A_str], Str)
;
RttiName = type_ctor_info,
- rtti__make_type_ctor_info_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__type_ctor_info_",
+ TypeName, "_", A_str], Str)
;
RttiName = type_hashcons_pointer,
- rtti__make_type_hashcons_pointer_name(RttiTypeId, Str)
+ string__append_list([ModuleName, "__hashcons_ptr_",
+ TypeName, "_", A_str], Str)
).
rtti__sectag_locn_to_string(sectag_none, "MR_SECTAG_NONE").
@@ -535,12 +396,18 @@
"MR_TYPECTOR_REP_ENUM").
rtti__type_ctor_rep_to_string(enum(user_defined),
"MR_TYPECTOR_REP_ENUM_USEREQ").
-rtti__type_ctor_rep_to_string(notag(standard),
+rtti__type_ctor_rep_to_string(notag(standard, equiv_type_is_not_ground),
"MR_TYPECTOR_REP_NOTAG").
-rtti__type_ctor_rep_to_string(notag(user_defined),
+rtti__type_ctor_rep_to_string(notag(user_defined, equiv_type_is_not_ground),
"MR_TYPECTOR_REP_NOTAG_USEREQ").
-rtti__type_ctor_rep_to_string(equiv,
+rtti__type_ctor_rep_to_string(notag(standard, equiv_type_is_ground),
+ "MR_TYPECTOR_REP_NOTAG_GROUND").
+rtti__type_ctor_rep_to_string(notag(user_defined, equiv_type_is_ground),
+ "MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ").
+rtti__type_ctor_rep_to_string(equiv(equiv_type_is_not_ground),
"MR_TYPECTOR_REP_EQUIV").
+rtti__type_ctor_rep_to_string(equiv(equiv_type_is_ground),
+ "MR_TYPECTOR_REP_EQUIV_GROUND").
rtti__type_ctor_rep_to_string(unknown,
"MR_TYPECTOR_REP_UNKNOWN").
@@ -554,7 +421,6 @@
rtti__name_would_include_code_address(enum_value_ordered_table, no).
rtti__name_would_include_code_address(du_name_ordered_table, no).
rtti__name_would_include_code_address(du_stag_ordered_table(_), no).
-rtti__name_would_include_code_address(du_ptag_layout(_), no).
rtti__name_would_include_code_address(du_ptag_ordered_table, no).
rtti__name_would_include_code_address(type_ctor_info, yes).
rtti__name_would_include_code_address(type_hashcons_pointer, no).
diff -rub --exclude CVS ws15.base/compiler/rtti_out.m /home/ender2/zs/ws15/compiler/rtti_out.m
--- ws15.base/compiler/rtti_out.m Sat Feb 26 11:50:33 2000
+++ /home/ender2/zs/ws15/compiler/rtti_out.m Wed Mar 1 13:59:28 2000
@@ -18,7 +18,7 @@
:- interface.
-:- import_module rtti, llds_util.
+:- import_module rtti, llds_out.
:- import_module bool, io.
:- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out,
@@ -33,7 +33,7 @@
:- pred output_rtti_addr(rtti_type_id::in, rtti_name::in,
io__state::di, io__state::uo) is det.
-:- pred output_rtti_addr_scope_type_name(rtti_type_id::in, rtti_name::in,
+:- pred output_rtti_addr_storage_type_name(rtti_type_id::in, rtti_name::in,
bool::in, io__state::di, io__state::uo) is det.
:- pred rtti_data_to_name(rtti_data::in, rtti_type_id::out, rtti_name::out)
@@ -45,7 +45,7 @@
:- implementation.
-:- import_module llds, llds_out, prog_out, options, globals.
+:- import_module llds, prog_out, options, globals.
:- import_module string, list, require, std_util.
%-----------------------------------------------------------------------------%
@@ -99,7 +99,8 @@
output_rval(ArgType),
io__write_string("\n};\n").
output_rtti_data_defn(du_functor_desc(RttiTypeId, FunctorName, Ptag, Stag,
- Locn, Ordinal, Arity, ArgTypes, MaybeNames, MaybeExist),
+ Locn, Ordinal, Arity, ContainsVarBitVector, ArgTypes,
+ MaybeNames, MaybeExist),
DeclSet0, DeclSet) -->
output_rval_decls(ArgTypes, "", "", 0, _, DeclSet0, DeclSet1),
(
@@ -123,16 +124,18 @@
io__write_string(" = {\n\t"""),
io__write_string(FunctorName),
io__write_string(""",\n\t"),
- io__write_int(Ptag),
+ io__write_int(Arity),
io__write_string(",\n\t"),
- io__write_int(Stag),
+ io__write_int(ContainsVarBitVector),
io__write_string(",\n\t"),
{ rtti__sectag_locn_to_string(Locn, LocnStr) },
io__write_string(LocnStr),
io__write_string(",\n\t"),
- io__write_int(Ordinal),
+ io__write_int(Ptag),
io__write_string(",\n\t"),
- io__write_int(Arity),
+ io__write_int(Stag),
+ io__write_string(",\n\t"),
+ io__write_int(Ordinal),
io__write_string(",\n\t(MR_PseudoTypeInfo *) "),
output_rval(ArgTypes),
io__write_string(",\n\t"),
@@ -160,7 +163,7 @@
output_generic_rtti_data_defn_start(RttiTypeId,
enum_name_ordered_table, DeclSet1, DeclSet),
io__write_string(" = {\n"),
- output_rtti_addrs(RttiTypeId, Functors),
+ output_addr_of_rtti_addrs(RttiTypeId, Functors),
io__write_string("};\n").
output_rtti_data_defn(enum_value_ordered_table(RttiTypeId, Functors),
DeclSet0, DeclSet) -->
@@ -169,7 +172,7 @@
output_generic_rtti_data_defn_start(RttiTypeId,
enum_value_ordered_table, DeclSet1, DeclSet),
io__write_string(" = {\n"),
- output_rtti_addrs(RttiTypeId, Functors),
+ output_addr_of_rtti_addrs(RttiTypeId, Functors),
io__write_string("};\n").
output_rtti_data_defn(du_name_ordered_table(RttiTypeId, Functors),
DeclSet0, DeclSet) -->
@@ -178,7 +181,7 @@
output_generic_rtti_data_defn_start(RttiTypeId,
du_name_ordered_table, DeclSet1, DeclSet),
io__write_string(" = {\n"),
- output_rtti_addrs(RttiTypeId, Functors),
+ output_addr_of_rtti_addrs(RttiTypeId, Functors),
io__write_string("};\n").
output_rtti_data_defn(du_stag_ordered_table(RttiTypeId, Ptag, Sharers),
DeclSet0, DeclSet) -->
@@ -187,35 +190,20 @@
output_generic_rtti_data_defn_start(RttiTypeId,
du_stag_ordered_table(Ptag), DeclSet1, DeclSet),
io__write_string(" = {\n"),
- output_rtti_addrs(RttiTypeId, Sharers),
- io__write_string("\n};\n").
-output_rtti_data_defn(du_ptag_layout(RttiTypeId, Ptag, NumSharers, Locn,
- Descriptors), DeclSet0, DeclSet) -->
- output_rtti_addr_decls(RttiTypeId, Descriptors, "", "", 0, _,
- DeclSet0, DeclSet1),
- output_generic_rtti_data_defn_start(RttiTypeId,
- du_ptag_layout(Ptag), DeclSet1, DeclSet),
- io__write_string(" = {\n\t"),
- io__write_int(NumSharers),
- io__write_string(",\n\t"),
- { rtti__sectag_locn_to_string(Locn, LocnStr) },
- io__write_string(LocnStr),
- io__write_string(",\n\t(MR_DuFunctorDesc **) "),
- output_rtti_addr(RttiTypeId, Descriptors),
+ output_addr_of_rtti_addrs(RttiTypeId, Sharers),
io__write_string("\n};\n").
output_rtti_data_defn(du_ptag_ordered_table(RttiTypeId, PtagLayouts),
DeclSet0, DeclSet) -->
- output_maybe_rtti_addrs_decls(RttiTypeId, PtagLayouts, "", "",
- 0, _, DeclSet0, DeclSet1),
+ output_ptag_layout_decls(PtagLayouts, RttiTypeId, DeclSet0, DeclSet1),
output_generic_rtti_data_defn_start(RttiTypeId,
du_ptag_ordered_table, DeclSet1, DeclSet),
io__write_string(" = {\n"),
- output_maybe_rtti_addrs(RttiTypeId, PtagLayouts),
+ output_ptag_layout_defns(PtagLayouts, RttiTypeId),
io__write_string("\n};\n").
output_rtti_data_defn(type_ctor_info(RttiTypeId, Unify, Index, Compare,
- CtorRep, Solver, Init, Version, NumFunctors,
- FunctorsInfo, LayoutInfo, MaybeHashCons,
- Prettyprinter), DeclSet0, DeclSet) -->
+ CtorRep, Solver, Init, Version, NumPtags, NumFunctors,
+ FunctorsInfo, LayoutInfo, _MaybeHashCons, _Prettyprinter),
+ DeclSet0, DeclSet) -->
output_generic_rtti_data_defn_start(RttiTypeId,
type_ctor_info, DeclSet0, DeclSet),
io__write_string(" = {\n\t"),
@@ -242,6 +230,8 @@
io__write_string(""",\n\t"),
io__write_int(Version),
io__write_string(",\n\t"),
+ io__write_int(NumPtags),
+ io__write_string(",\n\t"),
io__write_int(NumFunctors),
io__write_string(",\n\t"),
(
@@ -288,18 +278,49 @@
{ LayoutInfo = no_layout },
io__write_string("{ 0 }")
),
- io__write_string(",\n\t"),
- (
- { MaybeHashCons = yes(HashConsDataAddr) },
- io__write_string("&"),
- output_rtti_addr(RttiTypeId, HashConsDataAddr)
+% io__write_string(",\n\t"),
+% (
+% { MaybeHashCons = yes(HashConsDataAddr) },
+% io__write_string("&"),
+% output_rtti_addr(RttiTypeId, HashConsDataAddr)
+% ;
+% { MaybeHashCons = no },
+% io__write_string("NULL")
+% ),
+% io__write_string(",\n\t"),
+% output_maybe_code_addr(Prettyprinter),
+ io__write_string("\n};\n").
+
+:- pred output_ptag_layout_decls(list(du_ptag_layout)::in, rtti_type_id::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_ptag_layout_decls([], _, DeclSet, DeclSet) --> [].
+output_ptag_layout_decls([DuPtagLayout | DuPtagLayouts], RttiTypeId,
+ DeclSet0, DeclSet) -->
+ { DuPtagLayout = du_ptag_layout(_, _, Descriptors) },
+ output_rtti_addr_decls(RttiTypeId, Descriptors, "", "", 0, _,
+ DeclSet0, DeclSet1),
+ output_ptag_layout_decls(DuPtagLayouts, RttiTypeId, DeclSet1, DeclSet).
+
+:- pred output_ptag_layout_defns(list(du_ptag_layout)::in, rtti_type_id::in,
+ io__state::di, io__state::uo) is det.
+
+output_ptag_layout_defns([], _) --> [].
+output_ptag_layout_defns([DuPtagLayout | DuPtagLayouts], RttiTypeId) -->
+ { DuPtagLayout = du_ptag_layout(NumSharers, Locn, Descriptors) },
+ io__write_string("\t{ "),
+ io__write_int(NumSharers),
+ io__write_string(", "),
+ { rtti__sectag_locn_to_string(Locn, LocnStr) },
+ io__write_string(LocnStr),
+ io__write_string(", (MR_DuFunctorDesc **)\n\t"),
+ output_rtti_addr(RttiTypeId, Descriptors),
+ ( { DuPtagLayouts = [] } ->
+ io__write_string(" }\n")
;
- { MaybeHashCons = no },
- io__write_string("NULL")
+ io__write_string(" },\n")
),
- io__write_string(",\n\t"),
- output_maybe_code_addr(Prettyprinter),
- io__write_string("\n};\n").
+ output_ptag_layout_defns(DuPtagLayouts, RttiTypeId).
%-----------------------------------------------------------------------------%
@@ -318,7 +339,7 @@
RttiTypeId, enum_functor_desc(Ordinal)).
rtti_data_to_name(notag_functor_desc(RttiTypeId, _, _),
RttiTypeId, notag_functor_desc).
-rtti_data_to_name(du_functor_desc(RttiTypeId, _, _, _, _, Ordinal, _, _, _, _),
+rtti_data_to_name(du_functor_desc(RttiTypeId, _,_,_,_, Ordinal, _,_,_,_,_),
RttiTypeId, du_functor_desc(Ordinal)).
rtti_data_to_name(enum_name_ordered_table(RttiTypeId, _),
RttiTypeId, enum_name_ordered_table).
@@ -328,11 +349,9 @@
RttiTypeId, du_name_ordered_table).
rtti_data_to_name(du_stag_ordered_table(RttiTypeId, Ptag, _),
RttiTypeId, du_stag_ordered_table(Ptag)).
-rtti_data_to_name(du_ptag_layout(RttiTypeId, Ptag, _, _, _),
- RttiTypeId, du_ptag_layout(Ptag)).
rtti_data_to_name(du_ptag_ordered_table(RttiTypeId, _),
RttiTypeId, du_ptag_ordered_table).
-rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_),
+rtti_data_to_name(type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_,_),
RttiTypeId, type_ctor_info).
%-----------------------------------------------------------------------------%
@@ -341,7 +360,7 @@
decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
output_generic_rtti_data_decl(RttiTypeId, RttiName, DeclSet0, DeclSet) -->
- output_rtti_addr_scope_type_name(RttiTypeId, RttiName, no),
+ output_rtti_addr_storage_type_name(RttiTypeId, RttiName, no),
io__write_string(";\n"),
{ DataAddr = rtti_addr(RttiTypeId, RttiName) },
{ decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
@@ -351,11 +370,11 @@
output_generic_rtti_data_defn_start(RttiTypeId, RttiName, DeclSet0, DeclSet) -->
io__write_string("\n"),
- output_rtti_addr_scope_type_name(RttiTypeId, RttiName, yes),
+ output_rtti_addr_storage_type_name(RttiTypeId, RttiName, yes),
{ DataAddr = rtti_addr(RttiTypeId, RttiName) },
{ decl_set_insert(DeclSet0, data_addr(DataAddr), DeclSet) }.
-output_rtti_addr_scope_type_name(RttiTypeId, RttiName, BeingDefined) -->
+output_rtti_addr_storage_type_name(RttiTypeId, RttiName, BeingDefined) -->
{ rtti_name_linkage(RttiName, Linkage) },
globals__io_get_globals(Globals),
{ c_data_linkage_string(Globals, Linkage, BeingDefined, LinkageStr) },
@@ -375,7 +394,8 @@
rtti_out__init_rtti_data_if_nec(Data) -->
(
- { Data = type_ctor_info(RttiTypeId, _,_,_,_,_,_,_,_,_,_,_,_) }
+ { Data = type_ctor_info(RttiTypeId,
+ _,_,_,_,_,_,_,_,_,_,_,_,_) }
->
io__write_string("\t\tMR_INIT_TYPE_CTOR_INFO(\n\t\t"),
output_rtti_addr(RttiTypeId, type_ctor_info),
@@ -441,57 +461,55 @@
output_data_addr_decls(rtti_addr(RttiTypeId, RttiName),
FirstIndent, LaterIndent, N0, N1, DeclSet0, DeclSet1).
-:- pred output_maybe_rtti_addrs(rtti_type_id::in, list(maybe(rtti_name))::in,
+:- pred output_addr_of_maybe_rtti_addr(rtti_type_id::in, maybe(rtti_name)::in,
io__state::di, io__state::uo) is det.
-output_maybe_rtti_addrs(_, []) --> [].
-output_maybe_rtti_addrs(RttiTypeId, [MaybeRttiName | MaybeRttiNames]) -->
- io__write_string("\t"),
+output_addr_of_maybe_rtti_addr(RttiTypeId, MaybeRttiName) -->
(
{ MaybeRttiName = yes(RttiName) },
- io__write_string("&"),
- output_rtti_addr(RttiTypeId, RttiName)
+ output_addr_of_rtti_addr(RttiTypeId, RttiName)
;
{ MaybeRttiName = no },
io__write_string("NULL")
- ),
- (
- { MaybeRttiNames = [] },
- io__write_string("\n")
- ;
- { MaybeRttiNames = [_|_] },
- io__write_string(",\n"),
- output_maybe_rtti_addrs(RttiTypeId, MaybeRttiNames)
).
-:- pred output_rtti_addrs(rtti_type_id::in, list(rtti_name)::in,
+:- pred output_addr_of_maybe_rtti_addrs(rtti_type_id::in,
+ list(maybe(rtti_name))::in, io__state::di, io__state::uo) is det.
+
+output_addr_of_maybe_rtti_addrs(_, []) --> [].
+output_addr_of_maybe_rtti_addrs(RttiTypeId,
+ [MaybeRttiName | MaybeRttiNames]) -->
+ io__write_string("\t"),
+ io__write_list([MaybeRttiName | MaybeRttiNames], ",\n",
+ output_addr_of_maybe_rtti_addr(RttiTypeId)),
+ io__write_string("\n").
+
+:- pred output_addr_of_rtti_addrs(rtti_type_id::in, list(rtti_name)::in,
io__state::di, io__state::uo) is det.
-output_rtti_addrs(_, []) --> [].
-output_rtti_addrs(RttiTypeId, [RttiName | RttiNames]) -->
- io__write_string("\t&"),
- output_rtti_addr(RttiTypeId, RttiName),
- (
- { RttiNames = [] },
- io__write_string("\n")
- ;
- { RttiNames = [_|_] },
- io__write_string(",\n"),
- output_rtti_addrs(RttiTypeId, RttiNames)
- ).
+output_addr_of_rtti_addrs(_, []) --> [].
+output_addr_of_rtti_addrs(RttiTypeId, [RttiName | RttiNames]) -->
+ io__write_string("\t"),
+ io__write_list([RttiName | RttiNames], ",\n",
+ output_addr_of_rtti_addr(RttiTypeId)),
+ io__write_string("\n").
+
+:- pred output_addr_of_rtti_addr(rtti_type_id::in, rtti_name::in,
+ io__state::di, io__state::uo) is det.
+
+output_addr_of_rtti_addr(RttiTypeId, RttiName) -->
+ io__write_string("&"),
+ output_rtti_addr(RttiTypeId, RttiName).
output_rtti_addr(RttiTypeId, RttiName) -->
io__write_string(mercury_data_prefix),
- { rtti_addr_to_string(RttiTypeId, RttiName, Str) },
+ { rtti__addr_to_string(RttiTypeId, RttiName, Str) },
io__write_string(Str).
-:- pred output_maybe_strings(list(maybe(string))::in,
+:- pred output_maybe_string(maybe(string)::in,
io__state::di, io__state::uo) is det.
-output_maybe_strings([]) -->
- { error("reached empty list of maybe strings") }.
-output_maybe_strings([MaybeName | MaybeNames]) -->
- io__write_string("\t"),
+output_maybe_string(MaybeName) -->
(
{ MaybeName = yes(Name) },
io__write_string(""""),
@@ -500,23 +518,20 @@
;
{ MaybeName = no },
io__write_string("NULL")
- ),
- (
- { MaybeNames = [] },
- io__write_string("\n")
- ;
- { MaybeNames = [_|_] },
- io__write_string(",\n"),
- output_maybe_strings(MaybeNames)
).
-:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
+:- pred output_maybe_strings(list(maybe(string))::in,
io__state::di, io__state::uo) is det.
-output_exist_locns([]) -->
- { error("reached empty list of exist locns") }.
-output_exist_locns([Locn | Locns]) -->
+output_maybe_strings(MaybeNames) -->
io__write_string("\t"),
+ io__write_list(MaybeNames, ",\n\t", output_maybe_string),
+ io__write_string("\n").
+
+:- pred output_exist_locn(exist_typeinfo_locn::in,
+ io__state::di, io__state::uo) is det.
+
+output_exist_locn(Locn) -->
(
{ Locn = plain_typeinfo(SlotInCell) },
io__write_string("{ "),
@@ -529,16 +544,16 @@
io__write_string(", "),
io__write_int(SlotInTci),
io__write_string(" }")
- ),
- (
- { Locns = [] },
- io__write_string("\n")
- ;
- { Locns = [_|_] },
- io__write_string(",\n"),
- output_exist_locns(Locns)
).
+:- pred output_exist_locns(list(exist_typeinfo_locn)::in,
+ io__state::di, io__state::uo) is det.
+
+output_exist_locns(Locns) -->
+ io__write_string("\t"),
+ io__write_list(Locns, ",\n\t", output_exist_locn),
+ io__write_string("\n").
+
:- pred output_maybe_code_addr(maybe(code_addr)::in,
io__state::di, io__state::uo) is det.
@@ -559,7 +574,6 @@
rtti_name_would_include_code_addr(enum_value_ordered_table, no).
rtti_name_would_include_code_addr(du_name_ordered_table, no).
rtti_name_would_include_code_addr(du_stag_ordered_table(_), no).
-rtti_name_would_include_code_addr(du_ptag_layout(_), no).
rtti_name_would_include_code_addr(du_ptag_ordered_table, no).
rtti_name_would_include_code_addr(type_ctor_info, yes).
rtti_name_would_include_code_addr(type_hashcons_pointer, no).
@@ -574,7 +588,6 @@
rtti_name_linkage(enum_value_ordered_table, static).
rtti_name_linkage(du_name_ordered_table, static).
rtti_name_linkage(du_stag_ordered_table(_), static).
-rtti_name_linkage(du_ptag_layout(_), static).
rtti_name_linkage(du_ptag_ordered_table, static).
rtti_name_linkage(type_ctor_info, extern).
rtti_name_linkage(type_hashcons_pointer, static).
@@ -589,8 +602,7 @@
rtti_name_c_type(enum_value_ordered_table, "MR_EnumFunctorDesc *", "[]").
rtti_name_c_type(du_name_ordered_table, "MR_DuFunctorDesc *", "[]").
rtti_name_c_type(du_stag_ordered_table(_), "MR_DuFunctorDesc *", "[]").
-rtti_name_c_type(du_ptag_layout(_), "MR_DuPtagLayout", "").
-rtti_name_c_type(du_ptag_ordered_table, "MR_DuPtagLayout *", "[]").
+rtti_name_c_type(du_ptag_ordered_table, "MR_DuPtagLayout", "[]").
rtti_name_c_type(type_ctor_info, "struct MR_TypeCtorInfo_Struct",
"").
rtti_name_c_type(type_hashcons_pointer, "union MR_TableNode_Union **", "").
diff -rub --exclude CVS ws15.base/compiler/stack_layout.m /home/ender2/zs/ws15/compiler/stack_layout.m
--- ws15.base/compiler/stack_layout.m Sat Feb 26 11:50:27 2000
+++ /home/ender2/zs/ws15/compiler/stack_layout.m Tue Feb 29 14:02:33 2000
@@ -1295,8 +1295,7 @@
% variables that are and aren't in scope; we can take the
% variable number directly from the procedure's tvar set.
ExistQTvars = [],
- base_type_layout__pseudo_typeinfo_max_var(Max),
- NumUnivQTvars = Max - 1,
+ NumUnivQTvars = -1,
base_type_layout__construct_typed_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars, ArgRval, ArgRvalType, CNum0, CNum).
@@ -1363,8 +1362,7 @@
% variables that are and aren't in scope; we can take the
% variable number directly from the procedure's tvar set.
{ ExistQTvars = [] },
- { base_type_layout__pseudo_typeinfo_max_var(Max) },
- { NumUnivQTvars = Max - 1 },
+ { NumUnivQTvars = -1 },
{ base_type_layout__construct_typed_pseudo_type_info(Type,
NumUnivQTvars, ExistQTvars,
Rval, LldsType, CNum0, CNum) },
diff -rub --exclude CVS ws15.base/library/std_util.m /home/ender2/zs/ws15/library/std_util.m
--- ws15.base/library/std_util.m Wed Mar 8 13:49:10 2000
+++ /home/ender2/zs/ws15/library/std_util.m Thu Mar 2 12:11:05 2000
@@ -1183,11 +1183,11 @@
typedef struct ML_Construct_Info_Struct {
ConstString functor_name;
- int arity;
+ Integer arity;
Word *argument_vector;
Word primary_tag; /* version 3 */
Word secondary_tag; /* version 3 */
- int type_ctor_version;
+ Integer type_ctor_version;
MR_TypeCtorRep type_ctor_rep;
union {
Word *functor_descriptor; /* version 3 */
@@ -1594,7 +1594,11 @@
if (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_NOTAG ||
type_ctor_info->type_ctor_rep ==
- MR_TYPECTOR_REP_NOTAG_USEREQ)
+ MR_TYPECTOR_REP_NOTAG_USEREQ ||
+ type_ctor_info->type_ctor_rep ==
+ MR_TYPECTOR_REP_NOTAG_GROUND ||
+ type_ctor_info->type_ctor_rep ==
+ MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ)
{
/*
** We set term_vector to point to
@@ -1657,8 +1661,8 @@
construct_info.primary_tag), new_data);
}
} else {
- /* CHECKME XXXX */
switch (type_ctor_info->type_ctor_rep) {
+
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
new_data = construct_info.functor_info.enum_functor_desc->
@@ -1667,6 +1671,8 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
if (MR_list_is_empty(ArgList)) {
fatal_error(""notag arg list is empty"");
}
@@ -1684,8 +1690,8 @@
{
MR_DuFunctorDesc *functor_desc;
Word arg_list;
- int ptag;
- int arity;
+ Word ptag;
+ Word arity;
int i;
functor_desc = construct_info.functor_info.du_functor_desc;
@@ -1872,6 +1878,8 @@
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
construct_info->functor_info.functor_descriptor =
MR_TYPE_CTOR_FUNCTORS_NO_TAG_FUNCTOR(
@@ -1903,6 +1911,7 @@
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
Word *equiv_type;
@@ -2154,68 +2163,54 @@
ML_get_num_functors(Word type_info)
{
MR_TypeCtorInfo type_ctor_info;
- int functors;
+ Integer functors;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
switch(type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
- if (type_ctor_info->type_ctor_version
- <= MR_RTTI_VERSION__USEREQ)
- {
- functors =
- MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ functors = MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
type_ctor_info->type_ctor_functors);
- } else
- {
- functors =
- type_ctor_info->type_ctor_num_functors;
+ } else {
+ functors = type_ctor_info->type_ctor_num_functors;
}
break;
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
- if (type_ctor_info->type_ctor_version
- <= MR_RTTI_VERSION__USEREQ)
- {
- functors =
- MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
+ functors = MR_TYPE_CTOR_FUNCTORS_DU_NUM_FUNCTORS(
type_ctor_info->type_ctor_functors);
- } else
- {
- functors =
- type_ctor_info->type_ctor_num_functors;
+ } else {
+ functors = type_ctor_info->type_ctor_num_functors;
}
break;
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
functors = 1;
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV:
- if (type_ctor_info->type_ctor_version
- <= MR_RTTI_VERSION__USEREQ)
- {
+ if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
Word *equiv_type;
- equiv_type = (Word *)
- MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
- type_ctor_info->
- type_ctor_functors);
- functors = ML_get_num_functors((Word)
- MR_create_type_info(
- (Word *) type_info,
- equiv_type));
+
+ equiv_type = (Word *) MR_TYPE_CTOR_FUNCTORS_EQUIV_TYPE(
+ type_ctor_info-> type_ctor_functors);
+ functors = ML_get_num_functors((Word) MR_create_type_info(
+ (Word *) type_info, equiv_type));
} else {
Word *equiv_type;
- equiv_type = (Word *) type_ctor_info->
- type_layout.layout_equiv;
- functors = ML_get_num_functors((Word)
- MR_create_type_info(
- (Word *) type_info,
- equiv_type));
+
+ equiv_type = (Word *) type_ctor_info->type_layout.layout_equiv;
+ functors = ML_get_num_functors((Word) MR_create_type_info(
+ (Word *) type_info, equiv_type));
}
break;
@@ -2349,13 +2344,15 @@
MR_TypeCtorInfo type_ctor_info;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
- expand_info->non_canonical_type = ( type_ctor_info->compare_pred ==
- ENTRY(mercury__builtin_compare_non_canonical_type_3_0) );
+ expand_info->non_canonical_type = FALSE;
switch(type_ctor_info->type_ctor_rep) {
- case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
+ expand_info->non_canonical_type = TRUE;
+ /* fall through */
+
+ case MR_TYPECTOR_REP_ENUM:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
Word data_value;
@@ -2388,8 +2385,11 @@
}
break;
- case MR_TYPECTOR_REP_DU:
case MR_TYPECTOR_REP_DU_USEREQ:
+ expand_info->non_canonical_type = TRUE;
+ /* fall through */
+
+ case MR_TYPECTOR_REP_DU:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
Word data_value;
@@ -2483,14 +2483,14 @@
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
const MR_DuExistInfo *exist_info;
- int data;
+ Word data;
int ptag;
- int sectag;
+ Word sectag;
Word *arg_vector;
data = *data_word_ptr;
ptag = MR_tag(data);
- ptag_layout = type_ctor_info->type_layout.layout_du[ptag];
+ ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_NONE:
@@ -2535,20 +2535,29 @@
expand_info->arity);
for (i = 0; i < expand_info->arity; i++) {
- expand_info->type_info_vector[i] =
- (Word) MR_create_type_info_maybe_existq(
- type_info, (Word *)
- functor_desc->MR_du_functor_arg_types[i],
+ if (MR_arg_type_may_contain_var(functor_desc, i)) {
+ expand_info->type_info_vector[i] = (Word)
+ MR_create_type_info_maybe_existq(
+ type_info, (Word *) functor_desc->
+ MR_du_functor_arg_types[i],
(Word *) MR_body(data, ptag),
type_ctor_info->type_ctor_version,
- (const MR_DuFunctorDesc *) functor_desc);
+ (const MR_DuFunctorDesc *)
+ functor_desc);
+ } else {
+ expand_info->type_info_vector[i] = (Word)
+ functor_desc->MR_du_functor_arg_types[i];
+ }
}
}
}
break;
- case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ expand_info->non_canonical_type = TRUE;
+ /* fall through */
+
+ case MR_TYPECTOR_REP_NOTAG:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
Word data_value;
@@ -2627,6 +2636,29 @@
}
break;
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ expand_info->non_canonical_type = TRUE;
+ /* fall through */
+
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ expand_info->arity = 1;
+ expand_info->num_extra_args = 0;
+
+ if (expand_info->need_functor) {
+ MR_make_aligned_string(expand_info->functor,
+ type_ctor_info->type_layout.layout_notag
+ ->MR_notag_functor_name);
+ }
+
+ if (expand_info->need_args) {
+ expand_info->argument_vector = data_word_ptr;
+ expand_info->type_info_vector = MR_GC_NEW_ARRAY(Word, 1);
+ expand_info->type_info_vector[0] =
+ type_ctor_info->type_layout.layout_notag->
+ MR_notag_functor_arg_type;
+ }
+ break;
+
case MR_TYPECTOR_REP_EQUIV:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
@@ -2656,6 +2688,11 @@
}
break;
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ ML_expand((Word *) type_ctor_info->type_layout.layout_equiv,
+ data_word_ptr, expand_info);
+ break;
+
case MR_TYPECTOR_REP_EQUIV_VAR:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
@@ -2764,6 +2801,7 @@
break;
case MR_TYPECTOR_REP_PRED:
+ /* XXX expand_info->non_canonical_type = TRUE; */
if (expand_info->need_functor) {
MR_make_aligned_string(expand_info->functor,
""<<predicate>>"");
@@ -2795,6 +2833,7 @@
fatal_error(""ML_expand: cannot expand void types"");
case MR_TYPECTOR_REP_C_POINTER:
+ /* XXX expand_info->non_canonical_type = TRUE; */
if (expand_info->need_functor) {
MR_make_aligned_string(expand_info->functor,
""<<c_pointer>>"");
@@ -2806,6 +2845,7 @@
break;
case MR_TYPECTOR_REP_TYPEINFO:
+ /* XXX expand_info->non_canonical_type = TRUE; */
if (expand_info->need_functor) {
MR_make_aligned_string(expand_info->functor, ""<<typeinfo>>"");
}
@@ -2817,6 +2857,7 @@
break;
case MR_TYPECTOR_REP_TYPECLASSINFO:
+ /* XXX expand_info->non_canonical_type = TRUE; */
if (expand_info->need_functor) {
MR_make_aligned_string(expand_info->functor,
""<<typeclassinfo>>"");
diff -rub --exclude CVS ws15.base/runtime/mercury_bootstrap.h /home/ender2/zs/ws15/runtime/mercury_bootstrap.h
--- ws15.base/runtime/mercury_bootstrap.h Sat Feb 26 11:51:53 2000
+++ /home/ender2/zs/ws15/runtime/mercury_bootstrap.h Tue Feb 29 13:50:04 2000
@@ -21,6 +21,8 @@
** but you can disable it by defining MR_NO_BACKWARDS_COMPAT.
*/
+#define MR_TypeCtorInfo_struct MR_TypeCtorInfo_Struct
+
#ifndef MR_NO_BACKWARDS_COMPAT
#define COMPARE_EQUAL MR_COMPARE_EQUAL
diff -rub --exclude CVS ws15.base/runtime/mercury_deep_copy_body.h /home/ender2/zs/ws15/runtime/mercury_deep_copy_body.h
--- ws15.base/runtime/mercury_deep_copy_body.h Sat Feb 26 11:51:53 2000
+++ /home/ender2/zs/ws15/runtime/mercury_deep_copy_body.h Wed Mar 1 12:49:43 2000
@@ -34,6 +34,8 @@
MR_TypeCtorInfo type_ctor_info;
data = *data_ptr;
+
+try_again:
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (type_ctor_info->type_ctor_rep) {
@@ -198,13 +200,12 @@
}
}
} else {
- /* XXX CHECKME */
MR_DuPtagLayout *ptag_layout;
int ptag;
Word *data_value;
ptag = MR_tag(data);
- ptag_layout = type_ctor_info->type_layout.layout_du[ptag];
+ ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_LOCAL:
@@ -219,8 +220,7 @@
** Since speed is important, we duplicate the code downstream
** of the first test of each kind. To avoid double maintenance
** problems, the stuff that is duplicated is macro invocations;
- ** each macro is of course defined only once. Note that the
- ** initial and final macros have unbalanced parentheses.
+ ** each macro is of course defined only once.
*/
/*
@@ -288,12 +288,19 @@
** }
**
** for (i = 0; i < arity; i++) {
+** if (MR_arg_type_may_contain_var(functor_desc, i)) {
** MR_field(0, new_data, cur_slot) =
** copy_arg(data_value, &data_value[cur_slot],
** type_ctor_info->type_ctor_version,
** functor_desc, type_info, (const Word *)
** functor_desc->MR_du_functor_arg_types[i],
** lower_limit, upper_limit);
+** } else {
+** MR_field(0, new_data, cur_slot) =
+** copy(&data_value[cur_slot], (const Word *)
+** functor_desc->MR_du_functor_arg_types[i],
+** lower_limit, upper_limit);
+** }
** cur_slot++;
** }
**
@@ -306,9 +313,11 @@
** break;
*/
-#define MR_DC_initial \
- data_value = (Word *) MR_body(data, ptag); \
- if (in_range(data_value)) { \
+/*
+** IMPORTANT: the macros below should be kept in sync with the comment above.
+*/
+
+#define MR_DC_decl \
const MR_DuFunctorDesc *functor_desc; \
const MR_DuExistInfo *exist_info; \
int sectag; \
@@ -347,26 +356,31 @@
#define MR_DC_copy_plain_args \
for (i = 0; i < arity; i++) { \
+ if (MR_arg_type_may_contain_var(functor_desc, i)) { \
MR_field(0, new_data, cur_slot) = \
copy_arg(data_value, &data_value[cur_slot], \
type_ctor_info->type_ctor_version, \
functor_desc, type_info, (const Word *) \
functor_desc->MR_du_functor_arg_types[i],\
lower_limit, upper_limit); \
+ } else { \
+ MR_field(0, new_data, cur_slot) = \
+ copy(&data_value[cur_slot], (const Word *) \
+ functor_desc->MR_du_functor_arg_types[i],\
+ lower_limit, upper_limit); \
+ } \
cur_slot++; \
}
-#define MR_DC_final \
- new_data = (Word) MR_mkword(ptag, new_data); \
- leave_forwarding_pointer(data_ptr, new_data); \
- } else { \
- new_data = data; \
- found_forwarding_pointer(data); \
- } \
- break;
+ /*
+ ** IMPORTANT: the code below should be kept in sync
+ ** with the comment above.
+ */
case MR_SECTAG_REMOTE:
- MR_DC_initial
+ data_value = (Word *) MR_body(data, ptag);
+ if (in_range(data_value)) {
+ MR_DC_decl
sectag = data_value[0];
MR_DC_functor_desc
cell_size = 1 + arity;
@@ -383,10 +397,24 @@
cur_slot = 1;
}
MR_DC_copy_plain_args
- MR_DC_final
+
+ new_data = (Word) MR_mkword(ptag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
+
+ /*
+ ** IMPORTANT: the code below should be kept in sync
+ ** with the comment above.
+ */
case MR_SECTAG_NONE:
- MR_DC_initial
+ data_value = (Word *) MR_body(data, ptag);
+ if (in_range(data_value)) {
+ MR_DC_decl
sectag = 0;
MR_DC_functor_desc
cell_size = arity;
@@ -400,7 +428,14 @@
cur_slot = 0;
}
MR_DC_copy_plain_args
- MR_DC_final
+
+ new_data = (Word) MR_mkword(ptag, new_data);
+ leave_forwarding_pointer(data_ptr, new_data);
+ } else {
+ new_data = data;
+ found_forwarding_pointer(data);
+ }
+ break;
}
}
break;
@@ -423,7 +458,6 @@
(Word *) *MR_TYPE_CTOR_LAYOUT_NO_TAG_VECTOR_ARGS(
entry_value), lower_limit, upper_limit);
} else {
- /* XXX CHECKME */
new_data = copy_arg(NULL, data_ptr,
type_ctor_info->type_ctor_version, NULL, type_info,
(const Word *) type_ctor_info->type_layout.layout_notag->
@@ -431,6 +465,13 @@
}
break;
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ type_info = (const Word *) type_ctor_info->type_layout.layout_notag->
+ MR_notag_functor_arg_type;
+ goto try_again;
+ break;
+
case MR_TYPECTOR_REP_EQUIV:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
Word layout_entry;
@@ -448,7 +489,6 @@
(const Word *) MR_TYPE_CTOR_LAYOUT_EQUIV_TYPE((Word *)
entry_value), lower_limit, upper_limit);
} else {
- /* XXX CHECKME */
new_data = copy_arg(NULL, data_ptr,
type_ctor_info->type_ctor_version, NULL, type_info,
(const Word *) type_ctor_info->type_layout.layout_equiv,
@@ -456,6 +496,11 @@
}
break;
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ type_info = (const Word *) type_ctor_info->type_layout.layout_equiv;
+ goto try_again;
+ break;
+
case MR_TYPECTOR_REP_EQUIV_VAR:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
Word layout_entry;
@@ -489,11 +534,9 @@
#ifdef BOXED_FLOAT
{
Word *data_value;
- int data_tag;
- /* XXX simplify: tag should be zero */
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
+ assert(MR_tag(data) == 0);
+ data_value = (Word *) MR_body(data, MR_mktag(0));
if (in_range(data_value)) {
restore_transient_hp();
@@ -513,9 +556,14 @@
case MR_TYPECTOR_REP_STRING:
{
Word *data_value;
- int data_tag;
+ Word data_tag;
+
+ /*
+ ** Not all Mercury strings are aligned; in particular,
+ ** string constants containing the empty string may be
+ ** allocated unaligned storage by the C compiler.
+ */
- /* XXX simplify: tag should be zero */
data_tag = MR_tag(data);
data_value = (Word *) MR_body(data, data_tag);
@@ -534,11 +582,9 @@
case MR_TYPECTOR_REP_PRED:
{
Word *data_value;
- int data_tag;
- /* XXX simplify: tag should be zero */
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
+ assert(MR_tag(data) == 0);
+ data_value = (Word *) MR_body(data, MR_mktag(0));
/*
** predicate closures store the number of curried arguments
@@ -592,11 +638,9 @@
case MR_TYPECTOR_REP_UNIV:
{
Word *data_value;
- int data_tag;
- /* XXX simplify: tag should be zero */
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
+ assert(MR_tag(data) == 0);
+ data_value = (Word *) MR_body(data, MR_mktag(0));
/* if the univ is stored in range, copy it */
if (in_range(data_value)) {
@@ -635,12 +679,10 @@
case MR_TYPECTOR_REP_ARRAY:
{
Word *data_value;
- int data_tag;
int i;
- /* XXX simplify: tag should be zero */
- data_tag = MR_tag(data);
- data_value = (Word *) MR_body(data, data_tag);
+ assert(MR_tag(data) == 0);
+ data_value = (Word *) MR_body(data, MR_mktag(0));
if (in_range(data_value)) {
MR_ArrayType *new_array;
diff -rub --exclude CVS ws15.base/runtime/mercury_ho_call.c /home/ender2/zs/ws15/runtime/mercury_ho_call.c
--- ws15.base/runtime/mercury_ho_call.c Sat Feb 26 11:51:54 2000
+++ /home/ender2/zs/ws15/runtime/mercury_ho_call.c Mon Mar 6 14:52:28 2000
@@ -207,7 +207,10 @@
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_EQUIV:
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV_VAR:
/*
@@ -396,7 +399,10 @@
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_EQUIV:
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV_VAR:
case MR_TYPECTOR_REP_ARRAY:
@@ -554,7 +560,10 @@
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_EQUIV:
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_EQUIV_VAR:
case MR_TYPECTOR_REP_ARRAY:
diff -rub --exclude CVS ws15.base/runtime/mercury_tabling.c /home/ender2/zs/ws15/runtime/mercury_tabling.c
--- ws15.base/runtime/mercury_tabling.c Sat Feb 26 11:51:54 2000
+++ /home/ender2/zs/ws15/runtime/mercury_tabling.c Thu Mar 2 12:13:34 2000
@@ -738,20 +738,19 @@
MR_deallocate(allocated_memory_cells);
}
} else {
- /* XXX CHECKME */
MR_MemoryList allocated_memory_cells = NULL;
const MR_DuPtagLayout *ptag_layout;
const MR_DuFunctorDesc *functor_desc;
const MR_DuExistInfo *exist_info;
Word *arg_type_info;
int ptag;
- int sectag;
+ Word sectag;
Word *arg_vector;
int meta_args;
int i;
ptag = MR_tag(data);
- ptag_layout = type_ctor_info->type_layout.layout_du[ptag];
+ ptag_layout = &type_ctor_info->type_layout.layout_du[ptag];
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_NONE:
@@ -793,11 +792,17 @@
}
for (i = 0; i < functor_desc->MR_du_functor_orig_arity; i++) {
- arg_type_info = MR_make_type_info_maybe_existq(type_info,
+ if (MR_arg_type_may_contain_var(functor_desc, i)) {
+ arg_type_info = MR_make_type_info_maybe_existq(
+ type_info,
(Word *) functor_desc->MR_du_functor_arg_types[i],
(Word *) MR_body(data, ptag),
type_ctor_info->type_ctor_version,
functor_desc, &allocated_memory_cells);
+ } else {
+ arg_type_info = (Word *)
+ functor_desc->MR_du_functor_arg_types[i];
+ }
MR_DEBUG_TABLE_ANY(table, arg_type_info,
arg_vector[meta_args + i]);
@@ -827,7 +832,6 @@
MR_DEBUG_TABLE_ANY(table, new_type_info, data);
MR_deallocate(allocated_memory_cells);
} else {
- /* XXX CHECKME */
MR_MemoryList allocated_memory_cells = NULL;
Word *eqv_type_info;
@@ -839,6 +843,12 @@
}
break;
+ case MR_TYPECTOR_REP_NOTAG_GROUND:
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ MR_DEBUG_TABLE_ANY(table, (Word *) type_ctor_info->type_layout.
+ layout_notag->MR_notag_functor_arg_type, data);
+ break;
+
case MR_TYPECTOR_REP_EQUIV:
if (type_ctor_info->type_ctor_version <= MR_RTTI_VERSION__USEREQ) {
MR_TypeCtorLayout type_ctor_layout;
@@ -857,7 +867,6 @@
MR_DEBUG_TABLE_ANY(table, new_type_info, data);
MR_deallocate(allocated_memory_cells);
} else {
- /* XXX CHECKME */
MR_MemoryList allocated_memory_cells = NULL;
Word *eqv_type_info;
@@ -867,6 +876,11 @@
MR_DEBUG_TABLE_ANY(table, eqv_type_info, data);
MR_deallocate(allocated_memory_cells);
}
+ break;
+
+ case MR_TYPECTOR_REP_EQUIV_GROUND:
+ MR_DEBUG_TABLE_ANY(table, (Word *) type_ctor_info->type_layout.
+ layout_equiv, data);
break;
case MR_TYPECTOR_REP_EQUIV_VAR:
diff -rub --exclude CVS ws15.base/runtime/mercury_type_info.c /home/ender2/zs/ws15/runtime/mercury_type_info.c
--- ws15.base/runtime/mercury_type_info.c Sat Feb 26 11:51:54 2000
+++ /home/ender2/zs/ws15/runtime/mercury_type_info.c Mon Feb 28 13:24:04 2000
@@ -60,6 +60,10 @@
** to change the code in MR_make_type_info in this module
** which does much the same thing, only allocating using MR_GC_malloc()
** instead of on the Mercury heap.
+ **
+ ** The rtti version number we pass in the call below is a placeholder;
+ ** its value does not matter because the functor_desc we pass, whose
+ ** format it describes, is NULL.
*/
Word *
@@ -83,6 +87,10 @@
** or if the arg_pseudo_type_info does not contain any
** existentially typed type variables, then it is OK
** for the data_value and functor_desc to be NULL.
+ **
+ ** XXX The rtti_version argument is only temporary; it should not be
+ ** needed once we have bootstrapped the CLEAN_LAYOUT change and
+ ** dropped support for older type_ctor_info versions.
*/
Word *
@@ -393,8 +401,9 @@
maybe_equiv_type_info);
/* Look past equivalences */
- while (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV
- || type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV_VAR)
+ while (type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV_GROUND
+ || type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV_VAR
+ || type_ctor_info->type_ctor_rep == MR_TYPECTOR_REP_EQUIV)
{
if (type_ctor_info->type_ctor_version <=
MR_RTTI_VERSION__USEREQ)
diff -rub --exclude CVS ws15.base/runtime/mercury_type_info.h /home/ender2/zs/ws15/runtime/mercury_type_info.h
--- ws15.base/runtime/mercury_type_info.h Sat Feb 26 11:51:54 2000
+++ /home/ender2/zs/ws15/runtime/mercury_type_info.h Tue Feb 29 17:11:13 2000
@@ -91,10 +91,11 @@
** may also store free type variables, represented as small integers:
** 1 to 512 represent universally quantified type variables
** and 513 to 1024 represent existentially quantified type variables.
-** (We do not use zero to, for two reasons. First, variable numbering
-** starts at one inside the compiler. Second, starting at one allows us
-** to use universally quantified type variable numbers to be used directly
-** as the offset into a (non-higher-order) typeinfo.
+** (We do not use zero to represent any type variable, for two reasons.
+** First, variable numbering starts at one inside the compiler. Second,
+** starting at one allows us to use universally quantified type variable
+** numbers to be used directly as the offset into a (non-higher-order)
+** typeinfo.
**
** This scheme relies on the bit patterns of these integers corresponding
** to memory that is either inaccessible (due to the first page of virtual
@@ -232,39 +233,6 @@
#define TYPE_CTOR_LAYOUT_NO_TAG 3
/*
-** Values in type_layout structures,
-** presently the values of CONST_TAG words.
-**
-** Also intended for use in handwritten C code.
-**
-** Note that MR_TYPE_CTOR_LAYOUT_UNASSIGNED_VALUE is not yet
-** used for anything.
-**
-** Changes in this type may need to be reflected in
-** compiler/base_type_layout.m.
-**
-** XXX This stuff is part of USEREQ type_ctor_infos and is obsolete;
-** it is needed now only for bootstrapping.
-*/
-
-enum MR_TypeLayoutValue {
- MR_TYPE_CTOR_LAYOUT_UNASSIGNED_VALUE,
- MR_TYPE_CTOR_LAYOUT_UNUSED_VALUE,
- MR_TYPE_CTOR_LAYOUT_STRING_VALUE,
- MR_TYPE_CTOR_LAYOUT_FLOAT_VALUE,
- MR_TYPE_CTOR_LAYOUT_INT_VALUE,
- MR_TYPE_CTOR_LAYOUT_CHARACTER_VALUE,
- MR_TYPE_CTOR_LAYOUT_UNIV_VALUE,
- MR_TYPE_CTOR_LAYOUT_PREDICATE_VALUE,
- MR_TYPE_CTOR_LAYOUT_VOID_VALUE,
- MR_TYPE_CTOR_LAYOUT_ARRAY_VALUE,
- MR_TYPE_CTOR_LAYOUT_TYPEINFO_VALUE,
- MR_TYPE_CTOR_LAYOUT_C_POINTER_VALUE,
- MR_TYPE_CTOR_LAYOUT_TYPECLASSINFO_VALUE,
- MR_TYPE_CTOR_LAYOUT_UNWANTED_VALUE
-};
-
-/*
** This constant is also used for other information - for
** ctor infos a small integer is used for higher order types.
** Even integers represent preds, odd represent functions.
@@ -377,8 +345,6 @@
** mercury_date__type_ctor_info_void_0, mercury__unused_0_0);
**
** This will initialize a type_ctor_info with a single code address.
-**
-**
*/
#ifndef MR_STATIC_CODE_ADDRESSES
@@ -771,6 +737,9 @@
MR_TYPECTOR_REP_REDOIP,
MR_TYPECTOR_REP_TRAIL_PTR,
MR_TYPECTOR_REP_TICKET,
+ MR_TYPECTOR_REP_NOTAG_GROUND,
+ MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ,
+ MR_TYPECTOR_REP_EQUIV_GROUND,
/*
** MR_TYPECTOR_REP_UNKNOWN should remain the last alternative;
** MR_CTOR_REP_STATS depends on this.
@@ -778,13 +747,54 @@
MR_TYPECTOR_REP_UNKNOWN
} MR_TypeCtorRep;
+/*
+** This macro is intended to be used for the initialization of an array
+** that converts each MR_TypeCtorRep into a string form. Therefore it
+** must be kept synchronized with the definition of MR_TypeCtorRep.
+*/
+
+#define MR_CTOR_REP_NAMES \
+ "ENUM", \
+ "ENUM_USEREQ", \
+ "DU", \
+ "DU_USEREQ", \
+ "NOTAG", \
+ "NOTAG_USEREQ", \
+ "EQUIV", \
+ "EQUIV_VAR", \
+ "INT", \
+ "CHAR", \
+ "FLOAT", \
+ "STRING", \
+ "PRED", \
+ "UNIV", \
+ "VOID", \
+ "C_POINTER", \
+ "TYPEINFO", \
+ "TYPECLASSINFO", \
+ "ARRAY", \
+ "SUCCIP", \
+ "HP", \
+ "CURFR", \
+ "MAXFR", \
+ "REDOFR", \
+ "REDOIP", \
+ "TRAIL_PTR", \
+ "TICKET", \
+ "NOTAG_GROUND", \
+ "NOTAG_GROUND_USEREQ", \
+ "EQUIV_GROUND", \
+ "UNKNOWN"
+
#define MR_type_ctor_rep_is_basically_du(rep) \
( ((rep) == MR_TYPECTOR_REP_ENUM) \
|| ((rep) == MR_TYPECTOR_REP_ENUM_USEREQ) \
|| ((rep) == MR_TYPECTOR_REP_DU) \
|| ((rep) == MR_TYPECTOR_REP_DU_USEREQ) \
|| ((rep) == MR_TYPECTOR_REP_NOTAG) \
- || ((rep) == MR_TYPECTOR_REP_NOTAG_USEREQ) )
+ || ((rep) == MR_TYPECTOR_REP_NOTAG_USEREQ) \
+ || ((rep) == MR_TYPECTOR_REP_NOTAG_GROUND) \
+ || ((rep) == MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ))
/*
** If the MR_TypeCtorRep is MR_TYPE_CTOR_REP_DU{,_USEREQ},
@@ -823,11 +833,6 @@
/*---------------------------------------------------------------------------*/
/*
-** XXX The sizes of the Integers below requires more thought;
-** 16 bits may be enough for some fields, and 32 for the others.
-*/
-
-/*
** The argument number gives the offset in the cell (in a form in which
** it can be given to the MR_field macro directly) of either of the typeinfo
** itself or of the typeclassinfo containing the typeinfo. If the former,
@@ -868,9 +873,9 @@
*/
typedef struct {
- Integer MR_exist_typeinfos_plain;
- Integer MR_exist_typeinfos_in_tci;
- Integer MR_exist_tcis;
+ MR_int_least16_t MR_exist_typeinfos_plain;
+ MR_int_least16_t MR_exist_typeinfos_in_tci;
+ MR_int_least16_t MR_exist_tcis;
const MR_DuExistLocn *MR_exist_typeinfo_locns;
} MR_DuExistInfo;
@@ -903,6 +908,14 @@
** The arg_types field points to an array of pseudo typeinfos, one for each
** visible argument.
**
+** The arg_type_contains_var field contains a bit vector which has one bit
+** for each of the first N (currently N=16) arguments. This bit is set iff
+** the type of the corresponding argument contains a type variable.
+** This field is meant to be used only via the MR_arg_type_may_contain_var
+** and MR_any_arg_type_may_contain_var macros below. In the absence of
+** compiler-recorded information, these macros return conservative answers
+** for any argument whose type is not represented in this bit vector.
+**
** The arg_name field points to an array of field names, one for each
** visible argument. If no argument has a name, this field will be NULL.
**
@@ -919,16 +932,36 @@
typedef struct {
ConstString MR_du_functor_name;
- Integer MR_du_functor_primary;
- Integer MR_du_functor_secondary;
+ MR_int_least16_t MR_du_functor_orig_arity;
+ MR_int_least16_t MR_du_functor_arg_type_contains_var;
MR_Sectag_Locn MR_du_functor_sectag_locn;
+ MR_int_least8_t MR_du_functor_primary;
+ Integer MR_du_functor_secondary;
Integer MR_du_functor_ordinal;
- Integer MR_du_functor_orig_arity;
MR_PseudoTypeInfo *MR_du_functor_arg_types;
const ConstString *MR_du_functor_arg_names;
const MR_DuExistInfo *MR_du_functor_exist_info;
} MR_DuFunctorDesc;
+/*
+** This macro represents the number of bits in the
+** MR_du_functor_arg_type_contains_var field of a MR_DuFunctorDesc.
+** It should be kept in sync with contains_var_bit_vector_size
+** in base_type_layout.m.
+*/
+
+#define MR_ARG_TYPE_CONTAINS_VAR_BIT_VECTOR_SIZE 16
+
+#define MR_arg_type_may_contain_var(functor_desc, arg_num) \
+ (arg_num >= MR_ARG_TYPE_CONTAINS_VAR_BIT_VECTOR_SIZE || \
+ (functor_desc->MR_du_functor_arg_type_contains_var & (1 << arg_num)) \
+ != 0)
+
+#define MR_any_arg_type_may_contain_var(functor_desc) \
+ (functor_desc->MR_du_functor_orig_arity > \
+ MR_ARG_TYPE_CONTAINS_VAR_BIT_VECTOR_SIZE || \
+ functor_desc->MR_du_functor_arg_type_contains_var > 0)
+
/*---------------------------------------------------------------------------*/
typedef struct {
@@ -957,11 +990,10 @@
** the alternatives field with zero; if it is MR_SECTAG_{LOCAL,REMOTE}, you
** compute the secondary tag and index the alternatives field with that.
**
-** A value of type MR_DuTypeLayout points to an array of size MR_PTAG_VALUES,
-** each element of which points to the MR_DuPtagLayout structure for the
-** ptag value given by the index.
-**
-** XXX maybe the array should contain the structures themselves, not pointers.
+** A value of type MR_DuTypeLayout points to an array of MR_DuPtagLayout
+** structures. The element at index k gives information primary tag value k.
+** The size of the array is recorded in the num_ptags field of the
+** type_ctor_info.
*/
typedef struct {
@@ -970,9 +1002,7 @@
MR_DuFunctorDesc **MR_sectag_alternatives;
} MR_DuPtagLayout;
-#define MR_PTAG_VALUES (1 << LOW_TAG_BITS)
-
-typedef MR_DuPtagLayout **MR_DuTypeLayout;
+typedef MR_DuPtagLayout *MR_DuTypeLayout;
/*---------------------------------------------------------------------------*/
@@ -1015,7 +1045,7 @@
**
** The intention is that if you have a word in an equivalence type that you
** want to interpret, you expand the pseudo typeinfo into a real typeinfo,
-** use that to interpret the word.
+** and then use that to interpret the word.
*/
typedef MR_PseudoTypeInfo MR_EquivLayout;
@@ -1026,6 +1056,8 @@
** This type describes the layout in any kind of discriminated union
** type: du, enum and notag. In an equivalence type, it gives the identity
** of the equivalent-to type.
+**
+** The layout_init alternative is used only for initialization.
*/
typedef union {
@@ -1049,6 +1081,8 @@
**
** The intention is that if you have a function symbol you want to represent,
** you can do binary search on the array for the symbol name and arity.
+**
+** The functors_init alternative is used only for initialization.
*/
typedef union {
@@ -1070,8 +1104,6 @@
** offset macros defines near the top of this file.
*/
-#define MR_TypeCtorInfo_struct MR_TypeCtorInfo_Struct
-
struct MR_TypeCtorInfo_Struct {
Integer arity;
Code *unify_pred;
@@ -1092,11 +1124,16 @@
ConstString type_ctor_module_name;
ConstString type_ctor_name;
Integer type_ctor_version;
+ Integer type_ctor_num_ptags; /* if DU */
Integer type_ctor_num_functors;
MR_TypeFunctors type_functors;
MR_TypeLayout type_layout;
- union MR_TableNode_Union **type_std_table;
- Code *prettyprinter;
+
+/*
+** The following fields will be added later, once we can exploit them:
+** union MR_TableNode_Union **type_std_table;
+** Code *prettyprinter;
+*/
};
typedef struct MR_TypeCtorInfo_Struct *MR_TypeCtorInfo;
@@ -1125,10 +1162,9 @@
MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),\
MR_RTTI_VERSION, \
-1, \
+ -1, \
{ 0 }, \
- { 0 }, \
- NULL, \
- NULL \
+ { 0 } \
}
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, i, c) \
diff -rub --exclude CVS ws15.base/runtime/mercury_wrapper.c /home/ender2/zs/ws15/runtime/mercury_wrapper.c
--- ws15.base/runtime/mercury_wrapper.c Sat Feb 26 11:51:54 2000
+++ /home/ender2/zs/ws15/runtime/mercury_wrapper.c Sun Feb 27 10:56:29 2000
@@ -214,6 +214,9 @@
#ifdef MEASURE_REGISTER_USAGE
static void print_register_usage_counts(void);
#endif
+#ifdef MR_CTOR_REP_STATS
+static void MR_print_type_ctor_stats(void);
+#endif
Declare_entry(do_interpreter);
@@ -919,186 +922,7 @@
}
#ifdef MR_CTOR_REP_STATS
- {
- FILE *fp;
-
- fp = fopen(MR_CTOR_REP_STATS, "a");
- if (fp != NULL) {
- fprintf(fp, "UNIFY ENUM %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_ENUM]);
- fprintf(fp, "UNIFY ENUM_USEREQ %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_ENUM_USEREQ]);
- fprintf(fp, "UNIFY DU %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_DU]);
- fprintf(fp, "UNIFY DU_USEREQ %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_DU_USEREQ]);
- fprintf(fp, "UNIFY NOTAG %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_NOTAG]);
- fprintf(fp, "UNIFY NOTAG_USEREQ %ld\n",
- MR_ctor_rep_unify[
- MR_TYPECTOR_REP_NOTAG_USEREQ]);
- fprintf(fp, "UNIFY EQUIV %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_EQUIV]);
- fprintf(fp, "UNIFY EQUIV_VAR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_EQUIV_VAR]);
- fprintf(fp, "UNIFY INT %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_INT]);
- fprintf(fp, "UNIFY CHAR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_CHAR]);
- fprintf(fp, "UNIFY FLOAT %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_FLOAT]);
- fprintf(fp, "UNIFY STRING %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_STRING]);
- fprintf(fp, "UNIFY PRED %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_PRED]);
- fprintf(fp, "UNIFY UNIV %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_UNIV]);
- fprintf(fp, "UNIFY VOID %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_VOID]);
- fprintf(fp, "UNIFY C_POINTER %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_C_POINTER]);
- fprintf(fp, "UNIFY TYPEINFO %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_TYPEINFO]);
- fprintf(fp, "UNIFY TYPECLASSINFO %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_TYPECLASSINFO]);
- fprintf(fp, "UNIFY ARRAY %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_ARRAY]);
- fprintf(fp, "UNIFY SUCCIP %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_SUCCIP]);
- fprintf(fp, "UNIFY HP %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_HP]);
- fprintf(fp, "UNIFY CURFR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_CURFR]);
- fprintf(fp, "UNIFY MAXFR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_MAXFR]);
- fprintf(fp, "UNIFY REDOFR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_REDOFR]);
- fprintf(fp, "UNIFY REDOIP %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_REDOIP]);
- fprintf(fp, "UNIFY TRAIL_PTR %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_TRAIL_PTR]);
- fprintf(fp, "UNIFY TICKET %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_TICKET]);
- fprintf(fp, "UNIFY UNKNOWN %ld\n",
- MR_ctor_rep_unify[MR_TYPECTOR_REP_UNKNOWN]);
-
- fprintf(fp, "INDEX ENUM %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_ENUM]);
- fprintf(fp, "INDEX ENUM_USEREQ %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_ENUM_USEREQ]);
- fprintf(fp, "INDEX DU %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_DU]);
- fprintf(fp, "INDEX DU_USEREQ %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_DU_USEREQ]);
- fprintf(fp, "INDEX NOTAG %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_NOTAG]);
- fprintf(fp, "INDEX NOTAG_USEREQ %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_NOTAG_USEREQ]);
- fprintf(fp, "INDEX EQUIV %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_EQUIV]);
- fprintf(fp, "INDEX EQUIV_VAR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_EQUIV_VAR]);
- fprintf(fp, "INDEX INT %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_INT]);
- fprintf(fp, "INDEX CHAR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_CHAR]);
- fprintf(fp, "INDEX FLOAT %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_FLOAT]);
- fprintf(fp, "INDEX STRING %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_STRING]);
- fprintf(fp, "INDEX PRED %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_PRED]);
- fprintf(fp, "INDEX UNIV %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_UNIV]);
- fprintf(fp, "INDEX VOID %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_VOID]);
- fprintf(fp, "INDEX C_POINTER %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_C_POINTER]);
- fprintf(fp, "INDEX TYPEINFO %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_TYPEINFO]);
- fprintf(fp, "INDEX TYPECLASSINFO %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_TYPECLASSINFO]);
- fprintf(fp, "INDEX ARRAY %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_ARRAY]);
- fprintf(fp, "INDEX SUCCIP %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_SUCCIP]);
- fprintf(fp, "INDEX HP %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_HP]);
- fprintf(fp, "INDEX CURFR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_CURFR]);
- fprintf(fp, "INDEX MAXFR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_MAXFR]);
- fprintf(fp, "INDEX REDOFR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_REDOFR]);
- fprintf(fp, "INDEX REDOIP %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_REDOIP]);
- fprintf(fp, "INDEX TRAIL_PTR %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_TRAIL_PTR]);
- fprintf(fp, "INDEX TICKET %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_TICKET]);
- fprintf(fp, "INDEX UNKNOWN %ld\n",
- MR_ctor_rep_index[MR_TYPECTOR_REP_UNKNOWN]);
-
- fprintf(fp, "COMPARE ENUM %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_ENUM]);
- fprintf(fp, "COMPARE ENUM_USEREQ %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_ENUM_USEREQ]);
- fprintf(fp, "COMPARE DU %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_DU]);
- fprintf(fp, "COMPARE DU_USEREQ %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_DU_USEREQ]);
- fprintf(fp, "COMPARE NOTAG %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_NOTAG]);
- fprintf(fp, "COMPARE NOTAG_USEREQ %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_NOTAG_USEREQ]);
- fprintf(fp, "COMPARE EQUIV %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_EQUIV]);
- fprintf(fp, "COMPARE EQUIV_VAR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_EQUIV_VAR]);
- fprintf(fp, "COMPARE INT %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_INT]);
- fprintf(fp, "COMPARE CHAR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_CHAR]);
- fprintf(fp, "COMPARE FLOAT %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_FLOAT]);
- fprintf(fp, "COMPARE STRING %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_STRING]);
- fprintf(fp, "COMPARE PRED %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_PRED]);
- fprintf(fp, "COMPARE UNIV %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_UNIV]);
- fprintf(fp, "COMPARE VOID %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_VOID]);
- fprintf(fp, "COMPARE C_POINTER %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_C_POINTER]);
- fprintf(fp, "COMPARE TYPEINFO %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_TYPEINFO]);
- fprintf(fp, "COMPARE TYPECLASSINFO %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_TYPECLASSINFO]);
- fprintf(fp, "COMPARE ARRAY %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_ARRAY]);
- fprintf(fp, "COMPARE SUCCIP %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_SUCCIP]);
- fprintf(fp, "COMPARE HP %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_HP]);
- fprintf(fp, "COMPARE CURFR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_CURFR]);
- fprintf(fp, "COMPARE MAXFR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_MAXFR]);
- fprintf(fp, "COMPARE REDOFR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_REDOFR]);
- fprintf(fp, "COMPARE REDOIP %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_REDOIP]);
- fprintf(fp, "COMPARE TRAIL_PTR %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_TRAIL_PTR]);
- fprintf(fp, "COMPARE TICKET %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_TICKET]);
- fprintf(fp, "COMPARE UNKNOWN %ld\n",
- MR_ctor_rep_compare[MR_TYPECTOR_REP_UNKNOWN]);
-
- (void) fclose(fp);
- }
- }
+ MR_print_type_ctor_stats();
#endif
/*
@@ -1110,6 +934,51 @@
restore_regs_from_mem(c_regs);
} /* end mercury_runtime_main() */
+
+#ifdef MR_CTOR_REP_STATS
+
+static ConstString MR_ctor_rep_name[] = {
+ MR_CTOR_REP_NAMES
+};
+
+static void
+MR_print_type_ctor_stats(void)
+{
+ FILE *fp;
+ int i;
+
+ fp = fopen(MR_CTOR_REP_STATS, "a");
+ if (fp != NULL) {
+
+ for (i = 0; i < (int) MR_TYPECTOR_REP_UNKNOWN; i++) {
+ if (MR_ctor_rep_unify[i] > 0) {
+ fprintf(fp, "UNIFY %-15s %20ld\n",
+ MR_ctor_rep_name[i],
+ MR_ctor_rep_unify[i]);
+ }
+ }
+
+ for (i = 0; i < (int) MR_TYPECTOR_REP_UNKNOWN; i++) {
+ if (MR_ctor_rep_index[i] > 0) {
+ fprintf(fp, "INDEX %-15s %20ld\n",
+ MR_ctor_rep_name[i],
+ MR_ctor_rep_index[i]);
+ }
+ }
+
+ for (i = 0; i < (int) MR_TYPECTOR_REP_UNKNOWN; i++) {
+ if (MR_ctor_rep_compare[i] > 0) {
+ fprintf(fp, "COMPARE %-15s %20ld\n",
+ MR_ctor_rep_name[i],
+ MR_ctor_rep_compare[i]);
+ }
+ }
+
+ (void) fclose(fp);
+ }
+}
+
+#endif
#ifdef MEASURE_REGISTER_USAGE
static void
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list