Category : Pascal Source Code
Archive   : TRACMOD.ZIP
Filename : TRCMOD.PAS

Program tracemod;

{
Quickie program to modify ICT definitions in TRACE.COM without
reassembling the dang thing. Note that this program modifies
TRACE.COM on disk, not in memory. The new definitions are not
effective until TRACE is next loaded. Keep a backup.

See TRACE.ASM by Joan Riff for explanations of what all this stuff
is. As Joan points out (more or less), if you don't understand
what TRACE does, you probably shouldn't be using it.

Released to the public domain by Chris Dunford, without any promises.

trcmod 1.00 04/24/86 cjd
}

Const
{ Bit definitions within the ICT's ICT_Flags field }
F_ACTIVE = $80; { Bit 7 = this ICT is active }
F_RET = $40; { Bit 6 = This INT exits via RET }
F_RET2 = $20; { Bit 5 = This INT exits via RET2 }
F_IRET = $10; { Bit 4 = This INT exits via IRET }
F_ENABLE = $08; { Bit 3 = Tracing enabled for this ICT }
F_FCB = $04; { Bit 2 = enable FCB/ASCII traces for INT 21h }
F_ROM = $02; { Bit 1 = exclude ROM invocations of this INT }
F_BELOW = $01; { Bit 0 = exclude invokers below us (DOS etc) }

MAXICT = 7;

Type
{ Define TRACE.COM's ICT structure }
ICT_Rec = record
ICT_flags, { See above }
ICT_intnum, { interrupt # this table belongs to }
ICT_AH_lo, { lower AH limit to trace }
ICT_AH_hi: Byte; { upper AH limit to trace }
Filler1, { Not needed by trcmod }
Filler2,
Filler3: Integer;
Filler4: Byte;
End;

String80 = String[80];

Var
f: file; { TRACE.COM program file }
ICT: Array[0..MAXICT] Of ICT_Rec; { Array of 8 ICT's }
Buffer: Array[0..200] Of Byte; { I/O buf, larger than necessary }


{
Uppercase a character
}
Function upper (Var ch: Char): Char;
Begin
If (ch >= 'a') And (ch <= 'z')
Then upper := chr (ord (ch) - 32)
Else upper := ch
End;


{
Output one hex digit
}
Procedure Hex1 (i: Integer);
Begin
If i <= 9
Then Write (Chr(i + 48))
Else Write (Chr(i + 55))
End;


{
Output two hex digits
}
Procedure hex2 (i: Integer);
Begin
Hex1 (i DIV 16);
Hex1 (i MOD 16)
End;


{
Return TRUE if specified bit is set
}
Function BitIsSet (i: Byte; bit: Integer): Boolean;
Begin
BitIsSet := Odd (i DIV bit)
End;


{
Set specified bit
}
Procedure SetBit (var i: Byte; bit: Integer);
Begin
If Not BitIsSet (i, bit)
Then i := i + bit
End;


{
Reset specified bit
}
Procedure ResetBit (var i: Byte; bit: Integer);
Begin
If BitIsSet (i, bit)
Then i := i - bit
End;


{
Display a prompt and return 'Y' or 'N' from keyboard.
}
Function GetYesNo (s: String80): Char;
Var ch: Char;
Begin
Write (s, ' (Y/N)? ');
Repeat
Read (kbd, ch);
ch := upper (ch)
Until ch In ['Y', 'N'];
WriteLn (ch);
GetYesNo := ch
End;


{
Get a hex byte from keyboard and return integer value
}
Function GetHex (prompt: String80): Byte;
Var
s: String80;
OK: Boolean;
d1, d2: Integer;
Begin
Repeat
Write (prompt, ' (00..FF): ');
ReadLn (s);
OK := False;
If length (s) = 2 Then Begin
d1 := pos (upper(s[1]), '0123456789ABCDEF');
d2 := pos (upper(s[2]), '0123456789ABCDEF');
If (d1 > 0) And (d2 > 0) Then Begin
OK := True;
GetHex := 16 * (d1-1) + d2 - 1
End
End
Until OK
End;


{
Return TRUE if specified ICT is active
}
Function ICT_Active (Num: Integer): Boolean;
Begin
ICT_Active := ICT[num].ICT_Flags > 128
End;


{
Display data for all 8 ICT's
}
Procedure DISP_ICTs;
Var i, Flags: Integer;
Begin
WriteLn;
WriteLn ('ICT Status Int Lo Hi Ret Enbl FCB ROM BLW');
WriteLn ('--- ------ --- -- -- --- ---- --- --- ---');

For i := 0 To MAXICT Do Begin
Write (i:2, ' ');
If Not ICT_Active (i) Then
WriteLn (' Unused')
Else Begin
Write (' Active');
Flags := ICT[i].ICT_Flags;

Write (' '); Hex2 (ICT[i].ICT_Intnum);
Write (' '); Hex2 (ICT[i].ICT_AH_lo);
Write (' '); Hex2 (ICT[i].ICT_AH_hi);

If BitIsSet (Flags,F_RET)
Then Write (' RET')
Else If BitIsSet (Flags, F_RET2)
Then Write (' RET2')
Else Write (' IRET');

If BitIsSet (Flags, F_Enable)
Then Write (' Y ')
Else Write (' N ');

If BitIsSet (Flags, F_FCB)
Then Write (' Y')
Else Write (' N');

If BitIsSet (Flags, F_ROM)
Then Write (' Y')
Else Write (' N');

If BitIsSet (Flags, F_BELOW)
Then Write (' Y')
Else Write (' N');

WriteLn;
End
End;
WriteLn
End;

{
Display program logo
}
Procedure Logo;
Begin
WriteLn ('trcmod 1.00 by Chris Dunford - modify TRACE.COM ICT''s');
WriteLn
End;


{
Read TRACE.COM into memory. Note that only the first
couple hundred bytes are actually read, that's all we
need. After read, moves data from the ICT's in file
into the ICT[] array for further processing.
}
Procedure ReadFile;
Var
i, result: Integer;
name: String80;
OK: Boolean;
Begin

name := 'TRACE.COM';

{$i-}
Repeat
assign (f, name);
reset (f);
OK := IOResult = 0;
If Not OK Then Begin
Write (name, ' not found. New name: ');
ReadLn (name);
If name = '' Then Halt;
End

Until OK;

Blockread (f, Buffer, sizeof(ICT_Rec)*(MAXICT+1)+3, result);
If result <> sizeof(ICT_Rec)*(MAXICT+1)+3 Then Begin
WriteLn ('***Unable to read file***');
Halt;
End;
{$i+}

For i := 0 To MAXICT Do
move (Buffer[i*sizeof(ICT[1]) + 3], ICT[i], sizeof(ICT[1]))
End;


{
Get new definition of specified ICT
}
Procedure EditICT (num: Integer);
Var
ch: Char;
Begin
WriteLn;
WriteLn ('Editing ICT',num);
WriteLn;

With ICT[num] Do Begin
If GetYesNo ('Active') = 'N' Then
ResetBit (ICT_Flags, F_ACTIVE)
Else Begin
SetBit (ICT_Flags, F_ACTIVE);
ICT_intnum := GetHex ('Int #');
ICT_AH_lo := GetHex ('AH lo');
ICT_AH_hi := GetHex ('AH hi');

Write ('Ret type (R=RET, I=IRET, 2=RET2): ');
Repeat
Read (kbd, ch);
ch := upper (ch)
Until ch in ['R','I','2'];
WriteLn (ch);
ResetBit (ICT_Flags, F_RET);
ResetBit (ICT_Flags, F_RET2);
ResetBit (ICT_Flags, F_IRET);
Case ch of
'R': SetBit (ICT_Flags, F_RET);
'I': SetBit (ICT_Flags, F_IRET);
'2': SetBit (ICT_Flags, F_RET2)
End;

If GetYesNo ('Enable') = 'Y'
Then SetBit (ICT_Flags, F_ENABLE)
Else ReSetBit (ICT_Flags, F_ENABLE);

ResetBit (ICT_Flags, F_FCB);
If ICT_intnum = $21 Then
If GetYesNo ('Enable FCB/ASCII traces') = 'Y'
Then SetBit (ICT_Flags, F_FCB);

If GetYesNo ('Exclude ROM calls') = 'Y'
Then SetBit (ICT_Flags, F_ROM)
Else ReSetBit (ICT_Flags, F_ROM);

If GetYesNo ('Exclude calls below us') = 'Y'
Then SetBit (ICT_Flags, F_BELOW)
Else ReSetBit (ICT_Flags, F_BELOW)
End
End
End;


{
Get new ICT definitions until 'Q' is pressed
}
Procedure UpdateData;
Var
i: Integer;
ch: Char;

Begin
Repeat
Disp_ICTs;
Write ('ICT to edit (0..7), or Q to Quit: ');
Repeat
Read (kbd, ch)
Until ch In ['0'..'7', 'Q', 'q'];
WriteLn (ch);
If ch In ['0'..'7'] Then EditICT (ord (ch) - ord ('0'))
Until ch In ['Q', 'q']
End;


{
Write the modified ICT's back into TRACE.COM.
}
Procedure WriteFile;
Var i, result: Integer;
Begin
WriteLn;
If GetYesNo ('Write modified ICT''s to disk') = 'Y' Then Begin
For i := 0 To MAXICT Do
move (ICT[i], Buffer[i*sizeof(ICT[1]) + 3], sizeof(ICT_Rec));

{$i-}
Seek (f, 0);
Blockwrite (f, Buffer, sizeof(ICT_Rec)*(MAXICT+1)+3, result);
{$i+}

If result <> sizeof(ICT_Rec)*(MAXICT+1)+3
Then WriteLn (chr(7), '***WARNING: error writing TRACE.COM!')
End;

close (f)
End;


{ MAINLINE }
Begin
Logo;
ReadFile;
UpdateData;
WriteFile
End.