cvs diff: imp. base_type_infos with no static code addresses.
Tyson Richard DOWD
trd at students.cs.mu.oz.au
Fri Feb 14 14:13:31 AEDT 1997
Hello everybody! (*)
Fergus Henderson (or your alter-ego, Ferguson Henders), could you
please review this change?
(*) Everybody replies: "Hi Doctor Nick".
===================================================================
Estimated hours taken: 25
Implement shared-one-or-two-cell type_infos for grades without static
code addresses. This allows us to use functor, arg, expand, deep_copy,
etc without changes in all grades.
compiler/base_type_info.m:
- If static code addresses are not available, eliminate the
special procedures, and output the constant 0 instead of a
code address.
- We now keep the `eliminated' predicates in the base_gen_info
structure, so that dead_proc_elim knows they are referenced
from the base_type_info.
compiler/dead_proc_elim.m:
- For the moment, don't eliminate any special preds - the
analysis to so this safely is quite complex so we take a
conservative approach - base_type_infos are always needed, and
hence the special preds are always referenced.
- Also, fix a bug in the handling of eliminated procs - if they
are eliminated elsewhere, any eliminated here should be added
find the total number. (this bug doesn't occur presently due
to the conservative approach we now make).
compiler/globals.m:
compiler/handle_options.m:
- Change the handling of type_info_method option - we no longer
need static addresses to do shared-one-or-two-cell.
- Add predicate globals__have_static_code_addresses/2 to check
for this feature.
- Make shared-one-or-two-cell the default type_info method.
compiler/llds_out.m:
- Output initialisation code for the base_type_infos in this
module as part of the module initialisation.
- Don't declare base_type_infos as const if the don't have
static code addresses, because we'll have to initialise them
at runtime.
- Don't make decls of base_type_infos `const' if we don't have
static code addresses.
compiler/polymorphism.m:
- Update examples of transformed code to include
base_type_layouts, clarify difference between shared and
non-shared one-or-two-cell.
library/mercury_builtin.m:
- Conditionally reference entry labels of builtin special preds,
using `MR_MAYBE_STATIC_CODE()' macro.
- Replace `const' in handwritten base_type_info structs with
`MR_STATIC_CODE_CONST'.
- Add initialisation code to fill in the code addresses.
runtime/type_info.h:
- Conditionally define MR_STATIC_CODE_ADDRESSES.
- Define macros to initialise base_type_infos:
mercury_init_builtin_base_type_info, and
mercury_init_base_type_info
- Define `MR_STATIC_CODE_CONST' (which is `const' if static code
addresses are available, and blank otherwise).
_ Define MR_MAYBE_STATIC_CODE(X) which is X if static code
addresses are available, and 0 otherwise.
- Make shared-one-or-two-cell the default setting, don't require
static code addresses for one-or-two-cell.
- Create versions of make_typelayout_for_all_tags for 0, 1, 2
and 3 tagbits, so as to save space, add error message if we
try to use more than 3 tagbits.
- Improve layout and commenting, break file up into sections.
- Fix typos.
Index: compiler/base_type_info.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/base_type_info.m,v
retrieving revision 1.5
diff -u -r1.5 base_type_info.m
--- base_type_info.m 1997/01/29 00:47:57 1.5
+++ base_type_info.m 1997/02/14 00:53:06
@@ -70,11 +70,26 @@
map__lookup(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_status(TypeDefn, Status),
special_pred_list(Specials),
+ module_info_globals(ModuleInfo, Globals),
+ globals__have_static_code_addresses(Globals,
+ StaticCode),
module_info_get_special_pred_map(ModuleInfo, SpecMap),
base_type_info__gen_proc_list(Specials, SpecMap,
- TypeId, Procs),
- Info = base_gen_info(TypeId, ModuleName, TypeName,
- TypeArity, Status, no, Procs),
+ TypeId, Procs),
+
+ % If we can't store static code addresses,
+ % replace the code addresses with null pointers.
+ % later code will do this if we tell it they
+ % have been eliminiated.
+
+ ( StaticCode = yes ->
+ Elim = no
+ ;
+ list__length(Specials, NumSpecials),
+ Elim = yes(NumSpecials)
+ ),
+ Info = base_gen_info(TypeId, ModuleName,
+ TypeName, TypeArity, Status, Elim, Procs),
BaseGenInfos = [Info | BaseGenInfos1]
;
BaseGenInfos = BaseGenInfos1
@@ -157,9 +172,21 @@
Elim = yes(ProcsLength)
->
- PredAddrArg = yes(const(code_addr_const(
- imported(proc("mercury_builtin", predicate,
- "mercury_builtin", "unused", 0, 0))))),
+ module_info_globals(ModuleInfo, Globals),
+
+ % If eliminated, make procs point to
+ % mercury_builtin__unused. (Or, if static code
+ % addresses are not available, use NULL
+ % pointers).
+ (
+ globals__have_static_code_addresses(Globals, yes)
+ ->
+ PredAddrArg = yes(const(code_addr_const(
+ imported(proc("mercury_builtin", predicate,
+ "mercury_builtin", "unused", 0, 0)))))
+ ;
+ PredAddrArg = yes(const(int_const(0)))
+ ),
list__duplicate(ProcsLength, PredAddrArg, PredAddrArgs)
;
base_type_info__construct_pred_addrs2(Procs, ModuleInfo,
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.21
diff -u -r1.21 dead_proc_elim.m
--- dead_proc_elim.m 1997/01/27 07:44:57 1.21
+++ dead_proc_elim.m 1997/02/11 04:56:51
@@ -159,11 +159,26 @@
dead_proc_elim__initialize_base_gen_infos([BaseGenInfo | BaseGenInfos],
Queue0, Queue, Needed0, Needed) :-
BaseGenInfo = base_gen_info(_TypeId, ModuleName, TypeName,
- Arity, Status, _Elim, _Procs),
+ Arity, _Status, _Elim, _Procs),
(
- ( Status = exported
- ; Status = abstract_exported
- )
+ % XXX: We'd like to do this, but there are problems.
+ % ( Status = exported
+ % ; Status = abstract_exported
+ % )
+ % We need to do more thorough analysis of the
+ % reachability of the special predicates, in general,
+ % because using arg/3 allows us to get at base_type_info
+ % via the base_type_layout. The base_type_infos of
+ % arguments of functors may have had their special preds
+ % eliminated, but they can still be called. In addition,
+ % it would be nice for pragma C code to have some
+ % support for using compiler generated data structures
+ % and preds, so that they aren't just eliminated.
+ %
+ % So presently, all base_type_infos will be treated
+ % as exported, and hence no special preds will be
+ % eliminated.
+ semidet_succeed
->
Entity = base_gen_info(ModuleName, TypeName, Arity),
queue__put(Queue0, Entity, Queue1),
@@ -524,7 +539,7 @@
dead_proc_elim__eliminate_base_gen_infos(BaseGenInfos0, Needed,
BaseGenInfos1),
BaseGenInfo0 = base_gen_info(TypeId, ModuleName, TypeName,
- Arity, Status, _Elim, Procs),
+ Arity, Status, Elim0, Procs),
(
Entity = base_gen_info(ModuleName, TypeName, Arity),
map__search(Needed, Entity, _)
@@ -532,8 +547,18 @@
BaseGenInfos = [BaseGenInfo0 | BaseGenInfos1]
;
list__length(Procs, ProcsLength),
+
+ % Procs may have been eliminated elsewhere, if so
+ % we sum the eliminated procs together.
+ (
+ Elim0 = yes(NumProcs0)
+ ->
+ NumProcs is ProcsLength + NumProcs0
+ ;
+ NumProcs = ProcsLength
+ ),
NeuteredBaseGenInfo = base_gen_info(TypeId, ModuleName,
- TypeName, Arity, Status, yes(ProcsLength), []),
+ TypeName, Arity, Status, yes(NumProcs), []),
BaseGenInfos = [NeuteredBaseGenInfo | BaseGenInfos1]
).
Index: compiler/globals.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/globals.m,v
retrieving revision 1.18
diff -u -r1.18 globals.m
--- globals.m 1996/10/30 07:01:27 1.18
+++ globals.m 1997/02/14 00:56:32
@@ -51,8 +51,7 @@
:- pred convert_args_method(string::in, args_method::out) is semidet.
-:- pred convert_type_info_method(string::in, option_table::in,
- type_info_method::out) is semidet.
+:- pred convert_type_info_method(string::in, type_info_method::out) is semidet.
:- pred convert_prolog_dialect(string::in, prolog_dialect::out) is semidet.
@@ -99,6 +98,15 @@
%-----------------------------------------------------------------------------%
+ % More complex options
+
+ % Check if static code addresses are available in the
+ % current grade of compilation
+
+:- pred globals__have_static_code_addresses(globals::in, bool::out) is det.
+
+%-----------------------------------------------------------------------------%
+
% Access predicates for storing a `globals' structure in the
% io__state using io__set_globals and io__get_globals.
@@ -167,33 +175,10 @@
convert_args_method("simple", simple).
convert_args_method("compact", compact).
-convert_type_info_method("one-cell", _, one_cell).
-convert_type_info_method("one-or-two-cell", _, one_or_two_cell).
-convert_type_info_method("shared-one-or-two-cell", OptionTable,
- Method) :-
- getopt__lookup_bool_option(OptionTable, gcc_non_local_gotos,
- NonLocalGotos),
- getopt__lookup_bool_option(OptionTable, asm_labels, AsmLabels),
- exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst),
- (
- IsConst = yes,
- Method = shared_one_or_two_cell
- ;
- IsConst = no,
- error("shared_one_or_two_cell requires static code addresses")
- ).
-convert_type_info_method("default", OptionTable, Method) :-
- getopt__lookup_bool_option(OptionTable, gcc_non_local_gotos,
- NonLocalGotos),
- getopt__lookup_bool_option(OptionTable, asm_labels, AsmLabels),
- exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst),
- (
- IsConst = yes,
- Method = shared_one_or_two_cell
- ;
- IsConst = no,
- Method = one_cell
- ).
+convert_type_info_method("one-cell", one_cell).
+convert_type_info_method("one-or-two-cell", one_or_two_cell).
+convert_type_info_method("shared-one-or-two-cell", shared_one_or_two_cell).
+convert_type_info_method("default", shared_one_or_two_cell).
convert_prolog_dialect("default", default).
convert_prolog_dialect("nu", nu).
@@ -285,6 +270,21 @@
;
error("globals__lookup_accumulating_option: invalid accumulating option")
).
+
+%-----------------------------------------------------------------------------%
+
+globals__have_static_code_addresses(Globals, IsConst) :-
+ globals__get_options(Globals, OptionTable),
+ globals__have_static_code_addresses_2(OptionTable, IsConst).
+
+:- pred globals__have_static_code_addresses_2(option_table::in,
+ bool::out) is det.
+
+globals__have_static_code_addresses_2(OptionTable, IsConst) :-
+ getopt__lookup_bool_option(OptionTable, gcc_non_local_gotos,
+ NonLocalGotos),
+ getopt__lookup_bool_option(OptionTable, asm_labels, AsmLabels),
+ exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/handle_options.m,v
retrieving revision 1.20
diff -u -r1.20 handle_options.m
--- handle_options.m 1997/01/27 07:45:06 1.20
+++ handle_options.m 1997/02/11 03:03:47
@@ -118,7 +118,7 @@
(
{ TypeInfoMethod0 = string(TypeInfoMethodStr) },
{ convert_type_info_method(TypeInfoMethodStr,
- OptionTable, TypeInfoMethod) }
+ TypeInfoMethod) }
->
{ map__lookup(OptionTable, prolog_dialect,
PrologDialect0) },
Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.35
diff -u -r1.35 llds_out.m
--- llds_out.m 1997/01/29 00:47:51 1.35
+++ llds_out.m 1997/02/14 02:19:07
@@ -237,7 +237,9 @@
io__write_string("\t|| defined(DEBUG_LABELS) || !defined(SPEED) \\\n"),
io__write_string("\t|| defined(NATIVE_GC) \n\n"),
output_c_module_init_list_3(0, BaseName, InitFuncs),
- io__write_string("#endif\n}\n").
+ io__write_string("#endif\n"),
+ output_c_data_init_list(Modules),
+ io__write_string("}\n").
:- pred output_c_module_init_list_2(list(c_module), string, int, int, int, int,
io__state, io__state).
@@ -294,6 +296,44 @@
output_c_module_init_list_3(InitFunc1, BaseName, MaxInitFunc)
).
+
+ % Output MR_INIT_BASE_TYPE_INFO(BaseTypeInfo, TypeId);
+ % for each base_type_info defined in this module.
+
+:- pred output_c_data_init_list(list(c_module), io__state, io__state).
+:- mode output_c_data_init_list(in, di, uo) is det.
+
+output_c_data_init_list([]) --> [].
+output_c_data_init_list([c_export(_) | Ms]) -->
+ output_c_data_init_list(Ms).
+output_c_data_init_list([c_code(_, _) | Ms]) -->
+ output_c_data_init_list(Ms).
+output_c_data_init_list([c_module(_, _) | Ms]) -->
+ output_c_data_init_list(Ms).
+output_c_data_init_list([c_data(BaseName, DataName, _, _, _) | Ms]) -->
+ (
+ { DataName = base_type_info(TypeName, Arity) }
+ ->
+ io__write_string("\tMR_INIT_BASE_TYPE_INFO(\n\t\t"),
+ output_data_addr(BaseName, DataName),
+ io__write_string(",\n\t\t"),
+ { string__append(BaseName, "__", UnderscoresModule) },
+ (
+ { string__append(UnderscoresModule, _, TypeName) }
+ ->
+ []
+ ;
+ io__write_string(UnderscoresModule)
+ ),
+ io__write_string(TypeName),
+ io__write_string("_"),
+ io__write_int(Arity),
+ io__write_string("_0);\n")
+ ;
+ []
+ ),
+ output_c_data_init_list(Ms).
+
:- pred output_init_name(string, io__state, io__state).
:- mode output_init_name(in, di, uo) is det.
@@ -1425,6 +1465,11 @@
% ...
% };
%
+ % Unless the term contains code addresses, and we don't have
+ % static code addresses available, in which case we'll have
+ % to initialize them dynamically, so we must omit `const'
+ % from the above structure.
+
:- pred output_const_term_decl(list(maybe(rval)), decl_id, bool, string, string,
int, int, io__state, io__state).
:- mode output_const_term_decl(in, in, in, in, in, in, out, di, uo) is det.
@@ -1438,7 +1483,17 @@
;
io__write_string("static ")
),
- io__write_string("const struct "),
+ globals__io_get_globals(Globals),
+ { globals__have_static_code_addresses(Globals, StaticCode) },
+ (
+ { StaticCode = no },
+ { DeclId = data_addr(data_addr(_, base_type_info(_, _))) }
+ ->
+ []
+ ;
+ io__write_string("const ")
+ ),
+ io__write_string("struct "),
output_decl_id(DeclId),
io__write_string("_struct {\n"),
output_cons_arg_types(ArgVals, "\t", 1),
@@ -1729,7 +1784,20 @@
FirstIndent, LaterIndent, N0, N) -->
output_indent(FirstIndent, LaterIndent, N0),
{ N is N0 + 1 },
- io__write_string("extern const struct "),
+ io__write_string("extern "),
+ globals__io_get_globals(Globals),
+
+ % Don't make decls of base_type_infos `const' if we
+ % don't have static code addresses.
+ (
+ { VarName = base_type_info(_, _) },
+ { globals__have_static_code_addresses(Globals, no) }
+ ->
+ []
+ ;
+ io__write_string("const ")
+ ),
+ io__write_string("struct "),
output_data_addr(BaseName, VarName),
io__write_string("_struct\n"),
io__write_string(LaterIndent),
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.93
diff -u -r1.93 polymorphism.m
--- polymorphism.m 1997/02/04 01:22:24 1.93
+++ polymorphism.m 1997/02/11 00:23:43
@@ -108,6 +108,7 @@
% '__Compare__'<list/1>,
% '__Term_To_Type__'<list/1>,
% '__Type_To_Term__'<list/1>,
+% <base_type_layout for list/1>,
% TypeInfoT1),
% q(TypeInfoT2, [X]),
% TypeInfoT3 = type_info(
@@ -116,7 +117,8 @@
% builtin_index_int,
% builtin_compare_int,
% builtin_term_to_type_int,
-% builtin_type_to_term_int),
+% builtin_type_to_term_int,
+% <base_type_layout for int/0>),
% r(TypeInfoT3, 0).
%
% With the one_or_two_cell representation, we transform the body of p to this:
@@ -128,7 +130,8 @@
% '__Index__'<list/1>,
% '__Compare__'<list/1>,
% '__Term_To_Type__'<list/1>,
-% '__Type_To_Term__'<list/1>),
+% '__Type_To_Term__'<list/1>,
+% <base_type_layout for int/0>),
% TypeInfoT2 = type_info(
% BaseTypeInfoT2,
% TypeInfoT1),
@@ -139,36 +142,15 @@
% builtin_index_int,
% builtin_compare_int,
% builtin_term_to_type_int,
-% builtin_type_to_term_int),
+% builtin_type_to_term_int,
+% <base_type_layout for int/0>),
% r(TypeInfoT3, 0).
%
% With the shared_one_or_two_cell representation, we transform the body of p
-% to this:
-%
-% p(TypeInfoT1, X) :-
-% BaseTypeInfoT2 = base_type_info(
-% 1,
-% '__Unify__'<list/1>,
-% '__Index__'<list/1>,
-% '__Compare__'<list/1>,
-% '__Term_To_Type__'<list/1>,
-% '__Type_To_Term__'<list/1>),
-% TypeInfoT2 = type_info(
-% BaseTypeInfoT2,
-% TypeInfoT1),
-% q(TypeInfoT2, [X]),
-% TypeInfoT3 = base_type_info(
-% 0,
-% builtin_unify_int,
-% builtin_index_int,
-% builtin_compare_int,
-% builtin_term_to_type_int,
-% builtin_type_to_term_int),
-% r(TypeInfoT3, 0).
-%
-% Actually, the unifications with base_type_info(...) are generated
-% as references to the single definition of base_type_info, however,
-% conceptually this transformation is correct.
+% to the same as one_or_two_cell, but the unifications with
+% base_type_info(...) are generated as references to the single
+% definition of base_type_info (which is generated in the module that
+% defines it).
%-----------------------------------------------------------------------------%
Index: library/mercury_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/mercury_builtin.m,v
retrieving revision 1.64
diff -u -r1.64 mercury_builtin.m
--- mercury_builtin.m 1997/01/20 03:32:48 1.64
+++ mercury_builtin.m 1997/02/14 02:30:21
@@ -472,6 +472,7 @@
:- pragma(c_code, "
+
#ifdef SHARED_ONE_OR_TWO_CELL_TYPE_INFO
#ifdef USE_TYPE_LAYOUT
@@ -518,7 +519,7 @@
Declare_entry(mercury__builtin_compare_int_3_0);
Declare_entry(mercury__builtin_term_to_type_int_2_0);
Declare_entry(mercury__builtin_type_to_term_int_2_0);
-const struct mercury_data___base_type_info_int_0_struct {
+MR_STATIC_CODE_CONST struct mercury_data___base_type_info_int_0_struct {
Integer f1;
Code *f2;
Code *f3;
@@ -532,12 +533,12 @@
#endif
} mercury_data___base_type_info_int_0 = {
((Integer) 0),
- ENTRY(mercury__builtin_unify_int_2_0),
- ENTRY(mercury__builtin_index_int_2_0),
- ENTRY(mercury__builtin_compare_int_3_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_int_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_int_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_int_3_0)),
#ifdef USE_TYPE_TO_TERM
- ENTRY(mercury__builtin_term_to_type_int_2_0),
- ENTRY(mercury__builtin_type_to_term_int_2_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_int_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_int_2_0)),
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_int_0
@@ -550,7 +551,8 @@
Declare_entry(mercury__builtin_compare_character_3_0);
Declare_entry(mercury__builtin_term_to_type_character_2_0);
Declare_entry(mercury__builtin_type_to_term_character_2_0);
-const struct mercury_data___base_type_info_character_0_struct {
+MR_STATIC_CODE_CONST struct
+mercury_data___base_type_info_character_0_struct {
Integer f1;
Code *f2;
Code *f3;
@@ -564,12 +566,14 @@
#endif
} mercury_data___base_type_info_character_0 = {
((Integer) 0),
- ENTRY(mercury__builtin_unify_character_2_0),
- ENTRY(mercury__builtin_index_character_2_0),
- ENTRY(mercury__builtin_compare_character_3_0),
-#ifdef USE_TYPE_TO_TERM
- ENTRY(mercury__builtin_term_to_type_character_2_0),
- ENTRY(mercury__builtin_type_to_term_character_2_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_character_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_character_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_character_3_0)),
+#ifdef USE_TYPE_TO_TERM
+ MR_MAYBE_STATIC_CODE(
+ ENTRY(mercury__builtin_term_to_type_character_2_0)),
+ MR_MAYBE_STATIC_CODE(
+ ENTRY(mercury__builtin_type_to_term_character_2_0)),
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_character_0
@@ -582,7 +586,7 @@
Declare_entry(mercury__builtin_compare_string_3_0);
Declare_entry(mercury__builtin_term_to_type_string_2_0);
Declare_entry(mercury__builtin_type_to_term_string_2_0);
-const struct mercury_data___base_type_info_string_0_struct {
+MR_STATIC_CODE_CONST struct mercury_data___base_type_info_string_0_struct {
Integer f1;
Code *f2;
Code *f3;
@@ -596,12 +600,12 @@
#endif
} mercury_data___base_type_info_string_0 = {
((Integer) 0),
- ENTRY(mercury__builtin_unify_string_2_0),
- ENTRY(mercury__builtin_index_string_2_0),
- ENTRY(mercury__builtin_compare_string_3_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_string_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_string_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_string_3_0)),
#ifdef USE_TYPE_TO_TERM
- ENTRY(mercury__builtin_term_to_type_string_2_0),
- ENTRY(mercury__builtin_type_to_term_string_2_0)
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_string_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_string_2_0))
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_string_0
@@ -614,7 +618,7 @@
Declare_entry(mercury__builtin_compare_float_3_0);
Declare_entry(mercury__builtin_term_to_type_float_2_0);
Declare_entry(mercury__builtin_type_to_term_float_2_0);
-const struct mercury_data___base_type_info_float_0_struct {
+MR_STATIC_CODE_CONST struct mercury_data___base_type_info_float_0_struct {
Integer f1;
Code *f2;
Code *f3;
@@ -628,12 +632,12 @@
#endif
} mercury_data___base_type_info_float_0 = {
((Integer) 0),
- ENTRY(mercury__builtin_unify_float_2_0),
- ENTRY(mercury__builtin_index_float_2_0),
- ENTRY(mercury__builtin_compare_float_3_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_float_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_float_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_float_3_0)),
#ifdef USE_TYPE_TO_TERM
- ENTRY(mercury__builtin_term_to_type_float_2_0),
- ENTRY(mercury__builtin_type_to_term_float_2_0)
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_float_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_float_2_0))
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_float_0
@@ -646,7 +650,7 @@
Declare_entry(mercury__builtin_compare_pred_3_0);
Declare_entry(mercury__builtin_term_to_type_pred_2_0);
Declare_entry(mercury__builtin_type_to_term_pred_2_0);
-const struct mercury_data___base_type_info_pred_0_struct {
+MR_STATIC_CODE_CONST struct mercury_data___base_type_info_pred_0_struct {
Integer f1;
Code *f2;
Code *f3;
@@ -660,19 +664,57 @@
#endif
} mercury_data___base_type_info_pred_0 = {
((Integer) 0),
- ENTRY(mercury__builtin_unify_pred_2_0),
- ENTRY(mercury__builtin_index_pred_2_0),
- ENTRY(mercury__builtin_compare_pred_3_0),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_unify_pred_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_index_pred_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_compare_pred_3_0)),
#ifdef USE_TYPE_TO_TERM
- ENTRY(mercury__builtin_term_to_type_pred_2_0),
- ENTRY(mercury__builtin_type_to_term_pred_2_0)
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_term_to_type_pred_2_0)),
+ MR_MAYBE_STATIC_CODE(ENTRY(mercury__builtin_type_to_term_pred_2_0))
#endif
#ifdef USE_TYPE_LAYOUT
(const Word *) & mercury_data___base_type_layout_pred_0
#endif
};
+BEGIN_MODULE(builtin_types_module)
+
+BEGIN_CODE
+
+END_MODULE
+
+/*
+INIT sys_init_builtin_types_module
+*/
+void sys_init_builtin_types_module(void);
+void sys_init_builtin_types_module(void) {
+ extern ModuleFunc builtin_types_module;
+ extern ModuleFunc mercury__mercury_builtin__init;
+
+ builtin_types_module();
+
+ /*
+ ** We had better call this init() because we use the
+ ** labels for the special preds of int, float, pred,
+ ** character and string. If they aren't initialized,
+ ** we might initialize the base_type_info with
+ ** garbage
+ */
+ mercury__mercury_builtin__init();
+
+ MR_INIT_BUILTIN_BASE_TYPE_INFO(
+ mercury_data___base_type_info_int_0, _int_);
+ MR_INIT_BUILTIN_BASE_TYPE_INFO(
+ mercury_data___base_type_info_float_0, _float_);
+ MR_INIT_BUILTIN_BASE_TYPE_INFO(
+ mercury_data___base_type_info_pred_0, _pred_);
+ MR_INIT_BUILTIN_BASE_TYPE_INFO(
+ mercury_data___base_type_info_character_0, _character_);
+ MR_INIT_BUILTIN_BASE_TYPE_INFO(
+ mercury_data___base_type_info_string_0, _string_);
+}
+
#endif /* SHARED_ONE_OR_TWO_CELL_TYPE_INFO */
+
").
% This is used by the code that the compiler generates for compare/3.
Index: runtime/type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/type_info.h,v
retrieving revision 1.15
diff -u -r1.15 type_info.h
--- type_info.h 1997/02/12 02:16:46 1.15
+++ type_info.h 1997/02/14 02:40:35
@@ -16,6 +16,8 @@
#include "mercury_types.h" /* for `Word' */
+/*---------------------------------------------------------------------------*/
+
/*
** Decide which type_info representation we will use.
**
@@ -37,19 +39,14 @@
#undef ONE_OR_TWO_CELL_TYPE_INFO
/* #define ONE_CELL_TYPE_INFO */
#else
- /* use the default type_info representation: */
- /* shared_one_or_two_cell if addresses are constants, otherwise one_cell */
- #if defined(USE_GCC_NONLOCAL_GOTOS) && !defined(USE_ASM_LABELS)
- #undef SHARED_ONE_OR_TWO_CELL_TYPE_INFO
- #undef ONE_OR_TWO_CELL_TYPE_INFO
- #define ONE_CELL_TYPE_INFO
- #else
- #define SHARED_ONE_OR_TWO_CELL_TYPE_INFO
- #define ONE_OR_TWO_CELL_TYPE_INFO
- #undef ONE_CELL_TYPE_INFO
- #endif
+ /* use the default type_info representation: shared-one-or-two-cell */
+ #define SHARED_ONE_OR_TWO_CELL_TYPE_INFO
+ #define ONE_OR_TWO_CELL_TYPE_INFO
+ #undef ONE_CELL_TYPE_INFO
#endif
+/*---------------------------------------------------------------------------*/
+
/*
** Define offsets of fields in the type_info structure.
** See polymorphism.m for explanation of these offsets and how the
@@ -98,6 +95,12 @@
#define TYPEINFO_OFFSET_FOR_PRED_ARGS 2
#endif
+/*---------------------------------------------------------------------------*/
+
+/*
+** Definitions for handwritten code, mostly for mercury_compare_typeinfo.
+*/
+
#define COMPARE_EQUAL 0
#define COMPARE_LESS 1
#define COMPARE_GREATER 2
@@ -146,6 +149,7 @@
#define index_output r2
#endif
+/*---------------------------------------------------------------------------*/
/*
** Definitions and macros for base_type_layout definition.
@@ -160,6 +164,8 @@
*/
/*
+** Conditionally define USE_TYPE_LAYOUT.
+**
** All code using type_layout structures should check to see if
** USE_TYPE_LAYOUT is defined, and give a fatal error otherwise.
** For USE_TYPE_LAYOUT to be defined, we need to be using
@@ -174,6 +180,12 @@
#undef USE_TYPE_LAYOUT
#endif
+
+/*
+** Code indended for defining type_layouts for handwritten code.
+**
+** See library/io.m or library/mercury_builtin.m for details.
+*/
#if TAGBITS >= 2
typedef const Word *TypeLayoutField;
#define TYPE_LAYOUT_FIELDS \
@@ -191,11 +203,24 @@
#endif
/*
-** Typelayouts for builtins often defined as 8 indentical
-** values (8 because that's the highest number of tag values
-** we use at the moment).
+** Typelayouts for builtins are often defined as X identical
+** values, where X is the number of possible tag values.
*/
+#if TAGBITS == 0
+#define make_typelayout_for_all_tags(Tag, Value) \
+ make_typelayout(Tag, Value)
+#elif TAGBITS == 1
+#define make_typelayout_for_all_tags(Tag, Value) \
+ make_typelayout(Tag, Value), \
+ make_typelayout(Tag, Value)
+#elif TAGBITS == 2
+#define make_typelayout_for_all_tags(Tag, Value) \
+ make_typelayout(Tag, Value), \
+ make_typelayout(Tag, Value), \
+ make_typelayout(Tag, Value), \
+ make_typelayout(Tag, Value)
+#elif TAGBITS == 3
#define make_typelayout_for_all_tags(Tag, Value) \
make_typelayout(Tag, Value), \
make_typelayout(Tag, Value), \
@@ -205,6 +230,13 @@
make_typelayout(Tag, Value), \
make_typelayout(Tag, Value), \
make_typelayout(Tag, Value)
+#endif
+
+#if !defined(make_typelayout_for_all_tags)
+#error "make_typelayout_for_all_tags is not defined for this number of tags"
+#endif
+
+/*---------------------------------------------------------------------------*/
/*
** Tags in type_layout structures.
@@ -226,7 +258,7 @@
** Values in type_layout structures,
** presently the values of CONST_TAG words.
**
-** Also indended for use in handwritten C code.
+** Also intended for use in handwritten C code.
**
** Note that TYPELAYOUT_UNASSIGNED_VALUE is not yet
** used for anything.
@@ -249,7 +281,6 @@
#define TYPELAYOUT_MAX_VARINT 1024
-
/*
** Offsets for functors and arities.
**
@@ -268,6 +299,8 @@
#define TYPELAYOUT_SIMPLE_ARITY_OFFSET 0
#define TYPELAYOUT_SIMPLE_ARGS_OFFSET 1
+/*---------------------------------------------------------------------------*/
+
/*
** Offsets for dealing with `univ' types.
**
@@ -278,5 +311,124 @@
#define UNIV_OFFSET_FOR_TYPEINFO 0
#define UNIV_OFFSET_FOR_DATA 1
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Code for dealing with the static code addresses stored in
+** base_type_infos.
+*/
+
+/*
+** Static code addresses are available, unless using gcc non-local gotos,
+** without assembler labels.
+*/
+
+#if (defined(USE_GCC_NONLOCAL_GOTOS) && !defined(USE_ASM_LABELS))
+ #undef MR_STATIC_CODE_ADDRESSES
+#else
+ #define MR_STATIC_CODE_ADDRESSES
+#endif
+
+/*
+** Definitions for initialization of base_type_infos. If
+** MR_STATIC_CODE_ADDRESSES are not available, we need to initialize
+** the special predicates in the base_type_infos.
+*/
+
+/*
+** A fairly generic static code address initializer.
+*/
+#define MR_INIT_CODE_ADDR(Base, PredAddr, Offset) \
+ ((Word *) (Word) &Base)[Offset] = (Word) ENTRY(PredAddr)
+
+#define MR_SPECIAL_PRED_INIT(Base, TypeId, Offset, Pred) \
+ MR_INIT_CODE_ADDR(Base, mercury____##Pred##___##TypeId##, Offset)
+
+/*
+** Macros are provided here to initialize base_type_infos, both for
+** builtin types (such as in library/mercury_builtin.m) and user
+** defined C types (like library/uniq_array.m). Also, the automatically
+** generated code uses these initializers.
+**
+** Examples of use:
+**
+** MR_INIT_BUILTIN_BASE_TYPE_INFO(
+** mercury_data__base_type_info_string_0, _string_);
+**
+** note we use _string_ to avoid the redefinition of string via #define
+**
+** MR_INIT_BASE_TYPE_INFO(
+** mercury_data_group__base_type_info_group_1, group__group_1_0);
+**
+*/
+
+#ifndef MR_STATIC_CODE_ADDRESSES
+
+ #define MR_MAYBE_STATIC_CODE(X) ((Integer) 0)
+
+ #define MR_STATIC_CODE_CONST
+
+ #ifdef USE_TYPE_TO_TERM
+
+ #define MR_INIT_BUILTIN_BASE_TYPE_INFO(B, T) \
+ do { \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_unify##T##2_0, \
+ OFFSET_FOR_UNIFY_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_index##T##2_0, \
+ OFFSET_FOR_INDEX_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_compare##T##3_0, \
+ OFFSET_FOR_COMPARE_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_type_to_term##T##2_0,\
+ OFFSET_FOR_TYPE_TO_TERM_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_term_to_type##T##2_0,\
+ OFFSET_FOR_TERM_TO_TYPE_PRED); \
+ } while (0)
+
+ #define MR_INIT_BASE_TYPE_INFO(B, T) \
+ do { \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_UNIFY_PRED, Unify); \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_INDEX_PRED, Index); \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_COMPARE_PRED, Compare); \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_TERM_TO_TYPE_PRED, Term_To_Type);\
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_TYPE_TO_TERM_PRED, Type_To_Term);\
+ } while (0)
+
+ #else /* not USE_TYPE_TO_TERM */
+
+ #define MR_INIT_BUILTIN_BASE_TYPE_INFO(B, T) \
+ do { \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_unify##T##2_0, \
+ OFFSET_FOR_UNIFY_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_index##T##2_0, \
+ OFFSET_FOR_INDEX_PRED); \
+ MR_INIT_CODE_ADDR(B, mercury__builtin_compare##T##3_0, \
+ OFFSET_FOR_COMPARE_PRED); \
+ } while (0)
+
+ #define MR_INIT_BASE_TYPE_INFO(B, T) \
+ do { \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_UNIFY_PRED, Unify); \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_INDEX_PRED, Index); \
+ MR_SPECIAL_PRED_INIT(B, T, OFFSET_FOR_COMPARE_PRED, Compare); \
+ } while (0)
+
+ #endif /* not USE_TYPE_TO_TERM */
+
+#else /* MR_STATIC_CODE_ADDRESSES */
+
+ #define MR_MAYBE_STATIC_CODE(X) (X)
+
+ #define MR_STATIC_CODE_CONST const
+
+ #define MR_INIT_BUILTIN_BASE_TYPE_INFO(B, T) \
+ do { } while (0)
+
+ #define MR_INIT_BASE_TYPE_INFO(B, T) \
+ do { } while (0)
+
+#endif /* MR_STATIC_CODE_ADDRESSES */
+
+/*---------------------------------------------------------------------------*/
#endif /* not TYPEINFO_H */
More information about the developers
mailing list