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

Pascal/Delphi Source File | 1990-08-14 | 13.3 KB | 448 lines

unit decode87;

  { Unit to classify an 8087 instruction by its encoding }
interface
type
  instruction =
  (iF2XM1, iFABS, iFADD, iFADDP, iFBLD, iFBSTP, iFCHS, iFCLEX, iFCOM,
   iFCOMP, iFCOMPP, iFCOS, iFDECSTP, iFDISI, iFDIV, iFDIVP, iFDIVR, iFDIVRP,
   iFENI, iFFREE, iFIADD, iFICOM, iFICOMP, iFIDIV, iFIDIVR, iFILD, iFIMUL,
   iFINCSTP, iFINIT, iFIST, iFISTP, iFISUB, iFISUBR, iFLD, iFLD1, iFLDCW,
   iFLDENV, iFLDL2E, iFLDL2T, iFLDLG2, iFLDLN2, iFLDPI, iFLDZ, iFMUL, iFMULP,
   iFNOP, iFPATAN, iFPREM, iFPREM1, iFPTAN, iFRNDINT, iFRSTOR, iFSAVE,
   iFSCALE, iFSETPM, iFSIN, iFSINCOS, iFSQRT, iFST, iFSTCW, iFSTENV, iFSTP,
   iFSTSW, iFSUB, iFSUBP, iFSUBR, iFSUBRP, iFTST, iFUCOM, iFUCOMP,
   iFUCOMPP, iFXAM, iFXCH, iFXTRACT, iFYL2X, iFYL2XP1, iUnknown);
const
  inst_names : array[instruction] of String[7] =
  ('F2XM1', 'FABS', 'FADD', 'FADDP', 'FBLD', 'FBSTP', 'FCHS', 'FCLEX', 'FCOM',
   'FCOMP', 'FCOMPP', 'FCOS', 'FDECSTP', 'FDISI', 'FDIV', 'FDIVP', 'FDIVR', 'FDIVRP', 'FENI',
   'FFREE', 'FIADD', 'FICOM', 'FICOMP', 'FIDIV', 'FIDIVR', 'FILD', 'FIMUL', 'FINCSTP',
   'FINIT', 'FIST', 'FISTP', 'FISUB', 'FISUBR', 'FLD', 'FLD1', 'FLDCW', 'FLDENV', 'FLDL2E',
   'FLDL2T', 'FLDLG2', 'FLDLN2', 'FLDPI', 'FLDZ', 'FMUL', 'FMULP', 'FNOP', 'FPATAN',
   'FPREM', 'FPREM1', 'FPTAN', 'FRNDINT', 'FRSTOR', 'FSAVE', 'FSCALE', 'FSETPM', 'FSIN', 'FSINCOS', 'FSQRT', 'FST', 'FSTCW',
   'FSTENV', 'FSTP', 'FSTSW', 'FSUB', 'FSUBP', 'FSUBR', 'FSUBRP', 'FTST', 'FUCOM',
   'FUCOMP', 'FUCOMPP', 'FXAM', 'FXCH', 'FXTRACT', 'FYL2X', 'FYL2XP1', '');
type
  reg_count = 0..8;

  operand_type = (arReg0, arReg1, arReg2, arReg3, arReg4, arReg5, arReg6,
                  arReg7, arWord, arLongint, arComp, arBCD,
                  arSingle, arDouble, arExtended, arControl, arStatus,
                  arEnviron, arState, arNone);
  operand_set = set of operand_type;
const
  arg_names : array[operand_type] of String[8] =
  ('Reg0', 'Reg1', 'Reg2', 'Reg3', 'Reg4', 'Reg5', 'Reg6',
   'Reg7', 'Word', 'Longint', 'Comp', 'BCD',
   'Single', 'Double', 'Extended', 'Control', 'Status',
   'Environ', 'State', 'None');

type
  opcode_info = record
                  inst     : instruction;
                  arg1, arg2 : operand_type;
                end;

procedure decode_opcode(opcode : Word; var result : opcode_info);

procedure operands_read(inst_info : opcode_info; var ops_read : operand_set);

function num_pops(inst_info : opcode_info) : reg_count;

function num_pushes(inst_info : opcode_info) : reg_count;

function limited(inst_info : opcode_info): boolean;

function lower_limit(inst_info : opcode_info) : extended;
  { least legal operand }

function upper_limit(inst_info : opcode_info) : extended;
  { greatest legal operand }


implementation
const
  Plus_Infinity_Array : array[1..2] of word = (0, $7f80);
var
  Plus_Infinity : single absolute Plus_Infinity_Array;
const
  Minus_Infinity_Array : array[1..2] of word = (0, $ff80);
var
  Minus_Infinity : single absolute Minus_Infinity_Array;

  procedure operands_read(inst_info : opcode_info; var ops_read : operand_set);
  const
    reads_reg0 =
    [iF2XM1, iFABS, iFADD, iFADDP, iFBSTP, iFCHS, iFCOM,
    iFCOMP, iFCOMPP, iFCOS, iFDIV, iFDIVP, iFDIVR, iFDIVRP,
    iFIADD, iFICOM, iFICOMP, iFIDIV, iFIDIVR, iFIMUL,
    iFIST, iFISTP, iFISUB, iFISUBR, iFMUL, iFMULP,
    iFPATAN, iFPREM, iFPREM1, iFPTAN, iFRNDINT,
    iFSCALE, iFSIN, iFSINCOS, iFSQRT, iFST, iFSTP,
    iFSUB, iFSUBP, iFSUBR, iFSUBRP, iFTST, iFUCOM, iFUCOMP,
    iFUCOMPP, iFXAM, iFXCH, iFXTRACT, iFYL2X, iFYL2XP1];
    reads_reg1 =
    [iFPATAN, iFPREM, iFSCALE, iFYL2X, iFYL2XP1];
    reads_arg1 =
    [iFADD, iFADDP, iFBLD, iFCOM, iFCOMP, iFCOMPP, iFDIV, iFDIVP,
    iFDIVR, iFDIVRP, iFIADD, iFICOM, iFICOMP, iFIDIV, iFIDIVR, iFILD, iFIMUL,
    iFISUB, iFISUBR, iFLD, iFLDCW, iFLDENV, iFMUL, iFMULP,
    iFRSTOR, iFSUB, iFSUBP, iFSUBR, iFSUBRP, iFTST, iFUCOM, iFUCOMP,
    iFUCOMPP, iFXAM, iFXCH];

  begin
    with inst_info do
    begin
      if inst in reads_reg0 then
        ops_read := [arReg0]
      else
        ops_read := [];
      if inst in reads_reg1 then
        ops_read := ops_read+[arReg1];
      if (arg1 <> arNone) and (inst in reads_arg1) then
        ops_read := ops_read+[arg1];
      if arg2 <> arNone then
        ops_read := ops_read+[arg2];
    end;
  end;

  function num_pops(inst_info : opcode_info) : reg_count;
  const
    two_pop  = [iFCOMPP, iFUCOMPP];
    pops =
    [iFADDP, iFBSTP, iFCOMP, iFDIVP, iFDIVRP, iFICOMP, iFISTP, iFMULP,
    iFPATAN, iFSTP, iFSUBP, iFSUBRP, iFUCOMP, iFYL2X, iFYL2XP1]+two_pop;
  begin
    if inst_info.inst in pops then
      if inst_info.inst in two_pop then
        num_pops := 2
      else
        num_pops := 1
    else
      num_pops := 0;
  end;

  function num_pushes(inst_info : opcode_info) : reg_count;
  const
    does_push =
    [iFBLD, iFILD, iFLD, iFLD1, iFLDL2E, iFLDL2T, iFLDLG2, iFLDLN2,
    iFLDPI, iFLDZ, iFPTAN, iFSINCOS, iFXTRACT];
  begin
    if inst_info.inst in does_push then
      num_pushes := 1
    else
      num_pushes := 0;
  end;

function limited(inst_info:opcode_info):boolean;
const
  limited_instructions =
  [iF2XM1 {0 to 0.5} , iFPATAN {0 < Y < X < pinf} ,
  iFPTAN {0 to pi/4} , iFSCALE {won't cause exception, but -2^15<Y<2^15} ,
  iFSQRT {0 to pinf} , iFYL2X {0 < X < pinf} ,
  iFYL2XP1 {|X| < (1-1/sqrt(2))} ];
begin
  limited := inst_info.inst in limited_instructions;
end;


  function lower_limit(inst_info : opcode_info) : extended;
  begin
    if limited(inst_info) then
      case inst_info.inst of
        iF2XM1,
        iFPATAN,
        iFPTAN,
        iFSQRT,
        iFYL2X : lower_limit := 0.0;
        iFSCALE : lower_limit := -32768;
        iFYL2XP1 : lower_limit := -(1-1/Sqrt(2));
      end
    else
      lower_limit := minus_infinity;
  end;

  function upper_limit(inst_info : opcode_info) : extended;
  begin
    if limited(inst_info)  then
      case inst_info.inst of
        iF2XM1 : upper_limit := 0.5;
        iFSQRT,
        iFYL2X,
        iFPATAN : upper_limit := plus_infinity;
        iFPTAN : upper_limit := pi/4;
        iFSCALE : upper_limit := 32768;
        iFYL2XP1 : upper_limit := (1-1/Sqrt(2));
      end
    else
      upper_limit := plus_infinity;
  end;
  procedure decode_opcode(opcode : Word; var result : opcode_info);

  { This routine and those within it are closely based on UNINLINE,
    by L. David Baldwin. }

  var
    opbyte1,
    opbyte2,
    rm,
    mode,
    middle   : Byte;
    memory_reference : Boolean;

    procedure ReadModeByte;
    {read the mode byte and sort out the various parts.  read the
     displacement byte or word if req'D}
    var Modebyte : Byte;
    begin
      Modebyte := opbyte2;
      rm := Modebyte and 7;
      mode := (Modebyte and $C0) div 64;
      middle := (Modebyte and $38) div 8;
      if (mode = 0) and (rm = 6) or (mode = 2) or (mode = 1) then
        memory_reference := True;
    end;

    procedure ST_i;               {do st(i) }
    begin
      result.arg1 := operand_type(Word(rm));
    end;

    procedure STi_ST;             {do st(i),st }
    begin
      ST_i;
      result.arg2 := arReg0;
    end;

    procedure ST_STi;             { do st,st(i) }
    begin
      ST_i;
      with result do
      begin
        arg2 := arg1;
        arg1 := arReg0;
      end;
    end;

    procedure DB;
    const inst_list : array[0..12] of instruction =
      (iFILD, iUnknown, iFIST, iFISTP, iUnknown, iFLD, iUnknown,
       iFSTP, iFENI, iFDISI, iFCLEX, iFINIT, iFSETPM);
    var I    : Word;
      Tmp      : instruction;
    begin
      ReadModeByte;
      if (mode = 3) then
        I := rm+8
      else
        I := middle;              {form an index}
      Tmp := inst_list[I];
      if (Tmp <> iUnknown) and (I <= 12) then
      begin
        result.inst := Tmp;
        if I <= 3 then
          result.arg1 := arLongint
        else
          if I <= 7 then
            result.arg1 := arExtended
      end
      else
        { Unknown! };
    end;

    procedure DD;
    const inst_list : array[0..13] of instruction =
      (iFLD, iUnknown, iFST, iFSTP, iFRSTOR,
       iUnknown, iFSAVE, iFSTSW, iFFREE, iFXCH,
       iFST, iFSTP, iFUCOM, iFUCOMP);
    var I    : Word;
      Tmp      : instruction;
    begin
      ReadModeByte;
      if mode = 3 then
        I := middle+8
      else
        I := middle;
      Tmp := inst_list[I];
      if (Tmp <> iUnknown) and (I <= 13) then
      begin
        result.inst := Tmp;
        if I <= 3 then
          result.arg1 := arDouble
        else if I <= 7 then
          if I in [4, 6] then
            result.arg1 := arState
          else
            result.arg1 := arStatus
        else
          ST_i;
      end
      else
        { Unknown !};
    end;

    procedure DF;
    const inst_list : array[0..11] of instruction =
      (iFILD, iUnknown, iFIST, iFISTP, iFBLD,
       iFILD, iFBSTP, iFISTP, iFFREE, iFXCH,
       iFST, iFSTP);
    var I    : Word;
    begin
      ReadModeByte;
      if mode = 3 then
        I := middle+8
      else
        I := middle;              {form index}
      if (I <> 1) and (I <= 11) then
      begin
        result.inst := inst_list[I];
        if I <= 3 then
          result.arg1 := arWord
        else
          if I <= 7 then
          begin
            if (I and 5) = 4 then
              result.arg1 := arBCD
            else
              result.arg1 := arComp;
          end
        else
          ST_i;
      end
      else
        { Unknown !};
    end;

    procedure D9;
    const inst_list1 : array[0..11] of instruction =
      (iFLD, iUnknown, iFST, iFSTP,
       iFLDENV, iFLDCW, iFSTENV, iFSTCW,
       iFLD, iFXCH, iFNOP, iFSTP);

    const inst_list2 : array[0..31] of instruction =
      (iFCHS, iFABS, iUnknown, iUnknown, iFTST,
       iFXAM, iUnknown, iUnknown, iFLD1, iFLDL2T,
       iFLDL2E, iFLDPI, iFLDLG2, iFLDLN2, iFLDZ,
       iUnknown, iF2XM1, iFYL2X, iFPTAN, iFPATAN,
       iFXTRACT, iFPREM1, iFDECSTP, iFINCSTP, iFPREM,
       iFYL2XP1, iFSQRT, iFSINCOS, iFRNDINT, iFSCALE,
       iFSIN, iFCOS);
    var I    : Word;
      Tmp      : instruction;
    begin
      ReadModeByte;
      if (mode <> 3) or (middle <= 3) then
      begin
        if mode = 3 then
          I := middle+8
        else
          I := middle;
        if (I = 1) or ((I = 10) and (rm <> 0)) then
          { Unknown !}
        else
        begin
          Tmp := inst_list1[I];
          result.inst := Tmp;
          if I <= 3 then
            result.arg1 := arSingle
          else if I <= 7 then
            if I in [4, 6] then
              result.arg1 := arEnviron
            else
              result.arg1 := arControl
          else
            if I <> 10 then       {fnop is 10}
              ST_i;               {st(i)}
        end;
      end
      else
      begin                       {mode=3 and middle>=4}
        I := rm+(middle and 3)*8; {include lower 2 bits of middle in index}
        if (inst_list2[I] <> iUnknown) and (I <= 31) then
          result.inst := inst_list2[I]
        else
          { unknown! };
      end;
    end;

    procedure D8_DC;
    type Nametype = array[0..7] of instruction;
    var Shortreal : Boolean;
    const inst_list : Nametype = (
      iFADD, iFMUL, iFCOM, iFCOMP, iFSUB, iFSUBR, iFDIV, iFDIVR);
    begin
      Shortreal := opbyte1 = $D8;
      ReadModeByte;
      if not Shortreal then
        if (middle >= 6) then     {fdiv, fdivr are reversed here}
          middle := middle xor 1;
      result.inst := inst_list[middle];
      if mode <> 3 then
      begin
        if Shortreal then
          result.arg1 := arSingle
        else
          result.arg1 := arDouble
      end
      else                        {mode=3}
        if Shortreal then
          ST_STi
      else
        STi_ST;                   {add the stack info}
    end;

    procedure DA_DE;
    type Nametype = array[0..15] of instruction;
    var ShortInt : Boolean;
    const inst_list : Nametype = (
      iFIADD, iFIMUL, iFICOM, iFICOMP, iFISUB, iFISUBR, iFIDIV,
      iFIDIVR, iFADDP, iFMULP, iFCOMP, iFCOMPP, iFSUBRP, iFSUBP,
      iFDIVRP, iFDIVP);
    begin
      ShortInt := opbyte1 = $DA;
      ReadModeByte;
      if mode <> 3 then
      begin
        result.inst := inst_list[middle];
        if ShortInt then
          result.arg1 := arLongint
        else
          result.arg1 := arWord;
      end
      else
      begin                       {mode=3}
        if ((middle = 3) and (rm <> 1)) then
          { Unknown! }                  {not fl pt}
        else
          if ShortInt and (rm = 1) and (middle = 5) then
            result.inst := iFUCOMPP
        else
        begin
          result.inst := inst_list[middle+8];
          if (middle <> 3) then
            STi_ST;
        end;
      end;
    end;

  begin                           { decode_opcode}
    opbyte1 := Hi(opcode);
    opbyte2 := Lo(opcode);
    with result do
    begin
      inst := iUnknown;
      arg1 := arNone;
      arg2 := arNone;
      case opbyte1 of
        $DA, $DE : DA_DE;
        $D8, $DC : D8_DC;
        $D9 : D9;
        $DB : DB;
        $DD : DD;
        $DF : DF;
      end;
    end;
  end;
end.