PreviousUpNext

15.4.447  src/lib/compiler/back/low/treecode/treecode-hash-g.pkg

## treecode-hash-g.pkg

# Compiled by:
#     src/lib/compiler/back/low/lib/lowhalf.lib

# We get invoked from
#
#    src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg
#    src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg
#    src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg

stipulate
    package lbl =  codelabel;                                                   # codelabel                     is from   src/lib/compiler/back/low/code/codelabel.pkg
    package lem =  lowhalf_error_message;                                       # lowhalf_error_message         is from   src/lib/compiler/back/low/control/lowhalf-error-message.pkg
    package rkj =  registerkinds_junk;                                          # registerkinds_junk            is from   src/lib/compiler/back/low/code/registerkinds-junk.pkg
    package tcp =  treecode_pith;                                               # treecode_pith                 is from   src/lib/compiler/back/low/treecode/treecode-pith.pkg
    package unt =  unt;                                                         # unt                           is from   src/lib/std/unt.pkg
herein

    generic package   treecode_hash_g   (
        #             ===============
        #
        package tcf: Treecode_Form;                                             # Treecode_Form                 is from   src/lib/compiler/back/low/treecode/treecode-form.api

        # Hashing extensions 
        #
        hash_sext:   tcf::Hash_Fns -> tcf::Sext  -> Unt;
        hash_rext:   tcf::Hash_Fns -> tcf::Rext  -> Unt;
        hash_fext:   tcf::Hash_Fns -> tcf::Fext  -> Unt;
        hash_ccext:  tcf::Hash_Fns -> tcf::Ccext -> Unt;
    )
    : (weak) Treecode_Hash                                                      # Treecode_Hash                 is from   src/lib/compiler/back/low/treecode/treecode-hash.api
    {
        # Export to client packages:
        #
        package tcf =  tcf;

        stipulate
            package mi  =  tcf::mi;                                             # "mi"  == "machine_int".
            package lac =  tcf::lac;                                            # "lac" == "late_constant".
        herein

            unt =   unt::from_int;
            i2s =   int::to_string;

            to_lower =   string::map char::to_lower;

            fun error msg
                =
                lem::error("label_expression", msg);

            fun wv (rkj::CODETEMP_INFO { id, ... } )
                =
                unt id;

            fun wvs is
                = 
                f (is, 0u0)
                where
                    fun f ([],     h) =>  h;
                        f (i ! is, h) =>  f (is, wv i+h);
                    end;
                end;


            # Hashing

            hash_label =   lbl::codelabel_to_hashcode;

            fun hasher ()
                =
                { void_expression  =>  hash_void_expression,
                  int_expression   =>  hash_int_expression,
                  float_expression =>  hash_float_expression,
                  flag_expression  =>  hash_flag_expression
                }

           also
           fun hash_ctrl ctrl
                =
                wv ctrl

           also
           fun hash_void_expression void_expression
                =
                case void_expression
                    #
                    tcf::LOAD_INT_REGISTER (t, dst, int_expression) => 0u123 + unt t + wv dst + hash_int_expression int_expression;
                    tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER (dst, flag_expression) => 0u1234 + wv dst + hash_flag_expression flag_expression;
                    tcf::LOAD_FLOAT_REGISTER (fty, dst, float_expression) => 0u12345 + unt fty + wv dst + hash_float_expression float_expression;
                    tcf::MOVE_INT_REGISTERS (type, dst, src) => 0u234 + unt type + wvs dst + wvs src;
                    tcf::MOVE_FLOAT_REGISTERS (fty, dst, src) => 0u456 + unt fty + wvs dst + wvs src;
                    tcf::GOTO (ea, labels) => 0u45 + hash_int_expression ea;
                    tcf::CALL { funct, targets, defs, uses, region, pops } =>
                         hash_int_expression funct + hash_lowhalfs defs + hash_lowhalfs uses; 
                    tcf::RET _ => 0u567;
                    tcf::STORE_INT (type, ea, data, mem) => 0u888 + unt type + hash_int_expression ea + hash_int_expression data; 
                    tcf::STORE_FLOAT (fty, ea, data, mem) => 0u7890 + unt fty + hash_int_expression ea + hash_float_expression data;
                    tcf::IF_GOTO (a, lab) => 0u233 + hash_flag_expression a + hash_label lab;
                    tcf::IF (a, b, c) => 0u233 + hash_flag_expression a + hash_void_expression b + hash_void_expression c;
                    tcf::NOTE (void_expression, a) => hash_void_expression void_expression; 
                    tcf::PHI { preds, block } => unt block; 
                    tcf::SOURCE => 0u123; 
                    tcf::SINK => 0u423; 
                    tcf::REGION (void_expression, ctrl) => hash_void_expression void_expression + hash_ctrl ctrl;
                    tcf::RTL { hash, ... } => hash;
                    tcf::SEQ ss => hash_void_expressions (ss, 0u23);
                    tcf::ASSIGN (type, lhs, rhs) => unt type + hash_int_expression lhs + hash_int_expression rhs;
                    _ => error "hashStm";
                esac 

           also
           fun hash_void_expressions ([], h)
                    =>
                    h;

               hash_void_expressions (s ! ss, h)
                    =>
                    hash_void_expressions (ss, hash_void_expression s + h);
           end 

           also
           fun hash_lowhalf (tcf::FLAG_EXPRESSION flag_expression) =>   hash_flag_expression  flag_expression;
               hash_lowhalf (tcf::INT_EXPRESSION             int_expression) =>   hash_int_expression         int_expression; 
               hash_lowhalf (tcf::FLOAT_EXPRESSION         float_expression) =>   hash_float_expression     float_expression;
            end 

            also
            fun hash_lowhalfs [] => 0u123;
                hash_lowhalfs (m ! ms) => hash_lowhalf m + hash_lowhalfs ms;
            end 

            also
            fun hash2 (type, x, y)
                =
                unt type + hash_int_expression x + hash_int_expression y

            also
            fun hashm tcf::d::ROUND_TO_ZERO   => 0u158;                 # Rounding-mode for divide operations.
                hashm tcf::d::ROUND_TO_NEGINF => 0u159;
            end 

            also
            fun hash3 (m, type, x, y)
                =
                hashm m + unt type + hash_int_expression x + hash_int_expression y

            also
            fun hash_int_expression int_expression
                =  
                case int_expression
                    #
                    tcf::CODETEMP_INFO (type, src) =>  unt type + wv src;
                    tcf::LITERAL i       =>  mi::hash i;
                    tcf::LABEL l         =>  hash_label l;
                    tcf::LABEL_EXPRESSION le       =>  hash_int_expression int_expression;
                    tcf::LATE_CONSTANT lateconst =>  lac::late_constant_to_hashcode  lateconst;
                    #
                    tcf::NEG         (type, x) => unt type + hash_int_expression x + 0u24;
                    tcf::NEG_OR_TRAP        (type, x) => unt type + hash_int_expression x + 0u1224;
                    tcf::BITWISE_NOT (type, x) => unt type + hash_int_expression x;  
                    #
                    tcf::ADD  x =>  hash2 x + 0u234;
                    tcf::SUB  x =>  hash2 x + 0u456;
                    tcf::MULS x =>  hash2 x + 0u2131;
                    tcf::DIVS x =>  hash3 x + 0u156;
                    tcf::REMS x =>  hash3 x + 0u231;
                    tcf::MULU x =>  hash2 x + 0u123;
                    tcf::DIVU x =>  hash2 x + 0u1234;
                    tcf::REMU x =>  hash2 x + 0u211;
                    #
                    tcf::ADD_OR_TRAP          x =>  hash2 x + 0u1219;
                    tcf::SUB_OR_TRAP          x =>  hash2 x + 0u999;
                    tcf::MULS_OR_TRAP          x =>  hash2 x + 0u7887;
                    tcf::DIVS_OR_TRAP          x =>  hash3 x + 0u88884;
                    #
                    tcf::BITWISE_AND   x =>  hash2 x + 0u12312;
                    tcf::BITWISE_OR    x =>  hash2 x + 0u558;
                    tcf::BITWISE_XOR   x =>  hash2 x + 0u234;
                    tcf::BITWISE_EQV   x =>  hash2 x + 0u734;
                    #
                    tcf::RIGHT_SHIFT   x =>  hash2 x + 0u874; 
                    tcf::RIGHT_SHIFT_U x =>  hash2 x + 0u223;
                    tcf::LEFT_SHIFT    x =>  hash2 x + 0u499;
                    #
                    tcf::CONDITIONAL_LOAD (type, e, e1, e2) =>   unt type + hash_flag_expression e + hash_int_expression e1 + hash_int_expression e2;
                    #
                    tcf::SIGN_EXTEND (type, type', int_expression) =>  0u232 + unt type + unt type' + hash_int_expression int_expression;
                    tcf::ZERO_EXTEND (type, type', int_expression) =>  0u737 + unt type + unt type' + hash_int_expression int_expression;
                    #
                    tcf::FLOAT_TO_INT (type, round, type', float_expression) => 
                       unt type + tcp::hash_rounding_mode round + unt type' + hash_float_expression float_expression;

                    tcf::LOAD (type, ea, mem) => unt type + hash_int_expression ea + 0u342;
                    tcf::LET (void_expression, int_expression) => hash_void_expression void_expression + hash_int_expression int_expression;
                    tcf::PRED (e, ctrl) => hash_int_expression e + hash_ctrl ctrl;
                    tcf::RNOTE (e, _) => hash_int_expression e;
                    tcf::REXT (type, rext) => unt type + hash_rext (hasher()) rext;
                    tcf::QQQ => 0u485;
                    tcf::OP (type, op, es) => hash_rexps (es, unt type + hash_operator op);
                    tcf::ARG _ => 0u23;
                    tcf::ATATAT(type, k, e) => unt type + hash_int_expression e;
                    tcf::PARAM n => unt n;
                    tcf::BITSLICE (type, sl, e) => unt type + hash_int_expression e;
                esac

            also
            fun hash_operator (tcf::OPERATOR { hash, ... } )
                =
                hash

            also
            fun hash_rexps ([],     h) =>  h; 
                hash_rexps (e ! es, h) =>  hash_rexps (es, hash_int_expression e + h);
            end 

            also
            fun hash2'(type, x, y)
                =
                unt type + hash_float_expression x + hash_float_expression y

            also
            fun hash_float_expression float_expression
                =  
                case float_expression   
                    #
                    tcf::CODETEMP_INFO_FLOAT (fty, src) =>  unt fty + wv src;
                    #
                    tcf::FLOAD (fty, ea, mem) =>  unt fty + hash_int_expression ea;
                    #
                    tcf::FADD            x => hash2' x + 0u123;
                    tcf::FMUL            x => hash2' x + 0u1234;
                    tcf::FSUB            x => hash2' x + 0u12345;
                    tcf::FDIV            x => hash2' x + 0u234;
                    tcf::COPY_FLOAT_SIGN x => hash2' x + 0u883;
                    #   
                    tcf::FCONDITIONAL_LOAD (fty, c, x, y) => unt fty + hash_flag_expression c + hash_float_expression x + hash_float_expression y;
                    #
                    tcf::FABS              (fty, float_expression) =>  unt fty + hash_float_expression float_expression + 0u2345;
                    tcf::FNEG              (fty, float_expression) =>  unt fty + hash_float_expression float_expression + 0u23456;
                    tcf::FSQRT             (fty, float_expression) =>  unt fty + hash_float_expression float_expression + 0u345;
                    #
                    tcf::INT_TO_FLOAT      (fty, type, int_expression  ) =>  unt fty + unt type + hash_int_expression int_expression;
                    tcf::FLOAT_TO_FLOAT    (fty, fty', float_expression) =>  unt fty + hash_float_expression float_expression + unt fty';
                    #
                    tcf::FNOTE (e, _)     =>  hash_float_expression e;
                    tcf::FPRED (e, ctrl)  =>  hash_float_expression e + hash_ctrl ctrl;
                    tcf::FEXT (fty, fext) =>  unt fty + hash_fext (hasher()) fext;
                esac

            also
            fun hash_fexps ([], h) => h;
                hash_fexps (e ! es, h) => hash_fexps (es, hash_float_expression e + h);
            end 

            also
            fun hash_flag_expression flag_expression
                =
                case flag_expression   
                    #
                    tcf::CC (cc, src) => tcp::hash_cond cc + wv src;
                    tcf::FCC (fcc, src) => tcp::hash_fcond fcc + wv src;
                    tcf::CMP (type, cond, x, y) => 
                       unt type + tcp::hash_cond cond + hash_int_expression x + hash_int_expression y;
                    tcf::FCMP (fty, fcond, x, y) => 
                       unt fty + tcp::hash_fcond fcond + hash_float_expression x + hash_float_expression y;
                    tcf::NOT x => 0u2321 + hash_flag_expression x; 
                    tcf::AND (x, y) => 0u2321 + hash_flag_expression x + hash_flag_expression y;
                    tcf::OR (x, y) => 0u8721 + hash_flag_expression x + hash_flag_expression y;
                    tcf::XOR (x, y) => 0u6178 + hash_flag_expression x + hash_flag_expression y;
                    tcf::EQV (x, y) => 0u178 + hash_flag_expression x + hash_flag_expression y;
                    tcf::TRUE => 0u0;
                    tcf::FALSE => 0u1232;
                    tcf::CCNOTE (e, _) => hash_flag_expression e;
                    tcf::CCEXT (type, ccext) => unt type + hash_ccext (hasher()) ccext;
                esac

            also
            fun hash_flag_expressions ([], h) => h;
                hash_flag_expressions (e ! es, h) => hash_flag_expressions (es, hash_flag_expression e + h);
            end;


            hash = hash_int_expression;
        end;                                                                    # stipulate
    };                                                                          # generic package   treecode_hash_g
end;                                                                            # stipulate

## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext