|
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: 35900 (0x8c3c)
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 Implementation_Dependencies;
use Implementation_Dependencies;
with Type_Definitions;
use Type_Definitions;
with String_Pkg;
use String_Pkg;
with Write_Log;
use Write_Log;
with Rtm_List_Package;
use Rtm_List_Package;
with Text_Io;
use Text_Io;
with Time_Library_1;
use Time_Library_1;
with File_Manager;
use File_Manager;
with Calendar;
-----------------------------
package body Run_Time_Monitor is
-----------------------------
-- Version : 5.0
-- Author : Mary Koppes Intermetrics, Inc.
-- Initial release : 05/01/85
-- Last modified : 07/18/85
-----------------------------------------------------------------------
-- Variables to be used by the RTM procedures
Task_List : List;
--| To keep track of the tasks of task type which have been entered.
--| This list is used to maintain the Task_Type_Activation_Number,
--| which is incremented each time the task type is "Entered" via
--| Entering_Unit.
Logfile_Open : Boolean := False;
--| To flag whether the logfile has been opened for this execution of RTM
Package_Initialization_In_Progress : Boolean := False;
--| To flag whether a package is running.
Main_Procedure_Entered : Boolean := False;
--| Flags whether main procedure has been entered
First_Task_Entered : Boolean := False;
--| Flags whether a task has been entered.
Logfile_Name : Filename; --| Logfile for this execution
Append_Logfile_Name : Filename; --| Name of the logfile to append to
Append_Logfile : Boolean := False;
--| Flags if the user decided to append. If TRUE then the
--| logfile is given a temp name and then appended to
--| Append_Logfile_Name when the program is finished
--| executing.
Tool_In_Use : Tool_Names; --| The tool being used during this execution
User_Input_Error : exception;
--| Raised when user input is bad, not handled by the RTM so it will
--| propagate back to the instrumented program and cause the program
--| to end.
Test_Identification : Test_Identifier;
Stop_Watch : Calendar.Time;
Accumulated_Overhead : Duration := 0.00;
package Tool_Io is new Enumeration_Io (Tool_Names);
use Tool_Io;
--------------------
procedure Query_User
(
--| Asks the user for the Tool_Name, Logfile_Name, and Test ID
Tool_Name : in out Tool_Names;
--| The tool being used during this execution
Logfile_Name : in out Filename;
--| The name of the log file
Test_Description : out Test_Identifier;
--| User may may enter a brief description of test
Return_Error : out Boolean
--| Flags a User Input Error
) is
--| Algorithm
--| Query_User prompts the user for the Tool he wishes to run. The user must
--| enter a valid toolname or he will continue to be asked for the toolname.
--| Next he is prompted for the logfile name. If no logfile name is entered,
--| the default "Toolname.LOG" is used. Query_User checks for the existence
--| of the logfile and if it does exist, the user is asked whether he wishes
--| to Overwrite the file, Append to the file, or Enter a new filename.
--| Finally, the user is asked to enter a unique test identification, which
--| is an Ada string that describes the test being run. The default is
--| "Toolname Report".
Max_String_Size : constant Natural := 80;
Input_String : String (1 .. Max_String_Size);
--| Variable to hold user input from a Get_Line.
String_Length : Natural := 0;
--| Last char in string (length of string) returned by Get_Line.
Zero_Length : constant Natural := 0;
-- Default Logfile names
Path_Logfile_Name : constant String := "Path.Log";
Autopath_Logfile_Name : constant String := "Autopath.log";
Smart_Logfile_Name : constant String := "Smart.Log";
Profile_Logfile_Name : constant String := "Profile.Log";
Temporary_Logfile_Name : constant String := "MRKZZZ.LOG";
--| Temporary name for logfile if it is to be appended to existing file
-- The following are the defaults for the Test Id
Default_Identification :
constant array (Tool_Names range Path_Tool .. Profile_Tool) of
String (1 .. 30) :=
("Path Analysis Report ", "Automatic Path Analysis Report",
"Self Metric Analysis Report ", "Performance Analysis Report ");
Bad_User_Input : Boolean := True; --| General loop flag
Test_File : File_Type;
type User_File_Options is (E, O, A);
File_Option : User_File_Options;
Enter_New_Name : constant User_File_Options := E;
Overwrite_File : constant User_File_Options := O;
Append_To_File : constant User_File_Options := A;
package Int_Io is new Integer_Io (Integer); -- debug
use Int_Io;
------------------------
function Get_User_Option
--| Get the user's option if the specified logfile exists.
return User_File_Options is
--| Algorithm
--| Get_User_Option is one loop which asks the user whether he wishes
--| to Overwrite an existing logfile, Append to an existing logfile,
--| or Enter a new filename. This option is returned to the caller.
Chosen_Option : User_File_Options;
package Option_Io is new Enumeration_Io (User_File_Options);
use Option_Io;
begin
loop
-- infinite loop until function return
begin
New_Line;
Put_Line ("File already exists!!! Do you wish to:");
Put_Line (" E = Enter a New Filename");
Put_Line (" O = Overwrite existing file");
Put_Line (" A = Append to the existing file");
New_Line;
Put ("Enter Option ===> ");
Get (Chosen_Option);
-- Get_Line to get rid of the carriage return
Get_Line (Input_String, String_Length);
return Chosen_Option;
exception
when Data_Error =>
Put_Line ("Data_Error!! Illegal Option, Try again.");
-- Get_Line to flush the bad input
Get_Line (Input_String, String_Length);
when others =>
raise User_Input_Error;
end;
end loop;
end Get_User_Option;
begin
String_Pkg.Mark; -- For Heap Management
-- First get the Tool_Name, loop until input is correct
while Bad_User_Input loop
begin
New_Line;
New_Line;
Put_Line ("Enter Tool Type : PATH_TOOL, AUTOPATH_TOOL,");
Put_Line (" SMART_TOOL, or PROFILE_TOOL)");
Put ("-----> ");
Get (Tool_Name);
-- Get_Line to flush out the Carriage Return
Get_Line (Input_String, String_Length);
Bad_User_Input := False;
exception
when Data_Error =>
Put_Line (" Data_Error !! Illegal Tool Name, try again");
when others =>
raise User_Input_Error;
end;
end loop;
New_Line;
New_Line;
Bad_User_Input := True;
while Bad_User_Input loop
begin
New_Line;
Put_Line ("Enter Logfile Name, Null for Default");
Put ("-----> ");
Get_Line (Input_String, String_Length);
if String_Length > Zero_Length then
Logfile_Name := Make_Persistent
(Input_String (1 .. String_Length));
else
-- length is zero therefore use the default name
case Tool_Name is
when Path_Tool =>
String_Length := Path_Logfile_Name'Last;
Input_String (1 .. String_Length) :=
Path_Logfile_Name;
Logfile_Name := Make_Persistent (Path_Logfile_Name);
when Autopath_Tool =>
String_Length := Autopath_Logfile_Name'Last;
Input_String (1 .. String_Length) :=
Autopath_Logfile_Name;
Logfile_Name := Make_Persistent
(Autopath_Logfile_Name);
when Smart_Tool =>
String_Length := Smart_Logfile_Name'Last;
Input_String (1 .. String_Length) :=
Smart_Logfile_Name;
Logfile_Name := Make_Persistent
(Smart_Logfile_Name);
when Profile_Tool =>
String_Length := Profile_Logfile_Name'Last;
Input_String (1 .. String_Length) :=
Profile_Logfile_Name;
Logfile_Name := Make_Persistent
(Profile_Logfile_Name);
when others =>
Put_Line
("Logfile_Name Case Statement: User Input Error!!");
raise User_Input_Error;
end case;
end if;
-- Need begin-end block for exception handling
-- must check to see if a logfile with the specified name exists
declare
Temporary_Filename : String (1 .. String_Length) :=
Input_String (1 .. String_Length);
begin
-- Open the file, if Name_Error is raised then the file
-- does not exist, If no exception raised must ask
-- the user what he wishes to do...
Open (Test_File, Out_File, Temporary_Filename);
Close (Test_File);
File_Option := Get_User_Option;
case File_Option is
when Enter_New_Name =>
null; -- do nothing so the loop will work
when Overwrite_File =>
-- Set Bad_User_Input to TRUE to make the loop exit
Bad_User_Input := False;
when Append_To_File =>
Append_Logfile_Name := Logfile_Name;
Logfile_Name := Make_Persistent
(Temporary_Logfile_Name);
Append_Logfile := True;
Bad_User_Input := False;
when others =>
raise User_Input_Error;
end case;
exception
when Name_Error =>
-- File does not exist so it's ok to create it
Bad_User_Input := False;
end;
end;
end loop;
-- Get the Test Identification string from the user.
-- The default will be TOOLNAME & " Report"
Put_Line ("Enter a unique Test Identification, Null for default.");
Get_Line (Input_String, String_Length);
if String_Length > Zero_Length then
Test_Description := Make_Persistent
(Input_String (1 .. String_Length));
else
Test_Description := Make_Persistent
(Default_Identification (Tool_Name));
end if;
String_Pkg.Release; -- Release the Heap space
Return_Error := False; -- was never set by this procedure (?! - jwb)
end Query_User;
--------------------------
procedure Open_The_Logfile --| Opens the log file for output
is
--| Algorithm
--| The Query_User procedure is
--| called to prompt the user for the Toolname, Logfile name and a
--| unique Test Identification string and the logfile is opened.
Query_Error : Boolean := False; --| Flags bad user input
Timing_Method : Time_Library_1.Timing_Type := Raw;
begin
Query_User (Tool_In_Use, Logfile_Name,
Test_Identification, Query_Error);
if Query_Error then
raise User_Input_Error;
end if;
-- The arguments have been decoded, now open the logfile.
Create_Log (Logfile_Name, Timing_Method, Stop_Watch);
Logfile_Open := True;
end Open_The_Logfile;
-------------
task body Rtm is
--| Effects
--| The external interface to the Run Time Monitor has been
--| implemented as a task in order to synchronize calls from
--| the instrumented program and prevent interleaving of
--| output to the log file
use Calendar;
Unit_Identifier : Program_Unit_Unique_Identifier;
Main_Program : Program_Unit_Unique_Identifier;
Ok_To_Terminate : Boolean :=
False; --| Goes TRUE when no more active units
Secs : Duration; --| The length of a delay in seconds
Active_Units : Natural := 0; --| The number of active program units
Entry_Time : Calendar.Time; --| Unit entry time adjusted for ovhd
Exit_Time : Calendar.Time; --| Unit exit time adjusted for ovhd
Unit_Exit_Error : exception;
begin
loop
select
-----------------------
accept
Unit_Information
( --| Defines a compilation unit to the RTM
Compilation_Unit : in Ada_Name;
--| The name of the compilation unit
Breakpoint_Number : in Breakpoint_Number_Range;
--| Total number of break points in the compilation unit
--| assigned by the Source Instrumenter
List_Of_Procedures : in Procedure_List
--| A list of the names of all of the program units in
--| the compilation unit
) do
--| Algorithm
--| If the logfile is not open then the Query_User procedure is
--| called to prompt the user for the Toolname, Logfile name and a
--| unique Test Identification string and the logfile is opened.
--| Define_Compilation_Unit is invoked to define the program unit
--| for the current execution.
-- Stop the clock immediately
Stop_Watch := Clock;
if not Logfile_Open then
Open_The_Logfile;
end if;
-- Write the information to the Logfile
Define_Compilation_Unit
(Compilation_Unit, Breakpoint_Number,
List_Of_Procedures);
-- Calculate the amount of time required to execute the
-- rendezvous and add it to the accumulated tool overhead
Accumulated_Overhead :=
Accumulated_Overhead + (Clock - Stop_Watch);
end Unit_Information;
or
--------------------
accept
Entering_Unit
( --| Logs program unit and start time to ELF
Enclosing_Unit : in String_Type;
--| The name of the compilation unit
Unit_Number : in Program_Unit_Number_Range;
--| The Program Unit Number
Unit_Type : in Program_Unit_Type;
--| The type of unit ( procedure, function task generic or package )
Task_Number : in out Task_Type_Activation_Number_Range
--| A unique number assigned by the Runtime Monitor
) do
--| Algorithm
--| First, the number of active units is incremented by 1.
--| A Unit_Identifier record is formed by joining all input
--| parameters. If Unit_Type = Package or Generic then
--| Package_Initialization_In_Progress is set to TRUE.
--| If Unit_Type = Task, then if the Task_List has not already
--| been created it is created. Unit_Identifier is added to the
--| task list. If Task_List exists, it is checked to see if the
--| Unit_Identifier is contained in the list and if it is in the
--| list, Replace_Value is invoked to increment the
--| Task_Type_Activation_Number. If it is not in the list, it
--| is added. Next, if the main procedure has not been entered
--| and the unit being entered is the main procedure, then the
--| Unit_Identifier is saved and Main_Procedure_Entered is set TRUE.
--| Put_Configuration_Data is invoked to write the Test information
--| to the logfile. Start_Unit is invoked to enter the Unit_Id
--| into the logfile.
-- Stop the clock immediately and calculate the adjusted
-- entry time for this program unit
Stop_Watch := Clock;
Entry_Time := Stop_Watch - Accumulated_Overhead;
Unit_Identifier := (Enclosing_Unit, Unit_Number,
Unit_Type, Task_Number);
Active_Units := Active_Units + 1;
if not Logfile_Open then
Open_The_Logfile;
end if;
case Unit_Type is
when Task_Type =>
-- Must set the Task_Type_Activation_Number. First check to
-- See if the Task_List has been created. If not create it.
if not First_Task_Entered then
Task_List := Create; -- Create the list
First_Task_Entered :=
True; -- Flag that it has been created
Add (Unit_Identifier, Task_List);
elsif Is_In_List (Task_List, Unit_Identifier) then
-- If the Task is already in the list then increment the
-- Task_Activation number to indicate a new copy.
-- This number is passed back to the instrumented code
-- via the IN OUT parm Unit_Identifier.
Replace_Value (Unit_Identifier, Task_List);
-- Set Task_Number to send it back to the caller
Task_Number := Unit_Identifier.
Task_Type_Activation_Number;
else
-- There is not another copy in the list so the
-- activation number = 1;
Add (Unit_Identifier, Task_List);
end if;
when Procedure_Type | Function_Type =>
if not Main_Procedure_Entered and
not Package_Initialization_In_Progress and
Unit_Identifier.Program_Unit_Number = 1 then
-- This must be the main procedure
Main_Procedure_Entered := True;
Main_Program := Unit_Identifier;
-- Write the Configuration data to the log
Put_Configuration_Data
(Tool_In_Use, Unit_Identifier.
Enclosing_Unit_Identifier,
Test_Identification);
end if;
when others =>
Package_Initialization_In_Progress := True;
end case;
-- Record the starting unit in the log file. The starting
-- time must be adjusted for accumulated tool overhead
Start_Unit (Unit_Identifier, Entry_Time);
-- Calculate the amount of time required to execute this
-- rendezvous and add it to the accumulated tool overhead
Accumulated_Overhead :=
Accumulated_Overhead + (Clock - Stop_Watch);
end Entering_Unit;
or
------------------
accept Exiting_Unit
( --| Logs program unit and stop time to ELF
Unit_Identifier : in Program_Unit_Unique_Identifier
--| A unique ID assigned by the Source Instrumenter
) do
--| Algorithm
--| If Package_Initialization_In_Progress := FALSE and
--| Main_Procedure_Entered = TRUE, then the Unit_ID is deleted
--| from Entered_List. If the list is empty, the logfile is closed.
--| If Unit_Type = Package, Package_Initialization_In_Progress is
--| set to FALSE.
-- Stop the clock immediately and calculate the adjusted
-- exit time for this program unit
Stop_Watch := Clock;
Exit_Time := Stop_Watch - Accumulated_Overhead;
Active_Units := Active_Units - 1;
if Unit_Identifier.Unit_Type = Package_Type then
Package_Initialization_In_Progress := False;
end if;
if Main_Procedure_Entered then
-- Do not stop the main procedure until all other
-- units have completed execution
if not Equal (Unit_Identifier, Main_Program) then
-- The main procedure has been entered but this isn't it.
-- It's OK to terminate it.
-- Record the exiting unit in the log file. The exit
-- time must be adjusted for accumulated tool overhead
Stop_Unit (Unit_Identifier, Exit_Time);
end if;
-- When all units have been terminated, stop the main
-- program unit, close the log file, and signal the
-- RTM task that it is OK to terminate execution
if Active_Units = 0 then
-- Record the exiting unit in the log file. The exit
-- time must be adjusted for accumulated tool overhead
Stop_Unit (Main_Program, Exit_Time);
Close_Log (Accumulated_Overhead);
-- If this log file was supposed to be appended to another
-- log file then do so
if Append_Logfile then
Append (Value (Logfile_Name),
Value (Append_Logfile_Name));
end if;
Ok_To_Terminate := True;
end if;
else
-- The main procedure has not been entered yet
-- Record the exiting unit in the log file. The exit
-- time must be adjusted for accumulated tool overhead
Stop_Unit (Unit_Identifier, Exit_Time);
end if;
-- Calculate the amount of time required to execute the
-- rendezvous and add it to the accumulated tool overhead
Accumulated_Overhead :=
Accumulated_Overhead + (Clock - Stop_Watch);
end Exiting_Unit;
or
--------------------
accept Breakpoint_At
( --| Process program breakpoint
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter
Breakpoint_Type : in Breakpoint_Types;
--| The type of breakpoint
Current_Breakpoint : in Breakpoint_Number_Range
--| Breakpoint number assigned by Source Instrumenter
) do
--| Algorithm
--| The Put_Breakpoint procedure is called for all tools except
--| Profile_Tool.
case Tool_In_Use is
when Path_Tool .. Smart_Tool =>
Put_Breakpoint (Breakpoint_Type, Unit_Identifier,
Current_Breakpoint);
when others =>
null;
end case;
end Breakpoint_At;
or
--------------------------
accept Put_Call_Parameters
(--| Log AutoPath input parameter list to ELF
Call_Parameters : in Input_Parameter_List
--| The user specified input parameter list
) do
--| Effects
--| Logs the calling parameter list for a single execution of the
--| unit under test by the AutoPath shell.
--| N/A: Raises, Requires, Modifies, Errors
if Tool_In_Use = Autopath_Tool then
Write_Log.Put_Call_Parameters (Call_Parameters);
end if;
end Put_Call_Parameters;
or
----------------
accept
Put_Value
(--| Logs value of integer variable to the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
Variable_Name : in
String; --| The name of the variable
Integer_Value : in Integer --| The variable's value
) do
--| Effects
--| Logs integer values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| N/A: Raises, Requires, Modifies, Errors
if Tool_In_Use = Smart_Tool then
Write_Log.Put_Value (Unit_Identifier,
Variable_Name, Integer_Value);
end if;
end Put_Value;
or
----------------
accept
Put_Value
(--| Logs value of Long_Integer variable to the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
Variable_Name : in
String; --| The name of the variable
Long_Integer_Value : in
Long_Integer --| The variable's value
) do
--| Effects
--| Logs long_integer values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| N/A: Raises, Requires, Modifies, Errors
if Tool_In_Use = Smart_Tool then
Write_Log.Put_Value (Unit_Identifier, Variable_Name,
Long_Integer_Value);
end if;
end Put_Value;
or
----------------
accept
Put_Value
(--| Logs value of FLOAT variable to the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
Variable_Name : in
String; --| The name of the variable
Float_Value : in Float --| The variable's value
) do
--| Effects
--| Logs floating point values to the execution log file
--| Puts the program unit, variable name, and current value
--| N/A: Raises, Requires, Modifies, Errors
if Tool_In_Use = Smart_Tool then
Write_Log.Put_Value (Unit_Identifier,
Variable_Name, Float_Value);
end if;
end Put_Value;
or
----------------
-- Rational Environment note: Long_Float not supported; following removed -jwb
-- accept Put_Value (--| Logs value of Long_Float variable to the ELF
-- Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
-- Variable_Name : in String; --| The name of the variable
-- Long_Float_Value : in Long_Float --| The variable's value
-- ) do
--| Effects
--| Logs long_float values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| N/A: Raises, Requires, Modifies, Errors
-- if Tool_In_Use = Smart_Tool then
-- Write_Log.Put_Value (Unit_Identifier, Variable_Name,
-- Long_Float_Value);
-- end if;
-- end Put_Value;
-- or
----------------
accept
Put_Value
(--| Logs value of string variable to the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
Variable_Name : in
String; --| The name of the variable
String_Value : in String --| The variable's value
) do
--| Effects
--| Logs string values to the execution log file
--| Puts the program unit, variable name, and current value
--| This procedure used to log the value of
--| strings
--| characters
--| enumerated data types (including booleans)
--| N/A: Raises, Requires, Modifies, Errors
if Tool_In_Use = Smart_Tool then
Write_Log.Put_Value (Unit_Identifier,
Variable_Name, String_Value);
end if;
end Put_Value;
or
------------------
accept
Start_Delay
(--| Records a delay for the specified unit and
--| duration in the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for
--| the current unit
Seconds : in Duration
--| The length of the delay in seconds
) do
--| Effects
--| Records a delay for the specified unit and duration in the
--| Execution Log File. This entry is not called directly by the
--| the instrumented program. It is called by the function
--| Starting_Delay.
--| N/A: Raises, Requires, Modifies, Error
-- Stop the clock immediately
Stop_Watch := Clock;
Secs := Write_Log.Starting_Delay (Unit_Identifier, Seconds);
-- Calculate the amount of time required to execute the
-- rendezvous and add it to the accumulated tool overhead
Accumulated_Overhead :=
Accumulated_Overhead + (Clock - Stop_Watch);
end Start_Delay;
or
when Ok_To_Terminate =>
terminate;
end select;
end loop;
end Rtm;
-----------------------
function Starting_Delay
(--| Records a delay for the specified unit and
--| duration in the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for the current unit
Seconds : in Duration
--| The length of the delay in seconds
)
return Duration is
--| Effects
--| Records a delay for the specified unit and duration in the
--| Execution Log File. The length of the Delay is returned to
--| the calling unit. This unit is implemented as a function
--| to enable trapping of delay times in timed entry statements.
--| N/A: Raises, Requires, Modifies, Errors
begin
if Tool_In_Use = Profile_Tool then
Rtm.Start_Delay (Unit_Identifier, Seconds);
end if;
return Seconds;
end Starting_Delay;
end Run_Time_Monitor;