|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 16862 (0x41de)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
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;