home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Stars of Shareware: Programmierung
/
SOURCE.mdf
/
programm
/
msdos
/
asm
/
iomon2
/
iorpt.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-02-20
|
9KB
|
346 lines
program IOReport;
{-Displays data from resident I/O monitor}
uses
Dos,
OpString;
const
{For communicating with resident IOMON}
IoMonInt = $61;
BufferSize = 8192;
Output = $10;
ContainsData = $80;
{For building reports}
DirectionText : array[Boolean] of String[3] = ('In ', 'Out');
PageSize = 60;
MaxTraceCol : Byte = 78;
{Program options}
DoDetails : Boolean = False;
DoTrace : Boolean = False;
FileName : PathStr = 'IORPT';
type
Buffer = record
IoAttr : Byte;
IoPort : Word;
IoData : Word;
end;
BufferArray = array[1..8192] of Buffer;
BufferPtr = ^BufferArray;
OS = record
O : Word;
S : Word;
end;
var
Buf : BufferPtr; {Pointer to IOMON's data}
Vector : Pointer; {For checking for presence of IOMON}
I : Word; {Index}
Limit : Word; {Highest possible index}
Regs : Registers; {For getting pointer to Buf}
BaseAddr : Word; {Base address of monitored UART}
Direction : Boolean; {Direction of IO operation (in or out)}
IoAddr : Word; {Address of IO operation}
IoReg : Word; {UART register of IO operation}
DLab : Boolean; {Boolean to track state of DLAB bit}
Lines : Word; {For displaying headers}
Wrapped : Boolean; {True if IOMON buffer wrapped once}
Head : Word; {Head pointer of IOMON's buffer}
T : Text;
procedure Abort(Msg : String; Code : Word);
begin
Write(Msg);
if Code <> 0 then
WriteLn(Code)
else
WriteLn;
Halt(Code);
end;
procedure WriteHelp;
{-Write help and halt}
begin
WriteLn('Usage: IORPT [options]');
WriteLn(' /T build standard APRO trace to IORPT.TRC');
WriteLn(' /D build detailed audit report to IORPT.AUD');
WriteLn(' /F filename to use (no extension)');
Halt;
end;
procedure ParseCommandLine;
{-Gets command line options and sets various parameters.}
var
Code : Word;
Param : String;
Cnt : Word;
begin
{Scan command line}
if ParamCount = 0 then
WriteHelp;
Param := ParamStr(1);
Cnt := 2;
while True do begin
case Param[1] of
'/', '-' :
if Length(Param) <> 2 then
Abort('Invalid parameter: '+Param, 0)
else
case Upcase(Param[2]) of
'T' : DoTrace := True;
'D' : DoDetails := True;
else
Abort('Invalid parameter: '+Param, 0);
end;
end;
{Get next parameter}
if Cnt > ParamCount then
Exit;
Param := ParamStr(Cnt);
Inc(Cnt);
end;
end;
function ShowByte(W : Word) : String;
begin
if (W > 31) and (W < 127) then
ShowByte := ' [' + Char(Lo(W)) + ']'
else
ShowByte := '';
end;
procedure BuildDetailReport;
begin
{Open the report file}
Assign(T, Filename + '.AUD');
Rewrite(T);
if Wrapped then begin
I := (Head div SizeOf(Buffer)) + 1;
Limit := Head;
end else begin
I := 1;
Limit := BufferSize div SizeOf(Buffer);
end;
Lines := PageSize;
while (I <> Limit) and ((Buf^[I].IoAttr and ContainsData) = ContainsData) do begin
{Write headings}
Inc(Lines);
if Lines > PageSize then begin
WriteLn(T);
WriteLn(T, ' Addr Direction Value Message');
WriteLn(T, ' ---- --------- ----- -------');
Lines := 1;
end;
{Report one line of data}
Direction := Buf^[I].IoAttr and Output = Output;
IoAddr := Buf^[I].IoPort;
Write(T, ' ', HexW(IoAddr), ' ');
Write(T, DirectionText[Direction], ' ');
Write(T, HexB(Lo(Buf^[I].IoData)), ' ');
{Set BaseAddr first time thru}
if BaseAddr = 0 then
case IoAddr of
$3F8..$3FF : BaseAddr := $3F8;
$2F8..$2FF : BaseAddr := $2F8;
$3E8..$3EF : BaseAddr := $3E8;
$2E8..$2EF : BaseAddr := $2E8;
end;
{Show a text message}
IoReg := IoAddr - BaseAddr;
case IoReg of
0 : if DLab then
if Direction then
WriteLn(T, 'Setting baud rate')
else
WriteLn(T, 'Reading baud rate')
else
if Direction then
WriteLn(T, 'Output byte', ShowByte(Buf^[I].IoData))
else
WriteLn(T, 'Input byte', ShowByte(Buf^[I].IoData));
1 : if Direction then
WriteLn(T, 'Setting interrupt enable mask')
else
WriteLn(T, 'Reading interrupt enable mask');
2 : if Direction then
if Buf^[I].IoData and $01 = $01 then
WriteLn(T, 'Enabling FIFO')
else
WriteLn(T, 'Disabling FIFO')
else
WriteLn(T, 'Reading interrupt type');
3 : if Direction then
if Buf^[I].IoData and $80 = $80 then begin
WriteLn(T, 'Enabling DLAB');
DLab := True;
end else begin
WriteLn(T, 'Setting line control register (DLAB off)');
DLab := False;
end
else
WriteLn(T, 'Reading line control register');
4 : if Direction then
WriteLn(T, 'Setting modem control register')
else
WriteLn(T, 'Reading modem control register');
5 : if not Direction then
WriteLn(T, 'Reading line status register')
else
WriteLn(T);
6 : if not Direction then
WriteLn(T, 'Reading modem status register')
else
WriteLn(T);
7 : if Direction then
WriteLn(T, 'Writing scratch register')
else
WriteLn(T, 'Reading scratch register');
end;
Inc(I);
if I > BufferSize div SizeOf(Buffer) then
I := 1;
end;
Close(T);
end;
procedure BuildTraceReport;
{-Write a standard APRO trace report}
var
Col : Byte;
OldDirection : Boolean;
C : Char;
J : Word;
procedure CheckCol(N : Byte);
{-Wrap if N bytes would exceed column limit}
begin
Inc(Col, N);
if Col > MaxTraceCol then begin
WriteLn(T);
Col := N;
end;
end;
begin
{Open the report file}
Assign(T, Filename + '.TRC');
Rewrite(T);
DLab := False;
Col := 1;
if Wrapped then begin
I := (Head div SizeOf(Buffer)) + 1;
Limit := Head;
end else begin
I := 1;
Limit := BufferSize div SizeOf(Buffer);
end;
while (I <> Limit) and ((Buf^[I].IoAttr and ContainsData) = ContainsData) do begin
{Get the next entry}
Direction := Buf^[I].IoAttr and Output = Output;
IoAddr := Buf^[I].IoPort;
{Set BaseAddr first time thru}
if BaseAddr = 0 then begin
case IoAddr of
$3F8..$3FF : BaseAddr := $3F8;
$2F8..$2FF : BaseAddr := $2F8;
$3E8..$3EF : BaseAddr := $3E8;
$2E8..$2EF : BaseAddr := $2E8;
end;
OldDirection := not Direction;
end;
{Show only puts and gets}
if IoAddr = BaseAddr then begin
if Direction <> OldDirection then begin
OldDirection := Direction;
if Direction then
WriteLn(T, ^M^J^M^J'Transmit:')
else
WriteLn(T, ^M^J^M^J'Receive:');
end;
{Display this character}
if not DLab then begin
C := Char(Lo(Buf^[I].IoData));
if (Ord(C) < 32) or (Ord(C) > 126) then begin
if Ord(C) > 99 then
J := 5
else if Ord(C) > 9 then
J := 4
else
J := 3;
CheckCol(J);
Write(T, '[',Ord(C),']')
end else begin
CheckCol(1);
Write(T, C);
end;
end;
end else
{Track DLAB}
if IoAddr - BaseAddr = 3 then
if Direction then
if Buf^[I].IoData and $80 = $80 then
DLab := True
else
DLab := False;
Inc(I);
if I > BufferSize div SizeOf(Buffer) then
I := 1;
end;
Close(T);
end;
begin
ParseCommandLine;
{Assure IOMON is resident}
GetIntVec(IoMonInt, Vector);
if Vector = nil then begin
WriteLn('IoMon not installed');
Halt(1);
end;
{Inits}
DLab := False;
BaseAddr := 0;
{Get buffer address from IOMON}
Intr(IoMonInt, Regs);
with Regs do begin
OS(Buf).S := Regs.DX;
OS(Buf).O := Regs.BX;
Wrapped := Regs.AX = 1;
Head := Regs.CX;
end;
if DoDetails then
BuildDetailReport;
if DoTrace then
BuildTraceReport;
end.