Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP_TRC.ZIP/DEMOTRC.PAS

Pascal/Delphi Source File | 1989-05-12 | 5.8 KB | 158 lines

{════════════════════════════ DEMOTRC.PAS ════════════════════════════}
{ This program demonstrates the use of a Trace Procedure which traps  }
{ each statement that changes one of three monitored variables.  The  }
{ user can resume, release to debugger, or halt based on user input.  }
{═════════════════════════════════════════════════════════════════════}
Program DemoTrc;

Uses TRACE;

{══════════════════════════════ HexOut ═══════════════════════════════}
{ Display a Word or Byte value as 4 hexidecimal digits.               }
{══════════════════════════════ HexOut ═══════════════════════════════}
TYPE     Str4 = STRING[4];
CONST    HexDigit: Array[0..15] OF CHAR = '0123456789ABCDEF';
FUNCTION HexOut(Num:INTEGER):Str4; VAR m:INTEGER;
BEGIN
  HexOut:='0000';
  For m:=3 downto 0 do HexOut[4-m]:=HexDigit[($F AND (Num SHR (4*m)))];
END; {FUNCTION HexOut}

{═══════════════════════════ DumpUserRegs ════════════════════════════}
{ Display all registers from the interrupted program in a format      }
{ similar to DEBUG.  (Valid only when called from the Trace routine). }
{═══════════════════════════ DumpUserRegs ════════════════════════════}
PROCEDURE DumpUserRegs;
VAR  Fg: WORD;  FgStr: STRING[9];
VAR  Ch: Char;  n: Byte;
BEGIN

  WRITELN(#10); {skip 2 lines}

  WRITE('  AX=',HexOut(User^.Ax));  WRITE('  BX=',HexOut(User^.Bx));
  WRITE('  CX=',HexOut(User^.Cx));  WRITE('  DX=',HexOut(User^.Dx));
  WRITE(' ':3);    { Adjust Sp for 12 words pushed onto User Stack }
  WRITE('  SP=',HexOut(UserSp +24 ));    WRITE('  BP=',HexOut(User^.Bp));
  WRITE('   ');
  WRITE('  SI=',HexOut(User^.Si));  WRITE('  DI=',HexOut(User^.Di));
  WRITELN;
  WRITE('  DS=',HexOut(User^.Ds));  WRITE('  ES=',HexOut(User^.Es));
  WRITE('  SS=',HexOut(UserSs));
  WRITE(' ':12);
  WRITE('  CS=',HexOut(User^.Cs));  WRITE('  IP=',HexOut(User^.Ip));
  WRITE('   ');
  WRITE('  FG=',HexOut(User^.Flags));
  Fg := User^.Flags; FgStr := '         ';
  IF Fg AND $0001 > 0 THEN FgStr[9] := 'c';
  IF Fg AND $0004 > 0 THEN FgStr[8] := 'e';
  IF Fg AND $0010 > 0 THEN FgStr[7] := 'a';
  IF Fg AND $0040 > 0 THEN FgStr[6] := 'z';
  IF Fg AND $0080 > 0 THEN FgStr[5] := 's';
  IF Fg AND $0200 > 0 THEN FgStr[4] := 'i';
  IF Fg AND $0400 > 0 THEN FgStr[3] := 'd';
  IF Fg AND $0800 > 0 THEN FgStr[2] := 'o';
  WRITELN(FgStr);
  WRITELN;

END; {PROCEDURE DumpUserRegs}


VAR
  ByteVar: BYTE;
  WordVar: WORD;
  StrgVar: STRING;

{════════════════════════════ GlobalTrace ════════════════════════════}
{ This is the Pascal Trace Procedure.  If one of the monitored        }
{ variables has changed from its saved value, save new values and     }
{ display menu of options.  Illustrates all three valid exits from    }
{ a trace procedure (TReturn, TRelease, or Halt).                     }
{════════════════════════════ GlobalTrace ════════════════════════════}
PROCEDURE GlobalTrace;
LABEL Menu;
CONST
  Init:  BOOLEAN = TRUE;
  SaveB: BYTE = 0;
  SaveW: WORD = 0;
  SaveS: STRING = '';

BEGIN
 IF (ByteVar <> SaveB)  OR (WordVar <> SaveW)  OR (StrgVar <> SaveS)
 THEN BEGIN

  SaveB:=ByteVar;    SaveW:=WordVar;    SaveS:=StrgVar;
  IF Init THEN BEGIN  Init:=FALSE;  TReturn;  END;

  WRITELN(#10#10); {skip 3 lines}
  WRITE(HexOut(User^.Cs),':',HexOut(User^.Ip),'  BP=',HexOut(User^.Bp));
  WRITE('  ByteVar=',ByteVar,'  WordVar=',WordVar);
  WRITELN('  StrgVar=',Copy(StrgVar,1,20));
  WRITELN;

 Menu:
  WRITE(#13'  Select:  <C>ontinue trace  <D>ebugger  <R>egisters  <Q>uit  :');
  CASE ReadKey OF
    'C','c': BEGIN WRITELN;  TReturn;  END;
    'D','d': TRelease;
    'R','r': BEGIN DumpUserRegs; Goto Menu; END;
    'Q','q': Halt;
      else   BEGIN WRITE(#7); Goto Menu; END;
  END; {CASE ReadKey}
 END;
 TReturn; {- If no monitored variable changed, exit via TReturn -}
END; {PROCEDURE GlobalTrace}


{════════════════════════════ ClearWordVar ═══════════════════════════}
{ This procedure modifies one of the monitored global variables.      }
{════════════════════════════ ClearWordVar ═══════════════════════════}
PROCEDURE ClearWordVar;
BEGIN
 WRITELN(#10#10);
 WRITELN('The following trap occurred within the procedure ClearWordVar.');
 WRITELN('(Note the reduced value in the BP register).');
 WordVar := 0;
END; {PROCEDURE ClearWordVar}


{════════════════════════════════ Nop ════════════════════════════════}
{ Inline directive used to insert dummy statements between the        }
{ statements which will be trapped by the trace routine.              }
{════════════════════════════════ Nop ════════════════════════════════}
PROCEDURE Nop; Inline($90);  {- Assembly "No Operation" -}


{════════════════════════════════ MAIN ═══════════════════════════════}
BEGIN {- MAIN -}
  ByteVar:=0;
  WordVar:=9999;
  StrgVar:='Hello =====================================================';
  TraceOn(@GlobalTrace);
  WRITELN(#10#10#10#10#10);
  WRITELN('                         TRACE Version 1.0'#10);
  WRITELN('              Copyright (c) 1989  Richard W. Prescott'#10#10);
  WRITELN('Trace is now active.  Each time ByteVar, WordVar, or StrgVar is');
  WRITELN('modified the Trace procedure will display this menu of choices.');
  WRITELN('Select:  "C" to continue the trace');
  WRITELN('         "D" to stop the trace and release to IDE/external debugger');
  WRITELN('         "R" to display all registers and return to the menu');
  WRITELN('         "Q" to halt the program'#10);
  WRITELN('Run this demonstration from the Version 5.0 IDE, or compile to disk');
  WRITELN('and run from DOS or any debugger.');
  Nop;
  Nop;
  Inc(ByteVar);
  Nop;  {- Note that release to debugger pops up at the FOLLOWING line -}
  Nop;
  WordVar:=34567;
  Nop;  {- Note that release to debugger pops up at the FOLLOWING line -}
  Nop;
  ClearWordVar;
  Nop;
  Nop;
  StrgVar:='Bye';
  Nop;
  Nop;
  TraceOff;
END.