with Stack_Pkg;
with Lists;
with Simple_Paginated_Output;
use Simple_Paginated_Output;
with Source_Instrumenter_Declarations;
with Change_Text;

package body Create_Breakpoint is

    --|  Overview
    --|
    --|  This package takes care of creating calls to the RTM.  It creates
    --|  breakpoints, Entering_units, and Exiting units with the appropriate
    --|  parameters.  It also exports a function that returns a
    --|  program_unit_unique_identifier for the current unit.  This function
    --|  is called to create the identifier for the calls create in tracing
    --|  variables
    --|
    --|  There are several routines called by the source instrumenter to tell
    --|  this package when a unit is entered or exited.  These calls are:
    --|  New_compilation_unit, Start_Program_Unit, and End_program_unit.
    --|  The information passed to these procedures allows the package to
    --|  determine the name, type, and other info about the current unit
    --|  and current compilation unit.
    --|
    --|  Four other procedure are used to output instrumented source.  They are
    --|  Create_entering_Unit, Create_exiting_unit, Create_Breakpoint, and
    --|  Create_Unit_Information.  These procedures when called will output
    --|  the appropriate call to the run time monitor.
    --|
    --|  The current program unit is identified by three elements: The compilation
    --|  unit containing it, a unique number assigned to the unit, and the type of
    --|  unit.  The current compilation unit is always maintained in
    --|  CURRENT_COMPILATION_UNIT, and the other elements are maintained in
    --|  a record.  These records are stacked for nested procedures in order
    --|  to maintain the current unit properly.
    --|
    --|  A list of the units in the current compilation unit is also maintained.
    --|  This list is used in the Unit_Information call to the Run time monitor to
    --|  identify the units in a compilation unit.  This is the only place where
    --|  the unit names are used.  All other places use the three elements used
    --|  above.  When the name of a unit is needed. Its unique number is used to
    --|  select the correct element of the list containing the program unit name.


    use String_Pkg;

    package Sid renames Source_Instrumenter_Declarations;

    type Program_Unit_Information is
    --|  Information needed to identify a unit
        record
            Unit_Number : Program_Unit_Number_Range; --|  unique unit number
            Unit_Type : Program_Unit_Type;         --|  type of unit
        end record;

    Current_Compilation_Unit : Current_Unit_Name;
    --|  The name of the current compilation unit being processed

    Breakpoint_Number : Breakpoint_Number_Range;
    --|  The number of breakpoints that have been created

    Number_Of_Program_Units : Program_Unit_Number_Range;
    --|  The number of program units in the current compilation unit that have
    --|  been processed so far

    Current_Program_Unit : Program_Unit_Information;
    --|  Contains the information about the program unit currently being processed

    Current_Nesting_Level : Natural;
    --|  The current level of nesting

    package Program_Unit_Stack_Package is
       new         -- Used to Maintain the current
           Stack_Pkg
              (Program_Unit_Information); -- unit info through nesting

    package Program_Unit_List_Package is
       new          -- Used to keep a list of the units
           Lists (Program_Unit_Name);            -- in the current comp unit

    Program_Unit_List : Program_Unit_List_Package.List;
    --|  The list of units in the current compilation unit

    Program_Unit_Stack : Program_Unit_Stack_Package.Stack;
    --|  The stack used to maintain the current unit

    -------------------------------------------------------------------------

    procedure New_Compilation_Unit (Unit_Name : in Current_Unit_Name;
                                    Type_Of_Unit : in Program_Unit_Type) is

        --|  Effects
        --|
        --|  This procedure is used to define the current compilation unit.  Since a
        --|  compilation can contain several compilation units, all variables
        --|  must be re-initialized when a new compilation unit is started.

    begin
        Current_Nesting_Level := 1;
        Program_Unit_Stack := Program_Unit_Stack_Package.Create;
        Program_Unit_List := Program_Unit_List_Package.Create;
        Current_Compilation_Unit := Make_Persistent (Unit_Name);
        Breakpoint_Number := 0;

        --  If the compilation unit is a procedure or function then the procedure
        --  or function is program unit number one.  In a package the first nested
        --  unit will be unit number 1.

        if Type_Of_Unit = Package_Type then
            Number_Of_Program_Units := 0;
        else
            -- add the procedure or function to the list of program units
            Number_Of_Program_Units := 1;
            Program_Unit_List_Package.Attach
               (Program_Unit_List, (Unit_Name, Type_Of_Unit));
        end if;
        Current_Program_Unit := (Number_Of_Program_Units, Type_Of_Unit);

    end New_Compilation_Unit;

    -------------------------------------------------------------------------

    procedure Start_Program_Unit (Unit_Name : in Current_Unit_Name;
                                  Type_Of_Unit : in Program_Unit_Type) is

        --|  Effects
        --|
        --|  This procedure defines a new program unit for the current compilation
        --|  unit.  The nesting level is updated, the information about the enclosing
        --|  unit is pushed on the stack, the new unit is defined to be the current
        --|  unit and it is added to the list of units.

    begin
        Current_Nesting_Level := Current_Nesting_Level + 1;
        Program_Unit_Stack_Package.Push
           (Program_Unit_Stack, Current_Program_Unit);
        Number_Of_Program_Units := Number_Of_Program_Units + 1;
        Current_Program_Unit := (Number_Of_Program_Units, Type_Of_Unit);
        Program_Unit_List_Package.Attach
           (Program_Unit_List, (Unit_Name, Type_Of_Unit));
    end Start_Program_Unit;

    -------------------------------------------------------------------------

    procedure Create_Entering_Unit is

        --|  Effects
        --|
        --|  This procedure outputs the entering unit call to the run time monitor
        --|  for the current unit.  The call is put to the instrumented file only

    begin

        -- Currently, entering unit call is not made for package body
        -- initialization at outer level.  This may be added back later
        -- if the problems can be overcome

        if not (Current_Program_Unit.Unit_Type = Package_Type and
                Current_Nesting_Level > 1) then
            Space_Line (Sid.Instrumented_File, 1);
            if Current_Nesting_Level = 1 and
               Current_Program_Unit.Unit_Type = Procedure_Type then
                Put_Line (Sid.Instrumented_File,
                          Change_Text.Convert_Periods_To_Underscores
                             (Value (Current_Compilation_Unit)) &
                          "_Call_Unit_Information;");
            end if;
            Put (Sid.Instrumented_File, "RTM.Entering_Unit");
            Put (Sid.Instrumented_File, Get_Program_Unit);
            Put (Sid.Instrumented_File, ";");
            if Current_Program_Unit.Unit_Type = Package_Type then
                Space_Line (Sid.Instrumented_File, 1);
            end if;
        end if;
    end Create_Entering_Unit;

    -------------------------------------------------------------------------

    procedure Create_Exiting_Unit is

        --|  Effects
        --|
        --|  This procedure creates the exiting unit call to the run time monitor.
        --|

    begin

        -- Currently, exiting unit call is not made for package body
        -- initialization at outer level.  This may be added back later
        -- if the problems can be overcome

        if not (Current_Program_Unit.Unit_Type = Package_Type and
                Current_Nesting_Level > 1) then
            Space_Line (Sid.Instrumented_File, 1);
            Put (Sid.Instrumented_File, "RTM.Exiting_Unit(");
            Put (Sid.Instrumented_File, Get_Program_Unit);
            Put_Line (Sid.Instrumented_File, ");");
            Breakpoint_Printed_Last := False;
        end if;
    end Create_Exiting_Unit;

    -------------------------------------------------------------------------

    procedure End_Program_Unit is

        --|  Effects
        --|
        --|  This is procedure is called to inform the create_breakpoint package
        --|  that the current unit has ended.  If we are nested then the outer
        --|  scope information is popped from the stack.  If the unit that
        --|  we have just complete processing is a procedure that is a compilation
        --|  unit, then output the call_unit_Information unit is created.
        --|

    begin
        Current_Nesting_Level := Current_Nesting_Level - 1;

        if Current_Nesting_Level = 0 then

            --  If this is an non-nested procedure then create a call_unit_info
            --  procedure.

            if Current_Program_Unit.Unit_Type = Procedure_Type then
                Space_Line (Sid.Instrumented_File, 1);
                Put_Line (Sid.Instrumented_File,
                          "separate(" & Current_Compilation_Unit & ")");
                Put_Line (Sid.Instrumented_File,
                          "procedure " & Change_Text.
                                            Convert_Periods_To_Underscores
                                            (Value (Current_Compilation_Unit)) &
                             "_Call_Unit_Information is");
                Put_Line (Sid.Instrumented_File, "begin");
                Create_Unit_Information;
                Put_Line (Sid.Instrumented_File, "end;");
            end if;
        else
            -- we are nested so pop the outer scope from the stack
            Program_Unit_Stack_Package.Pop
               (Program_Unit_Stack, Current_Program_Unit);
        end if;
    end End_Program_Unit;

    -------------------------------------------------------------------------

    procedure Create_Breakpoint (Type_Of_Breakpoint : in Breakpoint_Types;
                                 Putvars_To_Call : in Ada_Name) is

        --|  Effects
        --|
        --|  This procedure will create a breakpoint in the souce code.  The breakpoint
        --|  type is added to the breakpoint call.  If we are tracing variables then
        --|  a call to the current putvars is added after the breakpoint.  Due to
        --|  grammar ambiguities, there are several places where multiple calls to
        --|  create breakpoint are made.  To prevent multiple breakpoints from being
        --|  printed a flag is maintained that identifies whether a breakpoint was
        --|  the last item printed to the instrumented source.  If this flag is
        --|  true then no breakpoint is added

        Breakpoint_Length : Integer;
        --|  The length of the string representation of the current bkpt number

        Blank_String : String (1 .. 5) := "     ";
        --|  The string into which the bkpt number is put for printing in the
        --|  listing file.

    begin

        --  Currently breakpoints are not added to package initializations

        if Current_Program_Unit.Unit_Type /= Package_Type then
            if not Breakpoint_Printed_Last then

                -- Increment the breakpoint number and then make a string
                -- representation of the number for use in the listing

                Breakpoint_Number := Breakpoint_Number + 1;
                Breakpoint_Length := Integer'Image (Breakpoint_Number)'Length;
                Breakpoint_Number_For_Printing :=
                   Integer'Image (Breakpoint_Number) &
                      Blank_String (Breakpoint_Length .. 5);
                Breakpoint_Number_For_Printing :=
                   Breakpoint_Number_For_Printing (2 .. 6) & " ";

                --  output the breakpoint

                Space_Line (Sid.Instrumented_File, 1);
                Put (Sid.Instrumented_File, "RTM.Breakpoint_At(");
                Put (Sid.Instrumented_File, Get_Program_Unit);
                Put (Sid.Instrumented_File, ",");
                Space_Line (Sid.Instrumented_File, 1);
                if Type_Of_Breakpoint = Other_Breakpoint then
                    Put (Sid.Instrumented_File, "       Other_Breakpoint, ");
                else
                    Put (Sid.Instrumented_File, "       Loop_Breakpoint, ");
                end if;
                Put (Sid.Instrumented_File, Natural'Image (Breakpoint_Number));
                Put (Sid.Instrumented_File, ");");
                Breakpoint_Printed_Last := True;

                -- If there is a putvars to call, then add the call to
                -- the instrumented source

                if not Is_Empty (Putvars_To_Call) then
                    Space_Line (Sid.Instrumented_File, 1);
                    Put (Sid.Instrumented_File,
                         Putvars_To_Call & "_" & Sid.Prefix & "putvars;");
                end if;
            end if;
        end if;
    end Create_Breakpoint;

    -------------------------------------------------------------------------

    procedure Create_Unit_Information is

        --|  Effects
        --|
        --|  This procedure is called to output the unit information call to the
        --|  instrumented file.  This call must be made after all procedures in
        --|  the compilation unit are defined.  No further calls can be made for
        --|  the compilation unit after the unit information call is made.
        --|  The unit Information includes a list of the names and types of the
        --|  program units contained in the compilation unit.

        Next_Program_Unit : Program_Unit_Name;
        --|  Used to contain the next program unit when iterating the p.u. list

        Program_Unit_List_Iterator : Program_Unit_List_Package.Listiter;
        --|  The iterator used in iterating the program unit list

        Program_Unit_Number : Positive := 1;
        --|  Used to maintain unit number for program unit list

    begin
        Put (Sid.Instrumented_File,
             "RTM.Unit_Information(Create(""" &
                Value (Current_Compilation_Unit) & """), ");
        Put (Sid.Instrumented_File, Natural'Image (Breakpoint_Number));
        Put (Sid.Instrumented_File, ", (");

        --  Iterate throught the list of program units printing each to
        --  the listing file

        Program_Unit_List_Iterator :=
           Program_Unit_List_Package.Makelistiter (Program_Unit_List);
        while Program_Unit_List_Package.More (Program_Unit_List_Iterator) loop
            Program_Unit_List_Package.Next
               (Program_Unit_List_Iterator, Next_Program_Unit);
            Space_Line (Sid.Instrumented_File, 1);
            Put (Sid.Instrumented_File,
                 Integer'Image (Program_Unit_Number) & " => ");
            Put (Sid.Instrumented_File, "(Create(""");
            Put (Sid.Instrumented_File, Next_Program_Unit.Unit_Identifier);
            Put (Sid.Instrumented_File, """),");
            Put (Sid.Instrumented_File, Program_Unit_Type'Image
                                           (Next_Program_Unit.Unit_Type));
            Put (Sid.Instrumented_File, ")");
            if Program_Unit_List_Package.More (Program_Unit_List_Iterator) then
                Put (Sid.Instrumented_File, ",");
            end if;
            Program_Unit_Number := Program_Unit_Number + 1;
        end loop;
        Put (Sid.Instrumented_File, "));");
        Space_Line (Sid.Instrumented_File, 1);
    end Create_Unit_Information;

    -------------------------------------------------------------------------

    function Get_Program_Unit return String_Type is

        --|  Effects
        --|
        --|  Returns the program unit for the current unit.  The program unit
        --|  description is returned as a string for printing in the instrumented
        --|  file.  This call is used to add the program unit description to
        --|  put value calls for variable tracing as well as for breakpoints
        --|  and entering/exiting units

    begin
        return Create ("(Create(""" &
                       Value (Current_Compilation_Unit) & """), " &
                       Natural'Image (Current_Program_Unit.Unit_Number) & ", " &
                       Program_Unit_Type'Image
                          (Current_Program_Unit.Unit_Type) &
                       ", " & Sid.Prefix &
                       "Task_Number)");
    end Get_Program_Unit;

end Create_Breakpoint;