## 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.pkgstipulate
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.pkgherein
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 { op=>mcf::NOTE { note, op }, true, false }
=>
mcf::NOTE { note, op => set_branch_targets { op, true, false }};
set_branch_targets { op=>mcf::BASE_OP (mcf::BC { bo=>mcf::ALWAYS, bf, bit, address, fall, lk } ), ... }
=>
error "setBranchTargets";
set_branch_targets { op=>mcf::BASE_OP (mcf::BC { bo, bf, bit, address, fall, lk } ), true, false }
=>
mcf::bc { bo, bf, bit, lk, address=>label_op true, fall=>label_op false };
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-2015,
## released per terms of SMLNJ-COPYRIGHT.