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;