⟦1ccc14e5c⟧

TextFile

with Type_Definitions, Stack_Pkg, Dynarray_Pkg, Calendar;

-------------------
package body Clocks is
    -------------------

    --| Overview
    --|
    --|     This package contains procedures and functions for managing
    --| program unit startng and ending times. In a non-tasking
    --| program environment it functions merely as a stack. When a
    --| program unit begins execution its starting time is pushed onto
    --| the stack. When the unit ends execution its starting time is
    --| popped from the stack.
    --|
    --|      However, in a tasking environment when a program unit
    --| ends execution its starting time may not necessarily be the top
    --| element on the stack. This is true not only for tasks but also
    --| for other program units called by tasks. Therefore, tasks
    --| must be handled differently than other program units. There must
    --| also be a mechanism for determining whether a program unit
    --| that is ending execution was also the last currently active
    --| program unit to begin execution.
    --|
    --|     To accomplish this, two separate dynamic structures are
    --| maintained. Tasks are managed in a dynamic array. All other
    --| program units are maintained on a stack with a mechanism
    --| for fetching the starting times for units other than the
    --| last active unit started. However, when this happens, a
    --| fault occurs and the calling program is informed via the
    --| boolean flag "Clock_Fault".

    --| Requires:
    --| Prior to use the calling program must create the clock
    --| structures via a call to Create_Clocks.

    --| N/A: Requires, Modifies, Errors


    use Type_Definitions;

    package Time_Stack_Pkg is new Stack_Pkg (Unit_Start_Times);

    use Time_Stack_Pkg;

    Primary : Time_Stack_Pkg.Stack;
    Faults : Time_Stack_Pkg.Stack;

    type Task_Start_Times is
        record
            Unit_Num : Natural;
            Task_Type_Activation_Number : Task_Type_Activation_Number_Range;
            Start_Time : Calendar.Time;
            Stop_Watch : Calendar.Day_Duration;
            Sons : Natural;
            Grandsons : Natural;
        end record;

    package Task_Clocks is new Dynarray_Pkg (Task_Start_Times);
    use Task_Clocks;

    Tasks : Task_Clocks.Darray;

    Unit_Start_Time : Unit_Start_Times;
    Task_Start_Time : Task_Start_Times;


    ------------------------ Local Procedures ------------------------------

    ----------------
    function Task_Of (--| Fetch the starting time for the specified task
                      Unit_Num : in Positive;
                      Unit_Id : in Program_Unit_Unique_Identifier

                      ) return Unit_Start_Times

                 is

        --| Raises: Inactive_Program_Unit

        --| Effects
        --| Searches the task clock array for the Task_Start_Time corresponding
        --| to the the specified task. If found, the entry is removed from the
        --| array, converted into Unit_Start_Times form, and returned to
        --| the calling program. If not found then the exception
        --| Inactive program unit is raised.

        --| Modifies
        --| If found, the Task_Start_Time corresponding to Unit_Num and Unit_ID
        --| is removed from the dask array.

        --| N/A: Requires, Errors


        Found : Boolean := False;

    begin
        Found := False;
        for Task_Number in 1 .. Length (Tasks) loop
            Task_Start_Time := Fetch (Tasks, Task_Number);
            if Task_Start_Time.Unit_Num = Unit_Num and
               Task_Start_Time.Task_Type_Activation_Number =
                  Unit_Id.Task_Type_Activation_Number then
                Unit_Start_Time := (Unit_Num, Task_Start_Time.Start_Time,
                                    Task_Start_Time.Stop_Watch,
                                    Task_Start_Time.Sons,
                                    Task_Start_Time.Grandsons);
                Found := True;
                for Next_Task in Task_Number + 1 .. Length (Tasks) loop
                    Store (Tasks, Next_Task - 1, Fetch (Tasks, Next_Task));
                end loop;
                Remove_High (Tasks);
                exit;
            end if;
        end loop;
        if not Found then
            raise Inactive_Program_Unit;
        else
            return Unit_Start_Time;
        end if;
    end Task_Of;


    ------------------------ Heap Management ------------------------------

    -----------------------
    procedure Create_Clocks  --| Create a dynamic Clock structure

                  is

        --| Effects
        --| Creates the dynamic program unit clock structures

        --| N/A: Raises, Modifies, Errors

    begin

        --| Create primary stack for non-task program units and another to
        --| hold units which are active when a clock fault occurs.
        Primary := Time_Stack_Pkg.Create;
        Faults := Time_Stack_Pkg.Create;

        --| Create a dynamic array of unit clocks for tasks
        Create
           (1, 10,          --| Start with elements 1..10
            100,                   --| 100% of adds will be at high end of array
            50,                    --| Expand the array by 50% each time necessary
            Tasks);             --| The name of the array is Tasks

    end Create_Clocks;

    ------------------------
    procedure Destroy_Clocks  --| Destroy the clock structure

                  is

        --| Effects
        --| Destroys the dynamic program unit clock structures

        --| N/A: Raises, Modifies, Errors

    begin

        Time_Stack_Pkg.Destroy (Primary);
        Time_Stack_Pkg.Destroy (Faults);
        Task_Clocks.Destroy (Tasks);

    end Destroy_Clocks;


    --------------------- Constructors ------------------------------------


    --------------------
    procedure Start_Unit (--| Store a unit starting time in the clock structure

                          Unit_Id : in Program_Unit_Unique_Identifier;

                          Unit_Start_Time : in Unit_Start_Times

                          ) is

        --| Effects
        --| Saves the starting time of the program unit in a dynamic clock
        --| structure. Any tasks that are currently active are charged
        --| with a grandson for the purpose accumulating overhead time.

        --| N/A: Raises, Modifies, Errors

    begin

        --| If there are any tasks active then each must be charged with a
        --| a grandson. This will enable each task's execution time to be later
        --| adjusted for the overhead imposed by the Run Time Monitor.
        for Task_Number in 1 .. Length (Tasks) loop
            Task_Start_Time := Fetch (Tasks, Task_Number);
            Task_Start_Time.Grandsons := Task_Start_Time.Grandsons + 1;
            Store (Tasks, Task_Number, Task_Start_Time);
        end loop;

        --| Start the current unit
        case Unit_Id.Unit_Type is

            when Task_Type =>
                --| Store tasks in the the task array
                Task_Start_Time := (Unit_Start_Time.Unit_Num,
                                    Unit_Id.Task_Type_Activation_Number,
                                    Unit_Start_Time.Start_Time,
                                    Unit_Start_Time.Stop_Watch,
                                    Unit_Start_Time.Sons,
                                    Unit_Start_Time.Grandsons);
                Add_High (Tasks, Task_Start_Time);

            when others =>
                --| All non-tasks go on the unit stack
                Push (Primary, Unit_Start_Time);

        end case;

    end Start_Unit;

    ----------------------
    procedure Restart_Unit (--| Restore a unit starting time to the clock

                            Unit_Start_Time : in Unit_Start_Times

                            ) is

        --| Effects
        --| Saves the starting time of the program unit in a dynamic clock
        --| structure

        --| N/A: Raises, Modifies, Errors

    begin

        Push (Primary, Unit_Start_Time);

    end Restart_Unit;

    -------------------
    procedure Stop_Unit (--| Fetch a unit starting time from the clock structure

                         Unit_Num : in Natural;

                         Unit_Id : in Program_Unit_Unique_Identifier;

                         Unit_Start_Time : out Unit_Start_Times;

                         Clock_Fault : out Boolean

                         ) is

        --| Raises: Inactive_Program_Unit

        --| Effects
        --| Retrieves the starting time of the terminating program unit.
        --| If the program unit is not a task and and is not the last
        --| active program unit started the Clock_Fault is returned true.
        --| Otherwise, Clock_Fault is returned false.

        --| Modifies
        --| The Unit_Start_Time for the specified unit is deleted from
        --| the clock structure.

        --| N/A: Errors

        Next_Time : Unit_Start_Times;

        Found : Boolean := False;

    begin

        Clock_Fault := False;

        case Unit_Id.Unit_Type is

            when Task_Type =>
                Unit_Start_Time := Task_Of (Unit_Num, Unit_Id);

            when others =>
                while not Is_Empty (Primary) loop
                    Pop (Primary, Next_Time);
                    if Next_Time.Unit_Num = Unit_Num then
                        Found := True;
                        Unit_Start_Time := Next_Time;
                        exit;
                    else
                        Push (Faults, Next_Time);
                    end if;
                end loop;

                if not Is_Empty (Faults) then
                    Clock_Fault := True;
                end if;

                if not Found then
                    raise Inactive_Program_Unit;
                end if;

        end case;

    end Stop_Unit;

    --------------------
    procedure Pause_Unit
                 (--| Fetch a unit starting time from the clock structure

                  Unit_Start_Time : out Unit_Start_Times

                  ) is

        --| Raises: No_More_Units

        --| Effects
        --| Retrieves the starting time of the last currently active
        --| non-task program unit from the clock structure.

        --| Modifies
        --| The Unit_Start_Time for the specified unit is deleted from
        --| the clock structure.

        --| N/A: Errors

    begin

        Pop (Primary, Unit_Start_Time);

    end Pause_Unit;

    ----------------------
    function Dangling_Unit  --| Fetch the unit starting time for a dangling
                            --| unit from the clock structure
                return Unit_Start_Times

                 is

        --| Raises: No_More_Units

        --| Effects
        --| Returns the starting time of a "dangling" unit.
        --| A dangling unit is a unit that has been left in the clock
        --| structure after all records have been read from the log file.
        --| Under normal circumstances this should not occur unless
        --| the instrumented program that generated the log file terminated
        --| abnormally.

        --| Modifies
        --| The Unit_Start_Time for the specified unit is deleted from
        --| the clock structure.

        --| N/A: Requires, Errors

    begin

        Pop (Primary, Unit_Start_Time);
        return Unit_Start_Time;

    end Dangling_Unit;



    ----------------------
    function Dangling_Task  --| Fetch the unit starting time for a dangling
                            --| task from the clock structure
                return Unit_Start_Times

                 is

        --| Raises: No_More_Tasks

        --| Effects
        --| Returns the starting time of a "dangling" task.
        --| A dangling task is a task that has been left in the clock
        --| structure after all records have been read from the log file.
        --| Under normal circumstances this should not occur unless
        --| the task was aborted or the instrumented program that
        --| generated the log file terminated abnormally.

        --| Modifies
        --| The Unit_Start_Time for the specified task is deleted from
        --| the clock structure.

        --| N/A: Requires, Errors

    begin
        Task_Start_Time := Fetch (Tasks, Length (Tasks));
        Unit_Start_Time := (Task_Start_Time.Unit_Num,
                            Task_Start_Time.Start_Time,
                            Task_Start_Time.Stop_Watch, Task_Start_Time.Sons,
                            Task_Start_Time.Grandsons);
        Remove_High (Tasks);
        return Unit_Start_Time;
    end Dangling_Task;


    -------------------------
    function Next_Clock_Fault  --| Clear and return the unit number of the
                               --| next clock fault
                return Natural

                 is

        --| Raises: No_More_Clock_Faults

        --| Effects
        --| Clears one clock fault and returns the unit number of a non-task
        --| program unit that was active when the fault occurred. If no clock
        --| faults are outstanding then the exception No_More_Clock_Faults
        --| is raised.

        --| Requires;
        --| The calling program must check for outstanding clock faults via
        --| the function More_Clock_Faults.

        --| N/A: Modifies, Errors

    begin
        if not Is_Empty (Faults) then
            Pop (Faults, Unit_Start_Time);
            Push (Primary, Unit_Start_Time);
            return Unit_Start_Time.Unit_Num;
        else
            raise No_More_Clock_Faults;
        end if;
    end Next_Clock_Fault;


    ------------------------- Queries --------------------------------------

    ----------------------
    function Previous_Unit  --| Return the starting time of the last active
                            --| non-task program unit to begin execution
                return Unit_Start_Times

                 is

        --| Raises: No_More_Units

        --| Effects
        --| Returns the starting time of the last active non-task
        --| program unit to begin execution. This function is
        --| non-destructive, i.e., the starting time of the unit is
        --| not deleted from the structure.

        --| N/A: Modifies, Errors

    begin
        return Top (Primary);
    end Previous_Unit;

    -------------------
    function More_Units  --| Return true if more non-task program units in clock
                return Boolean

                 is

        --| Effects
        --| Returns true if one or more non-task program units remain in
        --| the clock structure.

        --| N/A: Raises, Modifies, Errors

    begin
        return not Is_Empty (Primary);
    end More_Units;

    -------------------
    function More_Tasks  --| Return true if more tasks in  clock
                return Boolean

                 is

        --| Effects
        --| Returns true if one or tasks remain in the clock structure.

        --| N/A: Raises, Modifies, Errors

    begin
        return Length (Tasks) > 0;
    end More_Tasks;



    --------------------------
    function More_Clock_Faults  --| Returns true if clock faults remain uncleared
                return Boolean

                 is

        --| Effects
        --| Checks to see if any clock faults remain uncleared. Returns true if
        --| any clock faults remain, otherwise returns false;

        --| N/A: Raises, Requires, Modifies, Errors

    begin
        return not Is_Empty (Faults);
    end More_Clock_Faults;

end Clocks;
DataMuseum.dk

Rational R1000/400 Tapes

⟦1ccc14e5c⟧ TextFile

Derivation

TextFile
