Newer
Older
// any memory operand could have register uses in the addressing
// expression, and we must create Uses for those registers. For
// example: mov eax,[ebx + esi*2 + 044Ch]
// This is a two-operand instruction with one def: eax. But
// there are three uses: [ebx + esi*2 + 044Ch], ebx, and esi.
// The first use is an op_t of type o_phrase (memory phrase),
// which can be copied from cmd.Operands[1]. Likewise, we just
// copy cmd.Operands[0] into the defs list. However, we must create
// op_t types for register ebx and register esi and append them
// to the Uses list. This is handled by the machine dependent
// method MDFixupDefUseLists().
for (OpNum = 0; OpNum < UA_MAXOP; ++OpNum) {
if (this->features & UseMacros[OpNum]) { // USE
op_t TempOp = this->SMPcmd.Operands[OpNum];
if (MDKnownOperandType(TempOp)) {
clc5q
committed
SMP_msg("DEBUG: Setting USE for: ");
clc5q
committed
SMP_msg("\n");
if (o_reg == TempOp.type) {
// We want to map AH, AL, and AX to EAX, etc. throughout our data flow
// analysis and type inference systems.
TempOp.reg = MDCanonicalizeSubReg(TempOp.reg);
}
this->Uses.SetRef(TempOp);
}
} // end for (OpNum = 0; ...)
return;
} // end of SMPInstr::BuildSMPDefUseLists()
// If DefReg is not already in the DEF list, add a DEF for it.
void SMPInstr::MDAddRegDef(ushort DefReg, bool Shown, SMPOperandType Type) {
op_t TempDef = InitOp;
TempDef.type = o_reg;
TempDef.reg = DefReg;
if (Shown)
TempDef.set_showed();
else
TempDef.clr_showed();
return;
} // end of SMPInstr::MDAddRegDef()
// If UseReg is not already in the USE list, add a USE for it.
void SMPInstr::MDAddRegUse(ushort UseReg, bool Shown, SMPOperandType Type) {
op_t TempUse = InitOp;
TempUse.type = o_reg;
TempUse.reg = UseReg;
if (Shown)
TempUse.set_showed();
else
TempUse.clr_showed();
return;
} // end of SMPInstr::MDAddRegUse()
// Perform machine dependent ad hoc fixes to the def and use lists.
// For example, some multiply and divide instructions in x86 implicitly
// use and/or define register EDX. For memory phrase examples, see comment
// in BuildSMPDefUseLists().
void SMPInstr::MDFixupDefUseLists(void) {
// First, handle the uses hidden in memory addressing modes. Note that we do not
// care whether we are dealing with a memory destination operand or source
// operand, because register USEs, not DEFs, happen within the addressing expressions.
size_t OpNum;
SMPOperandType RefType;
int BaseReg;
int IndexReg;
ushort ScaleFactor;
ea_t displacement;
bool UseFP = true;
bool HasIndexReg = false;
bool leaInst = (NN_lea == this->SMPcmd.itype);
bool DebugFlag = (this->GetAddr() == 0x8086177);
clc5q
committed
SMP_msg("DEBUG: Fixing up DEF-USE lists for debug location\n");
#if SMP_BASEREG_POINTER_TYPE
// Some instructions are analyzed outside of any function or block when fixing up
// the IDB, so we have to assume the block and func pointers might be NULL.
if ((NULL != this->BasicBlock) && (NULL != this->BasicBlock->GetFunc()))
UseFP = this->BasicBlock->GetFunc()->UsesFramePointer();
#endif
if (DebugFlag) {
clc5q
committed
SMP_msg("DEBUG: UseFP = %d\n", UseFP);
for (OpNum = 0; OpNum < UA_MAXOP; ++OpNum) {
op_t Opnd = SMPcmd.Operands[OpNum];
if ((Opnd.type == o_phrase) || (Opnd.type == o_displ) || (Opnd.type == o_mem)) {
MDExtractAddressFields(Opnd, BaseReg, IndexReg, ScaleFactor, displacement);
SingleAddressReg = ((0 == displacement)
&& ((R_none == BaseReg) || (R_none == IndexReg)));
if (R_none != IndexReg) {
op_t IndexOpnd = Opnd; // Init to current operand field values
IndexOpnd.type = o_reg; // Change type and reg fields
IndexOpnd.reg = (ushort) IndexReg;
IndexOpnd.hasSIB = 0;
IndexOpnd.set_showed();
// We want to map AH, AL, and AX to EAX, etc. throughout our data flow
// analysis and type inference systems.
IndexOpnd.reg = MDCanonicalizeSubReg(IndexOpnd.reg);
if (0 == ScaleFactor)
this->Uses.SetRef(IndexOpnd);
else { // scaling == shift ==> NUMERIC
HasIndexReg = true;
this->Uses.SetRef(IndexOpnd, NUMERIC);
if (R_none != BaseReg) {
op_t BaseOpnd = Opnd; // Init to current operand field values
BaseOpnd.type = o_reg; // Change type and reg fields
BaseOpnd.reg = (ushort) BaseReg;
BaseOpnd.set_showed();
// We want to map AH, AL, and AX to EAX, etc. throughout our data flow
// analysis and type inference systems.
BaseOpnd.reg = MDCanonicalizeSubReg(BaseOpnd.reg);
RefType = UNINIT;
#if SMP_BASEREG_POINTER_TYPE
// R_sp and R_bp will get type STACKPTR in SMPInstr::SetImmedTypes().
// Other registers used as base registers should get their USEs as
// base registers typed as POINTER, which might get refined later
// to STACKPTR, GLOBALPTR, HEAPPTR, etc.
// NOTE: the NN_lea opcode is often used without a true base register.
// E.g. lea eax,[eax+eax+5] is an x86 idiom for eax:=eax*2+5, which
// could not be done in one instruction without using the addressing
// modes of the machine to do the arithmetic. We don't want to set the
// USE of EAX to POINTER in this case, so we will conservatively skip
// all lea instructions here.
// We cannot be sure that a register is truly a base register unless
// there is also an index register. E.g. with reg+displacement, we
// could have memaddr+indexreg or basereg+offset, depending on what
// the displacement is. The exception is if there is no offset and only
// one addressing register, e.g. mov eax,[ebx].
if (BaseOpnd.is_reg(R_sp) || (UseFP && BaseOpnd.is_reg(R_bp))
|| leaInst || (!HasIndexReg && !SingleAddressReg)) {
#endif
this->Uses.SetRef(BaseOpnd, RefType);
} // end if R_none != BaseReg
} // end if (o_phrase or o_displ operand)
} // end for (all operands)
// The lea (load effective address) instruction looks as if it has
// a memory USE: lea ebx,[edx+esi]
// However, this instruction is really just: ebx := edx+esi
// Now that the above code has inserted the "addressing" registers
// into the USE list, we should remove the "memory USE".
if (leaInst) {
set<DefOrUse, LessDefUse>::iterator CurrUse;
for (CurrUse = this->GetFirstUse(); CurrUse != this->GetLastUse(); ++CurrUse) {
op_t UseOp = CurrUse->GetOp();
if ((o_mem <= UseOp.type) && (o_displ >= UseOp.type)) {
this->LeaUSEMemOp = UseOp;
this->EraseUse(CurrUse);
this->USEMemOp = InitOp;
break;
}
}
}
// Next, handle repeat prefices in the instructions. The Intel REPE/REPZ prefix
// is just the text printed for SCAS/CMPS instructions that have a REP prefix.
// Only two distinct prefix codes are actually defined: REP and REPNE/REPNZ, and
// REPNE/REPNZ only applies to SCAS and CMPS instructions.
bool HasRepPrefix = (0 != (this->SMPcmd.auxpref & aux_rep));
bool HasRepnePrefix = (0 != (this->SMPcmd.auxpref & aux_repne));
if (HasRepPrefix && HasRepnePrefix)
clc5q
committed
SMP_msg("REP and REPNE both present at %x %s\n", this->GetAddr(), DisAsmText.GetDisAsm(this->GetAddr()));
if (HasRepPrefix || HasRepnePrefix) {
// All repeating instructions use ECX as the countdown register.
op_t BaseOpnd = InitOp;
BaseOpnd.type = o_reg; // Change type and reg fields
BaseOpnd.reg = R_cx;
BaseOpnd.clr_showed();
this->Defs.SetRef(BaseOpnd, NUMERIC);
this->Uses.SetRef(BaseOpnd, NUMERIC);
if ((this->SMPcmd.itype == NN_cmps) || (this->SMPcmd.itype == NN_scas)
|| (this->SMPcmd.itype == NN_movs) || (this->SMPcmd.itype == NN_stos)) {
// ESI and EDI are USEd and DEFed to point to source and dest strings for CMPS/MOVS.
// Only EDI is involved with SCAS/STOS.
op_t BaseOpnd = InitOp;
BaseOpnd.type = o_reg; // Change type and reg fields
BaseOpnd.clr_showed();
if ((this->SMPcmd.itype == NN_cmps) || (this->SMPcmd.itype == NN_movs)) {
BaseOpnd.reg = R_si;
this->Defs.SetRef(BaseOpnd, POINTER);
this->Uses.SetRef(BaseOpnd, POINTER);
}
BaseOpnd.reg = R_di;
this->Defs.SetRef(BaseOpnd, POINTER);
this->Uses.SetRef(BaseOpnd, POINTER);
// Now, handle special instruction categories that have implicit operands.
if (NN_cmpxchg == this->SMPcmd.itype) {
// x86 Compare and Exchange conditionally sets EAX. We must keep data flow analysis
// sound by declaring that EAX is always a DEF.
this->MDAddRegDef(R_ax, false);
} // end if NN_cmpxchg
else if (this->MDIsPopInstr() || this->MDIsPushInstr() || this->MDIsReturnInstr()) {
// IDA does not include the stack pointer in the DEFs or USEs.
this->MDAddRegDef(R_sp, false);
this->MDAddRegUse(R_sp, false);
// We always reference [esp+0] or [esp-4], so add it to the DEF or USE list.
op_t StackOp = InitOp;
StackOp.type = o_displ;
StackOp.reg = R_sp;
if (this->MDIsPopInstr()) {
StackOp.addr = 0; // [ESP+0]
this->Uses.SetRef(StackOp); // USE
}
else {
StackOp.addr = (ea_t) -4; // [ESP-4]
this->Defs.SetRef(StackOp); // DEF
}
clc5q
committed
else if ((this->type == CALL) || (this->type == INDIR_CALL) || this->IsTailCall()) {
// We want to add the caller-saved registers to the USEs and DEFs lists
this->MDAddRegDef(R_ax, false);
this->MDAddRegDef(R_cx, false);
this->MDAddRegDef(R_dx, false);
this->MDAddRegUse(R_ax, false);
this->MDAddRegUse(R_cx, false);
this->MDAddRegUse(R_dx, false);
#if 1
if (this->MDIsInterruptCall()) {
#endif
this->MDAddRegDef(R_bx, false);
this->MDAddRegUse(R_bx, false);
this->MDAddRegDef(R_si, false);
this->MDAddRegUse(R_si, false);
}
#endif
else if (this->MDIsEnterInstr() || this->MDIsLeaveInstr()) {
// Entire function prologue or epilogue microcoded.
this->MDAddRegDef(R_sp, false);
this->MDAddRegUse(R_sp, false);
this->MDAddRegDef(R_bp, false);
this->MDAddRegUse(R_bp, false);
else if ((this->SMPcmd.itype == NN_maskmovq)
|| (this->SMPcmd.itype == NN_maskmovdqu)) {
else if (8 == this->GetOptType()) {
// This category implicitly writes to EDX:EAX.
this->MDAddRegDef(R_dx, false);
this->MDAddRegDef(R_ax, false);
} // end else if (8 == GetOptType)
else if (7 == this->GetOptType()) {
// Category 7 instructions sometimes write implicitly to EDX:EAX or DX:AX.
// DX is the same as EDX to IDA Pro (and SMP); ditto for EAX and AX.
// DIV, IDIV, and MUL all have hidden EAX or AX operands (hidden in the IDA Pro
// sense, because they are not displayed in the disassembly text). For example:
// mul ebx means EDX:EAX <-- EAX*EBX, and mul bx means DX:AX <-- AX*BX. If the
// source operand is only 8 bits wide, there is room to hold the result in AX
// without using DX: mul bl means AX <-- AL*BL.
// IMUL has forms with a hidden EAX or AX operand and forms with no implicit
// operands: imul ebx means EDX:EAX <-- EAX*EBX, but imul ebx,edx means that
// EBX*EDX gets truncated and the result placed in EBX (no hidden operands).
for (OpNum = 0; OpNum < UA_MAXOP; ++OpNum) {
op_t TempUse = this->SMPcmd.Operands[OpNum];
if (!TempUse.showed()) { // hidden operand
if (TempUse.is_reg(R_ax)) { // not R_al, so it is not 8 bits
if ((NN_div == this->SMPcmd.itype) || (NN_idiv == this->SMPcmd.itype)) {
this->MDAddRegUse(R_dx, false);
}
this->MDAddRegDef(R_ax, false);
this->MDAddRegDef(R_dx, false);
}
}
}
} // end else if (7 == OptType)
#if 0
// The floating point instructions in type categories 14 and 15 often USE and DEF
// the floating point register stack, e.g. pushing a value onto that stack is a
// massive copy downward of stack locations. We don't really care about the USE of
// the stack if the value being pushed came from elsewhere than the stack. For example,
// an "fld" opcode pushes its source onto the stack. We build RTLs with a simple
// move structure, but the RTL building can be fooled by seeing two "source" operands
// in the USE list.
if ((14 == SMPTypeCategory[this->SMPcmd.itype])
|| (15 == SMPTypeCategory[this->SMPcmd.itype])) {
}
#endif
clc5q
committed
#if 0 // Not true for LOOP instructions that use only the ECX counter register.
if (this->type == COND_BRANCH) {
assert(SMPUsesFlags[this->SMPcmd.itype]);
}
clc5q
committed
#endif
// The return value register EAX is not quite like a caller-save or callee-save
// register (technically, it is caller-save). Within a callee, it might appear
// that EAX has become dead by the time a return instruction is reached, but
// the USE that would make it not dead is in the caller. To prevent type inference
// from mistakenly thinking that all USEs of EAX have been seen in the callee,
// we add EAX to the USE list for all return instructions, as well as for all
// tail calls, which are essentially returns in terms of data flow analysis.
// This USE of EAX will always be of type UNINIT unless its DEF has a known type
// that propagates to it. Thus, it will prevent an invalid back inference of the
// DEF type from "all" USE types that are visible in the callee; even if they
// were all NUMERIC, this return USE will be UNINIT and inhibit the invalid
// type inference. EAX could be loaded with a pointer from memory, for example,
// and USEd only in a comparison instruction, making it falsely appear to be
// a NUMERIC, without this extra USE at the return instruction.
// Because some of the library functions pass values around in EBX, EDI, etc.,
// we will add these general purpose registers to the USE list for returns
// in order to prevent erroneous analyses of dead registers or unused
// metadata.
if ((this->type == RETURN) || this->IsTailCall()) {
this->MDAddRegUse(R_ax, false);
this->MDAddRegUse(R_bx, false);
this->MDAddRegUse(R_cx, false);
this->MDAddRegUse(R_dx, false);
if (!UseFP)
this->MDAddRegUse(R_bp, false);
this->MDAddRegUse(R_si, false);
this->MDAddRegUse(R_di, false);
}
clc5q
committed
// Next, add the flags register to the DEFs and USEs for those instructions that
// are marked as defining or using flags.
if (!this->IsDefsFlags() && SMPDefsFlags[this->SMPcmd.itype]) {
this->MDAddRegDef(X86_FLAGS_REG, false);
this->SetDefsFlags();
if (!this->IsUsesFlags() && SMPUsesFlags[this->SMPcmd.itype]) {
this->MDAddRegUse(X86_FLAGS_REG, false);
this->SetUsesFlags();
}
if (this->IsNop()) {
// Clear the DEFs and USEs for no-ops.
// These include machine idioms for no-ops, e.g. mov esi,esi
// or xchg ax,ax or lea esi,[esi].
this->Defs.clear();
this->Uses.clear();
this->MoveSource = InitOp;
this->OptType = 1;
}
#endif
clc5q
committed
SMP_msg("DEBUG after MDFixupDefUseLists:\n");
return;
} // end of SMPInstr::MDFixupDefUseLists()
// If we can definitely identify which part of the addressing expression
// used in MemOp is the POINTER type, and it is not a STACKPTR or GLOBALPTR
// immediate, set the USE type for that register to POINTER and return true.
// If we can find definite NUMERIC addressing registers that are not already
// typed as NUMERIC, set their USE types to NUMERIC and return true.
bool SMPInstr::MDFindPointerUse(op_t MemOp, bool UseFP) {
bool changed = false;
int BaseReg;
int IndexReg;
op_t BaseOp = InitOp;
op_t IndexOp = InitOp;
SMPOperandType BaseType = UNKNOWN;
SMPOperandType IndexType = UNKNOWN;
ushort ScaleFactor;
ea_t offset;
set<DefOrUse, LessDefUse>::iterator BaseIter;
set<DefOrUse, LessDefUse>::iterator IndexIter;
if (NN_lea == this->SMPcmd.itype)
return false; // lea instruction really has no memory operands
if (NN_fnop == this->SMPcmd.itype)
return false; // SSA marker instruction
MDExtractAddressFields(MemOp, BaseReg, IndexReg, ScaleFactor, offset);
if (R_none != IndexReg) {
IndexOp.type = o_reg;
IndexOp.reg = MDCanonicalizeSubReg((ushort) IndexReg);
IndexIter = this->FindUse(IndexOp);
assert(IndexIter != this->GetLastUse());
IndexType = IndexIter->GetType();
}
if (R_none != BaseReg) {
BaseOp.type = o_reg;
BaseOp.reg = MDCanonicalizeSubReg((ushort) BaseReg);
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
BaseIter = this->FindUse(BaseOp);
assert(BaseIter != this->GetLastUse());
BaseType = BaseIter->GetType();
}
if ((R_sp == BaseReg) || (UseFP && (R_bp == BaseReg))) {
if ((R_none != IndexReg) && (!IsNumeric(IndexType))) {
// We have an indexed access into the stack frame.
// Set IndexReg USE type to NUMERIC.
changed = true;
IndexIter = this->SetUseType(IndexOp, NUMERIC);
assert(IndexIter != this->GetLastUse());
}
return changed; // stack accesses will get STACKPTR type in SetImmedTypes()
}
if ((R_sp == IndexReg) || (UseFP && (R_bp == IndexReg))) {
if ((R_none != BaseReg) && (!IsNumeric(BaseType))) {
// We have an indexed access into the stack frame.
// Set BaseReg USE type to NUMERIC.
// Note that BaseReg is really an IndexReg and vice versa.
changed = true;
BaseIter = this->SetUseType(BaseOp, NUMERIC);
assert(BaseIter != this->GetLastUse());
clc5q
committed
SMP_msg("WARNING: BaseReg is index, IndexReg is base: %s\n",
DisAsmText.GetDisAsm(this->GetAddr()));
}
return changed; // stack accesses will get STACKPTR type in SetImmedTypes()
}
if (IsImmedGlobalAddress(offset)) {
if ((R_none != IndexReg) && (!IsNumeric(IndexType))) {
// We have an indexed access into a global.
// Set IndexReg USE type to NUMERIC.
changed = true;
IndexIter = this->SetUseType(IndexOp, NUMERIC);
assert(IndexIter != this->GetLastUse());
}
if ((R_none != BaseReg) && (!IsNumeric(BaseType))) {
// We have an indexed access into a global.
// Set BaseReg USE type to NUMERIC.
// Note that BaseReg is really an index register.
changed = true;
BaseIter = this->SetUseType(BaseOp, NUMERIC);
assert(BaseIter != this->GetLastUse());
clc5q
committed
SMP_msg("WARNING: BaseReg used as index: %s\n", DisAsmText.GetDisAsm(this->GetAddr()));
clc5q
committed
return changed; // global immediate is handled in SetImmedTypes()
// At this point, we must have a base address in a register, not used
// to directly address the stack or a global.
if ((0 < ScaleFactor) || (R_none == IndexReg)) {
// IndexReg is scaled, meaning it is NUMERIC, so BaseReg must
// be a POINTER; or IndexReg is not present, so BaseReg is the
// only possible holder of an address.
if (R_none != BaseReg) {
if (UNINIT == BaseIter->GetType()) {
changed = true;
BaseIter = this->SetUseType(BaseOp, POINTER);
assert(BaseIter != this->GetLastUse());
}
}
}
else if (R_none == BaseReg) {
// We have an unscaled IndexReg and no BaseReg and offset was
// not a global offset, so IndexReg must be a POINTER.
if (R_none != IndexReg) {
changed = true;
IndexIter = this->SetUseType(IndexOp, POINTER);
assert(IndexIter != this->GetLastUse());
}
}
}
else { // We have BaseReg and an unscaled IndexReg.
// The only hope for typing something like [ebx+edx] is for
// one register to already be typed NUMERIC, in which case
// the other one must be a POINTER, or if one register is
// already POINTER, then the other one must be NUMERIC.
if (IsNumeric(BaseType)) {
if (UNINIT == IndexType) {
// Set to POINTER or PROF_POINTER
changed = true;
IndexIter = this->SetUseType(IndexOp, POINTER);
assert(IndexIter != this->GetLastUse());
}
else if (IsNumeric(IndexType)) {
clc5q
committed
SMP_msg("ERROR: BaseReg and IndexReg both NUMERIC at %x: %s\n",
this->address, DisAsmText.GetDisAsm(this->GetAddr()));
}
}
else { // BaseReg was not NUMERIC
if (UNINIT == BaseType) { // BaseReg is UNINIT
if (IsNumeric(IndexType)) {
changed = true;
BaseIter = this->SetUseType(BaseOp, POINTER);
assert(BaseIter != this->GetLastUse());
}
else if (IsDataPtr(IndexType)) {
// IndexReg is POINTER, so make BaseReg NUMERIC.
changed = true;
BaseIter = this->SetUseType(BaseOp, NUMERIC);
assert(BaseIter != this->GetLastUse());
}
}
else if (IsDataPtr(BaseType)) {
// BaseReg was a pointer type. IndexReg must be NUMERIC.
if (UNINIT == IndexType) {
changed = true;
IndexIter = this->SetUseType(IndexOp, NUMERIC);
assert(IndexIter != this->GetLastUse());
}
else if (IsDataPtr(IndexType)) {
clc5q
committed
SMP_msg("ERROR: BaseReg and IndexReg both POINTER at %x: %s\n",
this->address, DisAsmText.GetDisAsm(this->GetAddr()));
}
}
}
}
return changed;
} // end of SMPInstr::MDFindPointerUse()
clc5q
committed
// Are all DEFs typed to something besides UNINIT?
bool SMPInstr::AllDEFsTyped(void) {
if (this->AreDEFsTyped()) {
return true;
}
clc5q
committed
bool FoundUNINIT = false;
set<DefOrUse, LessDefUse>::iterator DefIter;
for (DefIter = this->GetFirstDef(); DefIter != this->GetLastDef(); ++DefIter) {
if (IsEqType(UNINIT, DefIter->GetType())) {
FoundUNINIT = true;
break;
}
}
if (!FoundUNINIT) {
this->SetDEFsTyped();
}
clc5q
committed
return (!FoundUNINIT);
} // end of SMPInstr::AllDEFsTyped()
// Are all USEs typed to something besides UNINIT?
bool SMPInstr::AllUSEsTyped(void) {
if (this->AreUSEsTyped()) {
return true;
}
clc5q
committed
bool FoundUNINIT = false;
set<DefOrUse, LessDefUse>::iterator UseIter;
for (UseIter = this->GetFirstUse(); UseIter != this->GetLastUse(); ++UseIter) {
if (IsEqType(UNINIT, UseIter->GetType())) {
FoundUNINIT = true;
break;
}
}
if (!FoundUNINIT) {
this->SetUSEsTyped();
}
clc5q
committed
return (!FoundUNINIT);
} // end of SMPInstr::AllUSEsTyped()
clc5q
committed
// UseOp is a USE reg, not just an address reg in a memory USE
bool SMPInstr::IsNonAddressReg(op_t UseOp) const {
bool FoundUse = false;
ushort SearchReg = MDCanonicalizeSubReg(UseOp.reg);
for (size_t OpNum = 0; OpNum < UA_MAXOP; ++OpNum) {
op_t Opnd = this->SMPcmd.Operands[OpNum];
if (this->features & UseMacros[OpNum]) { // USE
if (Opnd.type == o_reg) {
ushort TestReg = MDCanonicalizeSubReg(Opnd.reg);
if (TestReg == SearchReg) {
FoundUse = true;
break;
}
}
}
}
return FoundUse;
} // end of SMPInstr::IsNonAddressReg()
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
// Is a sub-register of UseOp used as a shift counter in the RTL?
// For example, UseOp could be ECX on an x86 machine, and CL
// could be used as a shift or rotate counter.
bool SMPInstr::IsSubRegUsedAsShiftCount(op_t UseOp) {
bool ShiftCounter = false;
if ((o_reg == UseOp.type) && this->MDIsShiftOrRotate()) {
SMPRegTransfer *CurrRT = this->RTL.GetRT(0);
assert(CurrRT->HasRightSubTree());
CurrRT = CurrRT->GetRightTree();
op_t ShiftCountOp = CurrRT->GetRightOperand();
if (o_reg == ShiftCountOp.type) {
ushort UseReg = UseOp.reg;
ushort ShiftCountReg = ShiftCountOp.reg;
ushort WideUseReg = MDCanonicalizeSubReg(UseReg);
ushort WideShiftCountReg = MDCanonicalizeSubReg(ShiftCountReg);
if ((UseReg != ShiftCountReg) && (WideUseReg == WideShiftCountReg)) {
// Registers were not equal, but their canonical enclosing
// registers are equal. Because shift counters that are not
// immediate are the 8-bit subregister in x86 (MD here !!!!!!)
// it must be that the ShiftCountReg is a subreg of UseReg.
// This is the condition we are looking for.
ShiftCounter = true;
}
}
}
return ShiftCounter;
} // end of SMPInstr::IsSubRegUsedAsShiftCount()
// Is opcode a shift or rotate?
// NOTE: We omit MMX/SSE unit shifts that do not use a general purpose
// register as a shift counter, because right now this method is only
// used as a helper for IsSubRegUsedAsShiftCount().
bool SMPInstr::MDIsShiftOrRotate(void) const {
return (((NN_rcl <= SMPcmd.itype) && (NN_ror >= SMPcmd.itype))
|| ((NN_sal <= SMPcmd.itype) && (NN_shr >= SMPcmd.itype))
|| (NN_shld == SMPcmd.itype) || (NN_shrd == SMPcmd.itype));
} // end of SMPInstr::MDIsShiftOrRotate()
clc5q
committed
// Does the shift or rotate RTL move the upper HalfBitWidth bits
// into the lower half of the register?
bool SMPInstr::ShiftMakesUpperBitsLower(size_t HalfBitWidth) {
bool FullCircle = false;
if (MD_NORMAL_MACHINE_BITWIDTH == (HalfBitWidth * 2)) {
SMPRegTransfer *CurrRT = this->RTL.GetRT(0);
if ((NULL != CurrRT) && (CurrRT->HasRightSubTree())) {
CurrRT = CurrRT->GetRightTree();
SMPoperator CurrOper = CurrRT->GetOperator();
if ((SMP_U_RIGHT_SHIFT == CurrOper) || (SMP_S_RIGHT_SHIFT == CurrOper)
|| (SMP_ROTATE_LEFT == CurrOper) || (SMP_ROTATE_RIGHT == CurrOper)) {
if (CurrRT->HasRightSubTree()) { // double-word shift
CurrRT = CurrRT->GetRightTree();
}
assert(!(CurrRT->HasRightSubTree()));
op_t ShiftCount = CurrRT->GetRightOperand();
if (o_imm == ShiftCount.type) {
uval_t ImmVal = ShiftCount.value;
if (ImmVal == HalfBitWidth) {
FullCircle = true;
}
}
}
}
}
return FullCircle;
} // SMPInstr::ShiftMakesUpperBitsLower()
clc5q
committed
#if 0
// Find SearchDelta in StackDeltaSet, inserting it if not found. Return whether it was initially found.
bool SMPInstr::FindStackPtrDelta(sval_t SearchDelta) const {
bool found = (this->StackDeltaSet.find(SearchDelta) != this->StackDeltaSet.end());
if (!found) {
this->StackDeltaSet.insert(SearchDelta);
if (SearchDelta < this->StackPtrOffset) {
// Mimic IDA Pro, which seems to keep the biggest stack frame possible.
// With negative stack deltas, this means the smallest stack delta is kept.
this->SetStackPtrOffset(SearchDelta);
}
}
return found;
} // end of SMPInstr::FindStackPtrDelta()
#endif
// Set the type of all immediate operands found in the USE set.
// Set all flags and floating point register USEs and DEFs to NUMERIC also.
void SMPInstr::SetImmedTypes(bool UseFP) {
set<DefOrUse, LessDefUse>::iterator CurrUse;
set<DefOrUse, LessDefUse>::iterator CurrDef;
uval_t ImmVal;
#if SMP_VERBOSE_DEBUG_BUILD_RTL
DebugFlag = DebugFlag || (this->address == 0x805cd52) || (this->address == 0x805cd56);
DebugFlag |= (0 == strncmp("__libc_csu_fini", this->BasicBlock->GetFunc()->GetFuncName(), 15));
#endif
CurrUse = this->GetFirstUse();
while (CurrUse != this->GetLastUse()) {
UseOp = CurrUse->GetOp();
clc5q
committed
SMP_msg("SetImmedTypes USE: ");
clc5q
committed
SMP_msg("\n");
if (o_imm == UseOp.type) {
ImmVal = UseOp.value;
if (IsImmedGlobalAddress((ea_t) ImmVal)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting to GLOBALPTR\n");
CurrUse = this->SetUseType(UseOp, GLOBALPTR);
#if 0
else if (IsDataAddress((ea_t) ImmVal)) {
// NOTE: We must call IsDataAddress() before we call IsImmedCodeAddress()
// to catch the data addresses within the code address range.
clc5q
committed
if (DebugFlag) SMP_msg("Setting to POINTER\n");
CurrUse = this->SetUseType(UseOp, POINTER);
}
#endif
else if (this->MDIsInterruptCall() || IsImmedCodeAddress((ea_t) ImmVal)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting to CODEPTR\n");
CurrUse = this->SetUseType(UseOp, CODEPTR);
}
else { // NUMERIC
clc5q
committed
if (DebugFlag) SMP_msg("Setting to NUMERIC\n");
CurrUse = this->SetUseType(UseOp, NUMERIC);
else if (o_reg == UseOp.type) {
if (UseOp.is_reg(X86_FLAGS_REG)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting flags reg to NUMERIC\n");
CurrUse = this->SetUseType(UseOp, NUMERIC);
}
#if 1
else if (UseOp.is_reg(R_sp) || (UseFP && UseOp.is_reg(R_bp))) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting reg to STACKPTR\n");
CurrUse = this->SetUseType(UseOp, STACKPTR);
}
#endif
}
#if 0 // could these registers have pointers in them?
else if ((o_trreg == UseOp.type) ||(o_dbreg == UseOp.type) || (o_crreg == UseOp.type)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting special reg to NUMERIC\n");
CurrUse = this->SetUseType(UseOp, NUMERIC);
}
#endif
else if ((o_fpreg == UseOp.type) || (o_mmxreg == UseOp.type) || (o_xmmreg == UseOp.type)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting floating point reg to NUMERIC\n");
CurrUse = this->SetUseType(UseOp, NUMERIC);
}
else if ((o_mem == UseOp.type) || (o_phrase == UseOp.type) || (o_displ == UseOp.type)) {
// For memory operands, we need to identify the POINTER value that
// is used in the addressing mode, if possible.
(void) this->MDFindPointerUse(UseOp, UseFP);
}
++CurrUse;
} // end while all USEs via CurrUse
CurrDef = this->GetFirstDef();
while (CurrDef != this->GetLastDef()) {
DefOp = CurrDef->GetOp();
if (DebugFlag) {
clc5q
committed
SMP_msg("SetImmedTypes DEF: ");
clc5q
committed
SMP_msg("\n");
clc5q
committed
if (DebugFlag) SMP_msg("FuncName: %s\n", this->BasicBlock->GetFunc()->GetFuncName());
if (DefOp.is_reg(X86_FLAGS_REG)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting flags reg DEF to NUMERIC\n");
CurrDef = this->SetDefType(DefOp, NUMERIC);
// No need to propagate this DEF type, as all flags will become NUMERIC.
}
#if 1
else if (DefOp.is_reg(R_sp) || (DefOp.is_reg(R_bp) && UseFP)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting reg DEF to STACKPTR\n");
CurrDef = this->SetDefType(DefOp, STACKPTR);
assert(CurrDef != this->Defs.GetLastRef());
// No need to propagate; all stack and frame pointers will become STACKPTR.
else if ((o_fpreg == DefOp.type) || (o_mmxreg == DefOp.type) || (o_xmmreg == DefOp.type)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting floating point reg DEF to NUMERIC\n");
CurrDef = this->SetDefType(DefOp, NUMERIC);
// No need to propagate; all FP reg uses will become NUMERIC anyway.
}
#if 0 // could these registers have pointers in them?
else if ((o_trreg == DefOp.type) || (o_dbreg == DefOp.type) || (o_crreg == DefOp.type)) {
clc5q
committed
if (DebugFlag) SMP_msg("Setting special reg DEF to NUMERIC\n");
CurrDef = this->SetDefType(DefOp, NUMERIC);
}
#endif
else if ((o_mem == DefOp.type) || (o_phrase == DefOp.type) || (o_displ == DefOp.type)) {
// For memory operands, we need to identify the POINTER value that
// is used in the addressing mode, if possible.
(void) this->MDFindPointerUse(DefOp, UseFP);
}
++CurrDef;
} // end while all DEFs via CurrDef
return;
} // end of SMPInstr::SetImmedTypes()
// Is the instruction a load from the stack?
void SMPInstr::MDFindLoadFromStack(bool UseFP) {
set<DefOrUse, LessDefUse>::iterator UseIter;
op_t UseOp;
if ((3 == this->OptType) && (this->HasSourceMemoryOperand())) {
// Loads and stores are OptCategory 3. We want only loads from the stack.
for (UseIter = this->GetFirstUse(); UseIter != this->GetLastUse(); ++UseIter) {
UseOp = UseIter->GetOp();
if (MDIsStackAccessOpnd(UseOp, UseFP)) {
this->SetLoadFromStack();
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
break;
}
}
}
return;
} // end of SMPInstr::MDFindLoadFromStack()
// Determine if instr is inherently signed load instruction.
// True if sign or zero-extended; pass out mask bits if true.
bool SMPInstr::MDIsSignedLoad(unsigned short &SignMask) {
unsigned short opcode = this->SMPcmd.itype;
if (NN_movzx == opcode) {
SignMask = FG_MASK_UNSIGNED;
}
else if (NN_movsx == opcode) {
SignMask = FG_MASK_SIGNED;
}
else {
return false;
}
return true;
}
// Infer sign, bit width, other type info for simple cases where all the info needed is
// within the instruction or can be read from the FineGrainedStackTable in the SMPFunction.
// NOTE: Must be called after SSA analysis is complete.
void SMPInstr::MDSetWidthSignInfo(bool UseFP) {
set<DefOrUse, LessDefUse>::iterator UseIter;
set<DefOrUse, LessDefUse>::iterator DefIter;
op_t UseOp, DefOp;
struct FineGrainedInfo FGEntry;
bool ValueWillChange;
unsigned short SignMask, TempSign, WidthMask;
int DefHashValue, UseHashValue;
ea_t DefAddr; // for flags USE in conditional set
int SSANum; // for flags USE in conditional set
bool LocalFlags; // is flags register a local name?
bool case1, case2, case3, case4, case5, case6;
bool SignedSetOpcode = this->MDIsSignedSetValue();
bool UnsignedSetOpcode = this->MDIsUnsignedSetValue();
case1 = this->IsLoadFromStack();
case2 = this->MDIsSignedLoad(SignMask); // sets value of SignMask if it returns true
clc5q
committed
case3 = (7 == this->OptType); // Multiplies and divides
case4 = ((CALL == this->GetDataFlowType()) || (INDIR_CALL == this->GetDataFlowType()));
clc5q
committed
case5 = (SignedSetOpcode || UnsignedSetOpcode); // set boolean based on flag condition
case6 = this->MDDoublesWidth(); // convert byte to word, word to dword, etc.
// Case 1: Load from stack location.
if (case1) {
bool success = false;
for (UseIter = this->GetFirstUse(); UseIter != this->GetLastUse(); ++UseIter) {
UseOp = UseIter->GetOp();
if (MDIsStackAccessOpnd(UseOp, UseFP)) {
// Found the stack location being loaded into a register. Now we need
// to get the sign and width info from the fine grained stack frame
// analysis.
success = this->GetBlock()->GetFunc()->MDGetFGStackLocInfo(this->address, UseOp, FGEntry);
assert(success);
// Now we have signedness info in FGEntry. We need to OR it into the register target of the load.
if (FGEntry.SignMiscInfo == 0)
break; // nothing to OR in; save time
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
for (DefIter = this->GetFirstDef(); DefIter != this->GetLastDef(); ++DefIter) {
DefOp = DefIter->GetOp();
if (o_reg == DefOp.type) {
DefOp.reg = MDCanonicalizeSubReg(DefOp.reg);
TempSign = FGEntry.SignMiscInfo & FG_MASK_SIGNEDNESS_BITS; // Get both sign bit flags
DefHashValue = HashGlobalNameAndSSA(DefOp, DefIter->GetSSANum());
if (this->BasicBlock->IsLocalName(DefOp)) {
this->BasicBlock->UpdateDefSignMiscInfo(DefHashValue, TempSign);
}
else {
this->BasicBlock->GetFunc()->UpdateDefSignMiscInfo(DefHashValue, TempSign);
}
break; // Should be only one register target for stack load, and no flags are set.
}
}
break; // Only concerned with the stack operand
}
}
assert(success);
} // end if this->IsLoadFromStack()
// Case 2: Loads that are sign-extended or zero-extended imply signed and unsigned, respectively.
// NOTE: If from the stack, they were handled in Case 1, and the signedness of the stack location
// was recorded a long time ago in SMPFunction::FindOutgoingArgsSize();
else if (case2) {
DefIter = this->GetFirstDef();
while (DefIter != this->GetLastDef()) {
// All non-memory DEFs besides the flags register should get the new SignMask ORed in.
// On x86, there should only be one DEF for this move, and no flags, but we will generalize
// in case other architectures are odd.
DefOp = DefIter->GetOp();
if (!(IsMemOperand(DefOp) || MDIsFlagsReg(DefOp))) {
DefOp.reg = MDCanonicalizeSubReg(DefOp.reg);
DefHashValue = HashGlobalNameAndSSA(DefOp, DefIter->GetSSANum());
if (this->BasicBlock->IsLocalName(DefOp)) {
this->BasicBlock->UpdateDefSignMiscInfo(DefHashValue, SignMask);
}
else {
this->BasicBlock->GetFunc()->UpdateDefSignMiscInfo(DefHashValue, SignMask);
}
}
++DefIter;
}
// If the signed load is from memory, the only USEs are the memory
// operand and addressing registers. We do not want to claim that
// EBX is signed in the instruction movsx eax,[ebx]. Only the DEF
// register EAX and the memory location [EBX] are signed, and we
// have no idea where [EBX] is, so we punt on all USEs if we have
// a memory source operand.
if (!(this->HasSourceMemoryOperand())) {
UseIter = this->GetFirstUse();
while (UseIter != this->GetLastUse()) {
// All non-memory USEs besides the flags register should get the new SignMask ORed in.
UseOp = UseIter->GetOp();
if (!(IsMemOperand(UseOp) || MDIsFlagsReg(UseOp))) {
UseOp.reg = MDCanonicalizeSubReg(UseOp.reg);
UseHashValue = HashGlobalNameAndSSA(UseOp, UseIter->GetSSANum());
if (this->BasicBlock->IsLocalName(UseOp)) {
this->BasicBlock->UpdateUseSignMiscInfo(UseHashValue, SignMask);
}
else {
this->BasicBlock->GetFunc()->UpdateUseSignMiscInfo(UseHashValue, SignMask);
}
++UseIter;
} // end of case 2
// Case 3: multiplies and divides can be signed or unsigned.
else if (case3) { // Multiplies and divides are type 7.
if (this->MDIsSignedArithmetic()) {
SignMask = FG_MASK_SIGNED;
}
else if (this->MDIsUnsignedArithmetic()) {
SignMask = FG_MASK_UNSIGNED;
}
else {
SignMask = 0; // unknown, uninitialized
}
if (0 != SignMask) {
DefIter = this->GetFirstDef();
while (DefIter != this->GetLastDef()) {
// All DEFs besides the flags register should get the new SignMask ORed in.
DefOp = DefIter->GetOp();
if ((DefOp.type == o_reg) && (!(DefOp.is_reg(X86_FLAGS_REG)))) {
DefOp.reg = MDCanonicalizeSubReg(DefOp.reg);
DefHashValue = HashGlobalNameAndSSA(DefOp, DefIter->GetSSANum());
if (this->BasicBlock->IsLocalName(DefOp)) {
this->BasicBlock->UpdateDefSignMiscInfo(DefHashValue, SignMask);
}
else {
this->BasicBlock->GetFunc()->UpdateDefSignMiscInfo(DefHashValue, SignMask);
}
UseIter = this->GetFirstUse();
while (UseIter != this->GetLastUse()) {
// All USEs besides the flags register should get the new SignMask ORed in.
UseOp = UseIter->GetOp();
if ((UseOp.type == o_reg) && (!(UseOp.is_reg(X86_FLAGS_REG)))) {
UseOp.reg = MDCanonicalizeSubReg(UseOp.reg);
UseHashValue = HashGlobalNameAndSSA(UseOp, UseIter->GetSSANum());
if (this->BasicBlock->IsLocalName(UseOp)) {
this->BasicBlock->UpdateUseSignMiscInfo(UseHashValue, SignMask);
}
else {
this->BasicBlock->GetFunc()->UpdateUseSignMiscInfo(UseHashValue, SignMask);
}
} // end if (0 != SignMask)
} // end of case 3 (multiplies and divides)
// Case 4: Calls to library functions can reveal the type of the return register.
else if (case4) {
// Get name of function called.
string FuncName = this->GetTrimmedCalledFunctionName();
// Get FG info, if any, for called function.
GetLibFuncFGInfo(FuncName, FGEntry);
// See if anything was returned in FGEntry.
if ((FGEntry.SignMiscInfo != 0) || (FGEntry.SizeInfo != 0)) {
// Need to update the FG info for the DEF of the return register.
DefOp = InitOp;
DefOp.type = o_reg;
DefOp.reg = MD_RETURN_VALUE_REG;
DefIter = this->FindDef(DefOp);
assert(DefIter != this->GetLastDef());
DefHashValue = HashGlobalNameAndSSA(DefOp, DefIter->GetSSANum());
if (this->BasicBlock->IsLocalName(DefOp)) {
this->BasicBlock->UpdateDefFGInfo(DefHashValue, FGEntry);