home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / asmutil / trace.zip / TRCMOD.ZIP / TRCMOD.PAS < prev   
Pascal/Delphi Source File  |  1986-04-24  |  9KB  |  371 lines
  1. Program tracemod;
  2.  
  3. {
  4.     Quickie program to modify ICT definitions in TRACE.COM without
  5.     reassembling the dang thing.  Note that this program modifies
  6.     TRACE.COM on disk, not in memory.  The new definitions are not
  7.     effective until TRACE is next loaded.  Keep a backup.
  8.  
  9.     See TRACE.ASM by Joan Riff for explanations of what all this stuff
  10.     is.  As Joan points out (more or less), if you don't understand
  11.     what TRACE does, you probably shouldn't be using it.
  12.  
  13.     Released to the public domain by Chris Dunford, without any promises.
  14.  
  15.     trcmod 1.00 04/24/86 cjd
  16. }
  17.  
  18. Const
  19.     { Bit definitions within the ICT's ICT_Flags field }
  20.     F_ACTIVE    = $80;      { Bit 7 = this ICT is active                  }
  21.     F_RET       = $40;      { Bit 6 = This INT exits via RET              }
  22.     F_RET2      = $20;      { Bit 5 = This INT exits via RET2             }
  23.     F_IRET      = $10;      { Bit 4 = This INT exits via IRET             }
  24.     F_ENABLE    = $08;      { Bit 3 = Tracing enabled for this ICT        }
  25.     F_FCB       = $04;      { Bit 2 = enable FCB/ASCII traces for INT 21h }
  26.     F_ROM       = $02;      { Bit 1 = exclude ROM invocations of this INT }
  27.     F_BELOW     = $01;      { Bit 0 = exclude invokers below us (DOS etc) }
  28.  
  29.     MAXICT = 7;
  30.  
  31. Type
  32.    { Define TRACE.COM's ICT structure }
  33.    ICT_Rec = record
  34.         ICT_flags,                { See above }
  35.         ICT_intnum,               { interrupt # this table belongs to }
  36.         ICT_AH_lo,                { lower AH limit to trace }
  37.         ICT_AH_hi:      Byte;     { upper AH limit to trace }
  38.         Filler1,                  { Not needed by trcmod }
  39.         Filler2,
  40.         Filler3:        Integer;
  41.         Filler4:        Byte;
  42.    End;
  43.  
  44.    String80 = String[80];
  45.  
  46. Var
  47.     f:      file;                           { TRACE.COM program file }
  48.     ICT:    Array[0..MAXICT] Of ICT_Rec;    { Array of 8 ICT's }
  49.     Buffer: Array[0..200] Of Byte;          { I/O buf, larger than necessary }
  50.  
  51.  
  52. {
  53.     Uppercase a character
  54. }
  55. Function upper (Var ch: Char): Char;
  56. Begin
  57.     If (ch >= 'a') And (ch <= 'z')
  58.         Then upper := chr (ord (ch) - 32)
  59.         Else upper := ch
  60. End;
  61.  
  62.  
  63. {
  64.     Output one hex digit
  65. }
  66. Procedure Hex1 (i: Integer);
  67. Begin
  68.     If i <= 9
  69.         Then Write (Chr(i + 48))
  70.         Else Write (Chr(i + 55))
  71. End;
  72.  
  73.  
  74. {
  75.     Output two hex digits
  76. }
  77. Procedure hex2 (i: Integer);
  78. Begin
  79.     Hex1 (i DIV 16);
  80.     Hex1 (i MOD 16)
  81. End;
  82.  
  83.  
  84. {
  85.     Return TRUE if specified bit is set
  86. }
  87. Function BitIsSet (i: Byte; bit: Integer): Boolean;
  88. Begin
  89.     BitIsSet := Odd (i DIV bit)
  90. End;
  91.  
  92.  
  93. {
  94.     Set specified bit
  95. }
  96. Procedure SetBit (var i: Byte; bit: Integer);
  97. Begin
  98.     If Not BitIsSet (i, bit)
  99.         Then i := i + bit
  100. End;
  101.  
  102.  
  103. {
  104.     Reset specified bit
  105. }
  106. Procedure ResetBit (var i: Byte; bit: Integer);
  107. Begin
  108.     If BitIsSet (i, bit)
  109.         Then i := i - bit
  110. End;
  111.  
  112.  
  113. {
  114.     Display a prompt and return 'Y' or 'N' from keyboard.
  115. }
  116. Function GetYesNo (s: String80): Char;
  117. Var ch: Char;
  118. Begin
  119.     Write (s, ' (Y/N)? ');
  120.     Repeat
  121.         Read (kbd, ch);
  122.         ch := upper (ch)
  123.     Until ch In ['Y', 'N'];
  124.     WriteLn (ch);
  125.     GetYesNo := ch
  126. End;
  127.  
  128.  
  129. {
  130.     Get a hex byte from keyboard and return integer value
  131. }
  132. Function GetHex (prompt: String80): Byte;
  133. Var
  134.     s: String80;
  135.     OK: Boolean;
  136.     d1, d2: Integer;
  137. Begin
  138.     Repeat
  139.         Write (prompt, ' (00..FF): ');
  140.         ReadLn (s);
  141.         OK := False;
  142.         If length (s) = 2 Then Begin
  143.             d1 := pos (upper(s[1]), '0123456789ABCDEF');
  144.             d2 := pos (upper(s[2]), '0123456789ABCDEF');
  145.             If (d1 > 0) And (d2 > 0) Then Begin
  146.                 OK := True;
  147.                 GetHex := 16 * (d1-1) + d2 - 1
  148.             End
  149.         End
  150.     Until OK
  151. End;
  152.  
  153.  
  154. {
  155.     Return TRUE if specified ICT is active
  156. }
  157. Function ICT_Active (Num: Integer): Boolean;
  158. Begin
  159.     ICT_Active := ICT[num].ICT_Flags > 128
  160. End;
  161.  
  162.  
  163. {
  164.     Display data for all 8 ICT's
  165. }
  166. Procedure DISP_ICTs;
  167. Var i, Flags: Integer;
  168. Begin
  169.     WriteLn;
  170.     WriteLn ('ICT  Status  Int  Lo  Hi  Ret  Enbl  FCB  ROM  BLW');
  171.     WriteLn ('---  ------  ---  --  --  ---  ----  ---  ---  ---');
  172.  
  173.     For i := 0 To MAXICT Do Begin
  174.         Write (i:2, ' ');
  175.         If Not ICT_Active (i) Then
  176.             WriteLn ('  Unused')
  177.         Else Begin
  178.             Write ('  Active');
  179.             Flags := ICT[i].ICT_Flags;
  180.  
  181.             Write ('   '); Hex2 (ICT[i].ICT_Intnum);
  182.             Write ('  ');  Hex2 (ICT[i].ICT_AH_lo);
  183.             Write ('  ');  Hex2 (ICT[i].ICT_AH_hi);
  184.  
  185.             If BitIsSet (Flags,F_RET)
  186.                 Then Write ('  RET')
  187.                 Else If BitIsSet (Flags, F_RET2)
  188.                   Then Write (' RET2')
  189.                   Else Write (' IRET');
  190.  
  191.             If BitIsSet (Flags, F_Enable)
  192.                 Then Write ('    Y ')
  193.                 Else Write ('    N ');
  194.  
  195.             If BitIsSet (Flags, F_FCB)
  196.                 Then Write ('   Y')
  197.                 Else Write ('   N');
  198.  
  199.             If BitIsSet (Flags, F_ROM)
  200.                 Then Write ('    Y')
  201.                 Else Write ('    N');
  202.  
  203.             If BitIsSet (Flags, F_BELOW)
  204.                 Then Write ('    Y')
  205.                 Else Write ('    N');
  206.  
  207.             WriteLn;
  208.         End
  209.     End;
  210.     WriteLn
  211. End;
  212.  
  213. {
  214.     Display program logo
  215. }
  216. Procedure Logo;
  217. Begin
  218.     WriteLn ('trcmod 1.00 by Chris Dunford - modify TRACE.COM ICT''s');
  219.     WriteLn
  220. End;
  221.  
  222.  
  223. {
  224.     Read TRACE.COM into memory.  Note that only the first
  225.     couple hundred bytes are actually read, that's all we
  226.     need.  After read, moves data from the ICT's in file
  227.     into the ICT[] array for further processing.
  228. }
  229. Procedure ReadFile;
  230. Var
  231.     i, result: Integer;
  232.     name: String80;
  233.     OK: Boolean;
  234. Begin
  235.  
  236.     name := 'TRACE.COM';
  237.  
  238.     {$i-}
  239.     Repeat
  240.         assign (f, name);
  241.         reset (f);
  242.         OK := IOResult = 0;
  243.         If Not OK Then Begin
  244.             Write (name, ' not found.  New name: ');
  245.             ReadLn (name);
  246.             If name = '' Then Halt;
  247.         End
  248.  
  249.     Until OK;
  250.  
  251.     Blockread (f, Buffer, sizeof(ICT_Rec)*(MAXICT+1)+3, result);
  252.     If result <> sizeof(ICT_Rec)*(MAXICT+1)+3 Then Begin
  253.         WriteLn ('***Unable to read file***');
  254.         Halt;
  255.     End;
  256.     {$i+}
  257.  
  258.     For i := 0 To MAXICT Do
  259.         move (Buffer[i*sizeof(ICT[1]) + 3], ICT[i], sizeof(ICT[1]))
  260. End;
  261.  
  262.  
  263. {
  264.     Get new definition of specified ICT
  265. }
  266. Procedure EditICT (num: Integer);
  267. Var
  268.     ch: Char;
  269. Begin
  270.     WriteLn;
  271.     WriteLn ('Editing ICT',num);
  272.     WriteLn;
  273.  
  274.     With ICT[num] Do Begin
  275.         If GetYesNo ('Active') = 'N' Then
  276.             ResetBit (ICT_Flags, F_ACTIVE)
  277.         Else Begin
  278.             SetBit (ICT_Flags, F_ACTIVE);
  279.             ICT_intnum := GetHex ('Int #');
  280.             ICT_AH_lo := GetHex ('AH lo');
  281.             ICT_AH_hi := GetHex ('AH hi');
  282.  
  283.             Write ('Ret type (R=RET, I=IRET, 2=RET2): ');
  284.             Repeat
  285.                 Read (kbd, ch);
  286.                 ch := upper (ch)
  287.             Until ch in ['R','I','2'];
  288.             WriteLn (ch);
  289.             ResetBit (ICT_Flags, F_RET);
  290.             ResetBit (ICT_Flags, F_RET2);
  291.             ResetBit (ICT_Flags, F_IRET);
  292.             Case ch of
  293.                 'R': SetBit (ICT_Flags, F_RET);
  294.                 'I': SetBit (ICT_Flags, F_IRET);
  295.                 '2': SetBit (ICT_Flags, F_RET2)
  296.             End;
  297.  
  298.             If GetYesNo ('Enable') = 'Y'
  299.                 Then SetBit (ICT_Flags, F_ENABLE)
  300.                 Else ReSetBit (ICT_Flags, F_ENABLE);
  301.  
  302.             ResetBit (ICT_Flags, F_FCB);
  303.             If ICT_intnum = $21 Then
  304.                 If GetYesNo ('Enable FCB/ASCII traces') = 'Y'
  305.                     Then SetBit (ICT_Flags, F_FCB);
  306.  
  307.             If GetYesNo ('Exclude ROM calls') = 'Y'
  308.                 Then SetBit (ICT_Flags, F_ROM)
  309.                 Else ReSetBit (ICT_Flags, F_ROM);
  310.  
  311.             If GetYesNo ('Exclude calls below us') = 'Y'
  312.                 Then SetBit (ICT_Flags, F_BELOW)
  313.                 Else ReSetBit (ICT_Flags, F_BELOW)
  314.         End
  315.     End
  316. End;
  317.  
  318.  
  319. {
  320.     Get new ICT definitions until 'Q' is pressed
  321. }
  322. Procedure UpdateData;
  323. Var
  324.     i: Integer;
  325.     ch: Char;
  326.  
  327. Begin
  328.     Repeat
  329.         Disp_ICTs;
  330.         Write ('ICT to edit (0..7), or Q to Quit: ');
  331.         Repeat
  332.             Read (kbd, ch)
  333.         Until ch In ['0'..'7', 'Q', 'q'];
  334.         WriteLn (ch);
  335.         If ch In ['0'..'7'] Then EditICT (ord (ch) - ord ('0'))
  336.     Until ch In ['Q', 'q']
  337. End;
  338.  
  339.  
  340. {
  341.     Write the modified ICT's back into TRACE.COM.
  342. }
  343. Procedure WriteFile;
  344. Var i, result: Integer;
  345. Begin
  346.     WriteLn;
  347.     If GetYesNo ('Write modified ICT''s to disk') = 'Y' Then Begin
  348.         For i := 0 To MAXICT Do
  349.             move (ICT[i], Buffer[i*sizeof(ICT[1]) + 3], sizeof(ICT_Rec));
  350.  
  351.         {$i-}
  352.         Seek (f, 0);
  353.         Blockwrite (f, Buffer, sizeof(ICT_Rec)*(MAXICT+1)+3, result);
  354.         {$i+}
  355.  
  356.         If result <> sizeof(ICT_Rec)*(MAXICT+1)+3
  357.             Then WriteLn (chr(7), '***WARNING: error writing TRACE.COM!')
  358.     End;
  359.  
  360.     close (f)
  361. End;
  362.  
  363.  
  364. {  MAINLINE  }
  365. Begin
  366.     Logo;
  367.     ReadFile;
  368.     UpdateData;
  369.     WriteFile
  370. End.
  371.