## machcode-universals-sparc32-g.pkg
# Compiled by:
# src/lib/compiler/back/low/sparc32/backend-sparc32.lib# We are invoked from:
#
# src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.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_sparc32_g (
# ============================
#
package mcf: Machcode_Sparc32; # Machcode_Sparc32 is from src/lib/compiler/back/low/sparc32/code/machcode-sparc32.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 {
# Export to client packages:
#
package mcf = mcf; # "mcf" == "machcode_form" (abstract machine code).
package rgk = mcf::rgk; # "rgk" == "registerkinds".
stipulate
package tcf = mcf::tcf; # "tcf" == "treecode_form".
herein
exception NEGATE_CONDITIONAL;
fun error msg
=
lem::error("machcode_universals_sparc32_g", 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
;
always_zero_register
=
null_or::the # We know it exists on sparc32.
(rgk::get_always_zero_register rkj::INT_REGISTER);
r15 = rgk::get_ith_hardware_register_of_kind rkj::INT_REGISTER 15;
r31 = rgk::get_ith_hardware_register_of_kind rkj::INT_REGISTER 31;
# ========================================================================
# Instruction Kinds
# ========================================================================
fun instruction_kind (mcf::NOTE { op, ... } )
=>
instruction_kind op;
instruction_kind (mcf::COPY _)
=>
k::COPY;
instruction_kind (mcf::BASE_OP instruction)
=>
case instruction
#
(mcf::BICC _) => k::JUMP;
(mcf::FBFCC _) => k::JUMP;
(mcf::JMP _) => k::JUMP;
(mcf::RET _) => k::JUMP;
(mcf::BR _) => k::JUMP;
(mcf::BP _) => k::JUMP;
(mcf::TICC { t=>mcf::BA, ... } ) => k::JUMP; # trap always
(mcf::CALL { cuts_to=>_ ! _, ... } ) => k::CALL_WITH_CUTS;
(mcf::CALL _) => k::CALL;
(mcf::JMPL { cuts_to=>_ ! _, ... } ) => k::CALL_WITH_CUTS;
(mcf::JMPL _) => k::CALL;
(mcf::PHI _) => k::PHI;
(mcf::SOURCE _) => k::SOURCE;
(mcf::SINK _) => k::SINK;
_ => k::PLAIN;
esac;
instruction_kind _ => error "instrKind";
end;
fun branch_targets (mcf::NOTE { op, ... } )
=>
branch_targets op;
branch_targets (mcf::BASE_OP instruction)
=>
case instruction
#
(mcf::BICC { b=>mcf::BA, label, ... } ) => [LABELLED label];
(mcf::BICC { label, ... } ) => [LABELLED label, FALLTHROUGH];
(mcf::FBFCC { b=>mcf::FBA, label, ... } ) => [LABELLED label];
(mcf::FBFCC { label, ... } ) => [LABELLED label, FALLTHROUGH];
(mcf::BR { label, ... } ) => [LABELLED label, FALLTHROUGH];
(mcf::BP { label, ... } ) => [LABELLED label, FALLTHROUGH];
(mcf::JMP { labs => [], ... } ) => [ESCAPES];
(mcf::RET _) => [ESCAPES];
(mcf::JMP { labs, ... } ) => map LABELLED labs;
(mcf::CALL { cuts_to, ... } ) => FALLTHROUGH ! map LABELLED cuts_to;
(mcf::JMPL { cuts_to, ... } ) => FALLTHROUGH ! map LABELLED cuts_to;
(mcf::TICC { t=>mcf::BA, ... } ) => [ESCAPES];
_ => error "branchTargets";
esac;
branch_targets _ => error "branchTargets";
end;
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::BICC { b=>mcf::BA, a, nop, ... } ), l)
=>
mcf::bicc { b=>mcf::BA, a, label=>l, nop };
set_jump_target _ => error "setJumpTarget";
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::BICC { b=>mcf::BA, a, nop, ... } ), ... }
=>
error "setBranchTargets: Bicc";
set_branch_targets { op=>mcf::BASE_OP (mcf::BICC { b, a, nop, ... } ), true, false }
=>
mcf::bicc { b, a, label=>true, nop };
set_branch_targets { op=>mcf::BASE_OP (mcf::FBFCC { b, a, nop, ... } ), true, ... }
=>
mcf::fbfcc { b, a, label=>true, nop };
set_branch_targets { op=>mcf::BASE_OP (mcf::BR { rcond, p, r, a, nop, ... } ), true, ... }
=>
mcf::br { rcond, p, r, a, label=>true, nop };
set_branch_targets { op=>mcf::BASE_OP (mcf::BP { b, cc, p, a, nop, ... } ), true, ... }
=>
mcf::bp { b, cc, p, a, label=>true, nop };
set_branch_targets _ => error "set_branch_targets";
end;
fun rev_cond mcf::BA => mcf::BN;
rev_cond mcf::BN => mcf::BA;
rev_cond mcf::BNE => mcf::BE;
rev_cond mcf::BE => mcf::BNE;
rev_cond mcf::BG => mcf::BLE;
rev_cond mcf::BLE => mcf::BG;
rev_cond mcf::BGE => mcf::BL;
rev_cond mcf::BL => mcf::BGE;
rev_cond mcf::BGU => mcf::BLEU;
rev_cond mcf::BLEU => mcf::BGU;
rev_cond mcf::BCC => mcf::BCS;
rev_cond mcf::BCS => mcf::BCC;
rev_cond mcf::BPOS => mcf::BNEG;
rev_cond mcf::BNEG => mcf::BPOS;
rev_cond mcf::BVC => mcf::BVS;
rev_cond mcf::BVS => mcf::BVC;
end;
fun rev_fcond mcf::FBA => mcf::FBN;
rev_fcond mcf::FBN => mcf::FBA;
rev_fcond mcf::FBU => mcf::FBO;
rev_fcond mcf::FBG => mcf::FBULE;
rev_fcond mcf::FBUG => mcf::FBLE;
rev_fcond mcf::FBL => mcf::FBUGE;
rev_fcond mcf::FBUL => mcf::FBGE;
rev_fcond mcf::FBLG => mcf::FBUE;
rev_fcond mcf::FBNE => mcf::FBE;
rev_fcond mcf::FBE => mcf::FBNE;
rev_fcond mcf::FBUE => mcf::FBLG;
rev_fcond mcf::FBGE => mcf::FBUL;
rev_fcond mcf::FBUGE => mcf::FBL;
rev_fcond mcf::FBLE => mcf::FBUG;
rev_fcond mcf::FBULE => mcf::FBG;
rev_fcond mcf::FBO => mcf::FBU;
end;
fun rev_rcond mcf::RZ => mcf::RNZ;
rev_rcond mcf::RLEZ => mcf::RGZ;
rev_rcond mcf::RLZ => mcf::RGEZ;
rev_rcond mcf::RNZ => mcf::RZ;
rev_rcond mcf::RGZ => mcf::RLEZ;
rev_rcond mcf::RGEZ => mcf::RLZ;
end;
fun rev_p mcf::PT => mcf::PN;
rev_p mcf::PN => mcf::PT;
end;
fun negate_conditional (mcf::BASE_OP (mcf::BICC { b, a, nop, ... } ), lab)
=>
mcf::bicc { b=>rev_cond b, a, label=>lab, nop };
negate_conditional (mcf::BASE_OP (mcf::FBFCC { b, a, nop, ... } ), lab)
=>
mcf::fbfcc { b=>rev_fcond b, a, label=>lab, nop };
negate_conditional (mcf::BASE_OP (mcf::BR { p, r, rcond, a, nop, ... } ), lab)
=>
mcf::br { p=>rev_p p, a, r, rcond=>rev_rcond rcond, label=>lab, nop };
negate_conditional (mcf::BASE_OP (mcf::BP { b, cc, p, a, nop, ... } ), lab)
=>
mcf::bp { p=>rev_p p, a, b=>rev_cond b, cc, label=>lab, nop };
negate_conditional (mcf::NOTE { op, note }, lab)
=>
mcf::NOTE { op => negate_conditional (op, lab), note };
negate_conditional _ => raise exception NEGATE_CONDITIONAL;
end;
fun jump label
=
mcf::bicc { b=>mcf::BA, a=>TRUE, label, nop=>TRUE };
immed_range = { lo=> -4096, hi => 4095 };
fun load_immed { immed, t }
=
mcf::arith
{ a=>mcf::OR,
r=>always_zero_register,
i=> if (immed_range.lo <= immed and immed <= immed_range.hi)
mcf::IMMED immed;
else mcf::LAB (tcf::LITERAL (multiword_int::from_int immed));
fi,
d=>t
};
fun load_operand { operand, t }
=
mcf::arith { a=>mcf::OR, r=>always_zero_register, i=>operand, d=>t };
fun move_instruction (mcf::NOTE { op, ... } ) => move_instruction op;
move_instruction (mcf::COPY _) => TRUE;
#
move_instruction (mcf::LIVE _) => FALSE;
move_instruction (mcf::DEAD _) => FALSE;
move_instruction _ => FALSE;
end;
fun nop ()
=
mcf::sethi { d=>always_zero_register, i=>0 };
# ========================================================================
# Parallel Move
# ========================================================================
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;
# ========================================================================
# Equality and hashing
# ========================================================================
fun hash_operand (mcf::REG r) => rkj::register_to_hashcode r;
hash_operand (mcf::IMMED i) => unt::from_int i;
hash_operand (mcf::LAB l) => tch::hash l;
hash_operand (mcf::LO l) => tch::hash l;
hash_operand (mcf::HI l) => tch::hash l;
end;
fun eq_operand (mcf::REG a, mcf::REG b) => rkj::codetemps_are_same_color (a, b);
eq_operand (mcf::IMMED a, mcf::IMMED b) => a == b;
eq_operand (mcf::LAB a, mcf::LAB b) => tce::(====) (a, b);
eq_operand (mcf::LO a, mcf::LO b) => tce::(====) (a, b);
eq_operand (mcf::HI a, mcf::HI b) => tce::(====) (a, b);
eq_operand _ => FALSE;
end;
fun def_use_r instruction
=
{ fun op (mcf::REG r, def, uses) => (def, r ! uses);
op (_, def, uses) => (def, uses);
end;
fun sparc_du instruction
=
case instruction
#
mcf::LOAD { r, d, i, ... } => op (i,[d],[r]);
mcf::STORE { r, d, i, ... } => op (i,[],[r, d]);
mcf::FLOAD { r, d, i, ... } => op (i,[],[r]);
mcf::FSTORE { r, d, i, ... } => op (i,[],[r]);
mcf::SETHI { d, ... } => ([d],[]);
mcf::ARITH { r, i, d, ... } => op (i,[d],[r]);
mcf::SHIFT { r, i, d, ... } => op (i,[d],[r]);
mcf::BR { r, ... } => ([],[r]);
mcf::MOVICC { i, d, ... } => op (i,[d],[d]);
mcf::MOVFCC { i, d, ... } => op (i,[d],[d]);
mcf::MOVR { r, i, d, ... } => op (i,[d],[r, d]);
mcf::CALL { defs, uses, ... } => (r15 ! rgk::get_int_codetemp_infos defs, rgk::get_int_codetemp_infos uses);
mcf::JMP { r, i, ... } => op (i,[],[r]);
mcf::RET { leaf=>FALSE, ... } => ([],[r31]);
mcf::RET { leaf=>TRUE, ... } => ([],[r15]);
mcf::SAVE { r, i, d } => op (i,[d],[r]);
mcf::RESTORE { r, i, d } => op (i,[d],[r]);
mcf::TICC { r, i, ... } => op (i,[],[r]);
mcf::RDY { d, ... } => ([d],[]);
mcf::WRY { r, i, ... } => op (i,[],[r]);
mcf::JMPL { defs, uses, d, r, i, ... }
=>
op (i, d ! rgk::get_int_codetemp_infos defs, r ! rgk::get_int_codetemp_infos uses);
_ => ([],[]);
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 => sparc_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;
};
# Use of FP registers:
#
fun def_use_f instruction
=
{ fun sparc_du instruction
=
case instruction
#
mcf::FLOAD { r, d, i, ... } => ([d],[]);
mcf::FSTORE { r, d, i, ... } => ([],[d]);
mcf::FPOP1 { r, d, ... } => ([d],[r]);
mcf::FPOP2 { r1, r2, d, ... } => ([d],[r1, r2]);
mcf::FCMP { r1, r2, ... } => ([],[r1, r2]);
mcf::JMPL { defs, uses, ... } => (rgk::get_float_codetemp_infos defs, rgk::get_float_codetemp_infos uses);
mcf::CALL { defs, uses, ... } => (rgk::get_float_codetemp_infos defs, rgk::get_float_codetemp_infos uses);
mcf::FMOVICC { r, d, ... } => ([d],[r, d]);
mcf::FMOVFCC { r, d, ... } => ([d],[r, d]);
_ => ([],[]);
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 => sparc_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 rkj::INT_REGISTER => def_use_r;
def_use rkj::FLOAT_REGISTER => def_use_f;
def_use _ => error "defUse";
end;
# ========================================================================
# Annotations
# ========================================================================*/
fun get_notes (mcf::NOTE { op, note } )
=>
{ (get_notes op) -> (op, notes);
#
(op, note ! notes);
};
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.