⟦17b449d7b⟧

TextFile

package body Breakpoint is
    --|overview
    --|Three procedures are provided to initialize, update , and recall
    --|breakpoint information for a given unit. A dynamic data structure
    --|consisting of a linked list is utilized as well as the dynamic array
    --|and dynamic string data structures provided via library packages.

    --|effects
    --|package initialization has no effect on outside and/or "withing" units.

    --|raises
    --|No user defined exceptions are raised during package initialization.

    --|n/a requires,errors,tuning,notes.




    type Breakpoint_Table;
    type Next_Pointer is access Breakpoint_Table;

    type Breakpoint_Table is
        record
            Table_Unit_Name : Ada_Name;
            Next_Table : Next_Pointer;
            Execution_Count : Darray;

        end record;

    Top_Pointer : Next_Pointer;  --| global pointer for top of list

    procedure Initialize_Breakpoints
                 ( --| add entry to table
                  Unit_Name : in Ada_Name;
                  --| name of library unit
                  Number_Of_Breakpoints : in Breakpoint_Number_Range
                  --| number of brkpts in library unit
                  ) is

        --|effects
        --|The table is searched for the current library unit, if it is not found
        --|an entry is added for each breakpoint in the current library unit. The
        --|total execution count for each breakpoint is initialized to 0.

        --|modifies
        --|The internal Breakpoint_Information data structure is modified if the
        --|current unit is not found.

        --|n/a errors,requires,raises



        Local_Breakpoint_Array : Array_Type (1 .. Number_Of_Breakpoints) :=
           (others => 0);  --| local breakpoint table used
        --| to initialize counts to zero

        Point_To : Next_Pointer := Top_Pointer;
        --| local pointer for table access,
        --| initially is null
    begin
        while Point_To /= null and then
                 not Equal (Point_To.Table_Unit_Name, Unit_Name) loop

            -- search for library unit in table
            Point_To := Point_To.Next_Table;
        end loop;
        if Point_To = null then

            -- library unit not found so add it

            -- use dynamic array funcs convert array of proper length, initialized
            -- to zero counts to a darray.
            Point_To := new Breakpoint_Table;
            Point_To.Table_Unit_Name := Unit_Name;
            Point_To.Next_Table := Top_Pointer;
            Array_To_Darray (A => Local_Breakpoint_Array,
                             Predict => Number_Of_Breakpoints,
                             D => Point_To.Execution_Count);
            Top_Pointer := Point_To;
        end if;
    end Initialize_Breakpoints;

    procedure Break ( --| called at each breakpoint
                     Unit_Name : in Ada_Name;     --| procedure name
                     Breakpoint_Number : in Breakpoint_Number_Range
                     --| breakpoint number
                     ) is

        --|effects
        --|Break increments the execution count for Breakpoint_Number in the
        --|current Unit_Name.

        --|requires
        --|Initialize_Breakpoints must be called for the Unit_Name prior
        --|to calling Break.

        --|modifies
        --|The Execution_Count is modified for the given Breakpoint_Number.

        --|errors
        --|The Unit_Name can't be found in the table.

        --|raises
        --|Unit_Name_Not_Found

        --|n/a tuning,notes



        Pointer_To : Next_Pointer := Top_Pointer;
        --| local pointer for table access
        Count : Count_Range;

    begin
        while Pointer_To /= null and then
                 not Equal (Pointer_To.Table_Unit_Name, Unit_Name) loop

            -- search for unit name in table
            Pointer_To := Pointer_To.Next_Table;
        end loop;
        if Pointer_To /= null then

            -- unit name found
            -- increment the execution count
            Count := Fetch (D => Pointer_To.Execution_Count,
                            I => Breakpoint_Number);
            Count := Count + 1;
            Store (D => Pointer_To.Execution_Count,
                   I => Breakpoint_Number,
                   E => Count);
        else

            -- unit name not found in table
            -- error condition
            raise Unit_Name_Not_Found;
        end if;
    end Break;

    procedure Dump ( --| dump totals to logfile

                    Breakpoint_Table_Access : in out Table_Access;
                    --|unit name, breakpoints and counts
                    More_Units_Available : out Boolean
                    --|false if all units have been dumped
                    ) is

        --|effects
        --|A unit name and breakpoint Execution_Count data is returned to the
        --|calling unit. The internal storage space for that Unit_Information is
        --|then released. This does not affect the data returned to the user of
        --|this procedure. Upon encountering the last piece of Unit_Information,
        --|the boolean More_Units_Available is set to false. If a calling program
        --|invokes this procedure after the boolean More_Units_Available is set to
        --|false, the exeception No_Units_Available will be raised.

        --|modifies
        --|Breakpoint_Table_Access, More_Units_Available, Internal Unit_Information
        --|storage.

        --|errors
        --|If a calling program invokes the procedure after the boolean
        --|More_Units_Available has been set to false, an exception will
        --|be raised (No_Units_Available).

        --|raises No_Units_Available

        --|n/a
        --|tuning,notes,requires







        Points_To : Next_Pointer :=
           Top_Pointer;  --| local pointer for table access

    begin
        if Points_To /= null then
            Breakpoint_Table_Access :=
               new Breakpoint_Information'(Points_To.Table_Unit_Name,
                                           Copy (Points_To.Execution_Count));
            Top_Pointer := Points_To.Next_Table;
            if Top_Pointer /= null then
                More_Units_Available := True;
            else
                More_Units_Available := False;
            end if;
            Destroy (Points_To.Execution_Count);
        else
            More_Units_Available := False;

            --| Error condition encountered, no breakpoint information available
            raise No_Units_Available;
        end if;
    end Dump;


end Breakpoint;
DataMuseum.dk

Rational R1000/400 Tapes

⟦17b449d7b⟧ TextFile

Derivation

TextFile
