PreviousUpNext

15.4.338  src/lib/compiler/back/low/pwrpc32/code/machcode-universals-pwrpc32-g.pkg

## machcode-universals-pwrpc32-g.pkg

# Compiled by:
#     src/lib/compiler/back/low/pwrpc32/backend-pwrpc32.lib

# We are invoked from:
#
#     src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.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
herein

    generic package   machcode_universals_pwrpc32_g   (
        #             ============================
        #
        package mcf: Machcode_Pwrpc32;                                          # Machcode_Pwrpc32              is from   src/lib/compiler/back/low/pwrpc32/code/machcode-pwrpc32.codemade.api

        package tce: Treecode_Eval                                              # Treecode_Eval                 is from   src/lib/compiler/back/low/treecode/treecode-eval.api
                     where
                         tcf == mcf::tcf;                                       # "tcf" == "treecode_form".

        package tch: Treecode_Hash                                              # Treecode_Hash                 is from   src/lib/compiler/back/low/treecode/treecode-hash.api
                     where
                         tcf == mcf::tcf;                                       # "tcf" == "treecode_form".
    )
    : (weak) Machcode_Universals                                                # Machcode_Universals           is from   src/lib/compiler/back/low/code/machcode-universals.api
    {
        # We export these two to client packages:
        #
        package mcf =  mcf;                                                     # "mcf" == "machcode_form".
        package rgk =  mcf::rgk;                                                # "rgk" == "registerkinds".

        stipulate
            package tcf =  mcf::tcf;                                            # "tcf" == "treecode_form".
        herein

            exception NEGATE_CONDITIONAL;

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

            package k {
                #
                Kind = JUMP             # Branches, including returns.
                     | NOP              # No-ops 
                     | PLAIN            # Normal instructions 
                     | COPY             # Parallel copy 
                     | CALL             # Call instructions 
                     | CALL_WITH_CUTS   # Call with cut edges 
                     | PHI              # A phi node.    (For SSA -- static single assignment.) 
                     | SINK             # A sink node.   (For SSA -- static single assignment.) 
                     | SOURCE           # A source node. (For SSA -- static single assignment.) 
                     ;
            };

            Target = LABELLED  lbl::Codelabel
                   | FALLTHROUGH
                   | ESCAPES
                   ;

            # This architecture does not have
            # a hardwired always-zero register:
            #
            fun zero_r ()
                =
                rgk::get_ith_hardware_register_of_kind  rkj::INT_REGISTER  0;

            fun instruction_kind (mcf::NOTE { op, ... } )
                    =>
                    instruction_kind  op;

                instruction_kind (mcf::COPY _)
                    =>
                    k::COPY;

                instruction_kind  (mcf::BASE_OP  instruction)
                    =>
                    {
                        fun eq_test to
                            =
                            unt::bitwise_and (unt::from_int to, 0u4) != 0u0;

                        fun trap_always { to, ra, si }
                            = 
                            case si
                                #
                                mcf::REG_OP rb
                                    => 
                                    if (rkj::codetemps_are_same_color (ra, rb) and eq_test(to))  k::JUMP;
                                    else                                                         k::PLAIN;
                                    fi;

                                mcf::IMMED_OP 0
                                    =>
                                    if (rkj::interkind_register_id_of ra == 0 and eq_test(to))   k::JUMP;
                                    else                                                         k::PLAIN;
                                    fi;

                                _ => error "trapAlways: neither RegOp nor ImmedOp (0)";
                            esac;

                        case instruction
                            #
                            (mcf::BC _) => k::JUMP;
                            (mcf::BCLR _) => k::JUMP;
                            (mcf::BB _) => k::JUMP;
                            (mcf::TW t) => trap_always (t);
                            (mcf::TD t) => trap_always (t);
                            (mcf::ARITHI { oper=>mcf::ORI, rt, ra, im=>mcf::IMMED_OP 0 } )
                                => 
                                if (rkj::interkind_register_id_of rt == 0
                                and rkj::interkind_register_id_of ra == 0)   k::NOP;
                                else                                         k::PLAIN;
                                fi;
                            (mcf::CALL { cuts_to=>_ ! _, ... } ) => k::CALL_WITH_CUTS;
                            #
                            (mcf::CALL   _) =>  k::CALL;
                            (mcf::PHI    _) =>  k::PHI;
                            (mcf::SOURCE _) =>  k::SOURCE;
                            (mcf::SINK   _) =>  k::SINK;
                             _             =>  k::PLAIN;
                        esac;
                    };

                instruction_kind _ => error "instrKind";
            end;

            fun move_instruction (mcf::COPY _) => TRUE;
                move_instruction (mcf::NOTE { op, ... } ) => move_instruction  op;
                move_instruction  _ => FALSE;
            end;

            fun nop ()
                =
                mcf::arithi { oper=>mcf::ORI, rt=>zero_r(), ra=>zero_r(), im=>mcf::IMMED_OP 0 };

            fun move_tmp_r (mcf::COPY { tmp, ... } )
                    => 
                    case tmp
                        #
                        THE (mcf::DIRECT  r) =>  THE r;
                        THE (mcf::FDIRECT f) =>  THE f;
                        _ => NULL;
                    esac;

               move_tmp_r (mcf::NOTE { op, ... } )
                   =>
                   move_tmp_r  op;

               move_tmp_r _
                   =>
                   NULL;
            end;

            fun move_dst_src (mcf::COPY { dst, src, ... } ) => (dst, src);
                move_dst_src (mcf::NOTE { op, ... } ) => move_dst_src  op;
                move_dst_src _ => error "move_dst_src";
            end;


            fun branch_targets (mcf::BASE_OP (mcf::BC { bo=>mcf::ALWAYS, address,  ... } ))
                    => 
                    case address
                        #
                        mcf::LABEL_OP (tcf::LABEL lab) =>   [LABELLED lab];
                        _                             =>   error "branch_targets: BC: ALWAYS";
                     esac;


                branch_targets (mcf::BASE_OP (mcf::BC { address, ... } ))
                    => 
                    case address
                        #
                        mcf::LABEL_OP (tcf::LABEL lab) =>  [LABELLED lab, FALLTHROUGH];
                        _                             =>  error "branch_targets: BC";
                    esac;

                branch_targets (mcf::BASE_OP (mcf::BCLR { labels, bo=>mcf::ALWAYS, ... } ))
                    => 
                    case labels    [] => [ESCAPES];  _ => map LABELLED labels; esac;

                branch_targets (mcf::BASE_OP (mcf::BCLR { labels,  ... } ))
                    => 
                    case labels    [] => [ESCAPES, FALLTHROUGH];  _ => map LABELLED labels; esac;

                branch_targets (mcf::BASE_OP (mcf::BB { address=>mcf::LABEL_OP (tcf::LABEL lab), lk } ))
                    =>
                    [LABELLED lab];

                branch_targets (mcf::BASE_OP (mcf::CALL { cuts_to, ... } ))
                    =>
                    FALLTHROUGH ! map LABELLED cuts_to;

                branch_targets (mcf::BASE_OP (mcf::TD _)) =>   [ESCAPES];
                branch_targets (mcf::BASE_OP (mcf::TW _)) =>   [ESCAPES];

                branch_targets (mcf::NOTE { op, ... } )  =>   branch_targets  op;

                branch_targets _
                    =>
                    error "branchTargets";
            end;


            fun label_op l
                =
                mcf::LABEL_OP (tcf::LABEL l);


            fun set_jump_target (mcf::NOTE { note, op }, l)
                    =>
                    mcf::NOTE { note, op => set_jump_target (op, l) };

                set_jump_target (mcf::BASE_OP (mcf::BC { bo as mcf::ALWAYS, bf, bit, address, fall, lk } ), lab)
                    => 
                    mcf::bc { bo, bf, bit, fall, lk, address=>label_op lab };

                set_jump_target (mcf::BASE_OP (mcf::BB { address, lk } ), lab)
                    =>
                    mcf::bb { address=>label_op (lab), lk };

                set_jump_target _
                    =>
                    error "set_jump_target";
            end;


            fun set_branch_targets { i=>mcf::NOTE { note, op }, t, f }
                    => 
                    mcf::NOTE { note, op => set_branch_targets { i=>op, t, f }};

                set_branch_targets { i=>mcf::BASE_OP (mcf::BC { bo=>mcf::ALWAYS, bf, bit, address, fall, lk } ), ... }
                    => 
                    error "setBranchTargets";

                set_branch_targets { i=>mcf::BASE_OP (mcf::BC { bo, bf, bit, address, fall, lk } ), t, f }
                    => 
                    mcf::bc { bo, bf, bit, lk, address=>label_op t, fall=>label_op f };

                set_branch_targets _
                    =>
                    error "setBranchTargets";
            end;


            fun jump lab
                =
                mcf::bb { address=>mcf::LABEL_OP (tcf::LABEL lab), lk=>FALSE };


            fun negate_conditional (mcf::NOTE { note, op }, l)
                    => 
                    mcf::NOTE { note, op => negate_conditional (op, l) };

                negate_conditional (mcf::BASE_OP (mcf::BC { bo, bf, bit, address, fall, lk } ), lab)
                   =>
                   {   bo' = case bo 
                                 mcf::TRUE => mcf::FALSE;
                                 mcf::FALSE => mcf::TRUE;
                                 mcf::ALWAYS => error "negateCondtional: ALWAYS";
                                 mcf::COUNTER { eq_zero, cond=>NULL } => mcf::COUNTER { eq_zero=>not eq_zero, cond=>NULL };
                                 mcf::COUNTER { eq_zero, cond=>THE b } => error "negateConditional: COUNTER";
                             esac;

                        mcf::bc { bo=>bo', bf, bit, address=>label_op lab, fall, lk };
                    };

                negate_conditional _
                    =>
                    error "negateConditional";
            end;

            immed_range = { lo=> -32768, hi=>32767 };

            fun load_immed { immed, t }
                    = 
                    mcf::arithi
                      { oper=>mcf::ADDI, rt=>t, ra=>zero_r(), 
                        im => if (immed_range.lo <= immed and immed <= immed_range.hi)   mcf::IMMED_OP immed;
                              else                                                       mcf::LABEL_OP (mcf::tcf::LITERAL (multiword_int::from_int immed));
                              fi
                      };

            fun load_operand { operand, t }
                = 
                mcf::arithi { oper=>mcf::ADDI, rt=>t, ra=>zero_r(), im=>operand };


            fun hash_operand (mcf::REG_OP   r) =>  rkj::register_to_hashcode r;
                hash_operand (mcf::IMMED_OP i) =>  unt::from_int i;
                hash_operand (mcf::LABEL_OP l) =>  tch::hash l;
            end;

            fun eq_operand (mcf::REG_OP a, mcf::REG_OP b) => rkj::codetemps_are_same_color (a, b);
                eq_operand (mcf::IMMED_OP a, mcf::IMMED_OP b) => a == b;
                eq_operand (mcf::LABEL_OP a, mcf::LABEL_OP b) => tce::(====) (a, b);
                eq_operand _ => FALSE;
            end;

            fun def_use_r instruction
                =
                {
                    fun pwrpc32_du instruction
                        =
                        {
                            fun operand (mcf::REG_OP r, uses) =>  r ! uses;
                                operand(_, uses)            =>      uses;
                            end;

                            case instruction
                                #
                                mcf::LL { rt, ra, d, ... } => ([rt], operand (d,[ra]));
                                mcf::LF { ra, d, ... } => ([], operand (d,[ra]));
                                mcf::ST { rs, ra, d, ... } => ([], operand (d,[rs, ra]));
                                mcf::STF { ra, d, ... } => ([], operand (d,[ra]));
                                mcf::UNARY { rt, ra, ... } => ([rt], [ra]);
                                mcf::ARITH { rt, ra, rb, ... } => ([rt], [ra, rb]);
                                mcf::ARITHI { rt, ra, im, ... } => ([rt], operand (im,[ra]));
                                mcf::ROTATE { ra, rs, sh, ... } => ([ra], [rs, sh]);
                                mcf::ROTATEI { ra, rs, sh, ... } => ([ra], operand (sh,[rs]));
                                mcf::COMPARE { ra, rb, ... } => ([], operand (rb,[ra]));
                                mcf::MTSPR { rs, ... } => ([], [rs]);
                                mcf::MFSPR { rt, ... } => ([rt], []);
                                mcf::TW { to, ra, si } => ([], operand (si,[ra]));
                                mcf::TD { to, ra, si } => ([], operand (si,[ra]));
                                mcf::CALL { def, uses, ... } => (rgk::get_int_codetemp_infos def, rgk::get_int_codetemp_infos uses);
                                mcf::LWARX { rt, ra, rb, ... } => ([rt], [ra, rb]);
                                mcf::STWCX { rs, ra, rb, ... } => ([], [rs, ra, rb]); 
                                _ => ([], []);
                           esac;
                    };

                    case instruction
                        #
                        mcf::NOTE { op,   ... } =>  def_use_r  op;
                        mcf::LIVE { regs, ... } =>  ([], rgk::get_int_codetemp_infos regs);
                        mcf::DEAD { regs, ... } =>      (rgk::get_int_codetemp_infos regs, []);

                        mcf::BASE_OP (i) => pwrpc32_du (i);

                        mcf::COPY { kind, dst, src, tmp, ... }
                            =>
                            {
                                my (d, u)
                                    =
                                    case kind    rkj::INT_REGISTER => (dst, src);
                                                 _            => ([], []);
                                    esac;

                                case tmp
                                    #
                                    THE (mcf::DIRECT r) => (r ! d, u);
                                    THE (mcf::DISPLACE { base, ... } ) => (d, base ! u);
                                    _ => (d, u);
                                esac;
                          };
                    esac;
                };

            fun def_use_f instruction
                =
                {
                    fun pwrpc32_du instruction
                        = 
                        case instruction
                            #
                            mcf::LF { ft, ... } => ([ft],[]);
                            mcf::STF { fs, ... } => ([], [fs]);
                            mcf::FCOMPARE { fa, fb, ... }  => ([], [fa, fb]);
                            mcf::FUNARY { ft, fb, ... }  => ([ft], [fb]);
                            mcf::FARITH { ft, fa, fb, ... }  => ([ft], [fa, fb]);
                            mcf::FARITH3 { ft, fa, fb, fc, ... }  => ([ft], [fa, fb, fc]);
                            mcf::CALL { def, uses, ... } => (rgk::get_float_codetemp_infos def, rgk::get_float_codetemp_infos uses);
                            _ => ([], []);
                        esac;

                    case instruction
                        #
                        mcf::NOTE { op,   ... } =>  def_use_f  op;
                        #
                        mcf::LIVE { regs, ... } =>  ([], rgk::get_float_codetemp_infos regs);
                        mcf::DEAD { regs, ... } =>      (rgk::get_float_codetemp_infos regs, []);

                        mcf::BASE_OP i => pwrpc32_du (i);

                        mcf::COPY { kind, dst, src, tmp, ... }
                            =>
                            {   my (d, u)
                                    =
                                    case kind   rkj::FLOAT_REGISTER => (dst, src);
                                                _                  => ([],[]);
                                    esac;

                                case tmp
                                    THE (mcf::FDIRECT f) => (f ! d, u);
                                    _                  => (d, u);
                                esac;
                          };
                    esac;
                };

            fun def_use_cc instruction
                =
                error "defUseCC: not implemented";


            fun def_use  rkj::INT_REGISTER   =>  def_use_r;
                def_use  rkj::FLOAT_REGISTER =>  def_use_f;
                def_use  rkj::FLAGS_REGISTER =>  def_use_cc;
                def_use _ => error "defUse";
            end;


            #  Annotations 
            #
            fun get_notes (mcf::NOTE { op, note } )
                    => 
                    {   (get_notes op) ->   (i, an);
                        (i, note ! an);
                    };

                get_notes i
                    =>
                    (i,[]);
            end;


            fun annotate (op, note)
                =
                mcf::NOTE { op, note };


            # Replicate an instruction
            #
            fun replicate (mcf::NOTE { op, note } )
                    =>
                    mcf::NOTE { op => replicate op, note };

                replicate (mcf::COPY { kind, size_in_bits, tmp=>THE _, dst, src } )
                    =>  
                    mcf::COPY { kind, size_in_bits, tmp=>THE (mcf::DIRECT (rgk::make_int_codetemp_info ())), dst, src };

                replicate i
                    =>
                    i;
            end;
        end;
    };
end;



## 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