dasmmsil.pas

来自「反汇编delphi的.dcu文件至汇编代码的工具的所有源代码, 用delphi/」· PAS 代码 · 共 670 行 · 第 1/2 页

    (Name: 'ldelem_i'; {0x97}),
    (Name: 'ldelem_r4'; {0x98}),
    (Name: 'ldelem_r8'; {0x99}),
    (Name: 'ldelem_ref'; {0x9A}),
    (Name: 'stelem_i'; {0x9B}),
    (Name: 'stelem_i1'; {0x9C}),
    (Name: 'stelem_i2'; {0x9D}),
    (Name: 'stelem_i4'; {0x9E}),
    (Name: 'stelem_i8'; {0x9F}),
    (Name: 'stelem_r4'; {0xA0}),
    (Name: 'stelem_r8'; {0xA1}),
    (Name: 'stelem_ref'; {0xA2}),
    (Name: 'ldelem'; F: atMetadata {0xA3}),
    (Name: 'stelem'; F: atMetadata {0xA4}),
    (Name: 'unbox_any'; F: atMetadata {0xA5}),
    (Name: ''; {0xA6}),
    (Name: ''; {0xA7}),
    (Name: ''; {0xA8}),
    (Name: ''; {0xA9}),
    (Name: ''; {0xAA}),
    (Name: ''; {0xAB}),
    (Name: ''; {0xAC}),
    (Name: ''; {0xAD}),
    (Name: ''; {0xAE}),
    (Name: ''; {0xAF}),
    (Name: ''; {0xB0}),
    (Name: ''; {0xB1}),
    (Name: ''; {0xB2}),
    (Name: 'conv_ovf_i1'; {0xB3}),
    (Name: 'conv_ovf_u1'; {0xB4}),
    (Name: 'conv_ovf_i2'; {0xB5}),
    (Name: 'conv_ovf_u2'; {0xB6}),
    (Name: 'conv_ovf_i4'; {0xB7}),
    (Name: 'conv_ovf_u4'; {0xB8}),
    (Name: 'conv_ovf_i8'; {0xB9}),
    (Name: 'conv_ovf_u8'; {0xBA}),
    (Name: ''; {0xBB}),
    (Name: ''; {0xBC}),
    (Name: ''; {0xBD}),
    (Name: ''; {0xBE}),
    (Name: ''; {0xBF}),
    (Name: ''; {0xC0}),
    (Name: ''; {0xC1}),
    (Name: 'refanyval'; F: atMetadata {0xC2}),
    (Name: 'ckfinite'; {0xC3}),
    (Name: ''; {0xC4}),
    (Name: ''; {0xC5}),
    (Name: 'mkrefany'; F: atMetadata {0xC6}),
    (Name: ''; {0xC7}),
    (Name: ''; {0xC8}),
    (Name: ''; {0xC9}),
    (Name: ''; {0xCA}),
    (Name: ''; {0xCB}),
    (Name: ''; {0xCC}),
    (Name: ''; {0xCD}),
    (Name: ''; {0xCE}),
    (Name: ''; {0xCF}),
    (Name: 'ldtoken'; F: atMetadata {0xD0}),
    (Name: 'conv_u2'; {0xD1}),
    (Name: 'conv_u1'; {0xD2}),
    (Name: 'conv_i'; {0xD3}),
    (Name: 'conv_ovf_i'; {0xD4}),
    (Name: 'conv_ovf_u'; {0xD5}),
    (Name: 'add_ovf'; {0xD6}),
    (Name: 'add_ovf_un'; {0xD7}),
    (Name: 'mul_ovf'; {0xD8}),
    (Name: 'mul_ovf_un'; {0xD9}),
    (Name: 'sub_ovf'; {0xDA}),
    (Name: 'sub_ovf_un'; {0xDB}),
    (Name: 'endfinally'; {0xDC}),
    (Name: 'leave'; F: atJmpofs4 {0xDD}),
    (Name: 'leave_s'; F: atJmpofs1 {0xDE}),
    (Name: 'stind_i'; {0xDF}),
    (Name: 'conv_u'; {0xE0}),
    (Name: ''; {0xE1}),
    (Name: ''; {0xE2}),
    (Name: ''; {0xE3}),
    (Name: ''; {0xE4}),
    (Name: ''; {0xE5}),
    (Name: ''; {0xE6}),
    (Name: ''; {0xE7}),
    (Name: ''; {0xE8}),
    (Name: ''; {0xE9}),
    (Name: ''; {0xEA}),
    (Name: ''; {0xEB}),
    (Name: ''; {0xEC}),
    (Name: ''; {0xED}),
    (Name: ''; {0xEE}),
    (Name: ''; {0xEF}),
    (Name: ''; {0xF0}),
    (Name: ''; {0xF1}),
    (Name: ''; {0xF2}),
    (Name: ''; {0xF3}),
    (Name: ''; {0xF4}),
    (Name: ''; {0xF5}),
    (Name: ''; {0xF6}),
    (Name: ''; {0xF7}),
    (Name: ''; {0xF8}),
    (Name: ''; {0xF9}),
    (Name: ''; {0xFA}),
    (Name: ''; {0xFB}),
    (Name: ''; {0xFC}),
    (Name: ''; {0xFD}),
    (Name: '_EXT'; F: atExtTbl {0xFE}),
    (Name: ''; {0xFF})
  );

function ReadCodeByte(var B: Byte): boolean;
{ This procedure can use fixup information to prevent parsing commands }
{ which contradict fixups }
{Was copied here just in case that something is different with MSIL Fixups}
begin
  Result := ChkNoFixupIn(CodePtr,1);
  if not Result then
    Exit;
  B := Byte(CodePtr^);
  Inc(CodePtr);
  Result := true;
end ;

function ReadCodeInt(var V: integer): boolean;
{ This procedure can use fixup information to prevent parsing commands }
{ which contradict fixups }
begin
  Result := ChkNoFixupIn(CodePtr,4);
  if not Result then
    Exit;
  V := integer(Pointer(CodePtr)^);
  Inc(CodePtr,SizeOf(integer));
  Result := true;
end ;

procedure SkipCode(Size: Cardinal);
begin
  Inc(CodePtr,Size);
end ;

type
  TCmdAction = procedure(CI: PCmdInfo; DP: Pointer; IP: Pointer);

function ProcessCommand(Action: TCmdAction; IP: Pointer): boolean;
var
  opC: Byte;
  F,Sz: integer;
  PCmdTbl: PCmdInfoTbl;
  DP: Pointer;
  CmdTblHi: integer;
begin
  Result := false;
  CodePtr := PrevCodePtr;
  PCmdTbl := @CmdTbl;
  CmdTblHi := High(CmdTbl);
  repeat
    if not ReadCodeByte(opC) then
      Exit;
    if opC>CmdTblHi then
      Exit;
    if PCmdTbl^[opC].Name[0]=#0 then
      Exit;
    F := PCmdTbl^[opC].F;
    DP := CodePtr;
    Sz := CmdArgSize[F and atMask];
    if Sz>=0 then
      SkipCode(Sz)
    else begin
      if Sz=argSzWrong then
        Exit;
      case F of
       atJmpofs4tbl: begin
         if not ReadCodeInt(Sz) then
           Exit;
         SkipCode(Sz*SizeOf(integer))
        end ;
       atExtTbl: begin
         PCmdTbl := @CmdTblFE;
         CmdTblHi := High(CmdTblFE);
         Continue;
       end ;
      end ;
    end ;
    if CodePtr>CodeEnd then
      Exit; //Error
    Action(@PCmdTbl^[opC],DP,IP);
    if F and ckPrefix=0 then
      break;
    PCmdTbl := @CmdTbl;
    CmdTblHi := High(CmdTbl);
  until false;
  Result := true;
end ;

procedure DoNothing(CI: PCmdInfo; DP: Pointer; IP: Pointer);
begin
end ;

function ReadCommand: boolean;
begin
  PrevCodePtr := CodePtr;
  Result := ProcessCommand(DoNothing,Nil);
end ;

procedure ReportFlags(Flags: integer; Names: PStrTbl; NHi: integer);
var
  i,F: integer;
begin
  F := 1;
  for i:=0 to NHi do begin
    if Flags=0 then
      Exit;
    if Flags and F<>0 then begin
      Flags := Flags and not F;
      PutsFmt('.%s',[Names^[i]]);
    end ;
    F := F shl 1;
  end ;
  if F<>0 then
    PutsFmt('.$%x',[F]);
end ;

procedure ShowCmdPart(CI: PCmdInfo; DP: Pointer; IP: Pointer);
var
  Cnt,D: integer;
  Sep: Char;
  Fix: PFixupRec;
  Fixed: boolean;
begin
  PutS(CI^.Name);
  case CI^.F and atMask of
   atU1: PutSFmt(' $%2.2x',[Byte(DP^)]);
   atU2: PutSFmt(' $%4.4x',[Word(DP^)]);
   atU4: PutSFmt(' $%8.8x',[Cardinal(DP^)]);
   atI1: PutSFmt(' %d',[ShortInt(DP^)]);
   atI4: PutSFmt(' %d',[Integer(DP^)]);
   atI8: PutSFmt(' $%x%8.8x',[Integer(Pointer(PChar(DP)+4)^),Integer(DP^)]);
   atR4: PutSFmt(' %g',[Single(DP^)]);
   atR8: PutSFmt(' %g',[Double(DP^)]);
   atMetadata: begin
     PutS(' ');
     D := Integer(DP^);
     Fix := Nil;
     Fixed := false;
     if GetFixupFor(DP,SizeOf(integer),false,Fix)and(Fix<>Nil) then begin
       Fixed := ReportFixup(Fix,D,ShowHeuristicRefs);
     end ;
     if (D=0)and(Fix<>Nil) then
       Exit;
     if Fixed then
       PutS('{+');
     PutSFmt('%d',[D]);
     if Fixed then
       PutS('}');
    end ;
   atCheckKind: ReportFlags(Byte(DP^),@CheckKindTbl,High(CheckKindTbl));
   atJmpofs1: PutSFmt(' $%x',[(CodePtr-CodeBase)+ShortInt(DP^)]);
   atJmpofs4: PutSFmt(' $%x',[(CodePtr-CodeBase)+LongInt(DP^)]);
   atJmpofs4tbl: begin
     Cnt := integer(DP^);
     Puts(' ');
     Sep := '[';
     while Cnt>0 do begin
       Inc(PChar(DP),SizeOf(integer));
       PutSFmt('%s$%x',[Sep,(CodePtr-CodeBase)+LongInt(DP^)]);
       Sep := ',';
       Dec(Cnt);
     end ;
     if Sep=',' then
       Puts(']');
    end ;
  end ;
end ;

procedure ShowCommand;
begin
  ProcessCommand(ShowCmdPart,Nil);
end ;

type
  TCmdRefCtx = record
    RegRef: TRegCommandRefProc;
    IPRegRef: Pointer;
    Res: integer;
    CmdOfs: Cardinal;
  end ;

procedure CmdPartRefs(CI: PCmdInfo; DP: Pointer; IP: Pointer);
var
  Cnt: integer;
begin
  with TCmdRefCtx(IP^) do begin
    if CI^.F and ckStop<>0 then
      Res := crJmp;
    case CI^.F and atMask of
     atJmpofs1: begin
       if Res<0 then
         Res := crJCond;
       RegRef(CmdOfs+ShortInt(DP^),Res,IPRegRef);
      end ;
     atJmpofs4: begin
       if Res<0 then
         Res := crJCond;
       RegRef(CmdOfs+LongInt(DP^),Res,IPRegRef);
      end ;
     atJmpofs4tbl: begin
       Res := crJCond;
       Cnt := integer(DP^);
       while Cnt>0 do begin
         Inc(PChar(DP),SizeOf(integer));
         RegRef(CmdOfs+LongInt(DP^),Res,IPRegRef);
         Dec(Cnt);
       end ;
      end ;
    end ;
  end ;
end ;

function CheckCommandRefs(RegRef: TRegCommandRefProc; CmdOfs: Cardinal;
  IP: Pointer): integer;
var
  Ctx: TCmdRefCtx;
begin
  Ctx.RegRef := RegRef;
  Ctx.IPRegRef := IP;
  Ctx.Res := -1;
  Ctx.CmdOfs := CmdOfs;
  ProcessCommand(CmdPartRefs,@Ctx);
  Result := Ctx.Res;
end ;

procedure SetMSILDisassembler;
begin
  SetDisassembler(ReadCommand, ShowCommand,CheckCommandRefs);
end ;

end.