ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/TPU6.ZIP/TPU6UNA.PAS

Pascal/Delphi Source File | 1991-04-16 | 23.8 KB | 948 lines

UNIT TPU6UNA;

(*****************)
(**) INTERFACE (**)             USES TPU6EQU, TPU6AMS;
(*****************)

TYPE
    OprStr = String[32];

    CpuGate = (C086,C186,C286,C386);

    ObjArg =
        RECORD
            Obj  : Word;    { Offset of text to Unassemble }
            Lim  : Word;    { Max Bytes to Examine  }
            TCpu : CpuGate; { Cpu code to handle }
            Locn : Word;    { Code Offset }
            Code : OprStr;    { Object Text in ASCII }
            Mnem : OprStr;    { Mnemonic(s) in ASCII }
            Opr1 : OprStr;    { ASCII Operand 1 }
            Opr2 : OprStr;    { ASCII Operand 2 }
            Opr3 : OprStr;    { ASCII Operand 3 }
        END;

CONST    SegDBit : Boolean = FALSE; { Assume 16-Bit Addressing }

PROCEDURE UnAssemble(U : UnitPtr; VAR P : ObjArg);

(**********************)
(**) IMPLEMENTATION (**)
(**********************)

TYPE    { Types Below Used For Quick Classification of Op-Codes }

   Gating =
    (G_RM1,     G_RM2,     G_RM3,     G_RM4,     G_RM5,
     G_RM6,     G_RM7,     G_RM8,     G_RM9,        { modR/M Has op bits }
     G_Hit,    { defined operation }
     G_0Fx,    { 0F-type operation }
     G_387,    { escapes to 80387  }
     G_Pfx,    { prefix  operation }
     G_ooo);   { invalid operation }

   Gate_2 =        { 2nd-level gates for G_0Fx Operations }
    (Row_0,
     Row_2,
     Row_8,
     Row_9,
     Row_A,
     Row_B,
     Row_X);   { invalid otherwise }

   TAdr = (Adr16,Adr32);    {16-bit or 32-bit Addressing}
   WBitStatus = (W0,W1);    {W1 = W-bit ON, else W0}
   REGString = String[3];
   TagRec =
    RECORD
        A : Char;    {tells type of operand}
        V : Byte        {gives width/value etc}
    END;
   TagGrp = ARRAY[1..3] OF TagRec;

   CpuVec =
    RECORD
        F,    {Bit Flags for Processing Options}
            {1xxx xxxx = alternate Mnemonic at M+1  }
            {x1xx xxxx = 32-bit if OpSiz Prefix     }
            {xx1x xxxx = 16-bit normally            }
            {xxx1 xxxx = sign-extend immediates     }
            {xxxx 1xxx = Op has modR/M field        }
            {---- -ccc = Cpu Required for Op    }

        M,    {8086  Mnemonic Index}
        T    {Operand Format Index}
                            : Byte
    END;

   MpuVec =                    {.CP27}
    RECORD
        F,    { Flag Bits (see below)
            0000 0000 = INVALID operation
            0010 xxxx = Entire modR/M byte defines op-code
            0001 xxxx = modR/M REG field defines op-code

            xxxx 0000 = no explicit operand(s) coded
            xxxx 0001 = operand is "AX"
            xxxx 0010 = operand is "Bcd80"
            xxxx 0011 = operand is "Ea" (no size implied)
            xxxx 0100 = operand is "Ew" (16-bit word)
            xxxx 0101 = operand is "Int16"
            xxxx 0110 = operand is "Int32"
            xxxx 0111 = operand is "Int64"
            xxxx 1000 = operand is "Real32"
            xxxx 1001 = operand is "Real64"
            xxxx 1010 = operand is "Real80"
            xxxx 1011 = operand is "ST(i)"
            xxxx 1100 = operand is "ST(i),ST"
            xxxx 1101 = operand is "ST,ST(i)"
            xxxx 1110 = reserved
            xxxx 1111 = reserved
            }
        M    { index to mnemonic table }
                : Byte
    END;


   TMrm =
    RECORD
        D,       { Size in Bytes of Displacement Field}
        SIB,     { 1 -> SIB field present, else no SIB}
        rS,      { index to Segment Register String   }
        rB,      { index to  Base   Register String   }
        rX       { index to  Index  Register String   }
            : Byte
    END;

   SibRec =
    RECORD
        D,      { displacement width (bytes) }
        rS,     { default segment register   }
        rB      { default base register      }
            : Byte
    END;

   sxRec =
    RECORD
        rX,  { to index reg name }
        sF   { multiplier; if 0, ss must be too or illegal}
            : Byte
    END;
{$I TPU6UNA.INC}

VAR                                    {.CP32}
    Is_386Xtnsn,    Is_32BitMax,    Is_16BitMin,    Is_SignXtnd,
    Is_MODrmFld,    HaveSizePfx,    HaveAddrPfx,    HaveMRM,
    HaveSIB,    FetchFailure,    DSiz32,        ASiz32,
    HaveSegPfx,    HaveInstPfx,    HaveMemOprnd    : Boolean;

    CpuAuth        : CpuGate;

    CodeByte,    PfxMax,        OprBytes,    DataByte,
    DLoc,        mrmMOD,        mrmREG,        mrmRM,
    IPfx,        sibSS,        sibNDX,        sibBAS,
    EmuFlag,    SPfx                    : Byte;

    BytesFetched,    BytesRemaining,    PrefixBytes,    CodeSeg,
    CodeOfs,    VirtualIP                : Word;

    REGOperand,    REGSeg,        REGBase,
    REGIndex,    REGSegOvr            : REGString;

    EAOperand,    CodeText,    Mnemonic    : OprStr;

    CodeStack    : ARRAY[1..16] OF Byte;
    Opnd         : ARRAY[1..3]  OF OprStr;
    ActGroup    : CpuVec;
    OpTags        : TagGrp;
    NdxSF        : String[2];

    ByteGate    : Gating;
    AddrMode    : TAdr;
    WBitMode    : WBitStatus;

    { --------------------------------------------- } {.CP19}
    { Fetches a Byte and stacks it for Disassembler }
    { --------------------------------------------- }

FUNCTION FetchByte : Byte;
BEGIN
    FetchFailure := BytesRemaining = 0;
    IF NOT FetchFailure THEN
    BEGIN
        Inc(BytesFetched);
        {$R+}
        CodeStack[BytesFetched] := Mem[CodeSeg:CodeOfs];
        {$R-}
        Dec(BytesRemaining);
        Inc(CodeOfs);
    END;
        FetchByte := CodeStack[BytesFetched]
END;

    { ----------------------------------------------- } {.CP14}
    { Undoes the Fetch Byte Process - Pops From Stack }
    { ----------------------------------------------- }

PROCEDURE UnFetchCodeByte;
BEGIN
    IF BytesFetched > 0 THEN
    BEGIN
        Dec(BytesFetched);
        Inc(BytesRemaining);
        Dec(CodeOfs);
    END
END;

    { ------------------------------------------------- } {.CP13}
    { Formats a Sequence of Stacked Bytes as printable  }
    { Hex in "logical" order - not processor order, and }
    { appends a Padding String and a Blank            }
    { ------------------------------------------------- }

PROCEDURE FormatText(Locn, SLen:Byte; Pad : String);
VAR  W : OprStr; i : Byte;
BEGIN
    W := '';
    FOR i := Locn TO Locn+SLen-1 DO W := HexB(CodeStack[i]) + W;
    CodeText := CodeText + W + Pad + ' ';
END;

    { ------------------- }    {.CP11}
    { Unpacks modR/M Byte }
    { ------------------- }

PROCEDURE UnPackModRM(modRM : Byte);
BEGIN
    HaveMRM := True;
    mrmMOD := (modRM SHR 6) AND $03;
    mrmREG := (modRM SHR 3) AND $07;
    mrmRM  :=  modRM AND $07;
END;

    { ---------------- } {.CP11}
    { Unpacks SIB Byte }
    { ---------------- }

PROCEDURE UnPackSIB(sib : Byte);
BEGIN
    HaveSIB := True;
    sibSS   := (sib SHR 6) AND $03;
    sibNDX  := (sib SHR 3) AND $07;
    sibBAS  :=  sib AND $07;
END;

PROCEDURE MergeActGrp(VAR Z : CpuVec);                {.CP10}
VAR I,J : Byte;
BEGIN
    ActGroup.M := Z.M;
    IF Z.T <> 0 THEN ActGroup.T := Z.T;
    I := ActGroup.F AND $7;
    J := Z.F AND $7;
    IF I < J THEN I := J;
    ActGroup.F := ((ActGroup.F OR Z.F) AND $F8) OR I;
END;

    { ------------------------------------------------- } {.CP52}
    { Formats a Sequence of Stacked Bytes as printable  }
    { Hex in "logical" order - not processor order for  }
    { use in Operand Expressions.  Lead zero suppressed }
    { May be SIGNED or UN-SIGNED                        }
    { ------------------------------------------------- }

PROCEDURE FormatDispl(VAR Sx:OprStr; Locn, SLen:Byte; Signed:Boolean);
TYPE
  MyWord = RECORD
    CASE Byte OF
        0: (Ds : ShortInt);
        1: (Db : Byte);
        2: (Dw : Word);
        3: (Di : Integer);
        4: (Dd : LongInt);
        5: (Dv : ARRAY[1..4] OF Byte);
    END;

VAR    W, X : MyWord; I : Byte; P : ^MyWord; Signit : Char;
BEGIN
    Sx := '';
    IF SLen IN [1,2,4] THEN
    BEGIN
        P := @ CodeStack[Locn];
        W.Dd := 0; X := W;
        WITH P^ DO
        IF Signed THEN
        BEGIN            { sign extend for next step }
            CASE SLen OF
                1: W.Dd := Ds;
                2: W.Dd := Di;
                4: W.Dd := Dd
            END;
            X.Dd := Abs(W.Dd)
        END ELSE
        BEGIN            { zero extend for next step }
            CASE SLen OF
                1: W.Dd := Db;
                2: W.Dd := Dw;
                4: W.Dd := Dd
            END;
            X.Dd := W.Dd
        END;
        FOR i := 1 TO SLen DO Sx := HexB(X.Dv[i]) + Sx;
        IF X.Dd <> W.Dd
            THEN Signit := '-'
            ELSE Signit := '+';
        Sx := Sx + 'h';
        IF Signed THEN Sx := Signit + Sx;
    END;
END; {FormatDispl}

    { ------------------------------------ }  {.CP24}
    { ERROR - Stacked Code printed as DB's }
    { ------------------------------------ }

PROCEDURE EmitConstants;
VAR c : Char;
BEGIN
    WHILE BytesFetched > 1 DO UnFetchCodeByte;
    Mnemonic := 'DB';
    CodeText := '';
    HaveInstPfx := False;
    c := Char(CodeStack[1]);
    CodeText := HexB(Byte(c));
    CASE c OF
        ' '..'&',
        '('..#$7F:    Opnd[1] := '''' + c + '''';
        ELSE        Opnd[1] := '0' + CodeText + 'h';
    END;
    Opnd[2] := '';
    Opnd[3] := '';
    { Ready to Build and Print Line }
END;

    { --------------------- } {.CP08}
    { Returns Register Name }
    { --------------------- }

FUNCTION ExtractReg(Am : TAdr; Wbit : WBitStatus; Arg : Byte) : RegString;
BEGIN
    ExtractReg := RegList[RegDecode[Am,Wbit,Arg]]
END;

    { ----------------------------------- } {.CP12}
    { Fetches Displacement/Immediate Data }
    { ----------------------------------- }

FUNCTION FetchDispl(Width:Byte) : Byte; { Index to LSB of Displ }
VAR i, j : Byte;
BEGIN
    FOR i := 1 TO Width DO j := FetchByte;
    IF FetchFailure
        THEN FetchDispl := 0
        ELSE FetchDispl := BytesFetched + 1 - Width;
END;

    { ------------------------------- } {.CP05}
    { Decodes and Stacks Prefix Bytes }
    { ------------------------------- }

PROCEDURE HandlePrefix;

    PROCEDURE StowPrefix;                             {.CP45}
    CONST PfxFlg : ARRAY[1..4] OF CHAR = '>||:';
    VAR PfxCls : 1..4; i : Byte;
    BEGIN
        CASE CodeByte OF
           $F0,    $F2..$F3:    BEGIN    {LOCK/REPE/REPNE}
                        PfxCls := 1;
                        IPfx := CodeByte;
                        HaveInstPfx := True;
                    END;
            $67:        BEGIN   {Address Size Prefix}
                        PfxCls := 2;
                        ASiz32 := NOT SegDBit;
                        HaveAddrPfx := True;
                    END;
            $66:        BEGIN   {Operand Size Prefix}
                        PfxCls := 3;
                        DSiz32 := NOT SegDBit;
                        HaveSizePfx := True;
                    END;
            $26,$2E,
            $36,$3E:    BEGIN   {Segment Prefix ES,CS,SS,DS}
                        PfxCls := 4;
                        SPfx := BytesFetched;
                        HaveSegPfx := True;
                        i := CodeByte SHR 3 AND $03;
                        REGSegOvr := RegList[i + 24];
                    END;
            $64,$65:    BEGIN   {Segment Prefix FS,GS}
                        PfxCls := 4;
                        SPfx := BytesFetched;
                        HaveSegPfx := True;
                        i := CodeByte AND $07;
                        REGSegOvr := RegList[i + 24];
                    END;
        END;
        IF PfxCls > PfxMax THEN
        BEGIN
            Inc(PrefixBytes);
            PfxMax := PfxCls;
            FormatText(BytesFetched,1,PfxFlg[PfxCls]);
        END ELSE
        BEGIN
            UnFetchCodeByte;   { will fetch again later  }
            EmitConstants;     { emit code stack as DB's }
            PrefixBytes := 0; PfxMax := 0;
            HaveAddrPfx := False; HaveSizePfx := False;
        END;
    END; {StowPrefix}

BEGIN {HandlePrefix}                {.CP05}
    IF NOT FetchFailure THEN
    IF (ActLvl1[CodeByte].F AND $7) > Ord(CpuAuth) THEN
    BEGIN   EmitConstants; ByteGate := G_ooo END ELSE
    BEGIN
        StowPrefix;
        CodeByte := FetchByte;
        IF NOT FetchFailure
            THEN ByteGate := GateLvl1[CodeByte]
            ELSE ByteGate := G_ooo;
    END;
END; {HandlePrefix}

    { -------------------------------------- } {.CP44}
    { Interprets modR/M and optional SIB to  }
    { get operand strings.  Fetches required }
    { displacement fields if any.         }
    { -------------------------------------- }

PROCEDURE DecodeModRM(W :WBitStatus);
VAR wmrm : TMrm; wsib : SibRec; wsx : sxRec; Sx : OprStr;
BEGIN
    IF mrmMOD = 3 THEN EAOperand := ExtractReg(AddrMode,W,mrmRM)
    ELSE
    BEGIN
        wmrm     := MrmTab[AddrMode,mrmMOD,mrmRM];
        IF wmrm.SIB = 1 THEN
        BEGIN
            DataByte := FetchByte;
            FormatText(BytesFetched,1,'');
            UnPackSIB(DataByte);
            wsib := SibTab[mrmMOD,sibBAS];
            wsx  := sxTAB[sibSS,sibNDX];
            wmrm.D := wsib.D;
            wmrm.rS := wsib.rS;
            wmrm.rB := wsib.rB;
            wmrm.rX := wsx.rX;
            IF wsx.SF = 0 THEN
            BEGIN
                NdxSF := '';
                wmrm.rX := 30     { null register string }
            END
            ELSE NdxSF := '*'+Chr(Ord('0')+wsx.SF);
                END;

        DLoc := FetchDispl(wmrm.D);
        FormatText(DLoc,wmrm.D,'');
        FormatDispl(Sx,DLoc,wmrm.D,True);
        REGSeg   := RegList[wmrm.rS];
        REGBase  := RegList[wmrm.rB];
        REGIndex := RegList[wmrm.rX];
        EAOperand := REGBase;
        IF Length(REGIndex) > 0
        THEN EAOperand := EAOperand + '+' + REGIndex + NdxSF;
        IF wmrm.D > 0 THEN  EAOperand := EAOperand + Sx;
    END;
    REGOperand := ExtractReg(AddrMode,W,mrmREG);
END;

    { ---------------------------------- }            {.CP08}
    { Main Driver for 80386 Operand Edit }
    { ---------------------------------- }

PROCEDURE Edit386Ops;
VAR
    OpEdit        : TagRec;    Sx    : OprStr;
    i               : Byte;

    PROCEDURE EditSplRegs(j : Byte); { CRx,DRx,TRx }    {.CP04}
    BEGIN
        Opnd[j] := OpEdit.A + 'R' + Chr(Ord('0')+mrmREG);
    END;

    PROCEDURE EditDblRegs(j : Byte); { EAX..EDI }        {.CP04}
    BEGIN
        Opnd[j] := RegList[16+mrmREG];
    END;

    PROCEDURE EditSegRegs(j : Byte); { ES:..GS: }        {.CP04}
    BEGIN
        Opnd[j] := RegList[24+mrmREG];
    END;

    PROCEDURE EditLiteral(j : Byte); { literal data }    {.CP04}
    BEGIN
        Opnd[j] := RegList[OpEdit.V];
    END;

    PROCEDURE EditGprRegs(j : Byte); { Gb,Gw,Gd,Gv }    {.CP04}
    BEGIN
        Opnd[j] := REGOperand;
    END;

    PROCEDURE EditJmpDspl(j : Byte); { Jb, Jv }        {.CP17}
        TYPE
          MyWord = RECORD
        CASE Byte OF
        0: (Ds : ShortInt);
        1: (Db : Byte);
        2: (Dw : Word);
        3: (Di : Integer);
        4: (Dd : LongInt);
        5: (Dv : ARRAY[1..4] OF Byte);
        END;

    VAR P : ^MyWord; i,k : Byte; l : LongInt;
    BEGIN
        IF RegList[OpEdit.V][1] = 'b' THEN
        BEGIN
            i := FetchDispl(1);
                        FormatText(i,1,'');
            P := @ CodeStack[i];
            l := CodeOfs + P^.Ds;
            P := @l;
            Opnd[j] := 'SHORT ' + HexB(Hi(P^.Dw))+HexB(Lo(P^.Dw))+'h';
        END ELSE
        BEGIN
            IF ASiz32 THEN k := 4 ELSE k := 2;
            i := FetchDispl(k);        { Displacement }
            FormatText(i,k,'');
                        P := @ CodeStack[i];
                        IF ASiz32
               THEN l := CodeOfs + P^.Dd
               ELSE l := CodeOfs + P^.Di;
            P := @l;
            Opnd[j] := 'h';
            FOR i := 1 TO k DO
                Opnd[j] := HexB(P^.Dv[i]) + Opnd[j]
        END;
    END;

    PROCEDURE EditPointer(j : Byte); { Ap }            {.CP13}
    VAR i,k : Byte;
    BEGIN
        IF ASiz32 THEN k := 4 ELSE k := 2;
        i := FetchDispl(k);            { Displacement }
        FormatText(i,k,'r');
        FormatDispl(Sx,i,k,False);
        k := 2;
        i := FetchDispl(k);            { Selector }
        FormatText(i,k,'s');
        FormatDispl(Opnd[j],i,k,False);
        Opnd[j] := Opnd[j] + ':' + Sx;
    END;

    PROCEDURE EditImmData(j : Byte);  { Ib, Iv, Iw }    {.CP17}
    VAR i,k : Byte;
    BEGIN
        CASE RegList[OpEdit.V][1] OF
            'b':    k := 1;
            'w':    k := 2;
            'v':    IF DSiz32 THEN k := 4 ELSE k := 2;
            ELSE    k := 0
        END; {CASE}
        IF k > 0 THEN
        BEGIN
            i := FetchDispl(k);
            FormatText(i,k,'');
            FormatDispl(Sx,i,k,Is_SignXtnd);
            Opnd[j] := Sx;
        END;
    END;

    PROCEDURE EditMemAddr(j : Byte);            {.CP04}
    BEGIN
        Opnd[j] := '';
        IF HaveSegPfx   THEN Opnd[j] := REGSegOvr + ': ';
        Opnd[j] := '['+ Opnd[j] + EAOperand + ']';
        HaveMemOprnd := True;
    END;

    PROCEDURE EditOfsDspl(j : Byte); { Ob, Ov }        {.CP16}
    VAR i,k : Byte;
    BEGIN
        CASE RegList[OpEdit.V][1] OF
            'b':    k := 2;
            'v':    IF ASiz32 THEN k := 4 ELSE k := 2;
            ELSE    k := 0
        END; {CASE}
        IF k > 0 THEN
        BEGIN
            i := FetchDispl(k);        { Offset }
            FormatText(i,k,'');
            FormatDispl(Sx,i,k,False);
            IF HaveSegPfx AND (mrmMOD <> 3)
                THEN Sx := REGSegOvr + ': ' + Sx;
            Opnd[j] := '[' + Sx + ']';
            HaveMemOprnd := True;
        END;
    END;

    PROCEDURE EditEffAddr(j : Byte); { Eb, Ew, Ev, Ep }    {.CP22}
    BEGIN
        Sx := '';
        IF mrmMOD <> 3 THEN
        IF j = 1 THEN
        CASE RegList[OpEdit.V][1] OF
            'b':    Sx := 'BYTE';
            'w':    Sx := 'WORD';
            'v':    IF DSiz32
                THEN Sx := 'DWORD'
                ELSE Sx := 'WORD';
            'p':    IF ASiz32
                THEN Sx := 'FWORD'
                ELSE Sx := 'DWORD';
            'q':    Sx := 'QWORD';
            't':    Sx := 'TBYTE';
            'd':    Sx := 'DWORD';
        END; {CASE}
        IF Sx <> '' THEN Sx := Sx + ' PTR ';
        IF HaveSegPfx AND (mrmMOD <> 3)
            THEN Sx := REGSegOvr + ': ' + Sx;
        Opnd[j] := Sx + EAOperand;
        IF mrmMOD <> 3
        THEN BEGIN
            Opnd[j] := '[' + Opnd[j] + ']';
            HaveMemOprnd := True;
             END;
    END;

    PROCEDURE EditVarRegs(j : Byte); { eAX..eDI }        {.CP04}
    BEGIN
        Opnd[j] := RegList[OpEdit.V+(Ord(DSiz32) SHL 3)];
    END;

BEGIN   {Edit386Ops}                                        {.CP22}

    FOR i := 1 TO 3 DO BEGIN
        OpEdit := OpTags[i];
        Opnd[i] := '';
        CASE OpEdit.A OF
            'C',
            'D',
            'T':    EditSplRegs(i);
            'A':    EditPointer(i);
            'R':    EditDblRegs(i);
            'S':    EditSegRegs(i);
            'G':    EditGprRegs(i);
            'J':    EditJmpDspl(i);
            'I':    EditImmData(i);
            'M':    EditMemAddr(i);
            'O':    EditOfsDspl(i);
            'E':    EditEffAddr(i);
            'e':    EditVarRegs(i);
            'r':    EditLiteral(i);
        END; {CASE}
    END;
END; {Edit386Ops}

PROCEDURE RemovePrefix;
BEGIN
    WHILE BytesFetched > SPfx DO UnFetchCodeByte;
    IF SPfx <> 1 THEN
    BEGIN
        UnFetchCodeByte;
        EmitConstants;
    END ELSE
    BEGIN
        CodeByte := CodeStack[SPfx];
        CodeText := '';
        FormatText(SPfx,1,'');
        ActGroup := ActLvl1[CodeByte];
        Opnd[1] := '';
        Opnd[2] := '';
        Opnd[3] := '';
        Mnemonic := Mnem386[ActGroup.M];
    END;
END;

    { ---------------------------------- } {.CP05}
    { Main Driver for 80386 Instructions }
    { ---------------------------------- }

PROCEDURE Handle386Op;
VAR i : Byte; OGate : Gating;

    PROCEDURE UpdateTags(n : Byte);
    VAR i : Byte;
    BEGIN
      FOR i := 1 TO 3 DO
        IF OpType386[n,i].A <> ' ' THEN OpTags[i] := OpType386[n,i];
    END;

    PROCEDURE HandleOpMRM;                 {.CP17}
    BEGIN
        DataByte := FetchByte;
        IF NOT FetchFailure THEN
        BEGIN
            FormatText(BytesFetched,1,'');
            UnPackModRM(DataByte);
            OGate := ByteGate;
            ByteGate := GateLvl3[ByteGate,mrmREG];
            IF ByteGate = G_Hit THEN
            BEGIN
                MergeActGrp(ActLvl3[OGate,mrmREG]);
                UpdateTags(ActGroup.T);
            END;
        END;
    END; {HandleOpMRM}

    PROCEDURE HandleOp0Fx;                  {.CP19}
    VAR RowNdx : Gate_2; ColNdx : $0..$F;
    BEGIN
        CodeByte := FetchByte;
        IF NOT FetchFailure THEN
        BEGIN
            FormatText(BytesFetched,1,'');
            RowNdx := GateLvX2[(CodeByte SHR 4) AND $0F];
            ColNdx := CodeByte AND $0F;
            ByteGate := GateLvl2[RowNdx,ColNdx];
            CASE ByteGate OF
               G_Hit: BEGIN
                    MergeActGrp(ActLvl2[RowNdx,ColNdx]);
                    UpdateTags(ActGroup.T);
                  END;
               G_RM6..G_RM8: HandleOpMRM;
            END; {CASE}
        END;
    END; {HandleOp0FX}

BEGIN  {Handle386Op}                {.CP34}
    FormatText(BytesFetched,1,'');
    WITH ActLvl1[CodeByte] DO BEGIN
        ActGroup.F := F;
        ActGroup.M := M;
        ActGroup.T := T;
        OpTags := OpType386[ActGroup.T];
    END;
    Case ByteGate OF
        G_RM1..G_RM9:    HandleOpMRM;
        G_0Fx:        HandleOp0Fx;
        G_Hit:;
    END;
    IF (ActGroup.F AND $7) > Ord(CpuAuth) THEN ByteGate := G_ooo;
    IF NOT FetchFailure AND (ByteGate <> G_ooo) THEN
    BEGIN
        Is_386Xtnsn := (ActGroup.F AND _386Xtnsn) = _386Xtnsn;
        Is_32BitMax := (ActGroup.F AND _32BitMax) = _32BitMax;
        Is_16BitMin := (ActGroup.F AND _16BitMin) = _16BitMin;
        Is_SignXtnd := (ActGroup.F AND _SignXtnd) = _SignXtnd;
        Is_MODrmFld := (ActGroup.F AND _MODrmFld) = _MODrmFld;
        IF Is_MODrmFld AND NOT HaveMRM THEN
        BEGIN
            CodeByte := FetchByte;
            IF NOT FetchFailure THEN UnPackModRM(CodeByte);
            FormatText(BytesFetched,1,'');
        END;
        IF Is_32BitMax OR Is_16BitMin THEN WBitMode := W1;
    END;
    IF FetchFailure OR (ByteGate = G_ooo) OR (ActGroup.M = 0)
    THEN EmitConstants ELSE
    BEGIN
        IF DSiz32 AND Is_386Xtnsn
            THEN Mnemonic := Mnem386[ActGroup.M+1]
            ELSE Mnemonic := Mnem386[ActGroup.M];
        IF HaveMRM THEN DecodeModRM(WBitMode);
        Edit386Ops;
        IF HaveSegPfx AND (NOT HaveMemOprnd)
        THEN RemovePrefix ELSE
        BEGIN
            EmuFlag := 0;
            IF (BytesFetched = 2) AND (CodeStack[1] = $CD) THEN
                CASE CodeStack[2] OF
                    $34..$3B,
                    $3E: BEGIN
                        EmuFlag := CodeStack[2];
                        Opnd[3] := '; F-P Emulator Linkage';
                         END;
                    $3C: BEGIN
                        EmuFlag := CodeStack[2];
                        Opnd[3] := '; Emulated SEG Prefix';
                         END;
                    $3D: Opnd[3] := '; Emulated FWAIT ';
                END;
        END;
        { emit instruction }
    END;
END; {Handle386Op}

    { ----------------------------------------- }        {.CP50}
    { Main driver for Co-Processor Instructions }
    { ----------------------------------------- }

PROCEDURE Handle387Op(Emulation : Boolean);
CONST T : ARRAY[2..10] OF Byte = (41,37,39,39,35,40,35,40,41);
VAR esc,flaga,flagop :byte; MpuAux : MpuVec;
    stkr : char;

BEGIN
    esc := CodeByte AND $07;
    IF NOT Emulation THEN FormatText(BytesFetched,1,'');
    CodeByte := FetchByte;
    IF NOT FetchFailure THEN UnPackModRM(CodeByte);
    FormatText(BytesFetched,1,'');
    IF mrmMOD = 3 THEN
    BEGIN
        MpuAux   := MpuM11[esc,mrmREG];    {flags,link}
        MpuAux.M := MpuOv[MpuAux.M,mrmRM]  { mnemonic }
    END
    ELSE
        MpuAux   := MpuEA[esc,mrmREG];     {flags,mnemonic}

    flaga  := MpuAux.F SHR 4;
    IF flaga = 0 THEN EmitConstants ELSE
    BEGIN
        flagop := MpuAux.F AND $0F;
        stkr   := Chr(Ord('0')+mrmRM);
        CASE flagop OF
             0:     Opnd[1] := '';
             1:     Opnd[1] := 'AX';
             2..10:     BEGIN
                    DecodeModRM(W0);
                    OpTags := OpType386[96];
                    OpTags[1].V := T[flagop];
                    Edit386Ops;
                END;
            11:     Opnd[1] := 'ST('+stkr+')';
            12:     Opnd[1] := 'ST('+stkr+'),ST';
            13:     Opnd[1] := 'ST,ST('+stkr+')';
        END;
        Mnemonic := Mnem387[MpuAux.M];
        Opnd[2] := '';
        Opnd[3] := '';
        { Emit Instruction Here }
    END;
END; {Handle387Op}

    { ----------------------------------------- }     {.CP17}
    { Main Driver for ALL Instruction Sequences }
    { ----------------------------------------- }

PROCEDURE HandleInstruction;
BEGIN
    ByteGate := GateLvl1[CodeByte];
    WHILE ByteGate = G_Pfx DO HandlePrefix;
    IF ASiz32 THEN AddrMode := Adr32 ELSE AddrMode := Adr16;
    IF NOT FetchFailure    THEN
        CASE ByteGate OF
            G_RM1..G_0Fx:    Handle386Op;  {Get Op and modR/M}
            G_387:         Handle387Op(False); { Ndp Ops   }
            ELSE        EmitConstants {Invalid Op Codes }
        END;
END;

    { -------------------------------- }        {.CP34}
    { Initialize for Instruction Fetch }
    { -------------------------------- }

PROCEDURE StartOpFetch; { Initializes for next Instruction }
BEGIN
    Is_386Xtnsn    := False;    Is_32BitMax    := False;
    Is_16BitMin    := False;    Is_SignXtnd     := False;
    Is_MODrmFld     := False;
    HaveSizePfx    := False;    HaveAddrPfx     := False;
    HaveMRM         := False;    HaveSIB        := False;
    FetchFailure    := False;       HaveMemOprnd    := False;
    HaveInstPfx    := False;    HaveSegPfx    := False;
    ASiz32        := SegDBit;    DSiz32        := SegDBit;

    CodeByte    := 0;        OprBytes    := 0;
    BytesFetched    := 0;        mrmMOD        := 0;
    mrmREG        := 0;        mrmRM        := 0;
    sibSS        := 0;        sibNDX        := 0;
    sibBAS        := 0;        PfxMax          := 0;
    PrefixBytes    := 0;        DLoc        := 0;
    SPfx        := 0;

    CodeText    := '';        NdxSF        := '';
    EAOperand    := '';        REGSeg        := '';
    REGBase        := '';        REGIndex    := '';
    REGOperand    := '';        REGSegOvr    := '';

    WBitMode    := W0;        AddrMode    := Adr16;
    ActGroup.F    := 0;        ActGroup.M    := 0;
    ActGroup.T    := 0;           VirtualIP    := CodeOfs;

    CodeByte := FetchByte;
END;

    { ------------------------------------- }    {.CP11}
    { Prototype For Disassembly of One Line }
    { ------------------------------------- }

PROCEDURE DisassembleLine;
BEGIN
    StartOpFetch;
    CASE EmuFlag OF           {Handle Turbo F-P Emulator Expansions}
        $34..$3B : BEGIN
                UnFetchCodeByte;
                CodeByte := EmuFlag + $A4;
                Handle387Op(True);
                Mnemonic := 'EMU_'+Mnemonic;
                EmuFlag := 0;
                Opnd[3] := '; Emulated Operation';
               END;
        $3C:       BEGIN
                HaveSegPfx := True;
                REGSegOvr := RegList[24+(CodeByte SHR 6 XOR 3)];
                Handle387Op(False);
                Mnemonic := 'EMU_'+Mnemonic;
                EmuFlag := 0;
                Opnd[3] := '; Emulated Operation';
               END;
        $3E:       BEGIN  { DB xxH for parameters }
                EmitConstants;
                Opnd[3] := '; Fast Path Emulations ';
                EmuFlag := 0;
               END;
        ELSE BEGIN
            HandleInstruction;
            IF HaveInstPfx
            THEN
              Mnemonic := Mnem386[ActLvl1[IPfx].M] + ' ' + Mnemonic;
             END
    END; {CASE}
END;

PROCEDURE UnAssemble(U : UnitPtr; VAR P : ObjArg);
BEGIN
    WITH P DO BEGIN
        IF NOT (TCpu IN [C086..C386]) THEN TCpu := C086;
        CpuAuth := TCpu;
        CodeSeg := Seg(BufPtr(U)^.BufByt[Obj]);
        CodeOfs := Ofs(BufPtr(U)^.BufByt[Obj]);
        BytesRemaining := Lim;
        VirtualIP := Obj;
        Locn := 0;
        Code := '';
        Mnem := '';
        Opr1 := '';
        Opr2 := '';
        Opr3 := '';
    END;
    DisAssembleLine;
    WITH P DO BEGIN
        Obj  := Obj+BytesFetched;
        Lim  := BytesRemaining;
        Code := CodeText;
        Mnem := Mnemonic;
        Opr1 := Opnd[1];
        Opr2 := Opnd[2];
        Opr3 := Opnd[3];
        Locn := VirtualIP;
    END;
END;
BEGIN
    EmuFlag := $0;    {No Borland/Microsoft F-P Emulator in Progress}
END.