PreviousUpNext

15.4.264  src/lib/compiler/back/low/intel32/regor/instruction-rewriter-intel32-g.pkg

## instruction-rewriter-intel32-g.pkg -- rewrite an intel32 instruction 

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


stipulate
    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   instruction_rewriter_intel32_g   (                # NOWHERE INVOKED.
        #             ==============================
        #
        mcf:  Machcode_Intel32                                          # Machcode_Intel32                      is from   src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api
    )
    : (weak)  Instruction_Rewriter_Intel32                              # Instruction_Rewriter_Intel32          is from   src/lib/compiler/back/low/intel32/regor/instruction-rewriter-intel32.api
    {
        # Exported to client packages:
        #
        package mcf  =  mcf;

        stipulate
            package rgk =  mcf::rgk;                                    # "rgk" == "registerkinds".
        herein

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

            fun do_operand (rs, rt) operand
                =
                case  operand
                    #
                    mcf::DIRECT r
                        =>
                        if (rkj::codetemps_are_same_color (r, rs))   mcf::DIRECT rt;
                        else                           operand;
                        fi;

                    mcf::DISPLACE { base, disp, ramregion }
                        => 
                        if (rkj::codetemps_are_same_color (base, rs))   mcf::DISPLACE { base=>rt, disp, ramregion }; 
                        else                              operand;
                        fi;

                    mcf::INDEXED { base as THE b, index, scale, disp, ramregion }
                        =>
                        {   base'= if (rkj::codetemps_are_same_color (b, rs) ) THE rt; else base;fi;
                            index'=if (rkj::codetemps_are_same_color (index, rs) ) rt; else index;fi;
                            mcf::INDEXED { base=>base', index=>index', scale, disp, ramregion };
                        };

                    mcf::INDEXED { base, index, scale, disp, ramregion }
                        => 
                        if (rkj::codetemps_are_same_color (index, rs))   mcf::INDEXED { base, index=>rt, scale, disp, ramregion };
                        else                              operand;
                        fi;

                    _ => operand;
                esac;


            fun rewrite_use (instruction, rs, rt)
                =
                {
                    do_operand = do_operand (rs, rt);

                    fun replace r = if (rkj::codetemps_are_same_color (r, rs) ) rt; else r;fi;

                    fun rewrite_intel32use (instruction)
                        = 
                        case instruction
                            mcf::JMP (operand, labs) => mcf::JMP (do_operand operand, labs);
                            mcf::JCC { cond, operand } => mcf::JCC { cond, operand => do_operand operand };

                            mcf::CALL { operand, defs, uses, return, cuts_to, ramregion, pops }
                                => 
                                mcf::CALL { operand=>do_operand operand, defs, return,
                                      uses=>rkj::cls::replace_this_by_that_in_codetemplists { this=>rs, that=>rt } uses, cuts_to,
                                      ramregion, pops };

                            mcf::MOVE { mv_op, src, dst as mcf::DIRECT _} => 
                               mcf::MOVE { mv_op, src=>do_operand src, dst };

                            mcf::MOVE { mv_op, src, dst } => 
                               mcf::MOVE { mv_op, src=>do_operand src, dst=>do_operand dst };

                            mcf::LEA { r32, address } => mcf::LEA { r32, address=>do_operand address };
                            mcf::CMPL { lsrc, rsrc } => mcf::CMPL { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };
                            mcf::CMPW { lsrc, rsrc } => mcf::CMPW { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };
                            mcf::CMPB { lsrc, rsrc } => mcf::CMPB { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };
                            mcf::TESTL { lsrc, rsrc } => mcf::TESTL { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };
                            mcf::TESTW { lsrc, rsrc } => mcf::TESTW { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };
                            mcf::TESTB { lsrc, rsrc } => mcf::TESTB { lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };

                            mcf::BITOP { bit_op, lsrc, rsrc } => 
                              mcf::BITOP { bit_op, lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };

                            mcf::BINARY { bin_op, src, dst } => 
                              mcf::BINARY { bin_op, src=>do_operand src, dst=>do_operand dst };

                            mcf::SHIFT { shift_op, src, dst, count } => 
                              mcf::SHIFT { shift_op, src=>do_operand src, dst=>do_operand dst, 
                                      count=>do_operand src };

                            mcf::CMPXCHG { lock, size, src, dst } => 
                              mcf::CMPXCHG { lock, size, src=>do_operand src, dst=>do_operand dst };

                            mcf::MULTDIV { mult_div_op, src } => 
                              mcf::MULTDIV { mult_div_op, src=>do_operand src };

                            mcf::MUL3 { dst, src1, src2 } => 
                              mcf::MUL3 { dst, src1=>do_operand src1, src2 };

                            mcf::UNARY { un_op, operand } => mcf::UNARY { un_op, operand=>do_operand operand };
                            mcf::SET { cond, operand } => mcf::SET { cond, operand=>do_operand operand };
                            mcf::PUSHL operand => mcf::PUSHL (do_operand operand);
                            mcf::PUSHW operand => mcf::PUSHW (do_operand operand);
                            mcf::PUSHB operand => mcf::PUSHB (do_operand operand);
                            mcf::POP operand  => mcf::POP (do_operand operand);
                            mcf::FSTPT operand => mcf::FSTPT (do_operand operand);
                            mcf::FSTPL operand => mcf::FSTPL (do_operand operand);
                            mcf::FSTPS operand => mcf::FSTPS (do_operand operand);
                            mcf::FSTL operand => mcf::FSTL (do_operand operand);
                            mcf::FSTS operand => mcf::FSTS (do_operand operand);
                            mcf::FLDT operand => mcf::FLDT (do_operand operand);
                            mcf::FLDL operand => mcf::FLDL (do_operand operand);
                            mcf::FLDS operand => mcf::FLDS (do_operand operand);
                            mcf::FUCOM operand => mcf::FUCOM (do_operand operand);
                            mcf::FUCOMP operand => mcf::FUCOMP (do_operand operand);
                            mcf::FCOMI operand => mcf::FCOMI (do_operand operand);
                            mcf::FCOMIP operand => mcf::FCOMIP (do_operand operand);
                            mcf::FUCOMI operand => mcf::FUCOMI (do_operand operand);
                            mcf::FUCOMIP operand => mcf::FUCOMIP (do_operand operand);
                            mcf::FENV { fenv_op, operand } => mcf::FENV { fenv_op, operand=>do_operand operand };

                            mcf::FBINARY { bin_op, src, dst } => 
                              mcf::FBINARY { bin_op, src=>do_operand src, dst };

                            mcf::FIBINARY { bin_op, src } => 
                              mcf::FIBINARY { bin_op, src=>do_operand src };

                             #  Pseudo floating point instructions 
                            mcf::FMOVE { fsize, src, dst } => 
                              mcf::FMOVE { fsize, src=>do_operand src, dst=>do_operand dst };

                            mcf::FILOAD { isize, ea, dst } => 
                              mcf::FILOAD { isize, ea=>do_operand ea, dst=>do_operand dst };

                            mcf::FBINOP { fsize, bin_op, lsrc, rsrc, dst } =>
                              mcf::FBINOP { fsize, bin_op,
                                       lsrc=>do_operand lsrc, rsrc=>do_operand rsrc, dst=>do_operand dst };

                            mcf::FIBINOP { isize, bin_op, lsrc, rsrc, dst } =>
                              mcf::FIBINOP { isize, bin_op,
                                        lsrc=>do_operand lsrc, rsrc=>do_operand rsrc, dst=>do_operand dst };

                            mcf::FUNOP { fsize, un_op, src, dst } =>
                              mcf::FUNOP { fsize, un_op, src=>do_operand src, dst=>do_operand dst };

                            mcf::FCMP { i, fsize, lsrc, rsrc } =>
                              mcf::FCMP { i, fsize, lsrc=>do_operand lsrc, rsrc=>do_operand rsrc };

                            mcf::CMOV { cond, src, dst } => mcf::CMOV { cond, src=>do_operand src, dst };
                            _ => instruction;
                        esac;


                    fun f (mcf::NOTE { note, op } )
                            => 
                            mcf::NOTE  { op   => rewrite_use (op, rs, rt),
                                        note => case note
                                                    rkj::DEF_USE { registerkind=>rkj::INT_REGISTER, defs, uses }
                                                        =>
                                                        rkj::DEF_USE { registerkind=>rkj::INT_REGISTER, uses=>map replace uses, defs };

                                                    _   => note;
                                                esac
                                    };

                        f (mcf::BASE_OP i)
                            =>
                            mcf::BASE_OP (rewrite_intel32use i);

                        f (mcf::COPY { kind as rkj::INT_REGISTER, size_in_bits, dst, src, tmp } )
                            => 
                            mcf::COPY { kind, size_in_bits, dst, src=>map replace src, tmp };

                        f _  => error "rewrite_use: f";
                    end;

                    f (instruction: mcf::Machine_Op);
                };                                                      # fun rewrite_use

            fun rewrite_def (instruction, rs, rt)
                =
                f  instruction
                where
                    fun do_operand (operand as mcf::DIRECT r)
                            => 
                            if (rkj::codetemps_are_same_color (r, rs))  mcf::DIRECT rt;
                            else                         operand;
                            fi;

                       do_operand _
                           =>
                           error "operand: not mcf::DIRECT";
                    end;

                    fun replace r
                        =
                        if (rkj::codetemps_are_same_color (r, rs))   rt;
                        else                            r;
                        fi;

                    fun rewrite_intel32def  instruction
                        =
                        case instruction 
                            #
                            mcf::CALL { operand, defs, uses, return, cuts_to, ramregion, pops }
                                => 
                                mcf::CALL { operand, cuts_to, 
                                       return=>rkj::cls::replace_this_by_that_in_codetemplists { this=>rs, that=>rt } return, pops,
                                       defs=>rkj::cls::replace_this_by_that_in_codetemplists { this=>rs, that=>rt } defs, uses, ramregion };

                            mcf::MOVE { mv_op, src, dst } => mcf::MOVE { mv_op, src, dst=>do_operand dst };
                            mcf::LEA { r32, address } => mcf::LEA { r32=>replace r32, address };

                            mcf::BINARY { bin_op, src, dst }
                                => 
                                mcf::BINARY { bin_op, src, dst=>do_operand dst };

                            mcf::SHIFT { shift_op, src, dst, count }
                                => 
                                mcf::SHIFT { shift_op, src, count, dst=>do_operand dst };

                            mcf::CMPXCHG { lock, size, src, dst }
                                => 
                                mcf::CMPXCHG { lock, size, src, dst=>do_operand dst };

                            mcf::MUL3 { dst, src1, src2 } => mcf::MUL3 { dst=>replace dst, src1, src2 };
                            mcf::UNARY { un_op, operand } => mcf::UNARY { un_op, operand=>do_operand operand };
                            mcf::SET { cond, operand } => mcf::SET { cond, operand=>do_operand operand };
                            mcf::CMOV { cond, src, dst } => mcf::CMOV { cond, src, dst=>replace dst };

                            _ => instruction;
                        esac;

                    fun f (mcf::NOTE { note, op } )
                               =>
                               mcf::NOTE { op=>rewrite_def (op, rs, rt),
                                         note => case note
                                                     rkj::DEF_USE { registerkind=>rkj::INT_REGISTER, defs, uses }
                                                         =>
                                                         rkj::DEF_USE { registerkind=>rkj::INT_REGISTER, uses, defs=>map replace defs };
                                                     _ => note;
                                                 esac
                                       };

                       f (mcf::BASE_OP i) => mcf::BASE_OP (rewrite_intel32def i);

                       f (mcf::COPY { kind as rkj::INT_REGISTER, size_in_bits, dst, src, tmp } )
                           =>
                           mcf::COPY { kind, size_in_bits, dst=>map replace dst, src, tmp };

                       f _ => error "rewrite_def: f";
                   end;
                end;

            fun frewrite_use (instruction, fs, ft)
                =
                f  instruction
                where
                    fun foperand (operand as mcf::FDIRECT f)
                            => 
                            if (rkj::codetemps_are_same_color (f, fs))   mcf::FDIRECT ft;
                            else                           operand;
                            fi;

                        foperand (operand as mcf::FPR f)
                            => 
                            if (rkj::codetemps_are_same_color (f, fs))   mcf::FPR ft;
                            else                           operand;
                            fi;

                        foperand operand
                            =>
                            operand;
                    end;

                    fun replace f
                        =
                        if (rkj::codetemps_are_same_color (f, fs))   ft;
                        else                           f;
                        fi;

                    fun frewrite_intel32use (instruction)
                       = 
                       case instruction

                           mcf::FLDL operand => mcf::FLDL (foperand operand);
                           mcf::FLDS operand => mcf::FLDS (foperand operand);

                           mcf::CALL { operand, defs, uses, return, cuts_to, ramregion, pops }
                               => 
                               mcf::CALL { operand, defs, return, cuts_to,
                                     uses=>rkj::cls::replace_this_by_that_in_codetemplists { this=>fs, that=>ft } uses, ramregion, pops };

                           mcf::FBINARY { bin_op, src, dst }
                               => 
                               mcf::FBINARY { bin_op, src=>foperand src, dst=>foperand dst };

                           mcf::FUCOM operand => mcf::FUCOM (foperand operand);
                           mcf::FUCOMP operand => mcf::FUCOMP (foperand operand);
                           mcf::FCOMI operand => mcf::FCOMI (foperand operand);
                           mcf::FCOMIP operand => mcf::FCOMIP (foperand operand);
                           mcf::FUCOMI operand => mcf::FUCOMI (foperand operand);
                           mcf::FUCOMIP operand => mcf::FUCOMIP (foperand operand);

                           #  Pseudo floating point instructions 
                           mcf::FMOVE { fsize, dst, src }
                               =>
                               mcf::FMOVE { fsize, dst, src=>foperand src };

                           mcf::FBINOP { fsize, bin_op, lsrc, rsrc, dst }
                               =>
                               mcf::FBINOP { fsize, bin_op,
                                      lsrc=>foperand lsrc, rsrc=>foperand rsrc, dst };

                           mcf::FIBINOP { isize, bin_op, lsrc, rsrc, dst }
                               =>
                               mcf::FIBINOP { isize, bin_op,
                                       lsrc=>foperand lsrc, rsrc=>foperand rsrc, dst };

                           mcf::FUNOP { fsize, un_op, src, dst }
                               =>
                               mcf::FUNOP { fsize, un_op, src=>foperand src, dst };

                           mcf::FCMP { i, fsize, lsrc, rsrc }
                               =>
                               mcf::FCMP { i, fsize, lsrc=>foperand lsrc, rsrc=>foperand rsrc };

                           _ => instruction;
                       esac;


                    fun f (mcf::NOTE { note, op } )
                              => 
                               mcf::NOTE { op=>frewrite_use (op, fs, ft),
                                         note => case note
                                                     #
                                                     rkj::DEF_USE { registerkind=>rkj::FLOAT_REGISTER, defs, uses }
                                                         =>
                                                         rkj::DEF_USE { registerkind=>rkj::FLOAT_REGISTER, uses=>map replace uses,
                                                                 defs };

                                                     _   => note;
                                                 esac
                                       };

                       f (mcf::BASE_OP i) => mcf::BASE_OP (frewrite_intel32use i);

                       f (mcf::COPY { kind as rkj::FLOAT_REGISTER, size_in_bits, dst, src, tmp } )
                           => 
                           mcf::COPY { kind, size_in_bits, dst, src=>map replace src, tmp };

                       f _ => error "frewrite";
                   end;
                end;

            fun frewrite_def (instruction, fs, ft)
                =
                f  instruction
                where

                    fun foperand (operand as mcf::FDIRECT r)
                            => 
                            if (rkj::codetemps_are_same_color (r, fs))   mcf::FDIRECT ft;
                            else                           operand;
                            fi;

                        foperand (operand as mcf::FPR r)
                            => 
                            if (rkj::codetemps_are_same_color (r, fs))   mcf::FPR ft;
                            else                           operand;
                            fi;

                        foperand operand
                            =>
                            operand;
                    end;

                    fun replace f
                        =
                        if (rkj::codetemps_are_same_color (f, fs))   ft;
                        else                           f;
                        fi;

                    fun frewrite_intel32def (instruction)
                       = 
                       case instruction
                           mcf::FSTPT operand => mcf::FSTPT (foperand operand);
                           mcf::FSTPL operand => mcf::FSTPL (foperand operand);
                           mcf::FSTPS operand => mcf::FSTPS (foperand operand);
                           mcf::FSTL operand => mcf::FSTL (foperand operand);
                           mcf::FSTS operand => mcf::FSTS (foperand operand);

                           mcf::CALL { operand, defs, uses, return, cuts_to, ramregion, pops }
                               => 
                               mcf::CALL { operand, uses, cuts_to, ramregion, pops,
                                          defs   => rkj::cls::replace_this_by_that_in_codetemplists { this=>fs, that=>ft } defs, 
                                          return => rkj::cls::replace_this_by_that_in_codetemplists { this=>fs, that=>ft } return
                                          
                                        };

                           mcf::FBINARY { bin_op, src, dst }
                               =>
                               mcf::FBINARY { bin_op, src, dst=>foperand dst };

                           #  Pseudo floating point instructions 
                           mcf::FMOVE { fsize, src, dst }
                               => 
                               mcf::FMOVE { fsize, src, dst=>foperand dst };

                           mcf::FILOAD { isize, ea, dst }
                               => 
                               mcf::FILOAD { isize, ea, dst=>foperand dst };

                           mcf::FBINOP { fsize, bin_op, lsrc, rsrc, dst }
                               =>
                               mcf::FBINOP { fsize, bin_op, lsrc, rsrc, dst=>foperand dst };

                           mcf::FIBINOP { isize, bin_op, lsrc, rsrc, dst }
                               =>
                               mcf::FIBINOP { isize, bin_op, lsrc, rsrc, dst=>foperand dst };

                           mcf::FUNOP { fsize, un_op, src, dst }
                               =>
                               mcf::FUNOP { fsize, un_op, src, dst=>foperand dst };

                           _  => instruction;
                        esac;

                    fun f (mcf::NOTE { op, note } )
                            =>
                            mcf::NOTE  { op => frewrite_def (op, fs, ft),
                                        #
                                        note =>  case note
                                                     #
                                                     rkj::DEF_USE { registerkind=>rkj::FLOAT_REGISTER, uses, defs }
                                                  => rkj::DEF_USE { registerkind=>rkj::FLOAT_REGISTER, uses, defs=>map replace defs };

                                                     _ => note;
                                                esac
                                     };

                        f (mcf::BASE_OP i)
                            =>
                            mcf::BASE_OP (frewrite_intel32def i);

                        f (mcf::COPY { kind as rkj::FLOAT_REGISTER, dst, src, tmp, size_in_bits } )
                            => 
                            mcf::COPY { kind, size_in_bits, dst=>map replace dst, src, tmp };

                        f _ => error "frewriteDef";
                    end;

                end;                                    # fun frewrite_def
        end;
    };
end;


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


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext