mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-08 18:34:00 +00:00
Code Issues Projects Releases Wiki Activity
Files
026148c907be6be23f45cf69862d1fcfc2b7e947
mercury/runtime/mercury_unify_compare_body.h
Zoltan Somogyi 86f563a94d Pack subword-sized arguments next to a remote sectag. 
compiler/du_type_layout.m:
    If the --allow-packing-remote-sectag option is set, then try to pack
    an initial subsequence of subword-sized arguments next to remote sectags.

    To allow the polymorphism transformation to put the type_infos and/or
    typeclass_infos it adds to a function symbol's argument list at the
    *front* of that argument list, pack arguments next to remote sectags
    only in function symbols that won't have any such extra arguments
    added to them.

    Do not write all new code for the new optimization; instead, generalize
    the code that already does a very similar job for packing args next to
    local sectags.

    Delete the code we used to have that picked the packed representation
    over the base unpacked representation only if it reduced the
    "rounded-to-even" number of words. A case could be made for its usefulness,
    but in the presence of the new optimization the extra code complexity
    it requires is not worth it (in my opinion).

    Extend the code that informs users about possible argument order
    rearrangements that yield better packing to take packing next to sectags
    into account.

compiler/hlds_data.m:
    Provide a representation for cons_tags that use the new optimization.
    Instead of adding a new cons_tag, we do this by replacing several old
    cons_tags that all represent pointers to memory cells with a single
    cons_tag named remote_args_tag with an argument that selects among
    the old cons_tags being replaced, and adding a new alternative inside
    this new type. The new alternative is remote_args_shared with a
    remote_sectag whose size is rsectag_subword(...).

    Instead of representing the value of the "data" field in classes
    on the Java and C# backends as a strange kind of secondary tag
    that is added to a memory cell by a class constructor instead of
    having to be explicitly added to the front of the argument vector
    by the code of a unification, represent it more directly as separate
    kind of remote_args_tag. Continuing to treat it as a sectag would have
    been very confusing to readers of the code of ml_unify_gen_*.m in the
    presence of the new optimization.

    Replacing several cons_tags that were usually treated similarly with
    one cons_tag simplifies many switches. Instead of an switch with that
    branches to the same switch arm for single_functor_tag, unshared_tag
    and shared_remote_tag, and then switches on these three tags again
    to get e.g. the primary tag of each, the new code of the switch arm
    is executed for just cons_tag value (remote_args_tag), and switches
    on the various kinds of remote args tags only when it needs to.
    In is also more natural to pass around the argument of remote_args_tag
    than to pass around a variable of type cons_tag that can be bound to only
    single_functor_tag, unshared_tag or shared_remote_tag.

    Add an XXX about possible further steps along these lines, such as
    making a new cons_tag named something like "user_const_tag" represent
    all user-visible constants.

compiler/unify_gen_construct.m:
compiler/unify_gen_deconstruct.m:
compiler/unify_gen_test.m:
compiler/unify_gen_util.m:
compiler/ml_unify_gen_construct.m:
compiler/ml_unify_gen_deconstruct.m:
compiler/ml_unify_gen_test.m:
compiler/ml_unify_gen_util.m:
    Implement X = f(Yi) unifications where f uses the new representation,
    i.e. some of its arguments are stored next to a remote sectag.

    Some of the Yi are stored in a tagword (a word that also contains a tag,
    in this case the remote secondary tag), while some are stored in other
    words in a memory cell. This means that such unifications have similarities
    both to unifications involving arguments being packed next to local
    sectags, and to unifications involving ordinary arguments in memory cells.
    Therefore wherever possible, their implemenation uses suitably generalized
    versions of existing code that did those two jobs for two separate kinds of
    cons_tags.

    Making such generalizations possible in some cases required shifting the
    boundary between predicates, moving work from a caller to a callee
    or vice versa.

    In unify_gen_deconstruct.m, stop using uni_vals to represent *either* a var
    *or* a word in a memory cell. While this enabled us to factor out some
    common code, the predicate boundaries it lead to are unsuitable for the
    generalizations we now need.

    Consistently use unsigned ints to represent both the whole and the parts
    of words containing packed arguments (and maybe sectags), except when
    comparing ptag constants with the result of applying the "tag" unop
    to a word, (since that unop returns an int, at least for now).

    In a few cases, avoid the recomputation of some information that we
    already know. The motivation is not efficiency, since the recomputation
    we avoid is usually cheap, but the simplification of the code's correctness
    argument.

    Use more consistent terminology in things such as variable names.

    Note the possibility of further future improvements in several places.

compiler/ml_foreign_proc_gen.m:
    Delete a long unused predicate.

compiler/mlds.m:
    Add an XXX documenting a possible improvement.

compiler/rtti.m:
    Update the compiler's internal representation of RTTI data structures
    to make them able to describe secondary tags that are smaller than
    a full word.

compiler/rtti_out.m:
    Conform to the changes above, and delete a long-unused predicate.

compiler/type_ctor_info.m:
    Use the RTTI's du_hl_rep to represent cons_tags that distinguish
    between function symbols using a field in a class.

compiler/ml_type_gen.m:
    Provide a specialized form of a function for code in ml_unify_gen_*.m.
    Conform to the changes above.

compiler/add_special_pred.m:
compiler/bytecode_gen.m:
compiler/export.m:
compiler/hlds_code_util.m:
compiler/lco.m:
compiler/ml_closure_gen.m:
compiler/ml_switch_gen.m:
compiler/ml_tag_switch.m:
compiler/rtti_to_mlds.m:
compiler/switch_util.m:
compiler/tag_switch.m:
    Conform to the changes above.

runtime/mercury_type_info.h:
    Update the runtime's representation of RTTI data structures to make them
    able to describe remote secondary tags that are smaller than a full word.

runtime/mercury_deconstruct.[ch]:
runtime/mercury_deconstruct.h:
runtime/mercury_deconstruct_macros.h:
runtime/mercury_ml_expand_body.h:
runtime/mercury_ml_arg_body.h:
runtime/mercury_ml_deconstruct_body.h:
runtime/mercury_ml_functor_body.h:
    These modules collectively implement the predicates in deconstruct.m
    in the library, and provide access to its functionality to other C code,
    e.g. in the debugger. Update these to be able to handle terms with the
    new data representation optimization.

    This update requires a significant change in the distribution of work
    between these files for the predicates deconstruct.deconstruct and
    deconstruct.limited_deconstruct. We used to have mercury_ml_expand_body.h
    fill in the fields of their expand_info structures (whose types are
    defined in mercury_deconstruct.h) with pointers to three vectors:
    (a) a vector of arg_locns with one element per argument, with a NULL
    pointer being equivalent to a vector with a given element in every slot;
    (b) a vector of type_infos with one element per argument, constructed
    dynamically (and later freed) if necessary; and (c) a vector of argument
    words. Once upon a time, before double-word and sub-word arguments,
    vector (c) also had one word per argument, but that hasn't been true
    for a while; we added vector (a) help the consumers of the expand_info
    decode the difference. The consumers of this info  always used these
    vectors to build up a Mercury term containing a list of univs,
    with one univ for each argument.

    This structure could be stretched to handle function symbols that store
    *all* their arguments in a tagword next to a local sectag, but I found
    that stretching it to cover function symbols that have *some* of their
    arguments packed next to a remote sectag and *some other* of their
    arguments in a memory cell as usual would have required a well-nigh
    incomprehensibly complex, and therefore almost undebuggable, interface
    between mercury_ml_expand_body.h and the other files above. This diff
    therefore changes the interface to have mercury_ml_expand_body.h
    build the list of univs directly. This make its code relatively simple
    and self-contained, and it should be somewhat faster then the old code
    as well, since it never needs to allocate, fill in and then free
    vectors of type_infos (each such typeinfo now gets put into a univ
    as soon as it is constructed). The downside is that if we ever wanted
    to get all the arguments at once for a purpose other than constructing
    a list of univs from them, it would nevertheless require constructing
    that list of univs anyway as an intermediate data structure. I don't see
    this downside is significant, because (a) I don't think such a use case
    is very likely, and (b) even if one arises, debuggable but a bit slow
    is probably preferable to faster but very hard to debug.

    Reduce the level of indentation of some of these files to make the code
    easier to edit. Do this by

    - not adding an indent level from switch statements to their cases; and
    - not adding an indent level when a case in a switch has a local block.

    Move the break or return ending a case inside that case's block,
    if it has one.

runtime/mercury_deep_copy_body.h:
runtime/mercury_table_type_body.h:
    Update these to enable the copying or tabling of terms whose
    representations uses the new optimization.

    Use the techniques listed above to reduce the level of indentation
    make the code easier to edit.

runtime/mercury_tabling.c:
runtime/mercury_term_size.c:
    Conform to the changes above.

runtime/mercury_unify_compare_body.h:
    Make this code compile after the changes above. It does need to work
    correctly, since we only ever used this code to compare the speed
    of unify-by-rtti with the speed of unify-by-compiler-generated-code,
    and in real life, we always use the latter. (It hasn't been updated
    to work right with previous arg packing changes either.)

library/construct.m:
    Update to enable the code to construct terms whose representations
    uses the new optimization.

    Add some sanity checks.

library/private_builtin.m:
runtime/mercury_dotnet.cs.in:
java/runtime/Sectag_Locn.java:
    Update the list of possible sectag kinds.

library/store.m:
    Conform to the changes above.

trace/mercury_trace_vars.c:
    Conform to the changes above.

tests/hard_coded/deconstruct_arg.{m,exp,exp2}:
    Extend this test to test the deconstruction of terms whose
    representations uses the new optimization.

    Modify some of the existing terms being tested to make them more diverse,
    in order to make the output easier to navigate.

tests/hard_coded/construct_packed.{m,exp}:
    A new test case to test the construction of terms whose
    representations uses the new optimization.

tests/debugger/browse_packed.{m,exp}:
    A new test case to test access to the fields of terms whose
    representations uses the new optimization.

tests/tabling/test_packed.{m,exp}:
    A new test case to test the tabling of terms whose
    representations uses the new optimization.

tests/debugger/Mmakefile:
tests/hard_coded/Mmakefile:
tests/tabling/Mmakefile:
    Enable the new test cases.
2018-08-30 05:14:38 +10:00

1015 lines
40 KiB
C
Raw Blame History

// vim: ts=4 sw=4 expandtab ft=c
// Copyright (C) 2000-2005, 2007, 2011 The University of Melbourne.
// Copyright (C) 2014-2018 The Mercury team.
// This file is distributed under the terms specified in COPYING.LIB.
// This file contains a piece of code that is included by mercury_ho_call.c
// six times:
//
// - as the body of the mercury__builtin__unify_2_0 Mercury procedure,
// - as the body of the mercury__builtin__compare_3_3 Mercury procedure,
// - as the body of the mercury__builtin__compare_representation_3_0
// Mercury procedure,
// - as the body of the MR_generic_unify C function,
// - as the body of the MR_generic_compare C function, and
// - as the body of the MR_generic_compare_representation C function.
//
// The inclusions are surrounded by #defines and #undefs of the macros
// that personalize each copy of the code.
//
// The reason why the unify and compare Mercury procedures share code is
// that unify is mostly just a special case of comparison; it differs only
// by treating "less than" and "greater than" the same way, and returning
// its result slightly differently. Likewise, compare_representation
// is mostly the same as compare.
//
// The reason why there is both a Mercury procedure and a C function for
// unifications and comparisons is that the Mercury procedure needs a
// mechanism that allows it to unify or compare each argument of a function
// symbol, and doing it with a loop body that calls a C function is
// significantly easier to program, and probably more efficient, than
// using recursion in Mercury. The Mercury procedure and C function share code
// because they implement the same task.
//
// XXX does the rationale still hold? Only rarely used code paths still have
// loop bodies in C and they are likely incorrect for deep profiling.
// Also, the Mercury implementation of tuple unify/compare predicates is
// faster than the hand-written version was in asm_fast.gc. --pw
//
// We need separate C functions for unifications and comparison because
// with --no-special-preds, a type with user-defined equality (but not
// comparison) has a non-NULL unify_pred field in its type_ctor_info but a
// NULL compare_pred field. While in principle unification is a special case
// of comparison, we cannot implement unifications by comparisons for such
// types: they support unifications but not comparisons. Since we cannot do
// it for such types, it is simplest not to do it for any types.
#ifdef select_compare_code
#if defined(MR_DEEP_PROFILING) && defined(entry_point_is_mercury)
#ifdef include_compare_rep_code
#define return_compare_answer(mod, type, arity, answer) \
do { \
compare_call_exit_code(mod, __CompareRep__, type, arity); \
raw_return_answer(answer); \
} while (0)
#else
#define return_compare_answer(mod, type, arity, answer) \
do { \
compare_call_exit_code(mod, __Compare__, type, arity); \
raw_return_answer(answer); \
} while (0)
#endif
#else
#define return_compare_answer(mod, type, arity, answer) \
raw_return_answer(answer)
#endif
#else
#if defined(MR_DEEP_PROFILING) && defined(entry_point_is_mercury)
#define return_unify_answer(mod, type, arity, answer) \
do { \
if (answer) { \
unify_call_exit_code(mod, __Unify__, type, arity); \
raw_return_answer(MR_TRUE); \
} else { \
unify_call_fail_code(mod, __Unify__, type, arity); \
raw_return_answer(MR_FALSE); \
} \
} while (0)
#else
#define return_unify_answer(mod, type, arity, answer) \
raw_return_answer(answer)
#endif
#endif
DECLARE_LOCALS
initialize();
start_label:
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
#ifdef MR_TYPE_CTOR_STATS
MR_register_type_ctor_stat(&type_stat_struct, type_ctor_info);
#endif
if (! MR_type_ctor_has_valid_rep(type_ctor_info)) {
MR_fatal_error(attempt_msg "terms of unknown representation");
}
switch (MR_type_ctor_rep(type_ctor_info)) {
#if defined(MR_COMPARE_BY_RTTI) || defined(include_compare_rep_code)
case MR_TYPECTOR_REP_EQUIV:
MR_save_transient_hp();
type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv);
MR_restore_transient_hp();
goto start_label;
case MR_TYPECTOR_REP_EQUIV_GROUND:
type_info = (MR_TypeInfo)
MR_type_ctor_layout(type_ctor_info).MR_layout_equiv;
goto start_label;
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_NOTAG_USEREQ:
// fall through
#endif
case MR_TYPECTOR_REP_NOTAG:
MR_save_transient_hp();
type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
MR_type_ctor_layout(type_ctor_info).MR_layout_notag->
MR_notag_functor_arg_type);
MR_restore_transient_hp();
goto start_label;
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
// fall through
#endif
case MR_TYPECTOR_REP_NOTAG_GROUND:
type_info = (MR_TypeInfo) MR_type_ctor_layout(type_ctor_info).
MR_layout_notag->MR_notag_functor_arg_type;
goto start_label;
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_ARRAY:
MR_fatal_error("sorry, not implemented: "
"compare_representation for arrays");
#endif
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_BITMAP:
MR_fatal_error("sorry, not implemented: "
"compare_representation for bitmaps");
#endif
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_FOREIGN:
MR_fatal_error("sorry, not implemented: "
"compare_representation for foreign types");
#endif
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_DU_USEREQ:
// fall through
#endif
case MR_TYPECTOR_REP_DU:
// When deep profiling is enabled, we use the call, exit and (for
// unifications) fail ports of dummy unify, compare and compare_rep
// predicates for the dummy type_ctor builtin.user_by_rtti/0.
//
// XXX The deep profiler invariants are likely broken in the loop.
{
const MR_DuFunctorDesc *functor_desc;
#ifdef select_compare_code
const MR_DuFunctorDesc *x_functor_desc;
const MR_DuFunctorDesc *y_functor_desc;
const MR_DuPtagLayout *x_ptag_layout;
const MR_DuPtagLayout *y_ptag_layout;
#else
MR_Word x_ptag;
MR_Word y_ptag;
MR_Word x_sectag;
MR_Word y_sectag;
const MR_DuPtagLayout *ptag_layout;
#endif
MR_Word *x_data_value;
MR_Word *y_data_value;
const MR_DuExistInfo *exist_info;
int result;
int cur_slot;
int arity;
int i;
#ifdef MR_CHECK_DU_EQ
#ifdef select_compare_code
if (x == y) {
return_compare_answer(builtin, user_by_rtti, 0,
MR_COMPARE_EQUAL);
}
#else
if (x == y) {
return_unify_answer(builtin, user_by_rtti, 0, MR_TRUE);
}
#endif
#endif
#ifdef select_compare_code
#define MR_find_du_functor_desc(data, data_value, functor_desc) \
do { \
const MR_DuPtagLayout *ptag_layout; \
int ptag; \
int sectag; \
\
ptag = MR_tag(data); \
ptag_layout = &MR_type_ctor_layout(type_ctor_info). \
MR_layout_du[ptag]; \
data_value = (MR_Word *) MR_body(data, ptag); \
\
switch (ptag_layout->MR_sectag_locn) { \
case MR_SECTAG_LOCAL_REST_OF_WORD: \
sectag = MR_unmkbody(data_value); \
break; \
case MR_SECTAG_LOCAL_BITS: \
sectag = MR_unmkbody(data_value) & \
((1 << ptag_layout->MR_sectag_numbits) - 1); \
break; \
case MR_SECTAG_REMOTE_FULL_WORD: \
sectag = data_value[0]; \
break; \
case MR_SECTAG_REMOTE_BITS: \
sectag = data_value[0] & \
((1 << ptag_layout->MR_sectag_numbits) - 1); \
break; \
case MR_SECTAG_NONE: /* fall-though */ \
case MR_SECTAG_NONE_DIRECT_ARG: \
sectag = 0; \
break; \
case MR_SECTAG_VARIABLE: \
sectag = 0; /* Avoid a warning. */ \
MR_fatal_error("find_du_functor_desc(): " \
"attempt get functor desc of variable"); \
default: \
sectag = 0; /* Avoid a warning. */ \
MR_fatal_error("find_du_functor_desc(): " \
"unrecognised sectag locn"); \
} \
\
functor_desc = \
ptag_layout->MR_sectag_alternatives[sectag]; \
} while (0)
MR_find_du_functor_desc(x, x_data_value, x_functor_desc);
MR_find_du_functor_desc(y, y_data_value, y_functor_desc);
#undef MR_find_du_functor_desc
if (x_functor_desc->MR_du_functor_ordinal !=
y_functor_desc->MR_du_functor_ordinal)
{
if (x_functor_desc->MR_du_functor_ordinal <
y_functor_desc->MR_du_functor_ordinal)
{
return_compare_answer(builtin, user_by_rtti, 0,
MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, user_by_rtti, 0,
MR_COMPARE_GREATER);
}
}
functor_desc = x_functor_desc;
#else // ! select_compare_code
x_ptag = MR_tag(x);
y_ptag = MR_tag(y);
if (x_ptag != y_ptag) {
return_unify_answer(builtin, user_by_rtti, 0, MR_FALSE);
}
ptag_layout = &MR_type_ctor_layout(type_ctor_info).
MR_layout_du[x_ptag];
x_data_value = (MR_Word *) MR_body(x, x_ptag);
y_data_value = (MR_Word *) MR_body(y, y_ptag);
switch (ptag_layout->MR_sectag_locn) {
case MR_SECTAG_LOCAL_REST_OF_WORD:
x_sectag = MR_unmkbody(x_data_value);
y_sectag = MR_unmkbody(y_data_value);
if (x_sectag == y_sectag) {
return_unify_answer(builtin, user_by_rtti, 0,
MR_TRUE);
} else {
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
}
break;
case MR_SECTAG_LOCAL_BITS:
{
MR_Word x_sectag_word;
MR_Word y_sectag_word;
x_sectag_word = MR_unmkbody(x_data_value);
y_sectag_word = MR_unmkbody(y_data_value);
if (x_sectag_word != y_sectag_word) {
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
}
x_sectag = x_sectag_word &
((1 << ptag_layout->MR_sectag_numbits) - 1);
}
break;
case MR_SECTAG_REMOTE_FULL_WORD:
x_sectag = x_data_value[0];
y_sectag = y_data_value[0];
if (x_sectag != y_sectag) {
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
}
break;
case MR_SECTAG_REMOTE_BITS:
x_sectag = x_data_value[0] &
((1 << ptag_layout->MR_sectag_numbits) - 1);
y_sectag = y_data_value[0] &
((1 << ptag_layout->MR_sectag_numbits) - 1);
if (x_sectag != y_sectag) {
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
}
break;
case MR_SECTAG_NONE:
case MR_SECTAG_NONE_DIRECT_ARG:
x_sectag = 0;
break;
case MR_SECTAG_VARIABLE:
MR_fatal_error("find_du_functor_desc():"
"attempt get functor desc of variable");
}
functor_desc = ptag_layout->MR_sectag_alternatives[x_sectag];
#endif // select_compare_code
switch (functor_desc->MR_du_functor_sectag_locn) {
case MR_SECTAG_NONE_DIRECT_ARG:
// The work is done in the switch.
{
MR_TypeInfo arg_type_info;
arg_type_info = (MR_TypeInfo)
functor_desc->MR_du_functor_arg_types[0];
MR_save_transient_registers();
#ifdef select_compare_code
#ifdef include_compare_rep_code
result = MR_generic_compare_representation(
arg_type_info,
(MR_Word) x_data_value, (MR_Word) y_data_value);
#else
result = MR_generic_compare(arg_type_info,
(MR_Word) x_data_value, (MR_Word) y_data_value);
#endif
#else
result = MR_generic_unify(arg_type_info,
(MR_Word) x_data_value, (MR_Word) y_data_value);
#endif
MR_restore_transient_registers();
}
#ifdef select_compare_code
return_compare_answer(builtin, user_by_rtti, 0, result);
#else
return_unify_answer(builtin, user_by_rtti, 0, result);
#endif
break;
case MR_SECTAG_REMOTE_FULL_WORD:
cur_slot = 1;
// The work is done after the switch.
break;
case MR_SECTAG_NONE:
cur_slot = 0;
// The work is done after the switch.
break;
case MR_SECTAG_REMOTE_BITS: // fall through
case MR_SECTAG_LOCAL_BITS:
MR_fatal_error("packed with sectag in du switch NYI");
break;
case MR_SECTAG_LOCAL_REST_OF_WORD:
// This case should have been handled in full above.
MR_fatal_error("MR_SECTAG_LOCAL_REST_OF_WORD in du switch");
default:
MR_fatal_error("bad sectag location in du switch");
}
arity = functor_desc->MR_du_functor_orig_arity;
exist_info = functor_desc->MR_du_functor_exist_info;
if (exist_info != NULL) {
int num_ti_plain;
int num_ti_in_tci;
int num_tci;
const MR_DuExistLocn *locns;
MR_TypeInfo x_ti;
MR_TypeInfo y_ti;
num_ti_plain = exist_info->MR_exist_typeinfos_plain;
num_ti_in_tci = exist_info->MR_exist_typeinfos_in_tci;
num_tci = exist_info->MR_exist_tcis;
locns = exist_info->MR_exist_typeinfo_locns;
for (i = 0; i < num_ti_plain + num_ti_in_tci; i++) {
if (locns[i].MR_exist_offset_in_tci < 0) {
x_ti = (MR_TypeInfo)
x_data_value[locns[i].MR_exist_arg_num];
y_ti = (MR_TypeInfo)
y_data_value[locns[i].MR_exist_arg_num];
} else {
x_ti = (MR_TypeInfo)
MR_typeclass_info_param_type_info(
x_data_value[locns[i].MR_exist_arg_num],
locns[i].MR_exist_offset_in_tci);
y_ti = (MR_TypeInfo)
MR_typeclass_info_param_type_info(
y_data_value[locns[i].MR_exist_arg_num],
locns[i].MR_exist_offset_in_tci);
}
MR_save_transient_registers();
result = MR_compare_type_info(x_ti, y_ti);
MR_restore_transient_registers();
if (result != MR_COMPARE_EQUAL) {
#ifdef select_compare_code
return_compare_answer(builtin, user_by_rtti, 0,
result);
#else
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
#endif
}
}
cur_slot += num_ti_plain + num_tci;
}
for (i = 0; i < arity; i++) {
MR_TypeInfo arg_type_info;
// XXX This code is like the expansion of
// MR_get_arg_type_info(type_info, functor_desc,
// x_data_value, i);
// but with save/restore of transient hp.
// Either that macro should have the same save/restore,
// or this code does not need it.
if (MR_arg_type_may_contain_var(functor_desc, i)) {
MR_save_transient_hp();
arg_type_info = MR_create_type_info_maybe_existq(
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info),
functor_desc->MR_du_functor_arg_types[i],
x_data_value, functor_desc);
MR_restore_transient_hp();
} else {
arg_type_info = (MR_TypeInfo)
functor_desc->MR_du_functor_arg_types[i];
}
#ifdef select_compare_code
MR_save_transient_registers();
// XXX The code below is wrong for packed args.
#ifdef include_compare_rep_code
result = MR_generic_compare_representation(arg_type_info,
x_data_value[cur_slot], y_data_value[cur_slot]);
#else
result = MR_generic_compare(arg_type_info,
x_data_value[cur_slot], y_data_value[cur_slot]);
#endif
MR_restore_transient_registers();
if (result != MR_COMPARE_EQUAL) {
return_compare_answer(builtin, user_by_rtti, 0,
result);
}
#else
MR_save_transient_registers();
result = MR_generic_unify(arg_type_info,
x_data_value[cur_slot], y_data_value[cur_slot]);
MR_restore_transient_registers();
if (! result) {
return_unify_answer(builtin, user_by_rtti, 0,
MR_FALSE);
}
#endif
cur_slot++;
}
#ifdef select_compare_code
return_compare_answer(builtin, user_by_rtti, 0,
MR_COMPARE_EQUAL);
#else
return_unify_answer(builtin, user_by_rtti, 0, MR_TRUE);
#endif
}
MR_fatal_error(MR_STRINGIFY(start_label) ": unexpected fall thru");
#endif // defined(MR_COMPARE_BY_RTTI) || defined(include_compare_rep_code)
#ifndef include_compare_rep_code
#ifndef MR_COMPARE_BY_RTTI
case MR_TYPECTOR_REP_EQUIV:
case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_NOTAG:
case MR_TYPECTOR_REP_NOTAG_GROUND:
case MR_TYPECTOR_REP_DU:
// fall through
#endif
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_DU_USEREQ:
case MR_TYPECTOR_REP_NOTAG_USEREQ:
case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
case MR_TYPECTOR_REP_ARRAY:
case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_FOREIGN:
case MR_TYPECTOR_REP_STABLE_FOREIGN:
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
// In deep profiling grades, the caller of builtin.unify or
// builtin.compare (the predicates this piece of code implements)
// has prepared for a normal call, which must be followed by
// the execution of the call port code and then of either the exit
// or the fail port code.
//
// That would be a problem if you wanted to pretest x == y here.
// First, at the moment there is no simple or fast way
// to get from the type_ctor_info (which we have) to the proc
// layout structures of the type's unify or compare predicates
// (which port codes need). Second, even if we put the addresses
// of those proc layout structures into the type_ctor_info,
// incrementing just the call and exit/fail port counts would
// leave the called predicate's counts inconsistent in cases where
// the body of that predicate did not have any paths through it
// without making calls (since those calls are being
// short-circuited here).
//
// Our solution is to check x == y not here, but at the starts of
// compiler-generated unify and compare predicates. This delays
// the check until after the extraction of any typeinfos
// representing the arguments of the main type constructor,
// but it also ensures that the check is performed not just on the
// top function symbols of the terms being unified or compared,
// but on all other function symbols too. Measurements show that
// the overhead of these extra tests is less than the amount of
// work that these extra pretests avoid.
#ifndef MR_DEEP_PROFILING
#if 0
#ifdef select_compare_code
if (x == y) {
raw_return_answer(MR_COMPARE_EQUAL);
}
#else
if (x == y) {
raw_return_answer(MR_TRUE);
}
#endif
#endif
#endif
// We call the type-specific compare routine as
// `CompPred(...ArgTypeInfos..., Result, X, Y)' is det.
// The ArgTypeInfo arguments are input, and are passed
// in MR_r1, MR_r2, ... MR_rN. The X and Y arguments are also
// input, and are passed in MR_rN+1 and MR_rN+2.
// The Result argument is output in MR_r1.
//
// We specialize the case where the type_ctor arity is 0, 1 or 2,
// in order to avoid the loop. If type_ctors with higher arities
// were commonly used, we could specialize them too.
if (type_ctor_info->MR_type_ctor_arity == 0) {
MR_r1 = x;
MR_r2 = y;
} else if (type_ctor_info->MR_type_ctor_arity == 1) {
MR_Word *args_base;
args_base = (MR_Word *)
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_r1 = args_base[1];
MR_r2 = x;
MR_r3 = y;
} else if (type_ctor_info->MR_type_ctor_arity == 2) {
MR_Word *args_base;
args_base = (MR_Word *)
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_r1 = args_base[1];
MR_r2 = args_base[2];
MR_r3 = x;
MR_r4 = y;
} else {
int i;
int type_arity;
MR_Word *args_base;
type_arity = type_ctor_info->MR_type_ctor_arity;
args_base = (MR_Word *)
MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
MR_save_registers();
// CompPred(...ArgTypeInfos..., Res, X, Y)
for (i = 1; i <= type_arity; i++) {
MR_virtual_reg_assign(i, args_base[i]);
}
MR_virtual_reg_assign(type_arity + 1, x);
MR_virtual_reg_assign(type_arity + 2, y);
MR_restore_registers();
}
tailcall_tci_pred();
#endif // !include_compare_rep_code
case MR_TYPECTOR_REP_TUPLE:
// The tuple unify and compare predicates are implemented in
// Mercury, mainly so that the compiler can perform the deep
// profiler transformation on them.
#ifdef select_compare_code
#ifdef include_compare_rep_code
if (MR_special_pred_hooks.MR_compare_rep_tuple_pred != NULL) {
tailcall(MR_special_pred_hooks.MR_compare_rep_tuple_pred);
} else {
MR_fatal_error(attempt_msg "tuples");
}
#else
if (MR_special_pred_hooks.MR_compare_tuple_pred != NULL) {
tailcall(MR_special_pred_hooks.MR_compare_tuple_pred);
} else {
tailcall_tci_pred();
}
#endif
#else
if (MR_special_pred_hooks.MR_unify_tuple_pred != NULL) {
tailcall(MR_special_pred_hooks.MR_unify_tuple_pred);
} else {
tailcall_tci_pred();
}
#endif
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
// fall through
#endif
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_FOREIGN_ENUM:
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_INT8:
case MR_TYPECTOR_REP_INT16:
case MR_TYPECTOR_REP_INT32:
case MR_TYPECTOR_REP_CHAR:
#ifdef select_compare_code
if ((MR_Integer) x == (MR_Integer) y) {
return_compare_answer(builtin, int, 0, MR_COMPARE_EQUAL);
} else if ((MR_Integer) x < (MR_Integer) y) {
return_compare_answer(builtin, int, 0, MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, int, 0, MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, int, 0,
(MR_Integer) x == (MR_Integer) y);
#endif
case MR_TYPECTOR_REP_UINT:
case MR_TYPECTOR_REP_UINT8:
case MR_TYPECTOR_REP_UINT16:
case MR_TYPECTOR_REP_UINT32:
#ifdef select_compare_code
if ((MR_Unsigned) x == (MR_Unsigned) y) {
return_compare_answer(builtin, uint, 0, MR_COMPARE_EQUAL);
} else if ((MR_Unsigned) x < (MR_Unsigned) y) {
return_compare_answer(builtin, uint, 0, MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, uint, 0, MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, uint, 0,
(MR_Unsigned) x == (MR_Unsigned) y);
#endif
case MR_TYPECTOR_REP_DUMMY:
// Since dummy types contain only value, all unifies succeed and
// all comparisons return "equal".
#ifdef select_compare_code
return_compare_answer(builtin, dummy, 0, MR_COMPARE_EQUAL);
#else
return_unify_answer(builtin, int, 0, MR_TRUE);
#endif
case MR_TYPECTOR_REP_FLOAT:
{
MR_Float fx, fy;
fx = MR_word_to_float(x);
fy = MR_word_to_float(y);
#ifdef select_compare_code
if (fx == fy) {
return_compare_answer(builtin, float, 0, MR_COMPARE_EQUAL);
} else if (fx < fy) {
return_compare_answer(builtin, float, 0, MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, float, 0,
MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, float, 0, fx == fy);
#endif
}
case MR_TYPECTOR_REP_INT64:
{
int64_t fx, fy;
fx = MR_word_to_int64(x);
fy = MR_word_to_int64(y);
#ifdef select_compare_code
if (fx == fy) {
return_compare_answer(builtin, int64, 0, MR_COMPARE_EQUAL);
} else if (fx < fy) {
return_compare_answer(builtin, int64, 0, MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, int64, 0,
MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, int64, 0, fx == fy);
#endif
}
case MR_TYPECTOR_REP_UINT64:
{
uint64_t fx, fy;
fx = MR_word_to_uint64(x);
fy = MR_word_to_uint64(y);
#ifdef select_compare_code
if (fx == fy) {
return_compare_answer(builtin, uint64, 0, MR_COMPARE_EQUAL);
} else if (fx < fy) {
return_compare_answer(builtin, uint64, 0, MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, uint64, 0,
MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, uint64, 0, fx == fy);
#endif
}
case MR_TYPECTOR_REP_STRING:
{
int result;
result = strcmp((char *) x, (char *) y);
#ifdef select_compare_code
if (result == 0) {
return_compare_answer(builtin, string, 0,
MR_COMPARE_EQUAL);
} else if (result < 0) {
return_compare_answer(builtin, string, 0,
MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, string, 0,
MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, string, 0, result == 0);
#endif
}
// We use the c_pointer statistics for stable_c_pointer
// until the stable_c_pointer type is actually added,
// which will be *after* the builtin types' handwritten
// unify and compare preds are replaced by automatically
// generated code.
//
// XXX This is a temporary measure.
#ifdef include_compare_rep_code
case MR_TYPECTOR_REP_STABLE_FOREIGN: // fallthru
#endif
case MR_TYPECTOR_REP_STABLE_C_POINTER: // fallthru
case MR_TYPECTOR_REP_C_POINTER:
#ifdef select_compare_code
if ((void *) x == (void *) y) {
return_compare_answer(builtin, c_pointer, 0,
MR_COMPARE_EQUAL);
} else if ((void *) x < (void *) y) {
return_compare_answer(builtin, c_pointer, 0,
MR_COMPARE_LESS);
} else {
return_compare_answer(builtin, c_pointer, 0,
MR_COMPARE_GREATER);
}
#else
return_unify_answer(builtin, c_pointer, 0,
(void *) x == (void *) y);
#endif
case MR_TYPECTOR_REP_TYPEINFO:
{
#ifdef select_compare_code
int result;
MR_save_transient_registers();
result = MR_compare_type_info(
(MR_TypeInfo) x, (MR_TypeInfo) y);
MR_restore_transient_registers();
return_compare_answer(private_builtin, type_info, 1, result);
#else
MR_bool result;
MR_save_transient_registers();
result = MR_unify_type_info(
(MR_TypeInfo) x, (MR_TypeInfo) y);
MR_restore_transient_registers();
return_unify_answer(private_builtin, type_info, 1, result);
#endif
}
case MR_TYPECTOR_REP_TYPEDESC:
// Differs from the code for MR_TYPECTOR_REP_TYPEINFO
// only in recording profiling information elsewhere.
{
#ifdef select_compare_code
int result;
MR_save_transient_registers();
result = MR_compare_type_info(
(MR_TypeInfo) x, (MR_TypeInfo) y);
MR_restore_transient_registers();
return_compare_answer(type_desc, type_desc, 0, result);
#else
MR_bool result;
MR_save_transient_registers();
result = MR_unify_type_info(
(MR_TypeInfo) x, (MR_TypeInfo) y);
MR_restore_transient_registers();
return_unify_answer(type_desc, type_desc, 0, result);
#endif
}
case MR_TYPECTOR_REP_PSEUDOTYPEDESC:
{
#ifdef select_compare_code
int result;
MR_save_transient_registers();
result = MR_compare_pseudo_type_info(
(MR_PseudoTypeInfo) x, (MR_PseudoTypeInfo) y);
MR_restore_transient_registers();
return_compare_answer(type_desc, pseudo_type_desc, 0, result);
#else
MR_bool result;
MR_save_transient_registers();
result = MR_unify_pseudo_type_info(
(MR_PseudoTypeInfo) x, (MR_PseudoTypeInfo) y);
MR_restore_transient_registers();
return_unify_answer(type_desc, pseudo_type_desc, 0, result);
#endif
}
case MR_TYPECTOR_REP_TYPECTORINFO:
{
#ifdef select_compare_code
int result;
MR_save_transient_registers();
result = MR_compare_type_ctor_info(
(MR_TypeCtorInfo) x, (MR_TypeCtorInfo) y);
MR_restore_transient_registers();
return_compare_answer(private_builtin, type_ctor_info, 1,
result);
#else
MR_bool result;
MR_save_transient_registers();
result = MR_unify_type_ctor_info(
(MR_TypeCtorInfo) x, (MR_TypeCtorInfo) y);
MR_restore_transient_registers();
return_unify_answer(private_builtin, type_ctor_info, 1,
result);
#endif
}
case MR_TYPECTOR_REP_TYPECTORDESC:
{
#ifdef select_compare_code
int result;
MR_save_transient_registers();
result = MR_compare_type_ctor_desc(
(MR_TypeCtorDesc) x, (MR_TypeCtorDesc) y);
MR_restore_transient_registers();
return_compare_answer(type_desc, type_ctor_desc, 0, result);
#else
MR_bool result;
MR_save_transient_registers();
result = MR_unify_type_ctor_desc(
(MR_TypeCtorDesc) x, (MR_TypeCtorDesc) y);
MR_restore_transient_registers();
return_unify_answer(type_desc, type_ctor_desc, 0, result);
#endif
}
case MR_TYPECTOR_REP_VOID:
MR_fatal_error(attempt_msg "terms of type `void'");
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
{
#ifdef include_compare_rep_code
int result;
MR_save_transient_registers();
result = MR_compare_closures_representation((MR_Closure *) x,
(MR_Closure *) y);
MR_restore_transient_registers();
if (MR_type_ctor_rep(type_ctor_info) == MR_TYPECTOR_REP_FUNC) {
return_compare_answer(builtin, func, 0, result);
} else {
return_compare_answer(builtin, pred, 0, result);
}
#else
MR_fatal_error(attempt_msg "higher-order terms");
#endif
}
case MR_TYPECTOR_REP_TYPECLASSINFO:
MR_fatal_error(attempt_msg "typeclass_infos");
case MR_TYPECTOR_REP_BASETYPECLASSINFO:
MR_fatal_error(attempt_msg "base_typeclass_infos");
case MR_TYPECTOR_REP_SUBGOAL:
MR_fatal_error(attempt_msg "subgoal");
case MR_TYPECTOR_REP_HP:
MR_fatal_error(attempt_msg "hp");
case MR_TYPECTOR_REP_SUCCIP:
MR_fatal_error(attempt_msg "succip");
case MR_TYPECTOR_REP_CURFR:
MR_fatal_error(attempt_msg "curfr");
case MR_TYPECTOR_REP_MAXFR:
MR_fatal_error(attempt_msg "maxfr");
case MR_TYPECTOR_REP_REDOFR:
MR_fatal_error(attempt_msg "redofr");
case MR_TYPECTOR_REP_REDOIP:
MR_fatal_error(attempt_msg "redoip");
case MR_TYPECTOR_REP_TICKET:
MR_fatal_error(attempt_msg "ticket");
case MR_TYPECTOR_REP_TRAIL_PTR:
MR_fatal_error(attempt_msg "trail_ptr");
case MR_TYPECTOR_REP_REFERENCE:
#ifdef select_compare_code
// This is not permitted, because keeping the order of references
// consistent would cause significant difficulty for a copying
// garbage collector.
MR_fatal_error(attempt_msg "terms of a reference type");
#else
return_unify_answer(private_builtin, ref, 1,
(void *) x == (void *) y);
#endif
case MR_TYPECTOR_REP_UNUSED1:
case MR_TYPECTOR_REP_UNUSED2:
case MR_TYPECTOR_REP_UNKNOWN:
MR_fatal_error(attempt_msg "terms of unknown type");
}
MR_fatal_error("got to the end of " MR_STRINGIFY(start_label));
#ifdef select_compare_code
#undef return_compare_answer
#else
#undef return_unify_answer
#endif
Reference in New Issue View Git Blame Copy Permalink