OS/2 Shareware BBS: 10 Tools/10-Tools.zip/pmos2002.zip/SRC/TRACE.MOD

Text File | 1996-10-16 | 8KB | 256 lines

IMPLEMENTATION MODULE Trace;

        (********************************************************)
        (*                                                      *)
        (*             Trace routines for Modula-2              *)
        (*                 program development.                 *)
        (*                                                      *)
        (*  Programmer:         P. Moylan                       *)
        (*  Last edited:        16 October 1996                 *)
        (*  Status:             Starting new approach           *)
        (*                                                      *)
        (********************************************************)

FROM DumpFile IMPORT
    (* proc *)  DumpString, DumpCard, DumpEOL;

(*
FROM Mouse IMPORT
    (* proc *)  MouseAvailable;
*)

FROM Timer IMPORT
    (* proc *)  Sleep;

FROM Windows IMPORT
    (* type *)  Window, RowRange, ColumnRange,
    (* proc *)  OpenSimpleWindow, CloseWindow, WriteString, WriteLn,
                ReadChar, EraseLine, CursorUp, PressAnyKey;

FROM NumericIO IMPORT
    (* proc *)  WriteCard;

(*
FROM UserInterface IMPORT
    (* type *)  UIWindow, Capability, CapabilitySet,
    (* proc *)  AllowMouseControl;
*)

FROM TaskControl IMPORT
    (* proc *)  CurrentTaskID;

(************************************************************************)

TYPE
    ThreadID = [0..100];

VAR ThreadInfo: ARRAY ThreadID OF
                    RECORD
                        TraceWindowOpen, TraceEnabled: BOOLEAN;
                        nesting: CARDINAL;  PauseLength: CARDINAL;
                        TraceWindow: Window;
                    END (*RECORD*);

(************************************************************************)

PROCEDURE CurrentID(): ThreadID;

    (* Returns an identifier for the current thread.  If we're tracing  *)
    (* too many threads, or if for any other reason the ID would go     *)
    (* outside the legal range, a result of 0 is returned.              *)

    VAR result: CARDINAL;

    BEGIN
        result := CurrentTaskID();
        IF result > MAX(ThreadID) THEN result := 0 END (*IF*);
        RETURN result;
    END CurrentID;

(************************************************************************)

PROCEDURE Pause;

    (* Types a "Press any key to continue" message.     *)
    (* A temporary trace window is opened if necessary. *)

    BEGIN
        WITH ThreadInfo[CurrentID()] DO
            IF NOT TraceWindowOpen THEN
                OpenSimpleWindow (TraceWindow, 22, 24, 0, 28);
                (*
                IF MouseAvailable() THEN
                    UIW := AllowMouseControl (TraceWindow, "Pause message",
                                            CapabilitySet {wshow, wmove});
                END (*IF*);
                *)
            END (*IF*);
            WriteLn (TraceWindow);
            PressAnyKey (TraceWindow);
            IF TraceWindowOpen THEN    (* i.e. not just the temporary window *)
                EraseLine (TraceWindow, 0);  CursorUp(TraceWindow);
            ELSE
                CloseWindow (TraceWindow);
            END (*IF*);
        END (*WITH*);
    END Pause;

(************************************************************************)

PROCEDURE NYI (name: ARRAY OF CHAR);

    (* Types a "not yet implemented" message.  A trace window is opened *)
    (* if necessary.                                                    *)

    (*VAR UIW: UIWindow;*)

    BEGIN
        WITH ThreadInfo[CurrentID()] DO
            IF NOT TraceWindowOpen THEN
                OpenSimpleWindow (TraceWindow, 21, 24, 1, 45);
                TraceWindowOpen := TRUE;
                (*
                IF MouseAvailable() THEN
                    UIW := AllowMouseControl (TraceWindow, "Procedure trace",
                                    CapabilitySet {wshow, wmove, whide});
                END (*IF*);
                *)
            END (*IF*);
            WriteLn (TraceWindow);
            WriteString (TraceWindow, name);
            WriteString (TraceWindow, " is not yet implemented.");
        END (*WITH*);
    END NYI;

(************************************************************************)

PROCEDURE DeliberatePause;

    (* Inserts a delay in execution, for situations where the trace     *)
    (* messages would otherwise flash by on the screen too quickly      *)
    (* to read.                                                         *)

    BEGIN
        Sleep (10*ThreadInfo[CurrentID()].PauseLength);
    END DeliberatePause;

(************************************************************************)

PROCEDURE InTrace (name: ARRAY OF CHAR);

    (* To be called when entering a procedure.  *)

    VAR j: CARDINAL;

    BEGIN
        WITH ThreadInfo[CurrentID()] DO
            IF TraceEnabled THEN
                WriteLn (TraceWindow);
                FOR j := 1 TO nesting DO
                    WriteString (TraceWindow, "   ");
                END (*FOR*);
                WriteString (TraceWindow, "Entering ");
                WriteString (TraceWindow, name);
                DeliberatePause;
            END (*IF*);
            INC (nesting);
        END (*WITH*);
    END InTrace;

(************************************************************************)

PROCEDURE OutTrace (name: ARRAY OF CHAR);

    (* To be called when leaving a procedure.   *)

    VAR j: CARDINAL;

    BEGIN
        WITH ThreadInfo[CurrentID()] DO
            DEC (nesting);
            IF TraceEnabled THEN
                WriteLn (TraceWindow);
                FOR j := 1 TO nesting DO
                    WriteString (TraceWindow, "   ");
                END (*FOR*);
                WriteString (TraceWindow, "Leaving ");
                WriteString (TraceWindow, name);
                DeliberatePause;
            END (*IF*);
        END (*WITH*);
    END OutTrace;

(************************************************************************)

PROCEDURE TraceOn (firstrow, lastrow: RowRange;
                        firstcol, lastcol: ColumnRange;
                        SlowDownFactor: CARDINAL);

    (* Turns tracing on.                *)

    (*VAR UIW: UIWindow;*)

    BEGIN
        DumpString ("TraceOn called by task ");  DumpCard (CurrentID());  DumpEOL;
        WITH ThreadInfo[CurrentID()] DO
            IF TraceWindowOpen THEN

                (* Close any previous trace window. *)

                CloseWindow (TraceWindow);

            END (*IF*);
            PauseLength := SlowDownFactor;
            OpenSimpleWindow (TraceWindow, firstrow, lastrow, firstcol, lastcol);
            WriteString (TraceWindow, "Tracing task ");
            WriteCard (TraceWindow, CurrentID());  WriteLn (TraceWindow);
            (*
            IF MouseAvailable() THEN
                UIW := AllowMouseControl (TraceWindow, "Procedure trace",
                                    CapabilitySet {wshow, wmove, whide});
            END (*IF*);
            *)
            TraceWindowOpen := TRUE;  TraceEnabled := TRUE;
        END (*WITH*);
    END TraceOn;

(************************************************************************)

PROCEDURE TraceOff;

    (* Turns tracing off.               *)

    BEGIN
        WITH ThreadInfo[CurrentID()] DO
            IF TraceEnabled THEN
                CloseWindow (TraceWindow);  TraceWindowOpen := FALSE;
            END (*IF*);
            TraceEnabled := FALSE;
        END (*WITH*);
    END TraceOff;

(************************************************************************)

PROCEDURE TraceStatus (): BOOLEAN;

    (* Says whether tracing is currently on.            *)

    BEGIN
        RETURN ThreadInfo[CurrentID()].TraceEnabled;
    END TraceStatus;

(************************************************************************)
(*                          INITIALISATION                              *)
(************************************************************************)

VAR j: ThreadID;

BEGIN
    FOR j := 0 TO MAX(ThreadID) DO
        WITH ThreadInfo[j] DO
            TraceEnabled := FALSE;  nesting := 0;  TraceWindowOpen := FALSE;
        END (*WITH*);
    END (*FOR*);
END Trace.