|
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: 24267 (0x5ecb)
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 Type_Definitions, Implementation_Dependencies,
Time_Library_1, Text_Io, Calendar, String_Pkg;
----------------------
package body Write_Log is
----------------------
--| Overview
--| Write_Log is an output package used by the Run Time Monitor (RTM)
--| for the Ada Testing and Evaluation Tools. It performs all output
--| to the Execution Log File (ELF) that is used to dynamically record
--| information about programs written in the Ada language. The ELF is
--| used for output by the Run Time Monitor (RTM) to record runtime
--| information about the execution of the Ada program being
--| tested. It is used as input by various report generators which
--| summarize the information and present it in a meaningful format.
--| N/A: Errors, Raises, Modifies, Requires
-- Version : 5.0
-- Author : Jeff England
-- Initial Release : 04/09/85
-- Last Modified : 07/18/85
use Type_Definitions; --| Global type declarations for all of
--| the Ada Testing and Analysis Tools.
use Implementation_Dependencies; --| Ada Compiler dependencies
use String_Pkg; --| for String_Types;
use Time_Library_1;
use Text_Io;
package New_Integer_Io is new Integer_Io (Integer);
use New_Integer_Io;
Logfile : Text_Io.File_Type;
Tool_Name : Tool_Names; --| Name of the tool
Timing : Boolean := True; --| Timing option is used by Profile
Logfile_Is_Open : Boolean := False; --| Goes true when logfile is opened
Last_Time : Calendar.Time;
--------------------
procedure Create_Log (--| Creates and opens the ELF for output
Logfile_Name : in
Filename; --| Name of logfile to be created
Timing_Method : in Timing_Type := Raw;
--| The method of recording Timing data
Start_Time : in Calendar.Time --| Program start time
) is
--| Raises: Logfile_Access_Error
--| Effects
--| Creates and opens the ELF for output by the Run Time Monitor.
--| If the logfile already exists it will be overwritten.
--| The date and time of the test are written
--| to the logfile. If the logfile is already open then a
--| Logfile_Access_Error exception is raised. Any other
--| Text_IO exceptions that may be raised are allowed to pass
--| unhandled back to the calling program.
--| Requires
--| Logfile_Name must conform to the file naming conventions for
--| the host computer operating system.
--| N/A: Modifies, Errors
use Time_Library_1;
begin
if Logfile_Is_Open then
raise Logfile_Access_Error;
end if;
Create (Logfile, Out_File, Value (Logfile_Name)); --| Create log file
Logfile_Is_Open := True; --| Open for business
Put (Logfile, Logfile_Keys'Pos (Test_Time), 0); --| Log date and time
case Timing_Method is
when Wall_Clock =>
Put (Logfile, " W ");
when Raw =>
Put (Logfile, " R ");
end case;
Time_Library_1.Set_Timing (Timing_Method);
Put_Time (Logfile, Start_Time);
Last_Time := Start_Time;
New_Line (Logfile);
end Create_Log;
--------------------------------
procedure Put_Configuration_Data
(--| Records configuration info in the ELF
Tool_Name : in Tool_Names; --| Name of the tool
Program_Name : in Ada_Name; --| Program being tested
Test_Ident : in
Test_Identifier --| A unique identifier specified
--| by the user
) is
--| Raises: Logfile_Access_Error
--| Effects
--| Records test configuration information in the logfile. The purpose of
--| recording this information in the logfile is to internally uniquely
--| identify the logfile for later use by the report generators. If the
--| logfile already exists it will be overwritten. If the logfile
--| is already open then the exception Logfile_Access_Error is raised.
--| Any other Text_IO exceptions that may be raised are allowed to
--| pass unhandled back to the calling program.
--| Requires
--| The logfile must have been previously opened via a call to the
--| procedure Create_Log.
--| N/A: Modifies, Errors
use Calendar;
begin
if not Logfile_Is_Open then
raise Logfile_Access_Error;
end if;
Put (Logfile, Logfile_Keys'Pos (Program), 0); --| Log program name
Put (Logfile, " ");
Put_Line (Logfile, Value (Program_Name));
Put (Logfile, Logfile_Keys'Pos (Tool), 0); --| Log tool name
Put (Logfile, " ");
Put_Line (Logfile, Tool_Names'Image (Tool_Name));
Put (Logfile, Logfile_Keys'Pos (Test_Id), 0); --| Log test id
Put (Logfile, " ");
Put_Line (Logfile, Value (Test_Ident));
case Tool_Name is
when Profile_Tool =>
Timing := True;
when others =>
Timing := False;
end case;
end Put_Configuration_Data;
---------------------
procedure Put_Unit_Id
( --| Puts the program unit id to the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier
--| A unique ID assigned by the Source Instrumenter for the current unit
) is
--| Effects
--| This is a local procedure that logs the program unit id to the
--| log file.
--| Requires
--| The log file must have been previously opened via a call
--| to Create_Log. This procedure assumes that the correct
--| logfile key has already been written to the log file.
--| N/A: Raises, Modifies, Errors
begin
Put (Logfile,
" " & Value (Unit_Identifier.Enclosing_Unit_Identifier) & " ");
Put (Logfile, Unit_Identifier.Program_Unit_Number, 0);
case Unit_Identifier.Unit_Type is
when Procedure_Type =>
Put (Logfile, " P ");
when Function_Type =>
Put (Logfile, " F ");
when Task_Type =>
Put (Logfile, " T ");
Put (Logfile, Unit_Identifier.Task_Type_Activation_Number, 0);
Put (Logfile, " ");
when Generic_Type =>
Put (Logfile, " G ");
when Package_Type =>
Put (Logfile, " K ");
when others =>
null;
end case;
end Put_Unit_Id;
---------------------------------
procedure Define_Compilation_Unit
( --| Define a new compilation unit
Compilation_Unit : in
Ada_Name; --| Name of the compilation unit
Number_Of_Breakpoints : in Breakpoint_Number_Range;
--| Number of breakpoints in the compilation unit
List_Of_Procedures : in Procedure_List
--| Array of names and unit types of all program units in compilation unit
) is
--| Raises: Logfile_Access_Error
--| Effects
--| Defines a new Compilation Unit and all of its program units
--| to the execution log file. Subsequent references by the calling
--| program to program units in the current compilation unit will
--| be by a unit ID of type Program_Unit where:
--|
--| Unit_Identifier.Program_Unit_Number = offset into List_of_Procedures
--|
--| If the logfile has not been previously opened via a call to
--| the procedure Create_Log then the exception Logfile_Access_Error
--| is raised.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| N/A: Modifies, Errors
use Calendar;
Unit_Identifier : Program_Unit_Unique_Identifier;
begin
if not Logfile_Is_Open then
raise Logfile_Access_Error;
end if;
Put (Logfile, Logfile_Keys'Pos (Compilation_Unit_Definition), 0);
Put (Logfile, " " & Value (Compilation_Unit) & " ");
Put (Logfile, Number_Of_Breakpoints, 0);
New_Line (Logfile);
for Unit_Number in List_Of_Procedures'Range loop
Put (Logfile, Logfile_Keys'Pos (Program_Unit_Definition), 0);
Unit_Identifier := (Compilation_Unit, Unit_Number,
List_Of_Procedures (Unit_Number).Unit_Type,
0); -- Task_Type_Activation_Number
Put_Unit_Id (Unit_Identifier);
Put_Line (Logfile,
Value (List_Of_Procedures (Unit_Number).Unit_Identifier));
end loop;
end Define_Compilation_Unit;
--------------------
procedure Start_Unit
( --| starts the current unit in the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for the current unit
Start_Time : in out
Calendar.Time --| Program unit start time
) is
--| Effects
--| Puts the program unit and start time to the execution log file.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| N/A: Raises, Modifies, Errors
use Calendar;
begin
if Timing then
if Start_Time < Last_Time then
Start_Time := Last_Time;
else
Last_Time := Start_Time;
end if;
Put (Logfile, Logfile_Keys'Pos (Unit_Start), 0);
Put_Unit_Id (Unit_Identifier);
Put_Time_Of_Day (Logfile, Seconds (Start_Time));
New_Line (Logfile);
else
Put (Logfile, Logfile_Keys'Pos (Unit_Start), 0);
Put_Unit_Id (Unit_Identifier);
New_Line (Logfile);
end if;
end Start_Unit;
-------------------
procedure Stop_Unit
(--| Stops the current unit in the ELF
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for the current unit
Stop_Time : in out Calendar.Time --| Program unit stop time
) is
--| Effects
--| Puts the program unit and stop time to the execution log file.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
use Calendar;
begin
if Timing then
if Stop_Time < Last_Time then
Stop_Time := Last_Time;
else
Last_Time := Stop_Time;
end if;
Put (Logfile, Logfile_Keys'Pos (Unit_Stop), 0);
Put_Unit_Id (Unit_Identifier);
Put_Time_Of_Day (Logfile, Seconds (Stop_Time));
New_Line (Logfile);
else
Put (Logfile, Logfile_Keys'Pos (Unit_Stop), 0);
Put_Unit_Id (Unit_Identifier);
New_Line (Logfile);
end if;
end Stop_Unit;
-----------------------
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
)
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.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
use Calendar;
begin
if Timing then
Put (Logfile, Logfile_Keys'Pos (Delay_Time), 0);
Put_Unit_Id (Unit_Identifier);
Put_Time_Of_Day (Logfile, Seconds);
New_Line (Logfile);
end if;
return Seconds;
end Starting_Delay;
------------------------
procedure Put_Breakpoint
(--| Puts info about the current breakpont to ELF
Breakpoint_Type : in
Breakpoint_Types; --| The type of breakpoint
Unit_Identifier : in Program_Unit_Unique_Identifier;
--| A unique ID assigned by the Source Instrumenter for the current unit
Current_Breakpoint : in Breakpoint_Number_Range
--| The breakpoint number assigned by the Source Instrumenter
) is
--| Effects
--| Puts the program unit, statement type, and current breakpoint
--| number to the execution log file.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
use Calendar;
begin
Put (Logfile, Logfile_Keys'Pos (Breakpoint_Type), 0);
Put_Unit_Id (Unit_Identifier);
Put (Logfile, Current_Breakpoint, 0);
New_Line (Logfile);
end Put_Breakpoint;
-----------------------------
procedure Put_Call_Parameters ( --| Log AutoPath input parameter list to ELF
Call_Parameters : in Input_Parameter_List
--| The user specified input parameter list
) is
--| Effects
--| Logs the calling parameter list for a single execution of the
--| unit under test by the AutoPath shell.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| N/A: Raises, Modifies, Errors
begin
Put (Logfile, Logfile_Keys'Pos (Autopath_Call), 0);
Put_Line (Logfile, " " & Value (Call_Parameters));
end Put_Call_Parameters;
-------------------
procedure 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
) is
--| Effects
--| Logs integer values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
begin
Put (Logfile, Logfile_Keys'Pos (Integer_Variable), 0);
Put_Unit_Id (Unit_Identifier);
Put (Logfile, Variable_Name & " ");
Put (Logfile, Integer_Value, 0);
New_Line (Logfile);
end Put_Value;
-------------------
procedure 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
) is
--| Effects
--| Logs long_integer values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
package New_Long_Integer_Io is new Integer_Io (Long_Integer);
use New_Long_Integer_Io;
begin
New_Integer_Io.Put (Logfile,
Logfile_Keys'Pos (Long_Integer_Variable), 0);
Put_Unit_Id (Unit_Identifier);
Put (Logfile, Variable_Name & " ");
New_Long_Integer_Io.Put (Logfile, Long_Integer_Value, 0);
New_Line (Logfile);
end Put_Value;
-------------------
procedure 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
) is
--| Effects
--| Logs floating point values to the execution log file
--| Puts the program unit, variable name, and current value
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
package New_Float_Io is new Float_Io (Float);
use New_Float_Io;
begin
Put (Logfile, Logfile_Keys'Pos (Float_Variable), 0);
Put_Unit_Id (Unit_Identifier);
Put (Logfile, Variable_Name & " ");
Put (Logfile, Float_Value, 0);
New_Line (Logfile);
end Put_Value;
-------------------
-- Rational Environment note: Long_Float not implemented; following removed -jwb
-- procedure 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
-- ) is
--| Effects
--| Logs long_float values to the execution log file.
--| Puts the program unit, variable name, and current value.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
-- package New_Long_Float_Io is new
-- Float_Io (Long_Float);
-- use New_Long_Float_Io;
-- begin
-- Put (Logfile, Logfile_Keys'Pos (Long_Float_Variable), 0);
-- Put_Unit_Id (Unit_Identifier);
-- Put (Logfile, Variable_Name & " ");
-- Put (Logfile, Long_Float_Value, 0);
-- New_Line (Logfile);
-- end Put_Value;
-------------------
procedure 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
) is
--| 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)
--| If STRING_VALUE contains trailing blanks then the
--| trailing blanks are suppressed and the notation <<N blanks>>
--| is appended, where N is the number of trailing blanks
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| The program unit must have been previously defined to the log file by
--| the calling program via a call to the procedure Define_Compilation_Unit.
--| N/A: Raises, Modifies, Errors
Number_Of_Blanks : Natural := 0;
begin
Put (Logfile, Logfile_Keys'Pos (String_Variable), 0);
Put_Unit_Id (Unit_Identifier);
for I in reverse String_Value'Range loop
if String_Value (I) = ' ' then
Number_Of_Blanks := Number_Of_Blanks + 1;
else
exit;
end if;
end loop;
Put (Logfile, Variable_Name & " ");
if String_Value'Last > Number_Of_Blanks then
Put (Logfile, String_Value
(1 .. String_Value'Last - Number_Of_Blanks));
end if;
case Number_Of_Blanks is
when 0 =>
New_Line (Logfile);
when 1 =>
Put_Line (Logfile, "<<1 blank>>");
when others =>
Put (Logfile, "<<");
Put (Logfile, Number_Of_Blanks, 0);
Put_Line (Logfile, " blanks>>");
end case;
end Put_Value;
-------------------
procedure Close_Log ( --| Closes the execution log file
Accumulated_Overhead : in
Duration --| Total accumulated tool overhead
) is
--| Raises: Logfile_Access_Error
--| Effects
--| Closes the execution log file.
--| If the logfile has not been previously opened via a call to
--| the procedure Create_Log then the exception Logfile_Access_Error
--| is raised.
--| Requires
--| The log file must have been previously opened by the calling
--| program via a call to Create_Log.
--| N/A: Modifies, Errors
use Calendar;
begin
if not Logfile_Is_Open then
raise Logfile_Access_Error;
end if;
if Timing then
Put (Logfile, Logfile_Keys'Pos (Timing_Overhead), 0);
Put (Logfile, ' ');
Put_Time_Of_Day (Logfile, Accumulated_Overhead);
end if;
Close (Logfile);
Logfile_Is_Open := False; --| Logfile is now closed for business
--| Reset Timing to true just in case AutoPath
--| tries to create more than 1 logfile
Timing := True;
end Close_Log;
end Write_Log;