home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
pascal
/
err87_13.zip
/
DECODE87.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-02-04
|
14KB
|
449 lines
{$N+}
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.