diff options
Diffstat (limited to 'src/miasm/arch/mips32')
| -rw-r--r-- | src/miasm/arch/mips32/__init__.py | 0 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/arch.py | 838 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/disasm.py | 16 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/jit.py | 160 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/lifter_model_call.py | 104 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/regs.py | 101 | ||||
| -rw-r--r-- | src/miasm/arch/mips32/sem.py | 667 |
7 files changed, 1886 insertions, 0 deletions
diff --git a/src/miasm/arch/mips32/__init__.py b/src/miasm/arch/mips32/__init__.py new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/src/miasm/arch/mips32/__init__.py diff --git a/src/miasm/arch/mips32/arch.py b/src/miasm/arch/mips32/arch.py new file mode 100644 index 00000000..76ebe730 --- /dev/null +++ b/src/miasm/arch/mips32/arch.py @@ -0,0 +1,838 @@ +#-*- coding:utf-8 -*- + +import logging +from collections import defaultdict + +from pyparsing import Literal, Optional + +from miasm.expression.expression import ExprMem, ExprInt, ExprId, ExprOp, ExprLoc +from miasm.core.bin_stream import bin_stream +import miasm.arch.mips32.regs as regs +import miasm.core.cpu as cpu +from miasm.ir.ir import color_expr_html + +from miasm.core.asm_ast import AstInt, AstId, AstMem, AstOp + +log = logging.getLogger("mips32dis") +console_handler = logging.StreamHandler() +console_handler.setFormatter(logging.Formatter("[%(levelname)-8s]: %(message)s")) +log.addHandler(console_handler) +log.setLevel(logging.DEBUG) + + +gpregs = cpu.reg_info(regs.regs32_str, regs.regs32_expr) + + +LPARENTHESIS = Literal("(") +RPARENTHESIS = Literal(")") + +def cb_deref(tokens): + if len(tokens) != 4: + raise NotImplementedError("TODO") + return AstMem(tokens[2] + tokens[0], 32) + +def cb_deref_nooff(tokens): + if len(tokens) != 3: + raise NotImplementedError("TODO") + return AstMem(tokens[1], 32) + +base_expr = cpu.base_expr + +deref_off = (Optional(base_expr) + LPARENTHESIS + gpregs.parser + RPARENTHESIS).setParseAction(cb_deref) +deref_nooff = (LPARENTHESIS + gpregs.parser + RPARENTHESIS).setParseAction(cb_deref_nooff) +deref = deref_off | deref_nooff + + +class additional_info(object): + def __init__(self): + self.except_on_instr = False + +br_0 = ['B', 'J', 'JR', 'BAL', 'JAL', 'JALR'] +br_1 = ['BGEZ', 'BLTZ', 'BGTZ', 'BGTZL', 'BLEZ', 'BLEZL', 'BC1T', 'BC1TL', 'BC1F', 'BC1FL'] +br_2 = ['BEQ', 'BEQL', 'BNE', 'BNEL'] + + +class instruction_mips32(cpu.instruction): + __slots__ = [] + + def __init__(self, *args, **kargs): + super(instruction_mips32, self).__init__(*args, **kargs) + self.delayslot = 1 + + + @staticmethod + def arg2str(expr, index=None, loc_db=None): + if expr.is_id() or expr.is_int(): + return str(expr) + elif expr.is_loc(): + if loc_db is not None: + return loc_db.pretty_str(expr.loc_key) + else: + return str(expr) + assert(isinstance(expr, ExprMem)) + arg = expr.ptr + if isinstance(arg, ExprId): + return "(%s)"%arg + assert(len(arg.args) == 2 and arg.op == '+') + return "%s(%s)"%(arg.args[1], arg.args[0]) + + @staticmethod + def arg2html(expr, index=None, loc_db=None): + if expr.is_id() or expr.is_int() or expr.is_loc(): + return color_expr_html(expr, loc_db) + assert(isinstance(expr, ExprMem)) + arg = expr.ptr + if isinstance(arg, ExprId): + return "(%s)"%color_expr_html(arg, loc_db) + assert(len(arg.args) == 2 and arg.op == '+') + return "%s(%s)"%( + color_expr_html(arg.args[1], loc_db), + color_expr_html(arg.args[0], loc_db) + ) + + def dstflow(self): + if self.name == 'BREAK': + return False + if self.name in br_0 + br_1 + br_2: + return True + return False + + def get_dst_num(self): + if self.name in br_0: + i = 0 + elif self.name in br_1: + i = 1 + elif self.name in br_2: + i = 2 + else: + raise NotImplementedError("TODO %s"%self) + return i + + def dstflow2label(self, loc_db): + if self.name in ["J", 'JAL']: + expr = self.args[0] + offset = int(expr) + addr = ((self.offset & (0xFFFFFFFF ^ ((1<< 28)-1))) + offset) & int(expr.mask) + loc_key = loc_db.get_or_create_offset_location(addr) + self.args[0] = ExprLoc(loc_key, expr.size) + return + + ndx = self.get_dst_num() + expr = self.args[ndx] + + if not isinstance(expr, ExprInt): + return + addr = (int(expr) + self.offset) & int(expr.mask) + loc_key = loc_db.get_or_create_offset_location(addr) + self.args[ndx] = ExprLoc(loc_key, expr.size) + + def breakflow(self): + if self.name == 'BREAK': + return False + if self.name in br_0 + br_1 + br_2: + return True + return False + + def is_subcall(self): + if self.name in ['JAL', 'JALR', 'BAL']: + return True + return False + + def getdstflow(self, loc_db): + if self.name in br_0: + return [self.args[0]] + elif self.name in br_1: + return [self.args[1]] + elif self.name in br_2: + return [self.args[2]] + elif self.name in ['JAL', 'JALR', 'JR', 'J']: + return [self.args[0]] + else: + raise NotImplementedError("fix mnemo %s"%self.name) + + def splitflow(self): + if self.name in ["B", 'JR', 'J']: + return False + if self.name in br_0: + return True + if self.name in br_1: + return True + if self.name in br_2: + return True + if self.name in ['JAL', 'JALR']: + return True + return False + + def get_symbol_size(self, symbol, loc_db): + return 32 + + def fixDstOffset(self): + ndx = self.get_dst_num() + e = self.args[ndx] + if self.offset is None: + raise ValueError('symbol not resolved %s' % self.l) + if not isinstance(e, ExprInt): + return + off = (int(e) - self.offset) & int(e.mask) + if int(off % 4): + raise ValueError('strange offset! %r' % off) + self.args[ndx] = ExprInt(off, 32) + + def get_args_expr(self): + args = [a for a in self.args] + return args + + +class mn_mips32(cpu.cls_mn): + delayslot = 1 + name = "mips32" + regs = regs + bintree = {} + num = 0 + all_mn = [] + all_mn_mode = defaultdict(list) + all_mn_name = defaultdict(list) + all_mn_inst = defaultdict(list) + pc = {'l':regs.PC, 'b':regs.PC} + sp = {'l':regs.SP, 'b':regs.SP} + instruction = instruction_mips32 + max_instruction_len = 4 + + @classmethod + def getpc(cls, attrib = None): + return regs.PC + + @classmethod + def getsp(cls, attrib = None): + return regs.SP + + def additional_info(self): + info = additional_info() + return info + + @classmethod + def getbits(cls, bitstream, attrib, start, n): + if not n: + return 0 + o = 0 + while n: + offset = start // 8 + n_offset = cls.endian_offset(attrib, offset) + c = cls.getbytes(bitstream, n_offset, 1) + if not c: + raise IOError + c = ord(c) + r = 8 - start % 8 + c &= (1 << r) - 1 + l = min(r, n) + c >>= (r - l) + o <<= l + o |= c + n -= l + start += l + return o + + @classmethod + def endian_offset(cls, attrib, offset): + if attrib == "l": + return (offset & ~3) + 3 - offset % 4 + elif attrib == "b": + return offset + else: + raise NotImplementedError('bad attrib') + + @classmethod + def check_mnemo(cls, fields): + l = sum([x.l for x in fields]) + assert l == 32, "len %r" % l + + @classmethod + def getmn(cls, name): + return name.upper() + + @classmethod + def gen_modes(cls, subcls, name, bases, dct, fields): + dct['mode'] = None + return [(subcls, name, bases, dct, fields)] + + def value(self, mode): + v = super(mn_mips32, self).value(mode) + if mode == 'l': + return [x[::-1] for x in v] + elif mode == 'b': + return [x for x in v] + else: + raise NotImplementedError('bad attrib') + + + +def mips32op(name, fields, args=None, alias=False): + dct = {"fields": fields} + dct["alias"] = alias + if args is not None: + dct['args'] = args + type(name, (mn_mips32,), dct) + #type(name, (mn_mips32b,), dct) + +class mips32_arg(cpu.m_arg): + def asm_ast_to_expr(self, arg, loc_db): + if isinstance(arg, AstId): + if isinstance(arg.name, ExprId): + return arg.name + if arg.name in gpregs.str: + return None + loc_key = loc_db.get_or_create_name_location(arg.name) + return ExprLoc(loc_key, 32) + if isinstance(arg, AstOp): + args = [self.asm_ast_to_expr(tmp, loc_db) for tmp in arg.args] + if None in args: + return None + return ExprOp(arg.op, *args) + if isinstance(arg, AstInt): + return ExprInt(arg.value, 32) + if isinstance(arg, AstMem): + ptr = self.asm_ast_to_expr(arg.ptr, loc_db) + if ptr is None: + return None + return ExprMem(ptr, arg.size) + return None + + +class mips32_reg(cpu.reg_noarg, mips32_arg): + pass + +class mips32_gpreg(mips32_reg): + reg_info = gpregs + parser = reg_info.parser + +class mips32_fltpreg(mips32_reg): + reg_info = regs.fltregs + parser = reg_info.parser + + +class mips32_fccreg(mips32_reg): + reg_info = regs.fccregs + parser = reg_info.parser + +class mips32_imm(cpu.imm_noarg): + parser = base_expr + + +class mips32_s16imm_noarg(mips32_imm): + def decode(self, v): + v = v & self.lmask + v = cpu.sign_ext(v, 16, 32) + self.expr = ExprInt(v, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) + if v & 0x80000000: + nv = v & ((1 << 16) - 1) + assert( v == cpu.sign_ext(nv, 16, 32)) + v = nv + self.value = v + return True + + +class mips32_s09imm_noarg(mips32_imm): + def decode(self, v): + v = v & self.lmask + v = cpu.sign_ext(v, 9, 32) + self.expr = ExprInt(v, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) + if v & 0x80000000: + nv = v & ((1 << 9) - 1) + assert( v == cpu.sign_ext(nv, 9, 32)) + v = nv + self.value = v + return True + + +class mips32_soff_noarg(mips32_imm): + def decode(self, v): + v = v & self.lmask + v <<= 2 + v = cpu.sign_ext(v, 16+2, 32) + # Add pipeline offset + self.expr = ExprInt(v + 4, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + # Remove pipeline offset + v = (int(self.expr) - 4) & 0xFFFFFFFF + if v & 0x80000000: + nv = v & ((1 << 16+2) - 1) + assert( v == cpu.sign_ext(nv, 16+2, 32)) + v = nv + self.value = v>>2 + return True + + +class mips32_s16imm(mips32_s16imm_noarg, mips32_arg): + pass + +class mips32_s09imm(mips32_s09imm_noarg, mips32_arg): + pass + +class mips32_soff(mips32_soff_noarg, mips32_arg): + pass + + +class mips32_instr_index(mips32_imm, mips32_arg): + def decode(self, v): + v = v & self.lmask + self.expr = ExprInt(v<<2, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) + if v & 3: + return False + v>>=2 + if v > (1<<self.l): + return False + self.value = v + return True + + +class mips32_u16imm(mips32_imm, mips32_arg): + def decode(self, v): + v = v & self.lmask + self.expr = ExprInt(v, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) + assert(v < (1<<16)) + self.value = v + return True + +class mips32_dreg_imm(mips32_arg): + parser = deref + def decode(self, v): + imm = self.parent.imm.expr + r = gpregs.expr[v] + self.expr = ExprMem(r+imm, 32) + return True + + def encode(self): + e = self.expr + if not isinstance(e, ExprMem): + return False + ptr = e.ptr + if isinstance(ptr, ExprId): + self.parent.imm.expr = ExprInt(0, 32) + r = ptr + elif len(ptr.args) == 2 and ptr.op == "+": + self.parent.imm.expr = ptr.args[1] + r = ptr.args[0] + else: + return False + self.value = gpregs.expr.index(r) + return True + + @staticmethod + def arg2str(expr, index=None): + assert(isinstance(expr, ExprMem)) + ptr = expr.ptr + if isinstance(ptr, ExprId): + return "(%s)"%ptr + assert(len(ptr.args) == 2 and ptr.op == '+') + return "%s(%s)"%(ptr.args[1], ptr.args[0]) + +class mips32_esize(mips32_imm, mips32_arg): + def decode(self, v): + v = v & self.lmask + self.expr = ExprInt(v+1, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) -1 + assert(v < (1<<16)) + self.value = v + return True + +class mips32_eposh(mips32_imm, mips32_arg): + def decode(self, v): + self.expr = ExprInt(v-int(self.parent.epos.expr)+1, 32) + return True + + def encode(self): + if not isinstance(self.expr, ExprInt): + return False + v = int(self.expr) + int(self.parent.epos.expr) -1 + self.value = v + return True + + + + +class mips32_cpr(mips32_arg): + parser = regs.regs_cpr0_info.parser + def decode(self, v): + index = int(self.parent.cpr0.expr) << 3 + index += v + self.expr = regs.regs_cpr0_expr[index] + return True + def encode(self): + e = self.expr + if not e in regs.regs_cpr0_expr: + return False + index = regs.regs_cpr0_expr.index(e) + self.value = index & 7 + index >>=2 + self.parent.cpr0.value = index + return True + +rs = cpu.bs(l=5, cls=(mips32_gpreg,)) +rt = cpu.bs(l=5, cls=(mips32_gpreg,)) +rd = cpu.bs(l=5, cls=(mips32_gpreg,)) +ft = cpu.bs(l=5, cls=(mips32_fltpreg,)) +fs = cpu.bs(l=5, cls=(mips32_fltpreg,)) +fd = cpu.bs(l=5, cls=(mips32_fltpreg,)) + +s16imm = cpu.bs(l=16, cls=(mips32_s16imm,)) +u16imm = cpu.bs(l=16, cls=(mips32_u16imm,)) +s09imm = cpu.bs(l=9, cls=(mips32_s09imm,)) +sa = cpu.bs(l=5, cls=(mips32_u16imm,)) +base = cpu.bs(l=5, cls=(mips32_dreg_imm,)) +soff = cpu.bs(l=16, cls=(mips32_soff,)) +oper = cpu.bs(l=5, cls=(mips32_u16imm,)) + +cpr0 = cpu.bs(l=5, cls=(mips32_imm,), fname="cpr0") +cpr = cpu.bs(l=3, cls=(mips32_cpr,)) + +stype = cpu.bs(l=5, cls=(mips32_u16imm,)) +hint_pref = cpu.bs(l=5, cls=(mips32_u16imm,)) + +s16imm_noarg = cpu.bs(l=16, cls=(mips32_s16imm_noarg,), fname="imm", + order=-1) +s09imm_noarg = cpu.bs(l=9, cls=(mips32_s09imm_noarg,), fname="imm", + order=-1) + +hint = cpu.bs(l=5, default_val="00000") +fcc = cpu.bs(l=3, cls=(mips32_fccreg,)) + +sel = cpu.bs(l=3, cls=(mips32_u16imm,)) + +code = cpu.bs(l=20, cls=(mips32_u16imm,)) + +esize = cpu.bs(l=5, cls=(mips32_esize,)) +epos = cpu.bs(l=5, cls=(mips32_u16imm,), fname="epos", + order=-1) + +eposh = cpu.bs(l=5, cls=(mips32_eposh,)) + +instr_index = cpu.bs(l=26, cls=(mips32_instr_index,)) +bs_fmt = cpu.bs_mod_name(l=5, fname='fmt', mn_mod={0x10: '.S', 0x11: '.D', + 0x14: '.W', 0x15: '.L', + 0x16: '.PS'}) +class bs_cond(cpu.bs_mod_name): + mn_mod = ['.F', '.UN', '.EQ', '.UEQ', + '.OLT', '.ULT', '.OLE', '.ULE', + '.SF', '.NGLE', '.SEQ', '.NGL', + '.LT', '.NGE', '.LE', '.NGT' + ] + + def modname(self, name, f_i): + raise NotImplementedError("Not implemented") + + +class bs_cond_name(cpu.bs_divert): + prio = 2 + mn_mod = [['.F', '.UN', '.EQ', '.UEQ', + '.OLT', '.ULT', '.OLE', '.ULE'], + ['.SF', '.NGLE', '.SEQ', '.NGL', + '.LT', '.NGE', '.LE', '.NGT'] + ] + + def divert(self, index, candidates): + out = [] + for candidate in candidates: + cls, name, bases, dct, fields = candidate + cond1 = [f for f in fields if f.fname == "cond1"] + assert(len(cond1) == 1) + cond1 = cond1.pop() + mm = self.mn_mod[cond1.value] + for value, new_name in enumerate(mm): + nfields = fields[:] + s = cpu.int2bin(value, self.args['l']) + args = dict(self.args) + args.update({'strbits': s}) + f = cpu.bs(**args) + nfields[index] = f + ndct = dict(dct) + ndct['name'] = name + new_name + out.append((cls, new_name, bases, ndct, nfields)) + return out + + + +class bs_cond_mod(cpu.bs_mod_name): + prio = 1 + +bs_cond = bs_cond_mod(l=4, + mn_mod = ['.F', '.UN', '.EQ', '.UEQ', + '.OLT', '.ULT', '.OLE', '.ULE', + '.SF', '.NGLE', '.SEQ', '.NGL', + '.LT', '.NGE', '.LE', '.NGT']) + + + +bs_arith = cpu.bs_name(l=6, name={'ADDU':0b100001, + 'SUBU':0b100011, + 'OR':0b100101, + 'AND':0b100100, + 'SLTU':0b101011, + 'XOR':0b100110, + 'SLT':0b101010, + 'SUBU':0b100011, + 'NOR':0b100111, + 'MOVN':0b001011, + 'MOVZ':0b001010, + }) + +bs_shift = cpu.bs_name(l=6, name={'SLL':0b000000, + 'SRL':0b000010, + 'SRA':0b000011, + }) + +bs_shift1 = cpu.bs_name(l=6, name={'SLLV':0b000100, + 'SRLV':0b000110, + 'SRAV':0b000111, + }) + + +bs_arithfmt = cpu.bs_name(l=6, name={'ADD':0b000000, + 'SUB':0b000001, + 'MUL':0b000010, + 'DIV':0b000011, + }) + +bs_s_l = cpu.bs_name(l=6, name = {"SW": 0b101011, + "SH": 0b101001, + "SB": 0b101000, + "LW": 0b100011, + "LH": 0b100001, + "LB": 0b100000, + "LHU": 0b100101, + "LBU": 0b100100, + "LWL": 0b100010, + "LWR": 0b100110, + + "SWL": 0b101010, + "SWR": 0b101110, + }) + + +bs_oax = cpu.bs_name(l=6, name = {"ORI": 0b001101, + "ANDI": 0b001100, + "XORI": 0b001110, + }) + +bs_bcc = cpu.bs_name(l=5, name = {"BGEZ": 0b00001, + "BGEZL": 0b00011, + "BGEZAL": 0b10001, + "BGEZALL": 0b10011, + "BLTZ": 0b00000, + "BLTZL": 0b00010, + "BLTZAL": 0b10000, + "BLTZALL": 0b10010, + }) + + +bs_code = cpu.bs(l=10) + + +mips32op("addi", [cpu.bs('001000'), rs, rt, s16imm], [rt, rs, s16imm]) +mips32op("addiu", [cpu.bs('001001'), rs, rt, s16imm], [rt, rs, s16imm]) +mips32op("nop", [cpu.bs('0'*32)], alias = True) +mips32op("lui", [cpu.bs('001111'), cpu.bs('00000'), rt, u16imm]) +mips32op("oax", [bs_oax, rs, rt, u16imm], [rt, rs, u16imm]) + +mips32op("arith", [cpu.bs('000000'), rs, rt, rd, cpu.bs('00000'), bs_arith], + [rd, rs, rt]) +mips32op("shift1", [cpu.bs('000000'), rs, rt, rd, cpu.bs('00000'), bs_shift1], + [rd, rt, rs]) + +mips32op("shift", [cpu.bs('000000'), cpu.bs('00000'), rt, rd, sa, bs_shift], + [rd, rt, sa]) + +mips32op("rotr", [cpu.bs('000000'), cpu.bs('00001'), rt, rd, sa, + cpu.bs('000010')], [rd, rt, sa]) + +mips32op("mul", [cpu.bs('011100'), rs, rt, rd, cpu.bs('00000'), + cpu.bs('000010')], [rd, rs, rt]) +mips32op("div", [cpu.bs('000000'), rs, rt, cpu.bs('0000000000'), + cpu.bs('011010')]) + +mips32op("s_l", [bs_s_l, base, rt, s16imm_noarg], [rt, base]) + +#mips32op("mfc0", [bs('010000'), bs('00000'), rt, rd, bs('00000000'), sel]) +mips32op("mfc0", [cpu.bs('010000'), cpu.bs('00000'), rt, cpr0, + cpu.bs('00000000'), cpr]) +mips32op("mfc1", [cpu.bs('010001'), cpu.bs('00000'), rt, fs, + cpu.bs('00000000000')]) + +mips32op("ldc1", [cpu.bs('110101'), base, ft, s16imm_noarg], [ft, base]) + +mips32op("mov", [cpu.bs('010001'), bs_fmt, cpu.bs('00000'), fs, fd, + cpu.bs('000110')], [fd, fs]) + +mips32op("add", [cpu.bs('010001'), bs_fmt, ft, fs, fd, bs_arithfmt], + [fd, fs, ft]) + +mips32op("divu", [cpu.bs('000000'), rs, rt, cpu.bs('0000000000'), + cpu.bs('011011')]) +mips32op("mult", [cpu.bs('000000'), rs, rt, cpu.bs('0000000000'), + cpu.bs('011000')]) +mips32op("multu", [cpu.bs('000000'), rs, rt, cpu.bs('0000000000'), + cpu.bs('011001')]) +mips32op("mflo", [cpu.bs('000000'), cpu.bs('0000000000'), rd, + cpu.bs('00000'), cpu.bs('010010')]) +mips32op("mfhi", [cpu.bs('000000'), cpu.bs('0000000000'), rd, + cpu.bs('00000'), cpu.bs('010000')]) + + +mips32op("b", [cpu.bs('000100'), cpu.bs('00000'), cpu.bs('00000'), soff], + alias = True) +mips32op("bne", [cpu.bs('000101'), rs, rt, soff]) +mips32op("bnel", [cpu.bs('010101'), rs, rt, soff]) + +mips32op("beq", [cpu.bs('000100'), rs, rt, soff]) +mips32op("beql", [cpu.bs('010100'), rs, rt, soff]) + +mips32op("blez", [cpu.bs('000110'), rs, cpu.bs('00000'), soff]) +mips32op("blezl", [cpu.bs('010110'), rs, cpu.bs('00000'), soff]) + +mips32op("bcc", [cpu.bs('000001'), rs, bs_bcc, soff]) + +mips32op("bgtz", [cpu.bs('000111'), rs, cpu.bs('00000'), soff]) +mips32op("bgtzl", [cpu.bs('010111'), rs, cpu.bs('00000'), soff]) +mips32op("bal", [cpu.bs('000001'), cpu.bs('00000'), cpu.bs('10001'), soff], + alias = True) + + +mips32op("slti", [cpu.bs('001010'), rs, rt, s16imm], [rt, rs, s16imm]) +mips32op("sltiu", [cpu.bs('001011'), rs, rt, s16imm], [rt, rs, s16imm]) + + +mips32op("j", [cpu.bs('000010'), instr_index]) +mips32op("jal", [cpu.bs('000011'), instr_index]) +mips32op("jalr", [cpu.bs('000000'), rs, cpu.bs('00000'), rd, hint, + cpu.bs('001001')]) +mips32op("jr", [cpu.bs('000000'), rs, cpu.bs('0000000000'), hint, + cpu.bs('001000')]) + +mips32op("lwc1", [cpu.bs('110001'), base, ft, s16imm_noarg], [ft, base]) + +#mips32op("mtc0", [bs('010000'), bs('00100'), rt, rd, bs('00000000'), sel]) +mips32op("mtc0", [cpu.bs('010000'), cpu.bs('00100'), rt, cpr0, + cpu.bs('00000000'), cpr]) +mips32op("mtc1", [cpu.bs('010001'), cpu.bs('00100'), rt, fs, + cpu.bs('00000000000')]) +# XXXX TODO CFC1 +mips32op("cfc1", [cpu.bs('010001'), cpu.bs('00010'), rt, fs, + cpu.bs('00000000000')]) +# XXXX TODO CTC1 +mips32op("ctc1", [cpu.bs('010001'), cpu.bs('00110'), rt, fs, + cpu.bs('00000000000')]) + +mips32op("break", [cpu.bs('000000'), code, cpu.bs('001101')]) +mips32op("syscall", [cpu.bs('000000'), code, cpu.bs('001100')]) + + +mips32op("c", [cpu.bs('010001'), bs_fmt, ft, fs, fcc, cpu.bs('0'), + cpu.bs('0'), cpu.bs('11'), bs_cond], [fcc, fs, ft]) + + +mips32op("bc1t", [cpu.bs('010001'), cpu.bs('01000'), fcc, cpu.bs('0'), + cpu.bs('1'), soff]) +mips32op("bc1tl", [cpu.bs('010001'), cpu.bs('01000'), fcc, cpu.bs('1'), + cpu.bs('1'), soff]) +mips32op("bc1f", [cpu.bs('010001'), cpu.bs('01000'), fcc, cpu.bs('0'), + cpu.bs('0'), soff]) +mips32op("bc1fl", [cpu.bs('010001'), cpu.bs('01000'), fcc, cpu.bs('1'), + cpu.bs('0'), soff]) + +mips32op("swc1", [cpu.bs('111001'), base, ft, s16imm_noarg], [ft, base]) + +mips32op("cvt.d", [cpu.bs('010001'), bs_fmt, cpu.bs('00000'), fs, fd, + cpu.bs('100001')], [fd, fs]) +mips32op("cvt.w", [cpu.bs('010001'), bs_fmt, cpu.bs('00000'), fs, fd, + cpu.bs('100100')], [fd, fs]) +mips32op("cvt.s", [cpu.bs('010001'), bs_fmt, cpu.bs('00000'), fs, fd, + cpu.bs('100000')], [fd, fs]) + +mips32op("ext", [cpu.bs('011111'), rs, rt, esize, epos, cpu.bs('000000')], + [rt, rs, epos, esize]) +mips32op("ins", [cpu.bs('011111'), rs, rt, eposh, epos, cpu.bs('000100')], + [rt, rs, epos, eposh]) + +mips32op("seb", [cpu.bs('011111'), cpu.bs('00000'), rt, rd, cpu.bs('10000'), + cpu.bs('100000')], [rd, rt]) +mips32op("seh", [cpu.bs('011111'), cpu.bs('00000'), rt, rd, cpu.bs('11000'), + cpu.bs('100000')], [rd, rt]) +mips32op("wsbh", [cpu.bs('011111'), cpu.bs('00000'), rt, rd, cpu.bs('00010'), + cpu.bs('100000')], [rd, rt]) + +mips32op("di", [cpu.bs('010000'), cpu.bs('01011'), rt, cpu.bs('01100'), + cpu.bs('00000'), cpu.bs('0'), cpu.bs('00'), cpu.bs('000')]) +mips32op("ei", [cpu.bs('010000'), cpu.bs('01011'), rt, cpu.bs('01100'), + cpu.bs('00000'), cpu.bs('1'), cpu.bs('00'), cpu.bs('000')]) + + +mips32op("tlbp", [cpu.bs('010000'), cpu.bs('1'), cpu.bs('0'*19), + cpu.bs('001000')]) +mips32op("tlbwi", [cpu.bs('010000'), cpu.bs('1'), cpu.bs('0'*19), + cpu.bs('000010')]) + + +mips32op("teq", [cpu.bs('000000'), rs, rt, bs_code, cpu.bs('110100')], + [rs, rt]) +mips32op("tne", [cpu.bs('000000'), rs, rt, bs_code, cpu.bs('110110')], + [rs, rt]) + +mips32op("clz", [cpu.bs('011100'), rs, rt, rd, cpu.bs('00000'), cpu.bs('100000')], + [rd, rs]) +mips32op("clz", [cpu.bs('000000'), rs, cpu.bs('00000'), rd, cpu.bs('00001010000')], + [rd, rs]) + +mips32op("ll", [cpu.bs('110000'), base, rt, s16imm_noarg], [rt, base]) +mips32op("ll", [cpu.bs('011111'), base, rt, s09imm_noarg, cpu.bs('0110110')], [rt, base]) + +mips32op("sc", [cpu.bs('111000'), base, rt, s16imm_noarg], [rt, base]) +mips32op("sc", [cpu.bs('011111'), base, rt, s09imm_noarg, cpu.bs('0'), cpu.bs('100110')], [rt, base]) + +mips32op("sync", [cpu.bs('000000000000000000000'), stype, cpu.bs('001111')], [stype]) + +mips32op("pref", [cpu.bs('110011'), base, hint_pref, s16imm_noarg], [hint_pref, base]) +mips32op("pref", [cpu.bs('011111'), base, hint_pref, s09imm_noarg, cpu.bs('0110101')], [hint_pref, base]) + +mips32op("tlbwr", [cpu.bs('01000010000000000000000000000110')], []) +mips32op("tlbr", [cpu.bs('01000010000000000000000000000001')], []) + +mips32op("cache", [cpu.bs('101111'), base, oper, s16imm_noarg], [oper, base]) +mips32op("cache", [cpu.bs('011111'), base, oper, s09imm_noarg, cpu.bs('0100101')], [oper, base]) + +mips32op("eret", [cpu.bs('01000010000000000000000000011000')], []) + +mips32op("mtlo", [cpu.bs('000000'), rs, cpu.bs('000000000000000'), cpu.bs('010011')], [rs]) +mips32op("mthi", [cpu.bs('000000'), rs, cpu.bs('000000000000000'), cpu.bs('010001')], [rs]) + diff --git a/src/miasm/arch/mips32/disasm.py b/src/miasm/arch/mips32/disasm.py new file mode 100644 index 00000000..b6c05cb7 --- /dev/null +++ b/src/miasm/arch/mips32/disasm.py @@ -0,0 +1,16 @@ +from miasm.core.asmblock import disasmEngine +from miasm.arch.mips32.arch import mn_mips32 + + + +class dis_mips32b(disasmEngine): + attrib = 'b' + def __init__(self, bs=None, **kwargs): + super(dis_mips32b, self).__init__(mn_mips32, self.attrib, bs, **kwargs) + + +class dis_mips32l(disasmEngine): + attrib = "l" + def __init__(self, bs=None, **kwargs): + super(dis_mips32l, self).__init__(mn_mips32, self.attrib, bs, **kwargs) + diff --git a/src/miasm/arch/mips32/jit.py b/src/miasm/arch/mips32/jit.py new file mode 100644 index 00000000..a4d8a193 --- /dev/null +++ b/src/miasm/arch/mips32/jit.py @@ -0,0 +1,160 @@ +from builtins import range +import logging + +from miasm.jitter.jitload import Jitter, named_arguments +from miasm.core.locationdb import LocationDB +from miasm.core.utils import pck32, upck32 +from miasm.arch.mips32.sem import Lifter_Mips32l, Lifter_Mips32b +from miasm.jitter.codegen import CGen +from miasm.ir.ir import AssignBlock, IRBlock +import miasm.expression.expression as m2_expr + +log = logging.getLogger('jit_mips32') +hnd = logging.StreamHandler() +hnd.setFormatter(logging.Formatter("[%(levelname)-8s]: %(message)s")) +log.addHandler(hnd) +log.setLevel(logging.CRITICAL) + + +class mipsCGen(CGen): + CODE_INIT = CGen.CODE_INIT + r""" + unsigned int branch_dst_pc; + unsigned int branch_dst_irdst; + unsigned int branch_dst_set=0; + """ + + CODE_RETURN_NO_EXCEPTION = r""" + %s: + if (branch_dst_set) { + %s = %s; + BlockDst->address = %s; + } else { + BlockDst->address = %s; + } + return JIT_RET_NO_EXCEPTION; + """ + + def __init__(self, lifter): + super(mipsCGen, self).__init__(lifter) + self.delay_slot_dst = m2_expr.ExprId("branch_dst_irdst", 32) + self.delay_slot_set = m2_expr.ExprId("branch_dst_set", 32) + + def block2assignblks(self, block): + irblocks_list = super(mipsCGen, self).block2assignblks(block) + for irblocks in irblocks_list: + for blk_idx, irblock in enumerate(irblocks): + has_breakflow = any(assignblock.instr.breakflow() for assignblock in irblock) + if not has_breakflow: + continue + + irs = [] + for assignblock in irblock: + if self.lifter.pc not in assignblock: + irs.append(AssignBlock(assignments, assignblock.instr)) + continue + assignments = dict(assignblock) + # Add internal branch destination + assignments[self.delay_slot_dst] = assignblock[ + self.lifter.pc] + assignments[self.delay_slot_set] = m2_expr.ExprInt(1, 32) + # Replace IRDst with next instruction + dst_loc_key = self.lifter.get_next_instr(assignblock.instr) + assignments[self.lifter.IRDst] = m2_expr.ExprLoc(dst_loc_key, 32) + irs.append(AssignBlock(assignments, assignblock.instr)) + irblocks[blk_idx] = IRBlock(irblock.loc_db, irblock.loc_key, irs) + + return irblocks_list + + def gen_finalize(self, block): + """ + Generate the C code for the final block instruction + """ + + loc_key = self.get_block_post_label(block) + offset = self.lifter.loc_db.get_location_offset(loc_key) + out = (self.CODE_RETURN_NO_EXCEPTION % (loc_key, + self.C_PC, + m2_expr.ExprId('branch_dst_irdst', 32), + m2_expr.ExprId('branch_dst_irdst', 32), + self.id_to_c(m2_expr.ExprInt(offset, 32))) + ).split('\n') + return out + + +class jitter_mips32l(Jitter): + + C_Gen = mipsCGen + + def __init__(self, loc_db, *args, **kwargs): + Jitter.__init__(self, Lifter_Mips32l(loc_db), *args, **kwargs) + self.vm.set_little_endian() + + def push_uint32_t(self, value): + self.cpu.SP -= 4 + self.vm.set_mem(self.cpu.SP, pck32(value)) + + def pop_uint32_t(self): + value = self.vm.get_u32(self.cpu.SP) + self.cpu.SP += 4 + return value + + def get_stack_arg(self, index): + return self.vm.get_u32(self.cpu.SP + 4 * index) + + def init_run(self, *args, **kwargs): + Jitter.init_run(self, *args, **kwargs) + self.cpu.PC = self.pc + + # calling conventions + + @named_arguments + def func_args_stdcall(self, n_args): + args = [self.get_arg_n_stdcall(i) for i in range(n_args)] + ret_ad = self.cpu.RA + return ret_ad, args + + def func_ret_stdcall(self, ret_addr, ret_value1=None, ret_value2=None): + self.pc = self.cpu.PC = ret_addr + if ret_value1 is not None: + self.cpu.V0 = ret_value1 + if ret_value2 is not None: + self.cpu.V1 = ret_value2 + return True + + def func_prepare_stdcall(self, ret_addr, *args): + for index in range(min(len(args), 4)): + setattr(self.cpu, 'A%d' % index, args[index]) + for index in range(4, len(args)): + self.vm.set_mem(self.cpu.SP + 4 * (index - 4), pck32(args[index])) + self.cpu.RA = ret_addr + + def get_arg_n_stdcall(self, index): + if index < 4: + arg = getattr(self.cpu, 'A%d' % index) + else: + arg = self.get_stack_arg(index-4) + return arg + + def syscall_args_systemv(self, n_args): + # Documentation: http://man7.org/linux/man-pages/man2/syscall.2.html + # mips/o32 a0 a1 a2 a3 stack + args = [self.get_arg_n_stdcall(i) for i in range(n_args)] + return args + + def syscall_ret_systemv(self, value1, value2, error): + # Documentation: http://man7.org/linux/man-pages/man2/syscall.2.html + self.cpu.V0 = value1 + self.cpu.V1 = value2 + self.cpu.A3 = error # 0 -> no error, -1 -> error + + func_args_systemv = func_args_stdcall + func_ret_systemv = func_ret_stdcall + func_prepare_systemv = func_prepare_stdcall + get_arg_n_systemv = get_arg_n_stdcall + + +class jitter_mips32b(jitter_mips32l): + + def __init__(self, loc_db, *args, **kwargs): + Jitter.__init__(self, Lifter_Mips32b(loc_db), *args, **kwargs) + self.vm.set_big_endian() diff --git a/src/miasm/arch/mips32/lifter_model_call.py b/src/miasm/arch/mips32/lifter_model_call.py new file mode 100644 index 00000000..bd0e8506 --- /dev/null +++ b/src/miasm/arch/mips32/lifter_model_call.py @@ -0,0 +1,104 @@ +#-*- coding:utf-8 -*- + +from miasm.expression.expression import ExprAssign, ExprOp +from miasm.ir.ir import IRBlock, AssignBlock +from miasm.ir.analysis import LifterModelCall +from miasm.arch.mips32.sem import Lifter_Mips32l, Lifter_Mips32b + +class LifterModelCallMips32l(Lifter_Mips32l, LifterModelCall): + def __init__(self, loc_db): + Lifter_Mips32l.__init__(self, loc_db) + self.ret_reg = self.arch.regs.V0 + + def call_effects(self, ad, instr): + call_assignblk = AssignBlock( + [ + ExprAssign( + self.ret_reg, + ExprOp( + 'call_func_ret', + ad, + self.arch.regs.A0, + self.arch.regs.A1, + self.arch.regs.A2, + self.arch.regs.A3, + ) + ), + ], + instr + ) + + return [call_assignblk], [] + + + def add_asmblock_to_ircfg(self, block, ircfg, gen_pc_updt=False): + """ + Add a native block to the current IR + @block: native assembly block + @ircfg: IRCFG instance + @gen_pc_updt: insert PC update effects between instructions + """ + loc_key = block.loc_key + ir_blocks_all = [] + + assignments = [] + for index, instr in enumerate(block.lines): + if loc_key is None: + assignments = [] + loc_key = self.get_loc_key_for_instr(instr) + if instr.is_subcall(): + assert index == len(block.lines) - 2 + + # Add last instruction first (before call) + split = self.add_instr_to_current_state( + block.lines[-1], block, assignments, + ir_blocks_all, gen_pc_updt + ) + assert not split + # Add call effects after the delay splot + split = self.add_instr_to_current_state( + instr, block, assignments, + ir_blocks_all, gen_pc_updt + ) + assert split + break + split = self.add_instr_to_current_state( + instr, block, assignments, + ir_blocks_all, gen_pc_updt + ) + if split: + ir_blocks_all.append(IRBlock(self.loc_db, loc_key, assignments)) + loc_key = None + assignments = [] + if loc_key is not None: + ir_blocks_all.append(IRBlock(self.loc_db, loc_key, assignments)) + + new_ir_blocks_all = self.post_add_asmblock_to_ircfg(block, ircfg, ir_blocks_all) + for irblock in new_ir_blocks_all: + ircfg.add_irblock(irblock) + return new_ir_blocks_all + + def get_out_regs(self, _): + return set([self.ret_reg, self.sp]) + + def sizeof_char(self): + return 8 + + def sizeof_short(self): + return 16 + + def sizeof_int(self): + return 32 + + def sizeof_long(self): + return 32 + + def sizeof_pointer(self): + return 32 + + + +class LifterModelCallMips32b(Lifter_Mips32b, LifterModelCallMips32l): + def __init__(self, loc_db): + Lifter_Mips32b.__init__(self, loc_db) + self.ret_reg = self.arch.regs.V0 diff --git a/src/miasm/arch/mips32/regs.py b/src/miasm/arch/mips32/regs.py new file mode 100644 index 00000000..967b7458 --- /dev/null +++ b/src/miasm/arch/mips32/regs.py @@ -0,0 +1,101 @@ +#-*- coding:utf-8 -*- + +from builtins import range +from miasm.expression.expression import ExprId +from miasm.core.cpu import gen_reg, gen_regs + + +PC, _ = gen_reg('PC') +PC_FETCH, _ = gen_reg('PC_FETCH') + +R_LO, _ = gen_reg('R_LO') +R_HI, _ = gen_reg('R_HI') + +exception_flags = ExprId('exception_flags', 32) + +PC_init = ExprId("PC_init", 32) +PC_FETCH_init = ExprId("PC_FETCH_init", 32) + +regs32_str = ["ZERO", 'AT', 'V0', 'V1'] +\ + ['A%d'%i for i in range(4)] +\ + ['T%d'%i for i in range(8)] +\ + ['S%d'%i for i in range(8)] +\ + ['T%d'%i for i in range(8, 10)] +\ + ['K0', 'K1'] +\ + ['GP', 'SP', 'FP', 'RA'] + +regs32_expr = [ExprId(x, 32) for x in regs32_str] +ZERO = regs32_expr[0] + +regs_flt_str = ['F%d'%i for i in range(0x20)] + +regs_fcc_str = ['FCC%d'%i for i in range(8)] + +R_LO = ExprId('R_LO', 32) +R_HI = ExprId('R_HI', 32) + +R_LO_init = ExprId('R_LO_init', 32) +R_HI_init = ExprId('R_HI_init', 32) + + +cpr0_str = ["CPR0_%d"%x for x in range(0x100)] +cpr0_str[0] = "INDEX" +cpr0_str[8] = "RANDOM" +cpr0_str[16] = "ENTRYLO0" +cpr0_str[24] = "ENTRYLO1" +cpr0_str[32] = "CONTEXT" +cpr0_str[33] = "CONTEXTCONFIG" +cpr0_str[40] = "PAGEMASK" +cpr0_str[41] = "PAGEGRAIN" +cpr0_str[42] = "SEGCTL0" +cpr0_str[43] = "SEGCTL1" +cpr0_str[44] = "SEGCTL2" +cpr0_str[45] = "PWBASE" +cpr0_str[46] = "PWFIELD" +cpr0_str[47] = "PWSIZE" +cpr0_str[48] = "WIRED" +cpr0_str[54] = "PWCTL" +cpr0_str[64] = "BADVADDR" +cpr0_str[65] = "BADINSTR" +cpr0_str[66] = "BADINSTRP" +cpr0_str[72] = "COUNT" +cpr0_str[80] = "ENTRYHI" +cpr0_str[104] = "CAUSE" +cpr0_str[112] = "EPC" +cpr0_str[120] = "PRID" +cpr0_str[121] = "EBASE" +cpr0_str[128] = "CONFIG" +cpr0_str[129] = "CONFIG1" +cpr0_str[130] = "CONFIG2" +cpr0_str[131] = "CONFIG3" +cpr0_str[132] = "CONFIG4" +cpr0_str[133] = "CONFIG5" +cpr0_str[152] = "WATCHHI" +cpr0_str[250] = "KSCRATCH" +cpr0_str[251] = "KSCRATCH1" +cpr0_str[252] = "KSCRATCH2" +cpr0_str[253] = "KSCRATCH3" +cpr0_str[254] = "KSCRATCH4" +cpr0_str[255] = "KSCRATCH5" + +regs_cpr0_expr, regs_cpr0_init, regs_cpr0_info = gen_regs(cpr0_str, globals()) + +gpregs_expr, gpregs_init, gpregs = gen_regs(regs32_str, globals()) +regs_flt_expr, regs_flt_init, fltregs = gen_regs(regs_flt_str, globals(), sz=64) +regs_fcc_expr, regs_fcc_init, fccregs = gen_regs(regs_fcc_str, globals()) + + +all_regs_ids = [PC, PC_FETCH, R_LO, R_HI, exception_flags] + gpregs_expr + regs_flt_expr + \ + regs_fcc_expr + regs_cpr0_expr +all_regs_ids_byname = dict([(x.name, x) for x in all_regs_ids]) +all_regs_ids_init = [ExprId("%s_init" % reg.name, reg.size) for reg in all_regs_ids] +all_regs_ids_no_alias = all_regs_ids[:] + +attrib_to_regs = { + 'l': all_regs_ids_no_alias, + 'b': all_regs_ids_no_alias, +} + +regs_init = {} +for i, r in enumerate(all_regs_ids): + regs_init[r] = all_regs_ids_init[i] diff --git a/src/miasm/arch/mips32/sem.py b/src/miasm/arch/mips32/sem.py new file mode 100644 index 00000000..649adcaa --- /dev/null +++ b/src/miasm/arch/mips32/sem.py @@ -0,0 +1,667 @@ +import miasm.expression.expression as m2_expr +from miasm.ir.ir import Lifter, IRBlock, AssignBlock +from miasm.arch.mips32.arch import mn_mips32 +from miasm.arch.mips32.regs import R_LO, R_HI, PC, RA, ZERO, exception_flags +from miasm.core.sembuilder import SemBuilder +from miasm.jitter.csts import EXCEPT_DIV_BY_ZERO, EXCEPT_SOFT_BP, EXCEPT_SYSCALL + + +# SemBuilder context +ctx = { + "R_LO": R_LO, + "R_HI": R_HI, + "PC": PC, + "RA": RA, + "m2_expr": m2_expr +} + +sbuild = SemBuilder(ctx) + + +@sbuild.parse +def addiu(arg1, arg2, arg3): + """Adds a register @arg3 and a sign-extended immediate value @arg2 and + stores the result in a register @arg1""" + arg1 = arg2 + arg3 + +@sbuild.parse +def lw(arg1, arg2): + "A word is loaded into a register @arg1 from the specified address @arg2." + arg1 = arg2 + +@sbuild.parse +def sw(arg1, arg2): + "The contents of @arg2 is stored at the specified address @arg1." + arg2 = arg1 + +@sbuild.parse +def jal(arg1): + "Jumps to the calculated address @arg1 and stores the return address in $RA" + PC = arg1 + ir.IRDst = arg1 + RA = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), RA.size) + +@sbuild.parse +def jalr(arg1, arg2): + """Jump to an address stored in a register @arg1, and store the return + address in another register @arg2""" + PC = arg1 + ir.IRDst = arg1 + arg2 = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), arg2.size) + +@sbuild.parse +def bal(arg1): + PC = arg1 + ir.IRDst = arg1 + RA = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), RA.size) + +@sbuild.parse +def l_b(arg1): + PC = arg1 + ir.IRDst = arg1 + +@sbuild.parse +def lbu(arg1, arg2): + """A byte is loaded (unsigned extended) into a register @arg1 from the + specified address @arg2.""" + arg1 = m2_expr.ExprMem(arg2.ptr, 8).zeroExtend(32) + +@sbuild.parse +def lh(arg1, arg2): + """A word is loaded into a register @arg1 from the + specified address @arg2.""" + arg1 = m2_expr.ExprMem(arg2.ptr, 16).signExtend(32) + +@sbuild.parse +def lhu(arg1, arg2): + """A word is loaded (unsigned extended) into a register @arg1 from the + specified address @arg2.""" + arg1 = m2_expr.ExprMem(arg2.ptr, 16).zeroExtend(32) + +@sbuild.parse +def lb(arg1, arg2): + "A byte is loaded into a register @arg1 from the specified address @arg2." + arg1 = m2_expr.ExprMem(arg2.ptr, 8).signExtend(32) + +@sbuild.parse +def ll(arg1, arg2): + "To load a word from memory for an atomic read-modify-write" + arg1 = arg2 + +@sbuild.parse +def beq(arg1, arg2, arg3): + "Branches on @arg3 if the quantities of two registers @arg1, @arg2 are eq" + dst = arg3 if m2_expr.ExprOp(m2_expr.TOK_EQUAL, arg1, arg2) else m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) + PC = dst + ir.IRDst = dst + +@sbuild.parse +def beql(arg1, arg2, arg3): + "Branches on @arg3 if the quantities of two registers @arg1, @arg2 are eq" + dst = arg3 if m2_expr.ExprOp(m2_expr.TOK_EQUAL, arg1, arg2) else m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) + PC = dst + ir.IRDst = dst + +@sbuild.parse +def bgez(arg1, arg2): + """Branches on @arg2 if the quantities of register @arg1 is greater than or + equal to zero""" + dst = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) if m2_expr.ExprOp(m2_expr.TOK_INF_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) else arg2 + PC = dst + ir.IRDst = dst + +@sbuild.parse +def bgezl(arg1, arg2): + """Branches on @arg2 if the quantities of register @arg1 is greater than or + equal to zero""" + dst = m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) if m2_expr.ExprOp(m2_expr.TOK_INF_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) else arg2 + PC = dst + ir.IRDst = dst + +@sbuild.parse +def bne(arg1, arg2, arg3): + """Branches on @arg3 if the quantities of two registers @arg1, @arg2 are NOT + equal""" + dst = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) if m2_expr.ExprOp(m2_expr.TOK_EQUAL, arg1, arg2) else arg3 + PC = dst + ir.IRDst = dst + +@sbuild.parse +def bnel(arg1, arg2, arg3): + """Branches on @arg3 if the quantities of two registers @arg1, @arg2 are NOT + equal""" + dst = m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) if m2_expr.ExprOp(m2_expr.TOK_EQUAL, arg1, arg2) else arg3 + PC = dst + ir.IRDst = dst + +@sbuild.parse +def lui(arg1, arg2): + """The immediate value @arg2 is shifted left 16 bits and stored in the + register @arg1. The lower 16 bits are zeroes.""" + arg1 = m2_expr.ExprCompose(i16(0), arg2[:16]) + +@sbuild.parse +def nop(): + """Do nothing""" + +@sbuild.parse +def sync(arg1): + """Synchronize Shared Memory""" + +@sbuild.parse +def pref(arg1, arg2): + """To move data between memory and cache""" + +@sbuild.parse +def j(arg1): + """Jump to an address @arg1""" + PC = arg1 + ir.IRDst = arg1 + +@sbuild.parse +def l_or(arg1, arg2, arg3): + """Bitwise logical ors two registers @arg2, @arg3 and stores the result in a + register @arg1""" + arg1 = arg2 | arg3 + +@sbuild.parse +def nor(arg1, arg2, arg3): + """Bitwise logical Nors two registers @arg2, @arg3 and stores the result in + a register @arg1""" + arg1 = (arg2 | arg3) ^ i32(-1) + +@sbuild.parse +def l_and(arg1, arg2, arg3): + """Bitwise logical ands two registers @arg2, @arg3 and stores the result in + a register @arg1""" + arg1 = arg2 & arg3 + +@sbuild.parse +def ext(arg1, arg2, arg3, arg4): + pos = int(arg3) + size = int(arg4) + arg1 = arg2[pos:pos + size].zeroExtend(32) + +@sbuild.parse +def mul(arg1, arg2, arg3): + """Multiplies @arg2 by $arg3 and stores the result in @arg1.""" + arg1 = 'imul'(arg2, arg3) + +@sbuild.parse +def sltu(arg1, arg2, arg3): + """If @arg2 is less than @arg3 (unsigned), @arg1 is set to one. It gets zero + otherwise.""" + arg1 = m2_expr.ExprCond( + m2_expr.ExprOp(m2_expr.TOK_INF_UNSIGNED, arg2, arg3), + m2_expr.ExprInt(1, arg1.size), + m2_expr.ExprInt(0, arg1.size) + ) + +@sbuild.parse +def slt(arg1, arg2, arg3): + """If @arg2 is less than @arg3 (signed), @arg1 is set to one. It gets zero + otherwise.""" + arg1 = m2_expr.ExprCond( + m2_expr.ExprOp(m2_expr.TOK_INF_SIGNED, arg2, arg3), + m2_expr.ExprInt(1, arg1.size), + m2_expr.ExprInt(0, arg1.size) + ) + + +@sbuild.parse +def l_sub(arg1, arg2, arg3): + arg1 = arg2 - arg3 + +def sb(ir, instr, arg1, arg2): + """The least significant byte of @arg1 is stored at the specified address + @arg2.""" + e = [] + e.append(m2_expr.ExprAssign(m2_expr.ExprMem(arg2.ptr, 8), arg1[:8])) + return e, [] + +def sh(ir, instr, arg1, arg2): + e = [] + e.append(m2_expr.ExprAssign(m2_expr.ExprMem(arg2.ptr, 16), arg1[:16])) + return e, [] + +@sbuild.parse +def movn(arg1, arg2, arg3): + if arg3: + arg1 = arg2 + +@sbuild.parse +def movz(arg1, arg2, arg3): + if not arg3: + arg1 = arg2 + +@sbuild.parse +def srl(arg1, arg2, arg3): + """Shifts arg1 register value @arg2 right by the shift amount @arg3 and + places the value in the destination register @arg1. + Zeroes are shifted in.""" + arg1 = arg2 >> arg3 + +@sbuild.parse +def sra(arg1, arg2, arg3): + """Shifts arg1 register value @arg2 right by the shift amount @arg3 and + places the value in the destination register @arg1. The sign bit is shifted + in.""" + arg1 = 'a>>'(arg2, arg3) + +@sbuild.parse +def srav(arg1, arg2, arg3): + arg1 = 'a>>'(arg2, arg3 & i32(0x1F)) + +@sbuild.parse +def sll(arg1, arg2, arg3): + arg1 = arg2 << arg3 + +@sbuild.parse +def srlv(arg1, arg2, arg3): + """Shifts a register value @arg2 right by the amount specified in @arg3 and + places the value in the destination register @arg1. + Zeroes are shifted in.""" + arg1 = arg2 >> (arg3 & i32(0x1F)) + +@sbuild.parse +def sllv(arg1, arg2, arg3): + """Shifts a register value @arg2 left by the amount specified in @arg3 and + places the value in the destination register @arg1. + Zeroes are shifted in.""" + arg1 = arg2 << (arg3 & i32(0x1F)) + +@sbuild.parse +def l_xor(arg1, arg2, arg3): + """Exclusive ors two registers @arg2, @arg3 and stores the result in a + register @arg3""" + arg1 = arg2 ^ arg3 + +@sbuild.parse +def seb(arg1, arg2): + arg1 = arg2[:8].signExtend(32) + +@sbuild.parse +def seh(arg1, arg2): + arg1 = arg2[:16].signExtend(32) + +@sbuild.parse +def bltz(arg1, arg2): + """Branches on @arg2 if the register @arg1 is less than zero""" + dst_o = arg2 if m2_expr.ExprOp(m2_expr.TOK_INF_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) else m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bltzl(arg1, arg2): + """Branches on @arg2 if the register @arg1 is less than zero""" + dst_o = arg2 if m2_expr.ExprOp(m2_expr.TOK_INF_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) else m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def blez(arg1, arg2): + """Branches on @arg2 if the register @arg1 is less than or equal to zero""" + cond = m2_expr.ExprOp(m2_expr.TOK_INF_EQUAL_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) + dst_o = arg2 if cond else m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def blezl(arg1, arg2): + """Branches on @arg2 if the register @arg1 is less than or equal to zero""" + cond = m2_expr.ExprOp(m2_expr.TOK_INF_EQUAL_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) + dst_o = arg2 if cond else m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bgtz(arg1, arg2): + """Branches on @arg2 if the register @arg1 is greater than zero""" + cond = m2_expr.ExprOp(m2_expr.TOK_INF_EQUAL_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) + dst_o = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) if cond else arg2 + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bgtzl(arg1, arg2): + """Branches on @arg2 if the register @arg1 is greater than zero""" + cond = m2_expr.ExprOp(m2_expr.TOK_INF_EQUAL_SIGNED, arg1, m2_expr.ExprInt(0, arg1.size)) + dst_o = m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) if cond else arg2 + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def wsbh(arg1, arg2): + arg1 = m2_expr.ExprCompose(arg2[8:16], arg2[0:8], arg2[24:32], arg2[16:24]) + +@sbuild.parse +def rotr(arg1, arg2, arg3): + arg1 = '>>>'(arg2, arg3) + +@sbuild.parse +def add_d(arg1, arg2, arg3): + # XXX TODO check + arg1 = 'fadd'(arg2, arg3) + +@sbuild.parse +def sub_d(arg1, arg2, arg3): + # XXX TODO check + arg1 = 'fsub'(arg2, arg3) + +@sbuild.parse +def div_d(arg1, arg2, arg3): + # XXX TODO check + arg1 = 'fdiv'(arg2, arg3) + +@sbuild.parse +def mul_d(arg1, arg2, arg3): + # XXX TODO check + arg1 = 'fmul'(arg2, arg3) + +@sbuild.parse +def mov_d(arg1, arg2): + # XXX TODO check + arg1 = arg2 + +@sbuild.parse +def mfc0(arg1, arg2): + arg1 = arg2 + +@sbuild.parse +def mfc1(arg1, arg2): + arg1 = arg2 + +@sbuild.parse +def mtc0(arg1, arg2): + arg2 = arg1 + +@sbuild.parse +def mtc1(arg1, arg2): + arg2 = arg1 + +@sbuild.parse +def tlbwi(): + "TODO XXX" + +@sbuild.parse +def tlbp(): + "TODO XXX" + +@sbuild.parse +def tlbwr(): + "TODO XXX" + +@sbuild.parse +def tlbr(): + "TODO XXX" + +def break_(ir, instr): + e = [] + e.append(m2_expr.ExprAssign(exception_flags, m2_expr.ExprInt(EXCEPT_SOFT_BP, 32))) + return e, [] + +def syscall(ir, instr, code): + e = [] + e.append(m2_expr.ExprAssign(exception_flags, m2_expr.ExprInt(EXCEPT_SYSCALL, 32))) + return e, [] + +def ins(ir, instr, a, b, c, d): + e = [] + pos = int(c) + l = int(d) + + my_slices = [] + if pos != 0: + my_slices.append(a[:pos]) + if l != 0: + my_slices.append(b[:l]) + if pos + l != 32: + my_slices.append(a[pos+l:]) + r = m2_expr.ExprCompose(*my_slices) + e.append(m2_expr.ExprAssign(a, r)) + return e, [] + + +@sbuild.parse +def lwc1(arg1, arg2): + arg1 = ('mem_%.2d_to_single' % arg2.size)(arg2) + +@sbuild.parse +def swc1(arg1, arg2): + arg2 = ('single_to_mem_%.2d' % arg1.size)(arg1) + +@sbuild.parse +def c_lt_d(arg1, arg2, arg3): + arg1 = 'fcomp_lt'(arg2, arg3) + +@sbuild.parse +def c_eq_d(arg1, arg2, arg3): + arg1 = 'fcomp_eq'(arg2, arg3) + +@sbuild.parse +def c_le_d(arg1, arg2, arg3): + arg1 = 'fcomp_le'(arg2, arg3) + +@sbuild.parse +def bc1t(arg1, arg2): + dst_o = arg2 if arg1 else m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bc1tl(arg1, arg2): + dst_o = arg2 if arg1 else m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bc1f(arg1, arg2): + dst_o = m2_expr.ExprLoc(ir.get_next_break_loc_key(instr), ir.IRDst.size) if arg1 else arg2 + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def bc1fl(arg1, arg2): + dst_o = m2_expr.ExprLoc(ir.get_next_delay_loc_key(instr), ir.IRDst.size) if arg1 else arg2 + PC = dst_o + ir.IRDst = dst_o + +@sbuild.parse +def cvt_d_w(arg1, arg2): + # TODO XXX + arg1 = 'flt_d_w'(arg2) + +@sbuild.parse +def mult(arg1, arg2): + """Multiplies (signed) @arg1 by @arg2 and stores the result in $R_HI:$R_LO""" + size = arg1.size + result = arg1.signExtend(size * 2) * arg2.signExtend(size * 2) + R_LO = result[:32] + R_HI = result[32:] + +@sbuild.parse +def multu(arg1, arg2): + """Multiplies (unsigned) @arg1 by @arg2 and stores the result in $R_HI:$R_LO""" + size = arg1.size + result = arg1.zeroExtend(size * 2) * arg2.zeroExtend(size * 2) + R_LO = result[:32] + R_HI = result[32:] + +@sbuild.parse +def div(arg1, arg2): + """Divide (signed) @arg1 by @arg2 and stores the remaining/result in $R_HI/$R_LO""" + R_LO = m2_expr.ExprOp('sdiv' ,arg1, arg2) + R_HI = m2_expr.ExprOp('smod', arg1, arg2) + +@sbuild.parse +def divu(arg1, arg2): + """Divide (unsigned) @arg1 by @arg2 and stores the remaining/result in $R_HI/$R_LO""" + R_LO = m2_expr.ExprOp('udiv', arg1, arg2) + R_HI = m2_expr.ExprOp('umod', arg1, arg2) + +@sbuild.parse +def mfhi(arg1): + "The contents of register $R_HI are moved to the specified register @arg1." + arg1 = R_HI + +@sbuild.parse +def mflo(arg1): + "The contents of register R_LO are moved to the specified register @arg1." + arg1 = R_LO + +@sbuild.parse +def di(arg1): + "NOP" + +@sbuild.parse +def ei(arg1): + "NOP" + +@sbuild.parse +def ehb(arg1): + "NOP" + +@sbuild.parse +def sc(arg1, arg2): + arg2 = arg1; + arg1 = m2_expr.ExprInt(0x1, 32) + +@sbuild.parse +def mthi(arg1): + R_HI = arg1 + +@sbuild.parse +def mtlo(arg1): + R_LOW = arg1 + +def clz(ir, instr, rs, rd): + e = [] + e.append(m2_expr.ExprAssign(rd, m2_expr.ExprOp('cntleadzeros', rs))) + return e, [] + +def teq(ir, instr, arg1, arg2): + e = [] + + loc_except, loc_except_expr = ir.gen_loc_key_and_expr(ir.IRDst.size) + loc_next = ir.get_next_loc_key(instr) + loc_next_expr = m2_expr.ExprLoc(loc_next, ir.IRDst.size) + + do_except = [] + do_except.append(m2_expr.ExprAssign(exception_flags, m2_expr.ExprInt( + EXCEPT_DIV_BY_ZERO, exception_flags.size))) + do_except.append(m2_expr.ExprAssign(ir.IRDst, loc_next_expr)) + blk_except = IRBlock(ir.loc_db, loc_except, [AssignBlock(do_except, instr)]) + + cond = arg1 - arg2 + + + e = [] + e.append(m2_expr.ExprAssign(ir.IRDst, + m2_expr.ExprCond(cond, loc_next_expr, loc_except_expr))) + + return e, [blk_except] + +def tne(ir, instr, arg1, arg2): + e = [] + + loc_except, loc_except_expr = ir.gen_loc_key_and_expr(ir.IRDst.size) + loc_next = ir.get_next_loc_key(instr) + loc_next_expr = m2_expr.ExprLoc(loc_next, ir.IRDst.size) + + do_except = [] + do_except.append(m2_expr.ExprAssign(exception_flags, m2_expr.ExprInt( + EXCEPT_DIV_BY_ZERO, exception_flags.size))) + do_except.append(m2_expr.ExprAssign(ir.IRDst, loc_next_expr)) + blk_except = IRBlock(ir.loc_db, loc_except, [AssignBlock(do_except, instr)]) + + cond = arg1 ^ arg2 + + + e = [] + e.append(m2_expr.ExprAssign(ir.IRDst, + m2_expr.ExprCond(cond, loc_next_expr, loc_except_expr))) + + return e, [blk_except] + + +mnemo_func = sbuild.functions +mnemo_func.update( + { + 'add.d': add_d, + 'addu': addiu, + 'addi': addiu, + 'and': l_and, + 'andi': l_and, + 'b': l_b, + 'c.eq.d': c_eq_d, + 'c.le.d': c_le_d, + 'c.lt.d': c_lt_d, + 'cvt.d.w': cvt_d_w, + 'div.d': div_d, + 'ins': ins, + 'jr': j, + 'mov.d': mov_d, + 'mul.d': mul_d, + 'or': l_or, + 'ori': l_or, + 'slti': slt, + 'sltiu': sltu, + 'sub.d': sub_d, + 'subu': l_sub, + 'xor': l_xor, + 'xori': l_xor, + 'clz': clz, + 'teq': teq, + 'tne': tne, + 'break': break_, + 'sb': sb, + 'sh': sh, + 'syscall': syscall, + } +) + +def get_mnemo_expr(ir, instr, *args): + instr, extra_ir = mnemo_func[instr.name.lower()](ir, instr, *args) + return instr, extra_ir + +class Lifter_Mips32l(Lifter): + + def __init__(self, loc_db): + Lifter.__init__(self, mn_mips32, 'l', loc_db) + self.pc = mn_mips32.getpc() + self.sp = mn_mips32.getsp() + self.IRDst = m2_expr.ExprId('IRDst', 32) + self.addrsize = 32 + + def get_ir(self, instr): + args = instr.args + instr_ir, extra_ir = get_mnemo_expr(self, instr, *args) + + fixed_regs = { + self.pc: m2_expr.ExprInt(instr.offset + 4, 32), + ZERO: m2_expr.ExprInt(0, 32) + } + + instr_ir = [m2_expr.ExprAssign(expr.dst, expr.src.replace_expr(fixed_regs)) + for expr in instr_ir] + + new_extra_ir = [irblock.modify_exprs(mod_src=lambda expr: expr.replace_expr(fixed_regs)) + for irblock in extra_ir] + return instr_ir, new_extra_ir + + def get_next_instr(self, instr): + return self.loc_db.get_or_create_offset_location(instr.offset + 4) + + def get_next_break_loc_key(self, instr): + return self.loc_db.get_or_create_offset_location(instr.offset + 8) + + def get_next_delay_loc_key(self, instr): + return self.loc_db.get_or_create_offset_location(instr.offset + 16) + +class Lifter_Mips32b(Lifter_Mips32l): + def __init__(self, loc_db): + self.addrsize = 32 + Lifter.__init__(self, mn_mips32, 'b', loc_db) + self.pc = mn_mips32.getpc() + self.sp = mn_mips32.getsp() + self.IRDst = m2_expr.ExprId('IRDst', 32) |