## instruction-rewriter-intel32-g.pkg -- rewrite an intel32 instruction
# Compiled by:
# src/lib/compiler/back/low/intel32/backend-intel32.libstipulate
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.pkgherein
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-2015,
## released per terms of SMLNJ-COPYRIGHT.