dasmutil.pas

dede 的源代码 3.10b

unit DAsmUtil;
(*
The main disassembler module of the DCU32INT utility by Alexei Hmelnov.
----------------------------------------------------------------------------
E-Mail: [e-mail]
http://monster.icc.ru/~alex/DCU/
----------------------------------------------------------------------------

See the file "readme.txt" for more details.

------------------------------------------------------------------------
                             IMPORTANT NOTE:
This software is provided 'as-is', without any expressed or implied warranty.
In no event will the author be held liable for any damages arising from the
use of this software.
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented, you must not
   claim that you wrote the original software.
2. Altered source versions must be plainly marked as such, and must not
   be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
   distribution.
*)
interface

uses
  FixUp;

const
  nf =  $40000000;
  nm =  nf-1;
  hEA = $7FFFFFFF;

  function Identic(I: integer): integer;
  function ReadByte(var B: integer): boolean;
  function UnReadByte: boolean;
  procedure SetPrefix(V: integer);
  procedure SetSuffix(V: integer);
  procedure SetOpName(V: integer);
  procedure SetCmdArg(V: integer);
  procedure SetOpPrefix(V: integer);
  procedure SetSeg(V: integer);
  function GetSeg: integer;
  function imPtr: boolean;
  //function im(DS: integer): boolean;
  function ImmedBW(DS: integer): boolean;
  //function imSExt(DS: integer): boolean;
  function imInt(DS: integer): boolean;
  function jmpOfs(DS: integer): boolean;
  function getEA(W: integer;var M,A: integer): boolean;
  function getImmOfsEA(W: integer;var A: integer): boolean;
  procedure setEASize(DS: integer);
  procedure setOS;
  procedure setAS;
  function GetAS: integer;
  function GetOS: integer;

type
  THBMName = integer;

  PBMTblProc = ^TBMTblProc;
  TBMTblProc = array[byte]of THBMName;

  TBMOpRec = string[7];

const
 {Command arguments}
  caReg    = 1;
  caEffAdr = 2;
  caImmed  = 3;
  caVal    = 4;
  caJmpOfs = 5;
  caInt    = 6;
  caMask   = $f;

const
  dsByte   = 1;
  dsWord   = 2;
  dsDbl    = 3;
  dsQWord  = 4;
  dsTWord  = 5;
  dsPtr    = 6;
  dsMask   = $7;
  dsToSize: array[0..7] of Cardinal = (0,1,2,4,8,10,4,0);

const
  hAX=0;
  hCX=1;
  hDX=2;
  hBX=3;
  hSP=4;
  hBP=5;
  hSI=6;
  hDI=7;
  hPresent=8;
  hWReg=$10;

const
  hBXF=hBX+hPresent;
  hBPF=hBP+hPresent;
  hSIF=(hSI+hPresent)shl 4;
  hDIF=(hDI+hPresent)shl 4;

const
  RMS : array[0..7] of Byte = (
    hBXF+hSIF,
    hBXF+hDIF,
    hBPF+hSIF,
    hBPF+hDIF,
         hSIF,
         hDIF,
    hBPF,
    hBXF
  ) ;
const
  hES=0;
  hCS=1;
  hSS=2;
  hDS=3;
  hFS=4;
  hGS=5;

  hNoSeg=7;
  hDefSeg=8;
  DefEASeg : array[0..7] of Byte = (
    hDS, hDS, hSS, hSS, hDS, hDS, hDS, hDS
  ) ;

type
  TRegNum=0..7;
  PEffAddr=^TEffAddr;
  TEffAddr=record
    hSeg:Byte;{0,dSize3,Seg4}
    hBase:Byte;{Index4,Base4}
    dOfs:Byte;{OfsSize3,Ofs5}
    SS: Byte;
    Fix: PFixupRec;
  end ;

  TCmArg=record
    Kind:integer{Byte};
    Inf:integer{Byte};
    Fix: PFixupRec;
  end ;

  PCmdInfo=^TCmdInfo;
  TCmdInfo=record
    PrefSize:Byte;
    hCmd:integer;
    EA:TEffAddr;
    Cnt:Byte;
    Arg:array[1..3] of TCmArg;
  end ;

var
  OpSeg: Byte;
  Cmd: TCmdInfo;
  CmdPrefix,CmdSuffix: integer;
  PrefixCnt: integer;
  PrefixTbl: array[0..10] of integer;
const
  AdrIs32Deft: boolean = true;
const
  OpIs32Deft: boolean = true;
  WordSize: array[boolean]of Byte = (2,4);
var
  AdrIs32: boolean;
  OpIs32: boolean;

var
  CodePtr, PrevCodePtr: PChar;

procedure ClearCommand;

function ReadCommand: boolean;

procedure ShowCommand;

var
  RegTbl:array[0..2] of PBMTblProc;
  SegRegTbl: PBMTblProc;

implementation

uses
  SysUtils, op, DCU_In, DCU_Out;


var {For unread}
  fxState0: TFixupState;

procedure ClearCommand;
begin
  PrevCodePtr := CodePtr;
  fillChar(Cmd,SizeOf(Cmd),0);
  OpSeg:=hDefSeg;
  CmdPrefix := 0;
  CmdSuffix := 0;
  PrefixCnt := 0;
  AdrIs32 := AdrIs32Deft;
  OpIs32 := OpIs32Deft;
  SaveFixupState(fxState0);
end ;

(*
function ReadCodeByte(var B: Byte): boolean;
{ This procedure can use fixup information to prevent parsing commands }
{ which contradict fixups }
var
  Fx: PFixupRec;
  F: Byte;
begin
  Result := false;
  if CodePtr>=CodeEnd then
    Exit {Memory block finished};
  SkipFixups(CodePtr-CodeStart);
  if CodePtr<FixUpEnd then
    Exit {Code can't be inside FixUp};
  repeat
    Fx := CurFixup(CodePtr-CodeStart);
    if Fx=Nil then
      Break;
    F := TByte4(Fx^.OfsF)[3];
    if F<fxStart then begin
      SetFixEnd;
      Exit {Code can't be inside FixUp};
    end ;
    if F=fxStart then begin
      if CodePtr>PrevCodePtr then
        Exit {Can't be inside a command};
     end
    else {if F=fxEnd then}
      Exit {Can't be inside a code};
  until not NextFixup(CodePtr-CodeStart);
  B := Byte(CodePtr^);
  Inc(CodePtr);
  Result := true;
end ;
*)

function ReadCodeByte(var B: Byte): boolean;
{ This procedure can use fixup information to prevent parsing commands }
{ which contradict fixups }
begin
  Result := ChkNoFixupIn(CodePtr,1);
  if not Result then
    Exit;
  B := Byte(CodePtr^);
  Inc(CodePtr);
  Result := true;
end ;

function ReadImmedData(Size:Cardinal; var Res: Byte; var Fix: PFixupRec): boolean;
begin
  Result := GetFixupFor(CodePtr,Size,false,Fix);
  if not Result then
    Exit;
  Res := CodePtr-PrevCodePtr;
  Inc(CodePtr,Size);
end ;

function Identic(I: integer): integer;
begin
  Result := i;
end ;

function ReadByte(var B: integer): boolean;
var
  B0: Byte;
begin
  Result := ReadCodeByte(B0);
  B := B0;
end ;

function UnReadByte: boolean;
begin
  Result := false;
  if CodePtr<=PrevCodePtr then
    Exit;
  Dec(CodePtr);
 {May be it's not necessary here, but it will be safer to playback fixups:}
  RestoreFixupState(fxState0);
  SkipFixups(CodePtr-CodeStart);
  Result := true;
end ;

procedure SetPrefix(V: integer);
begin
  CmdPrefix := V;
end ;

procedure SetSuffix(V: integer);
begin
  CmdSuffix := V;
end ;

procedure SetOpName(V: integer);
begin
  Cmd.hCmd := V;
end ;

procedure SetCmdArg(V: integer);
begin
//    Result := false;
  if Cmd.Cnt>=3 then
    Exit;
  Inc(Cmd.Cnt);
  with Cmd.Arg[Cmd.Cnt] do
   if V=hEA then
     Cmd.Arg[Cmd.Cnt].Kind := caEffAdr
   else if (V and nf)<>0 then begin
     Kind := caReg;
     Inf := V and nm;
    end
   else {if (V and $FFFFFF00)=0 then} begin
     Kind := caVal;
     Inf := V;
    end
   {else
     Exit};
end ;

procedure SetOpPrefix(V: integer);
begin
  PrefixTbl[PrefixCnt] := V;
  Inc(PrefixCnt);
end ;

procedure SetSeg(V: integer);
begin
  OpSeg := V;
end ;

function GetSeg: integer;
begin
  Result := OpSeg;
end ;

function im(DSize: integer): boolean;
const
  SizeTbl: array[1..6] of Cardinal = (
     SizeOf(Byte),
     SizeOf(Word),
     SizeOf(LongInt),
     8,
     10,
     SizeOf(Pointer)
  );
  PtrSize: array[boolean] of integer = (4,6);
var
  Size: Cardinal;
  imOfs: Byte;
begin
  Result := false;
  if Cmd.Cnt>=3 then
    Exit;
  Inc(Cmd.Cnt);
  if DSize=dsPtr then
    Size := PtrSize[OpIs32]
  else
    Size := SizeTbl[DSize];
  with Cmd.Arg[Cmd.Cnt] do begin
    Kind := caImmed+(DSize shl 4);
    if not ReadImmedData(Size,ImOfs,Fix) then
      Exit;
    Inf := ImOfs;
  end ;
  Result := true;
end ;

function imPtr: boolean;
begin
  Result := im(dsPtr);
end ;

function ImmedBW(DS: integer): boolean;
const
  BWTbl: array[0..3] of Byte = (dsByte,dsWord,dsDbl,dsQWord);
begin
  Result := im(BWTbl[DS and 3]);
end ;
(*
function imSExt(S,W: integer): boolean;
const
  BWTbl: array[0..1] of Byte = (dsByte,dsWord);
var
  SExt: Byte;
begin
  Result := false;
  SExt := S and $1;
  if not im(BWTbl[(W and 1)and not (SExt){橡