--::::::::::
--bgt.pro
--::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
-- Unit name : Benchmark Generator Tool (BGT)
-- Version : 1.0
-- Author : The MITRE Corporation
-- : 7252 Colshire Drive, McLean VA
-- DDN Address :
-- Copyright : (c)
-- Date created : 11/26/88
-- Release date : 11/26/88
-- Last update : 11/26/88
-- Machine/System Compiled/Run on : sun/verdix/unix dec/dec_ada/vms
---------------------------------------------------------------
-- Keywords : ada/benchmarks
-- Abstract :
-- This tool was developed for the Federal Aviation Administration (FAA).
-- to benchmark Ada compilation systems (ACS).
--
-- The BGT is to be used for measuring capacity and performance aspects
-- of the ACS.
--
-- The BGT will allow the generation of an Ada software system
-- that resembles the size and complexity of any Ada software system.
-- Use of the BGT will allow the user to demonstrate functionality
-- and capacities of the proposed systems ACS being examined
-- and to gain an understanding of the compilation system's ability to
-- handle software representative of the scale and complexity
-- of the software system to be developed. The BGT is composed of
-- two sets of tests, Library Capacity tests
-- and Dependency Maintenance Test tests.
--
-- The Library Capacity tests evaluate the number of dependent
-- compilation units that the library management system can accommodate. By
-- generating compilation units that reflect the size and complexity of a
-- given software system, the proposed ACS can be evaluated in terms of its
-- capacity to handle that software system.
--
-- The Dependency Maintenance tests evaluate the correctness and efficiency
-- of the ACS's dependency graph implementation. A key advantage of the
-- Ada library management system is the ability to decompose the software
-- system into manageable compilation units and to modify a compilation unit
-- without having to recompile the entire system. The Dependency
-- Maintenance tests allow the recompilation capabilities of the ACS to be
-- evaluated. By generating compilation units that reflect the size and
-- complexity of a given software system, the proposed ACS can be evaluated in
-- terms of its recompilation capabilities for handling that system.
------------------ Revision history ---------------------------
-- DATE VERSION AUTHOR HISTORY
-- 11/26/88 1.0 MITRE Initial Release to the ASR
------------------ Distribution and Copyright -----------------
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
-- software released to the Public Domain is not subject
-- to copyright protection).
-- Restrictions on use or distribution: NONE
------------------ Disclaimer ---------------------------------
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered. The user is advised to
-- test the software thoroughly before relying on it. The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
-------------------END-PROLOGUE--------------------------------
--::::::::::
--bgt.src
--::::::::::
::::::::::::::
BGTcomp.a
::::::::::::::
ada time_recorder_spec.a
ada time_recorder_body.a
ada menu_control_spec.a
ada user_data_spec.a
ada menu_control_body.a
ada test_generator_control_spec.a
ada statement_generator_spec.a
ada statement_generator_body.a
ada library_capacity_units_spec.a
ada library_capacity_units_body.a
ada dependency_units_spec.a
ada dependency_units_body.a
ada test_generator_control_body.a
ada benchmark_generator_tool.a
a.ld benchmark_generator_tool
::::::::::::::
benchmark_generator_tool.a
::::::::::::::
----------------------------------------------------------------------
-- Benchmark_Generator_Tool 14 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- FAA Benchmark Generator Tool Main Program
--
-- Exceptions Raised and Handled:
-- -----------------------------
-- Menu_Control.Illegal_Menu_Structure - Verify User_Menus
--
-- I/O : Terminal_IO for init parameters
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Menu_Control;
with User_Data;
with Test_Generator_Control;
procedure Benchmark_Generator_Tool is
subtype Menu_Index is Menu_Control.Menu_Index range
Menu_Control.Menu_Index'first .. Menu_Control.Menu_Index'last;
Next_Menu : Menu_Index := Menu_Index(User_Data.Menu_Names'pos(
User_Data.Menu_Names'first));
Value : Natural;
Action : Menu_Control.Object_Function;
begin
Text_IO.Put_Line("****************************************");
Text_IO.Put_Line("* Benchmark Generator Tool *");
Text_IO.Put_Line("****************************************");
Text_IO.New_Line;
-- Verify that User_Data.User_Menus allows one input type per menu
Menu_Control.Verify_Menu_Structure;
loop -- Loop until we get a proper input
Text_IO.Put("Enter Default Ada Source File Extension [1-5 char]: ");
begin
Text_IO.Get_Line(User_Data.File_Extension,
User_Data.File_Extension_Length);
exit;
exception
when others =>
Text_IO.Skip_Line;
Text_IO.Put_Line("### String Input too long, Retry ###");
end;
end loop;
loop -- Loop until we get a proper input
Text_IO.Put(
"Enter Default Filename Prefix for Compilation Units [1-256 char]: ");
begin
Text_IO.Get_Line(User_Data.Filename_Prefix,
User_Data.Filename_Prefix_Length);
exit;
exception
when others =>
Text_IO.Skip_Line;
Text_IO.Put_Line("### String Input too long, Retry ###");
end;
end loop;
--
-- Main Loop of the Tool that accepts User Inputs and processes
-- accordingly.
--
loop
Menu_Control.Get_Input(Next_Menu, Value, Action);
case Action is -- Perform functions based on Object Type
when Menu_Control.Submenu =>
-- Simply go to next menu unless done with the tool
exit when Next_Menu = Menu_Control.Exit_Tool_Signal;
when Menu_Control.Numeric =>
User_Data.User_Data_Array(User_Data.Menu_Names'val(
Menu_Control.Current_Menu)) := Value;
when Menu_Control.Execute =>
Test_Generator_Control.Generate_Compilation_Units(
Menu_Control.Current_Menu);
when Menu_Control.Display =>
Test_Generator_Control.Display_Parameters(
Menu_Control.Current_Menu);
end case;
end loop;
exception
when Menu_Control.Illegal_Menu_Structure =>
Text_IO.Put_Line("### Menus have been illegally defined with " &
"multiple input types per menu ###");
end Benchmark_Generator_Tool;
--
::::::::::::::
dependency_units_body.a
::::::::::::::
----------------------------------------------------------------------
-- Dependency_Units 11 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Generate compilation units for the Benchmark Generator Tool
-- Dependency Maintenance Test.
--
-- Generate_Spec - Based on the structure type and the level
-- number, generate a package spec with the
-- specified statements.
-- Generate_Spec_Body - Based on the structure type and the
-- level number, generate a spec/body pair
-- of compilation units.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : Text_IO to create compilation units
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Statement_Generator;
package body Dependency_Units is
Track_Constant_Name : constant string := "The_Constant";
Unit_Name : constant string (1..1) := "P";
Start_Name : constant string (1..5) := "Start";
Main_Name : constant string (1..4) := "Main";
Separator : constant string (1..1) := "X";
Constant_Value : constant string (1..1) := "1";
procedure Generate_Dependency_Structure (
Structure : in Dependency_Structure_Type;
Level : in Natural;
Position : in Natural;
Total_Levels : in Natural;
File_ID : in Text_IO.File_Type) is
begin
case Structure is
when Successor_Dependent => null;
when Right_Sibling_Dependent =>
If (Position rem 2) = 1 then
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level)(2..Integer'image(Level)'length)
& Separator & Integer'image(Position + 1)
(2..Integer'image(Position + 1)'length) & ";");
end if;
when Left_Cousin_Dependent =>
If (Position rem 2) = 1 then
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level)(2..Integer'image(Level)'length)
& Separator & Integer'image(Position + 1)
(2..Integer'image(Position + 1)'length) & ";");
if Position > 1 then
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level)(2..Integer'image(Level)'length)
& Separator & Integer'image(Position - 1)
(2..Integer'image(Position - 1)'length) & ";");
end if;
end if;
when Grandchild_Dependent =>
If (Position rem 2) = 1 then
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level)(2..Integer'image(Level)'length)
& Separator & Integer'image(Position + 1)
(2..Integer'image(Position + 1)'length) & ";");
if Position > 1 then
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level)(2..Integer'image(Level)'length)
& Separator & Integer'image(Position - 1)
(2..Integer'image(Position - 1)'length) & ";");
end if;
end if;
If Total_Levels >= (Level + 2) then
for I in 0..3 loop
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Level + 2)
(2..Integer'image(Level + 2)'length)
& Separator & Integer'image((Position * 4 ) - I)
(2..Integer'image((Position * 4) - I)'length) & ";");
end loop;
end if;
end case;
end Generate_Dependency_Structure;
----------------------------------------------------------------------
--
-- Generate_Spec
--
-- The File_ID is an open file for the storage of a package
-- specification compilation unit. The Structure and level
-- and position number determine where we are in the dependency
-- tree and what dependencies (withs) need to be included.
--
----------------------------------------------------------------------
procedure Generate_Spec (Structure : in Dependency_Structure_Type;
Level : in Natural; Position : in Natural;
Total_Level : in Natural;
Spec_File_ID : in Text_IO.File_Type) is
begin
if Total_Level = Level then
-- with start
Text_Io.Put_Line (Spec_File_ID, "with " & Start_Name & ";");
else
-- with left and right child
Text_Io.Put_Line (Spec_File_ID, "with " & Unit_Name &
Integer'image(Level + 1) (2..Integer'image
(Level + 1)'length) & Separator &
Integer'image(Position * 2)(2..Integer'image
(Position * 2)'length) & ";");
Text_Io.Put_Line (Spec_File_ID, "with " & Unit_Name &
Integer'image(Level + 1) (2..Integer'image
(Level + 1)'length) & Separator &
Integer'image(Position * 2 - 1)(2..Integer'image
(Position * 2 - 1)'length) & ";");
end if;
Generate_Dependency_Structure (Structure, Level, Position,
Total_Level, Spec_File_Id);
Text_Io.New_Line (Spec_File_ID);
Text_Io.Put_Line (Spec_File_ID, "package " & Unit_Name &
Integer'image(Level) (2..Integer'image(Level)'length) & Separator &
Integer'image(Position)(2..Integer'image(Position)'length) & " is");
Text_Io.New_Line (Spec_File_ID);
-- constant
if Total_Level = Level then
--reference start
Text_Io.Put_Line (Spec_File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Start_Name & '.' &
Track_Constant_Name & ";");
else
--reference left child and right child
Text_Io.Put_Line (Spec_File_ID, " " & Track_Constant_Name &
" : Constant integer := ("
& Unit_Name & Integer'image(Level + 1) (2..Integer'image
(Level + 1)'length) & Separator & Integer'image
(Position * 2 - 1)(2..Integer'image
(Position * 2 - 1)'length) & '.' & Track_Constant_Name &
" + " &
Unit_Name & Integer'image(Level + 1) (2..Integer'image
(Level + 1)'length) & Separator & Integer'image
(Position * 2 )(2..Integer'image
(Position * 2 )'length) & '.' & Track_Constant_Name &
") mod integer'last;");
end if;
Text_Io.New_Line (Spec_File_ID);
Text_Io.Put_Line (Spec_File_ID, "end " & Unit_Name &
Integer'image(Level) (2..Integer'image(Level)'length) & Separator &
Integer'image(Position)(2..Integer'image(Position)'length) & ";");
exception
when others => Text_Io.Put_Line ("###Error When writing to file: "
& Unit_Name & Integer'image(Level)
(2..Integer'image(Level)'length) & Separator &
Integer'image(Position)
(2..Integer'image(Position)'length) & "###");
raise Dependency_Error;
end Generate_Spec;
----------------------------------------------------------------------
--
-- Generate_Spec_Body
--
-- The File_IDs are open files for the storage of a package
-- spec/body compilation units. The Sturcture and level
-- and position number determine where we are in the dependency
-- tree and what dependencies (withs) need to be included.
--
----------------------------------------------------------------------
procedure Generate_Spec_Body (Structure : in Dependency_Structure_Type;
Level : in Natural; Position : in Natural;
Total_Level : in Natural;
Spec_File_ID : in Text_IO.File_Type;
Body_File_ID : in Text_IO.File_Type) is
begin
Generate_Spec(Structure,Level,Position,Total_Level,Spec_File_ID);
Text_Io.Put_Line (Body_File_ID, "package body " & Unit_Name &
Integer'image(Level) (2..Integer'image(Level)'length) & Separator &
Integer'image(Position)(2..Integer'image(Position)'length) & " is");
Text_Io.New_Line (Body_File_ID);
Text_Io.Put_Line(Body_File_ID, " begin");
Text_Io.Put_Line(Body_File_ID, " null;");
Text_Io.Put_Line (Body_File_ID, "end " & Unit_Name &
Integer'image(Level) (2..Integer'image(Level)'length) & Separator &
Integer'image(Position)(2..Integer'image(Position)'length) & ";");
exception
when others => Text_Io.Put_Line ("###Error When writing to file: "
& Unit_Name & Integer'image(Level)
(2..Integer'image(Level)'length) & Separator &
Integer'image(Position)
(2..Integer'image(Position)'length) & "###");
raise Dependency_Error;
end Generate_Spec_Body;
procedure Generate_Start(File_ID : in Text_Io.File_Type) is
begin
Text_Io.Put_Line (File_ID, "with Time_Recorder;");
Text_Io.Put_Line (File_ID, "pragma elaborate (Time_Recorder);");
Text_Io.Put_Line (File_ID, "package " & Start_Name & " is");
Text_Io.Put_Line (File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Constant_Value & ";");
Text_Io.Put_Line (File_ID, "end " & Start_Name & " ;");
end Generate_Start;
procedure Generate_Main_Program( File_ID : in Text_Io.File_Type;
Level : in Natural) is
begin
Text_Io.Put_Line (File_ID, "with Time_Recorder;");
Text_Io.Put_Line (File_ID, "with Text_Io;");
if Level = 0 then
--with start
Text_Io.Put_Line (File_ID, "with " & Start_Name & ";");
else
--with left and right children
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(1)(2..Integer'image (1)'length) & ";");
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(2)(2..Integer'image(2)'length) & ";");
end if;
Text_Io.Put_Line (File_ID, "procedure " & Main_Name & " is");
Text_Io.Put_Line (File_ID, " begin");
Text_Io.Put_Line (File_ID, " Time_Recorder.Stop_Time;");
Text_Io.Put_Line(File_ID, " Time_Recorder.Report_Elapsed_Time;");
-- constant
if Level = 0 then
--reference start
Text_Io.Put_Line (File_ID,
" Text_Io.Put_Line (""The Constant Value is: "" & integer'image("
& Start_Name & "." & Track_Constant_Name & "));");
else
--reference left child and right child
Text_Io.Put_Line (File_ID,
" Text_Io.Put_Line(""The Constant Value is: "" & integer'image(("
& Unit_Name & Integer'image(1) (2..Integer'image (1)'length)
& Separator & Integer'image(1)(2..Integer'image (1)'length)
& "." & Track_Constant_Name & " + " &
Unit_Name & Integer'image(1) (2..Integer'image (1)'length)
& Separator & Integer'image(2)(2..Integer'image (2)'length)
& "." & Track_Constant_Name & ") mod integer'last));");
end if;
Text_Io.Put_Line (File_ID, "end " & Main_Name & " ;");
end Generate_Main_Program;
procedure Generate_Comp_Order(File_ID : in Text_Io.File_Type;
Level : in Natural;
Prefix_Spec : in String; Prefix_Body : in String;
File_Name_Prefix : in String; File_Name_Extension : in String) is
Half_Max : Natural;
begin
--Generate Comp Order
-- Start
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Start_Name & File_Name_Extension);
-- Units starting with lowest level
for Current_Level in reverse 1..Level loop
Half_Max := ((2**Current_Level) / 2);
for Position in 1..Half_Max loop
--right sibling
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Spec & Integer'image(Current_Level)
(2..Integer'image (Current_Level)'length) & Separator &
Integer'image(Position * 2)(2..Integer'image
(Position * 2)'length) & File_Name_Extension);
--body
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Body & Integer'image(Current_Level)
(2..Integer'image (Current_Level)'length) & Separator &
Integer'image(Position * 2)(2..Integer'image
(Position * 2)'length) & File_Name_Extension);
--Left sibling
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Spec & Integer'image(Current_Level)
(2..Integer'image (Current_Level)'length) & Separator &
Integer'image((Position * 2) - 1)(2..Integer'image
((Position * 2) - 1)'length) & File_Name_Extension);
--body
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Body & Integer'image(Current_Level)
(2..Integer'image (Current_Level)'length) & Separator &
Integer'image((Position * 2) - 1)(2..Integer'image
((Position * 2) - 1)'length) & File_Name_Extension);
end loop;
end loop;
-- main
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Main_Name & File_Name_Extension);
end Generate_Comp_Order;
end Dependency_Units;
::::::::::::::
dependency_units_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Dependency_Units 21 Jul 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- Generate compilation units for the Benchmark Generator Tool
-- Dependency Maintenance Test.
--
-- Exceptions Raised and Handled: Dependency_Error
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Statement_Generator;
package Dependency_Units is
Dependency_Error : exception;
type Dependency_Structure_Type is (Successor_Dependent,
Right_Sibling_Dependent, Left_Cousin_Dependent,
Grandchild_Dependent);
procedure Generate_Spec_Body (Structure : in Dependency_Structure_Type;
Level : in Natural; Position : in Natural;
Total_Level : in Natural;
Spec_File_ID : in Text_IO.File_Type;
Body_File_ID : in Text_IO.File_Type);
procedure Generate_Start(File_ID : in Text_Io.File_Type);
procedure Generate_Main_Program( File_ID : in Text_Io.File_Type;
Level : in Natural);
procedure Generate_Comp_Order(File_ID : in Text_Io.File_Type;
Level : in Natural;
Prefix_Spec : in String; Prefix_Body : in String;
File_Name_Prefix : in String; File_Name_Extension : in String);
end Dependency_Units;
::::::::::::::
library_capacity_units_body.a
::::::::::::::
----------------------------------------------------------------------
-- Library_Capacity_Units 11 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Generate compilation units for the Benchmark Generator Tool
-- Library Capacity Test.
--
-- Generate_Specs - Create a compilation unit consisting of a
-- package spec and the requested statements.
-- Generate_Specs_Bodys - Generate two compilation units consisting
-- of a spec/body pair and the requested
-- statements.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : Text_IO to generate Comp. Units
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Statement_Generator;
package body Library_Capacity_Units is
Track_Constant_Name : constant string := "The_Constant";
Unit_Name : constant string (1..1) := "P";
Start_Name : constant string (1..5) := "Start";
Main_Name : constant string (1..4) := "Main";
Assign_Name : constant string (1..6) := "ASSIGN";
Separator : constant string (1..1) := "X";
Constant_Value : constant string(1..1) := "5";
procedure Generate_Spec_Statements(Stmts : in S_Statement_Array;
Current_Level : in Natural;
Current_Position : in Natural;
Total_LC_Units : in Natural;
File_ID : in Text_IO.File_Type) is
begin
--with statement
if Total_LC_Units > (2** (Current_Level + 1) -2) then
-- not bottom level
if Total_LC_Units >= ((2** (Current_Level + 1) -2) +
(2 * Current_Position)) then
-- with right and left child
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Current_Level + 1) (2..Integer'image
(Current_Level + 1)'length) & Separator &
Integer'image(Current_Position * 2)(2..Integer'image
(Current_Position * 2)'length) & ";");
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Current_Level + 1) (2..Integer'image
(Current_Level + 1)'length) & Separator &
Integer'image(Current_Position * 2 - 1)(2..Integer'image
(Current_Position * 2 - 1)'length) & ";");
elsif Total_LC_Units >= ((2** (Current_Level + 1) -2) +
(2 * Current_Position - 1)) then
-- with left child only
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(Current_Level + 1) (2..Integer'image
(Current_Level + 1)'length) & Separator &
Integer'image(Current_Position * 2 - 1)(2..Integer'image
(Current_Position * 2 - 1)'length) & ";");
else
-- with start
Text_Io.Put_Line (File_ID, "with " & Start_Name & ";");
end if;
else
-- with start
Text_Io.Put_Line (File_ID, "with " & Start_Name & ";");
end if;
Text_Io.New_Line (File_ID);
Text_Io.Put_Line (File_ID, "package " & Unit_Name &
Integer'image(Current_Level)(2..Integer'image(Current_Level)'length)
& Separator & Integer'image(Current_Position)
(2..Integer'image (Current_Position )'length) & " is");
Text_Io.New_Line (File_ID);
-- reference constant
if Total_LC_Units > ( 2** (Current_Level + 1) - 2) then
-- not bottom level
if Total_LC_Units >= ((2** (Current_Level + 1) - 2) +
(2 * Current_Position - 1)) then
--reference left child
Text_Io.Put_Line (File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Unit_Name &
Integer'image(Current_Level + 1) (2..Integer'image
(Current_Level + 1)'length) & Separator &
Integer'image (Current_Position * 2 - 1)(2..Integer'image
(Current_Position * 2 - 1)'length) & '.' &
Track_Constant_Name & ";");
else
--reference start
Text_Io.Put_Line (File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Start_Name & '.' &
Track_Constant_Name & ";");
end if;
else
--reference start
Text_Io.Put_Line (File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Start_Name & '.' &
Track_Constant_Name & ";");
end if;
Text_Io.New_Line (File_ID);
for I in 1..Stmts(Enumerated_Stmt) loop
Text_Io.Put_Line (File_ID, Statement_Generator.Create_Statement
(Enumerated_Stmt,Integer'image(I)(2..Integer'image(I)'length)));
end loop;
Text_Io.New_Line (File_ID);
for I in 1..Stmts(Constant_Stmt) loop
Text_Io.Put_Line (File_ID, Statement_Generator.Create_Statement
(Constant_Stmt,Integer'image (I)(2..Integer'image(I)'length)));
end loop;
Text_Io.New_Line (File_ID);
for I in 1..Stmts(Object_Stmt) loop
Text_Io.Put_Line (File_ID, Statement_Generator.Create_Statement
(Object_Stmt, Integer'image (I)(2..Integer'image(I)'length)));
end loop;
Text_Io.New_Line (File_ID);
end Generate_Spec_Statements;
----------------------------------------------------------------------
-- Generate_Spec
--
-- Parameters: Stmts : in S_Statement_Array
--
-- The File_ID represents an open file into which the
-- compilation unit is to be stored.
-- The Stmts array represents an array of values for
-- each legal statement type that needs to be generated
-- for this compilation unit via calls to Statement_Generator.
-- Unit_Num signals where we are in the sequence to determine
-- our unit name and dependency name.
--
----------------------------------------------------------------------
procedure Generate_Spec (Stmts : in S_Statement_Array;
Current_Level : in Natural;
Current_Position : in Natural;
Total_LC_Units : in Natural;
File_ID : in Text_IO.File_Type) is
begin
Generate_Spec_Statements(Stmts,Current_Level, Current_Position,
Total_LC_Units, File_ID);
Text_Io.Put_Line (File_ID, "end " & Unit_Name &
Integer'image(Current_Level)(2..Integer'image(Current_Level)'length)
& Separator & Integer'image(Current_Position)
(2..Integer'image (Current_Position )'length) & ";");
exception
when others => Text_Io.Put_Line ("###Error When writing to file: "
& Unit_Name & Integer'image(Current_Level)
(2..Integer'image(Current_Level)'length) & Separator &
Integer'image(Current_Position) (2..Integer'image
(Current_Position )'length) & ";");
raise Library_Capacity_Error;
end Generate_Spec;
----------------------------------------------------------------------
-- Generate_Spec_Body
--
-- Parameters: Stmts : in SB_Statement_Array
--
-- The File_IDs represents open files into which the
-- compilation units (spec/body) are to be stored.
-- The Stmts array represents an array of values for
-- each legal statement type that needs to be generated
-- for these compilation units via calls to Statement_Generator.
-- Unit_Num signals where we are in the sequence to determine
-- our unit name and dependency name.
--
----------------------------------------------------------------------
procedure Generate_Spec_Body (Stmts : in SB_Statement_Array;
Current_Level : in Natural;
Current_Position : in Natural;
Total_LC_Units : in Natural;
Spec_File_ID : in Text_IO.File_Type;
Body_File_ID : in Text_IO.File_Type) is
Spec_Stmts : S_Statement_Array;
begin
For I in Statement_Generator.Spec_Statement_Type loop
Spec_Stmts(I) := Stmts(I);
end loop;
Generate_Spec_Statements(Spec_Stmts, Current_Level, Current_Position,
Total_LC_Units, Spec_File_ID);
Text_Io.Put_Line (Body_File_ID, "package body " & Unit_Name &
Integer'image(Current_Level)(2..Integer'image(Current_Level)'length)
& Separator & Integer'image(Current_Position)
(2..Integer'image (Current_Position )'length) & " is");
Text_Io.New_Line (Body_File_ID);
for J in 1..Stmts(Assignment_Stmt) loop
Text_Io.Put_Line (Body_File_ID, " " &
Statement_Generator.Create_Statement
(Object_Stmt, Assign_Name &
Integer'image (J)(2..Integer'image(J)'length)));
end loop;
for I in 1..Stmts(Subprogram_Stmt) loop
Text_Io.Put_Line (Spec_File_ID,
Statement_Generator.Create_Statement (Subprogram_Stmt,
Integer'image (I)(2..Integer'image(I)'length) & ";"));
Text_Io.Put_Line (Body_File_ID,
Statement_Generator.Create_Statement (Subprogram_Stmt,
Integer'image (I)(2..Integer'image(I)'length) & " is"));
Text_Io.New_Line (Body_File_ID);
Text_Io.Put_Line (Body_File_ID, " begin");
if Stmts(Assignment_Stmt) > 0 then
for J in 1..Stmts(Assignment_Stmt) loop
Text_Io.Put_Line (Body_File_ID, " " &
Statement_Generator.Create_Statement
(Assignment_Stmt, Assign_Name &
Integer'image (J)(2..Integer'image(J)'length),
Integer'image (J) ));
end loop;
else
Text_Io.Put_Line(Body_File_ID, " null;");
end if;
Text_Io.Put_Line (Body_File_ID, " end;" );
Text_Io.New_Line (Body_File_ID);
end loop;
Text_Io.New_Line (Spec_File_ID);
Text_Io.Put_Line (Spec_File_ID, "end " & Unit_Name &
Integer'image(Current_Level)(2..Integer'image(Current_Level)'length)
& Separator & Integer'image(Current_Position) (2..Integer'image
(Current_Position )'length) & ";");
Text_Io.Put_Line (Body_File_ID, "end " & Unit_Name &
Integer'image(Current_Level)(2..Integer'image(Current_Level)'length)
& Separator & Integer'image(Current_Position)
(2..Integer'image (Current_Position )'length) & ";");
exception
when others => Text_Io.Put_Line ("###Error When writing to file: "
& Unit_Name & Integer'image(Current_Level)
(2..Integer'image(Current_Level)'length) & Separator &
Integer'image(Current_Position) (2..Integer'image
(Current_Position )'length) & ";");
raise Library_Capacity_Error;
end Generate_Spec_Body;
procedure Generate_Start(File_ID : in Text_Io.File_Type) is
begin
Text_Io.Put_Line (File_ID, "with Time_Recorder;");
Text_Io.Put_Line (File_ID, "pragma elaborate (Time_Recorder);");
Text_Io.Put_Line (File_ID, "package " & Start_Name & " is");
Text_Io.Put_Line (File_ID, " " & Track_Constant_Name &
" : Constant integer := " & Constant_Value & ";");
Text_Io.Put_Line (File_ID, "end " & Start_Name & " ;");
end Generate_Start;
procedure Generate_Main_Program( File_ID : in Text_Io.File_Type;
Total_LC_Units : in Natural) is
begin
Text_Io.Put_Line (File_ID, "with Time_Recorder;");
Text_Io.Put_Line (File_ID, "with Text_Io;");
if Total_LC_Units = 0 then
--with start
Text_Io.Put_Line (File_ID, "with " & Start_Name & ";");
elsif Total_LC_Units = 1 then
-- with left child
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(1)(2..Integer'image (1)'length) & ";");
else
--with left and right children
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(1)(2..Integer'image (1)'length) & ";");
Text_Io.Put_Line (File_ID, "with " & Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(2)(2..Integer'image(2)'length) & ";");
end if;
Text_Io.Put_Line (File_ID, "procedure " & Main_Name & " is");
Text_Io.Put_Line (File_ID, " begin");
Text_Io.Put_Line (File_ID, " Time_Recorder.Stop_Time;");
Text_Io.Put_Line(File_ID, " Time_Recorder.Report_Elapsed_Time;");
-- constant
if Total_LC_Units = 0 then
--reference start
Text_Io.Put_Line (File_ID,
" Text_Io.Put_Line (""The Constant Value is: "" & integer'image("
& Start_Name & "." & Track_Constant_Name & "));");
else
--reference left child
Text_Io.Put_Line (File_ID,
" Text_Io.Put_Line(""The Constant Value is: "" & integer'image("
& Unit_Name &
Integer'image(1) (2..Integer'image (1)'length) & Separator &
Integer'image(1)(2..Integer'image (1)'length)
& "." & Track_Constant_Name & "));");
end if;
Text_Io.Put_Line (File_ID, "end " & Main_Name & " ;");
end Generate_Main_Program;
procedure Generate_Comp_Order(File_ID : in Text_Io.File_Type;
Current_Level : in Natural; Current_Position : in Natural;
LC_SB_Number : in Natural;
Prefix_Spec : in String; Prefix_Body : in String;
File_Name_Prefix : in String; File_Name_Extension : in String) is
Total_At_Prev_Level : Natural;
Max_Position : Natural := Current_Position;
begin
--Generate Comp Order
-- Start
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Start_Name & File_Name_Extension);
-- Units starting with lowest level
for Level in reverse 1..Current_Level loop
Total_At_Prev_Level := ((2**Level) - 2);
if Level /= Current_Level then
Max_Position := (2**Level);
end if;
for Position in 1..Max_Position loop
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Spec & Integer'image(Level)
(2..Integer'image (Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length) & File_Name_Extension);
-- check for body
if Total_At_Prev_Level + Position <= LC_SB_Number then
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Prefix_Body & Integer'image(Level)
(2..Integer'image (Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length) & File_Name_Extension);
end if;
end loop;
end loop;
-- main
Text_Io.Put_Line(File_Id, File_Name_Prefix &
Main_Name & File_Name_Extension);
end Generate_Comp_Order;
end Library_Capacity_Units;
::::::::::::::
library_capacity_units_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Library_Capacity_Units 21 Jul 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- Generate compilation units for the Benchmark Generator Tool
-- Library Capacity Test.
--
-- Exceptions Raised and Handled: Library_Capacity_Error
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Statement_Generator;
package Library_Capacity_Units is
Library_Capacity_Error : exception;
enumerated_stmt : constant Statement_Generator.Statement_Type
:= Statement_Generator.enumerated_stmt;
constant_stmt : constant Statement_Generator.Statement_Type
:= Statement_Generator.constant_stmt;
object_stmt : constant Statement_Generator.Statement_Type
:= Statement_Generator.object_stmt;
subprogram_stmt : constant Statement_Generator.Statement_Type
:= Statement_Generator.subprogram_stmt;
assignment_stmt : constant Statement_Generator.Statement_Type
:= Statement_Generator.assignment_stmt;
type S_Statement_Array is array (Statement_Generator.Spec_Statement_Type)
of Natural;
type SB_Statement_Array is array
(Statement_Generator.Spec_Body_Statement_Type) of Natural;
procedure Generate_Spec (Stmts : in S_Statement_Array;
Current_Level : in Natural; Current_Position : in Natural;
Total_LC_Units : in Natural;
File_ID : in Text_IO.File_Type);
procedure Generate_Spec_Body (Stmts : in SB_Statement_Array;
Current_Level : in Natural; Current_Position : in Natural;
Total_LC_Units : in Natural;
Spec_File_ID : in Text_IO.File_Type;
Body_File_ID : in Text_IO.File_Type);
procedure Generate_Start(File_ID : in Text_Io.File_Type);
procedure Generate_Main_Program( File_ID : in Text_Io.File_Type;
Total_LC_Units : in Natural);
procedure Generate_Comp_Order(File_ID : in Text_Io.File_Type;
Current_Level : in Natural; Current_Position : in Natural;
LC_SB_Number : in Natural;
Prefix_Spec : in String; Prefix_Body : in String;
File_Name_Prefix : in String; File_Name_Extension : in String);
end Library_Capacity_Units;
::::::::::::::
menu_control_body.a
::::::::::::::
----------------------------------------------------------------------
-- Menu_Control Package Body 14 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Provides a user friendly menu interface. It obtains the user
-- menu data from User_Data.User_Menus (Menus template).
--
-- Verify_Menu_Structure - Verify that there are no menus with
-- multiple object types.
-- Get_Input - Print a menu, wait for the correct input
-- and return the position and data to the caller.
-- Current_Menu - Return the current menu number
-- Current_Object - Return the current object on the current menu
-- Get_Object_Function - Return the function for the specified
-- menu object
-- Get_Next_Menu - Return the successor menu for the specifed menu.
--
-- Exceptions Raised and Handled:
-- -----------------------------
-- Illegal_Menu_Structure - Flag an illegal menu configuration.
--
-- I/O : Text_IO to the Terminal
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with User_Data;
package body Menu_Control is
--
-- Local Type Declarations
--
-- This type should correspond to the maximum number of objects
type Options is (A, B, C, D, E, F, G, H, I, J);
--
-- Local Data Declarations
--
Current_Menu_Index : Menu_Index := 1;
Current_Menu_Object : Object_Index := 1;
--
-- Local Functions
--
package Int_IO is new Text_IO.Integer_IO(Natural);
package Enum_IO is new Text_IO.Enumeration_IO(Options);
function Minimum_String(Inp_Str : in string) return string is
Index : integer := 0;
begin
for I in reverse 1 .. Inp_Str'length loop
if Inp_Str(I) /= ' ' then
Index := I;
exit;
end if;
end loop;
return Inp_Str(1 .. Index);
end Minimum_String;
--
-- Subprogram Descriptions
--
procedure Verify_Menu_Structure is
Num_Of_Objects : Object_Index;
Go_To_Menu_Flag : Boolean;
Get_Numeric_Flag : Boolean;
begin
-- Verify the proper structure of every menu
for Menu in Main_Menu_Index .. User_Data.Menu_Names'pos(
User_Data.Menu_Names'last) loop
Num_Of_Objects := User_Data.User_Menus(Menu).Num_Objects;
Go_To_Menu_Flag := False;
Get_Numeric_Flag := False;
for I in 1 .. Num_Of_Objects loop -- Find out what we have
case User_Data.User_Menus(Menu).Item(I).Object_Type is
when Submenu | Execute | Display =>
Go_To_Menu_Flag := True;
when Numeric =>
Get_Numeric_Flag := True;
end case;
end loop;
if Go_To_Menu_Flag and Get_Numeric_Flag then -- Can't have 2 inputs
raise Illegal_Menu_Structure;
end if;
end loop;
end Verify_Menu_Structure;
procedure Get_Input(Menu : in out Menu_Index;
Value : out Natural; Action : out Object_Function) is
Num_Of_Objects : Object_Index := User_Data.User_Menus(Menu).Num_Objects;
Go_To_Menu_Flag : Boolean := False;
Get_Numeric_Flag : Boolean := False;
Inp_Value : Natural := 0;
Inp_Option : Options := Options'last;
begin
if User_Data.User_Menus(Menu).Item(1).Object_Type = Numeric then
Get_Numeric_Flag := True;
else
Go_To_Menu_Flag := True;
end if;
Current_Menu_Index := Menu; -- Keep Track of current Menu
--
-- One Menu Object; Numeric Input
--
if (Num_Of_Objects = 1) and (Get_Numeric_Flag) then
Text_IO.New_Line;
Text_IO.Put_Line("********** " &
Minimum_String(User_Data.User_Menus(Menu).Label) &
" **********");
Text_IO.New_Line;
loop
begin
Text_IO.Put(Minimum_String(
User_Data.User_Menus(Menu).Item(1).Label) & ": ");
Int_IO.Get(Inp_Value);
if Inp_Value <= User_Data.Max_Values(
User_Data.Menu_Names'val(Menu)) then
Value := Inp_Value;
exit; -- We exit the loop when accept a legal value
else
raise constraint_error;
end if;
exception
when others =>
Text_IO.Skip_Line;
Text_IO.Put_Line("### Numeric Input Error, " &
"Enter an integer value between 0 .. " &
Integer'image(User_Data.Max_Values(
User_Data.Menu_Names'val(Menu))) & " ###");
end;
end loop;
Menu := User_Data.User_Menus(Menu).Next;
Action := Numeric;
Current_Menu_Object := 1;
--
-- Multiple Menu Objects; Numeric Input
--
elsif (Num_Of_Objects > 1) and (Get_Numeric_Flag) then
Text_IO.New_Line;
Text_IO.Put_Line("********** " &
Minimum_String(User_Data.User_Menus(Menu).Label) &
" **********");
Text_IO.New_Line;
for I in 1 .. Num_Of_Objects loop
Text_IO.Put_Line(Integer'image(I) & " - " &
Minimum_String(User_Data.User_Menus(Menu).Item(I).Label));
end loop;
Text_IO.New_Line;
loop
begin
Text_IO.Put(" Enter Choice: ");
Int_IO.Get(Inp_Value);
if (Inp_Value > 0) and (Inp_Value <= Num_Of_Objects) then
Value := Inp_Value;
exit; -- We exit the loop when accept a legal value
else
raise constraint_error;
end if;
exception
when others =>
Text_IO.Skip_Line;
Text_IO.Put_Line("### Numeric Input Error, " &
"Enter a integer value between 1 .. " &
Integer'image(Num_Of_Objects) & " ###");
end;
end loop;
Menu := User_Data.User_Menus(Menu).Next;
Action := Numeric;
Current_Menu_Object := Inp_Value;
--
-- Multiple Menu Objects; Submenu/Execute/Display Options
--
elsif (Num_Of_Objects > 1) and (Go_To_Menu_Flag) then
Text_IO.New_Line;
Text_IO.Put_Line("********** " &
Minimum_String(User_Data.User_Menus(Menu).Label) &
" **********");
Text_IO.New_Line;
for I in Options'pos(Options'first) ..
Options'pos(Options'first) + Num_Of_Objects - 1 loop
Text_IO.Put_Line(Options'image(Options'val(I)) & " - " &
Minimum_String(User_Data.User_Menus(Menu).Item(I+1).Label));
end loop;
Text_IO.New_Line;
loop
begin
Text_IO.Put(" Enter Option: ");
Enum_IO.Get(Inp_Option);
if (Inp_Option >= Options'first) and
(Inp_Option <= Options'val(Options'pos(
Options'first) + Num_Of_Objects - 1)) then
exit; -- We exit the loop when accept a legal option
else
raise constraint_error;
end if;
exception
when others =>
Text_IO.Skip_Line;
Text_IO.Put_Line("### Option Input Error, " &
"Select one of the listed options ###");
end;
end loop;
Value := Options'pos(Inp_Option) + 1;
Action := User_Data.User_Menus(Menu).
Item(Options'pos(Inp_Option)+1).Object_Type;
Menu := User_Data.User_Menus(Menu).
Item(Options'pos(Inp_Option)+1).Next_Menu;
Current_Menu_Object := Options'pos(Inp_Option) + 1;
--
-- One Menu Object; Submenu/Execute/Display Option
--
else
Text_IO.New_Line;
Text_IO.Put_Line("********** " &
Minimum_String(User_Data.User_Menus(Menu).Label) &
" **********");
Text_IO.New_Line;
Text_IO.Put(Minimum_String(
User_Data.User_Menus(Menu).Item(1).Label));
Text_IO.New_Line;
Menu := User_Data.User_Menus(Menu).Item(1).Next_Menu;
Value := 1;
Action := User_Data.User_Menus(Menu).Item(1).Object_Type;
Current_Menu_Object := 1;
end if;
end Get_Input;
function Current_Menu return Menu_Index is
begin
return Current_Menu_Index;
end Current_Menu;
function Current_Object return Object_Index is
begin
return Current_Menu_Object;
end Current_Object;
function Get_Object_Function (Menu : in Menu_Index;
Object : in Object_Index) return Object_Function is
begin
return User_Data.User_Menus(Menu).Item(Object).Object_Type;
end Get_Object_Function;
function Get_Next_Menu (Menu : in Menu_Index) return Menu_Index is
begin
return User_Data.User_Menus(Menu).Next;
end Get_Next_Menu;
end Menu_Control;
::::::::::::::
menu_control_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Menu_Control Package 14 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- Provide a user-friendly menu interface. The user generates
-- his menu templates in the package User_Data.
--
-- Exceptions Raised and Handled:
-- -----------------------------
-- Illegal_Menu_Structure - flag an illegal menu configuration.
--
-- I/O : Text_IO to the Terminal
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
package Menu_Control is
-- Maximum Number of Menus allowed in the BGT
-- (Limit to number of menus needed in User_Data)
Max_Num_Menus : constant integer := 19;
-- Maximum Number of Objects allowed on a Menu
-- (Limited by how much will fit on users terminal screen)
Max_Num_Objects : constant integer := 10;
-- Maximum Length of a Label string
-- (Limited by how many columns fit on users terminal screen)
Max_Size_Label : constant integer := 60;
-- Special Menu Index to flag an exit from the BGT
-- (Usually Menu_Names will start with 0; so use -1)
Exit_Tool_Signal : constant integer := -1;
-- Menu Index assigned to the first or Main Menu
-- (Usually Menu_Names will start with 0)
Main_Menu_Index : constant integer := 0;
--
-- Menu and Menu Object Data Structures
--
subtype Menu_Index is integer range -1 .. Max_Num_Menus;
subtype Object_Index is integer range 1 .. Max_Num_Objects;
type Object_Function is (Submenu, Numeric, Execute, Display);
type Object (Object_Type : Object_Function := Numeric) is record
Label : string(1 .. Max_Size_Label);
case Object_Type is
when Numeric =>
null;
when Submenu | Execute | Display =>
Next_Menu : Menu_Index;
end case;
end record;
type Objects is array (Object_Index range <>) of Object;
type Menu (Num_Objects : Object_Index := 1) is record
Label : string(1 .. Max_Size_Label);
Next : Menu_Index;
Item : Objects(1 .. Num_Objects);
end record;
type Menus is array (Menu_Index range <>) of Menu;
--
-- Menu and Menu Object Functionality
--
procedure Verify_Menu_Structure;
procedure Get_Input(
Menu : in out Menu_Index; -- Menu Index of Menu to display
Value : out Natural; -- Return the input value for Menu
Action : out Object_Function); -- Return Action requested for Menu
function Current_Menu return Menu_Index;
function Current_Object return Object_Index;
function Get_Object_Function (
Menu : in Menu_Index; -- Menu Index of Menu to search
Object : in Object_Index) -- Object on Menu to search
return Object_Function; -- Return Function (Action) of Object
function Get_Next_Menu (
Menu : in Menu_Index) -- Menu Index of Menu to search
return Menu_Index; -- Next menu index of Menu
Illegal_Menu_Structure : exception; -- Returned by Verify_Menu_Structure
-- if multiple menu object types
-- allowed on a single menu
end Menu_Control;
::::::::::::::
statement_generator_body.a
::::::::::::::
----------------------------------------------------------------------
-- Statement_Generator 11 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Generate all Ada statement types for Benchmark Generator Tool.
--
-- Create_Statement - Create a statement string of the given type.
-- Track_Constant - Create a string for a special constant to
-- be used in all compilation units to verify
-- changes.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
package body Statement_Generator is
Constant_Value : constant string (1..2) := "15";
Enumeration_Name : constant string := "ENUMER";
Constant_Name : constant string := "CNSTNT";
Object_Name : constant string := "OBJECT";
Subprogram_Name : constant string := "SUBPRG";
----------------------------------------------------------------------
--
-- Create_Statement
--
-- Based on the statement type, generate the appropriate
-- statement string using the given type/object name.
-- Return the statement string;
--
----------------------------------------------------------------------
function Create_Statement (Stmt_Type : in Statement_Type;
Name : in String;
Value : in String := "") return String is
begin
case Stmt_Type is
when Enumerated_Stmt =>
return (" type " & Enumeration_Name & Name & " is (TBD);");
when Constant_Stmt =>
return ( " " & Constant_Name & Name &
" : constant integer := " & Constant_Value & ";");
when Object_Stmt =>
return ( " " & Object_Name & Name & " : integer;");
when Subprogram_Stmt =>
return ( " procedure " & Subprogram_Name & Name);
when Assignment_Stmt =>
return ( " " & Object_Name & Name & " := " & Value & ";");
end case;
end Create_Statement;
end Statement_Generator;
::::::::::::::
statement_generator_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Statement_Generator 21 Jul 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- Generate all Ada statement types for Benchmark Generator Tool.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
package Statement_Generator is
type Statement_Type is (enumerated_stmt, constant_stmt, object_stmt,
subprogram_stmt, assignment_stmt);
subtype Spec_Statement_Type is Statement_Type
range enumerated_stmt .. object_stmt;
subtype Spec_Body_Statement_Type is Statement_Type
range enumerated_stmt .. assignment_stmt;
function Create_Statement (Stmt_Type : in Statement_Type;
Name : in String;
Value : in String := "") return String;
end Statement_Generator;
::::::::::::::
test_generator_control_body.a
::::::::::::::
----------------------------------------------------------------------
-- Test_Generator_Control Package 11 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- This is the "smart" routine of the Benchmark Generator Tool that
-- controls the generation of the requested compilation units
--
-- Generate_Compilation_Units - Generate the requested source files
-- with the requested dependencies.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : Text_IO to build source files
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with User_Data;
with Library_Capacity_Units;
with Dependency_Units;
package body Test_Generator_Control is
procedure Display_Parameters(Menu : in Menu_Control.Menu_Index) is
function "="(X, Y : User_Data.Menu_Names) return Boolean renames
User_Data."=";
begin
--
-- Library Capacity Test Generation
--
case Menu is
when User_Data.Menu_Names'Pos(User_Data.Library_Capacity) =>
-- Display the Parameters for this test type
Text_IO.New_Line;
Text_IO.Put_Line("----- Library Capacity Test Parameters -----");
Text_IO.Put_Line(" Number of Package Specifications =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_Package_Specs)));
Text_IO.Put_Line(" Number of Enumerated Type Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PS_Stmts_Enumerate)));
Text_IO.Put_Line(" Number of Constant Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PS_Stmts_Constant)));
Text_IO.Put_Line(" Number of Object Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PS_Stmts_Object)));
Text_IO.Put_Line(" Number of Package Specification/Body Pairs =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_Package_Specs_Bodys)));
Text_IO.Put_Line(" Number of Enumerated Type Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PSB_Stmts_Enumerate)));
Text_IO.Put_Line(" Number of Constant Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PSB_Stmts_Constant)));
Text_IO.Put_Line(" Number of Object Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PSB_Stmts_Object)));
Text_IO.Put_Line(" Number of Subprogram Declarations =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PSB_Stmts_Subprgm)));
Text_IO.Put_Line(" Number of Assignments =" &
Natural'image(User_Data.User_Data_Array(
User_Data.LC_PSB_Stmts_Assigns)));
Text_IO.New_Line;
--
-- Dependency Maintenance Test Generation
--
when User_Data.Menu_Names'Pos(User_Data.Dependency_Maintenance) =>
Text_IO.New_Line;
Text_IO.Put_Line("--- Dependency Maintenance Test Parameters ---");
Text_IO.Put_Line(" Number of Dependency Structure Levels =" &
Natural'image(User_Data.User_Data_Array( User_Data.DM_Level)));
Text_IO.Put_Line(" Dependency Structure Code =" &
Natural'image(User_Data.User_Data_Array(
User_Data.DM_Structure)));
Text_IO.New_Line;
--
-- Undefined Tests
--
when others =>
Text_IO.Put_Line("### Unrecognized Test Type - " &
Menu_Control.Menu_Index'image(Menu) & " ###");
end case;
end Display_Parameters;
----------------------------------------------------------------------
--
-- Generate_Compilation_Units
--
-- Based on the Menu index, we know via User_Data.Menu_Names which
-- BGT test we are generating.
-- By using User_Data.Menu_Names as an index into
-- User_Data.User_Data_Array, we can extract the number of compilation
-- units and number of statements of each type to be generated.
-- This routine then proceeds to create each file and call
-- Library_Capacity_Units or Dependency_Units routines to fill
-- in the files.
--
----------------------------------------------------------------------
procedure Generate_Compilation_Units(Menu : in Menu_Control.Menu_Index) is
Test_Generator_Control_Error : Exception;
S_Stmt_Array : Library_Capacity_Units.S_Statement_Array;
SB_Stmt_Array : Library_Capacity_Units.SB_Statement_Array;
LC_Spec_Number : Natural;
LC_SB_Number : Natural;
Total_LC_Units : Natural;
Spec_Phyl : Text_Io.File_Type;
Body_Phyl : Text_Io.File_Type;
Comp_Phyl : Text_Io.File_Type;
Main_Phyl : Text_Io.File_Type;
Start_Phyl : Text_Io.File_Type;
Comp_Phyl_Name : constant string := "Comp";
Main_Phyl_Name : constant string := "Main";
Start_Phyl_Name : constant string := "Start";
File_Name_Extension : string (1..User_Data.File_Extension_Length) :=
User_Data.File_Extension
(1..User_Data.File_Extension_Length);
File_Name_Prefix : string (1..User_Data.Filename_Prefix_Length) :=
User_Data.Filename_Prefix
(1..User_Data.Filename_Prefix_Length);
Dependency_Structure : Dependency_Units.Dependency_Structure_Type;
Dependency_Level : Natural;
Max_Units_At_Level : Natural;
Current_Level : Natural := 0;
Current_Position : Natural := 0;
Current_Number_Of_Units : Natural := 0;
LC_Prefix_Spec : constant string := "LCS";
LC_Prefix_Body : constant string := "LCB";
DM_Prefix_Spec : constant string := "DMS";
DM_Prefix_Body : constant string := "DMB";
Separator : constant string := "X";
begin
Display_Parameters(Menu);
case Menu is
when User_Data.Menu_Names'Pos(User_Data.Library_Capacity) =>
LC_Spec_Number :=
User_Data.User_Data_Array (User_Data.LC_Package_Specs);
LC_SB_Number :=
User_Data.User_Data_Array (User_Data.LC_Package_Specs_Bodys);
Total_LC_Units := LC_Spec_Number + LC_SB_Number;
if Total_LC_Units > 0 then
Current_Level := 1;
end if;
-- Generate Specs and bodies first
if LC_SB_Number > 0 then
SB_Stmt_Array(Library_Capacity_Units.Enumerated_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PSB_Stmts_Enumerate);
SB_Stmt_Array(Library_Capacity_Units.Constant_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PSB_Stmts_Constant);
SB_Stmt_Array(Library_Capacity_Units.Object_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PSB_Stmts_Object);
SB_Stmt_Array(Library_Capacity_Units.Subprogram_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PSB_Stmts_Subprgm);
SB_Stmt_Array(Library_Capacity_Units.Assignment_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PSB_Stmts_Assigns);
-- Spec Body Pairs at top of tree
-- Handle a Complete level of Spec Body Pairs
Max_Units_At_Level := 2** Current_Level;
While (Current_Number_Of_Units + Max_Units_At_Level)
<= LC_SB_Number loop
For Position in 1..Max_Units_At_Level loop
begin
Text_Io.Create(File => Spec_Phyl, Name =>
( File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length)
& File_Name_Extension));
Text_Io.Create(File =>Body_Phyl,Name =>
( File_Name_Prefix & LC_Prefix_Body &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length)
& File_Name_Extension));
Library_Capacity_Units.Generate_Spec_Body
(SB_Stmt_Array, Current_Level, Position,
Total_LC_Units, Spec_Phyl,Body_Phyl);
Text_Io.Close(Spec_Phyl);
Text_Io.Close(Body_Phyl);
exception
when
Library_Capacity_Units.Library_Capacity_Error =>
raise Test_Generator_Control_Error;
when others => Text_Io.Put_Line
("### Error When accessing file: " &
File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Position)
(2..Integer'image(Position)'length)
& File_Name_Extension & " or " &
File_Name_Prefix & LC_Prefix_Body &
Integer'image(Current_Level)
(2..Integer'image(Current_Level)'length)
& Separator &
Integer'image(Position)
(2..Integer'image (Position)'length)
& File_Name_Extension & " ###");
raise Test_Generator_Control_Error;
end;
end loop;
Current_Number_Of_Units :=
Current_Number_Of_Units + Max_Units_At_Level;
Current_Level := Current_Level + 1;
Max_Units_At_Level := 2** Current_Level;
end loop;
-- Current Level is the value of the next level and
-- Current Position is 0.
-- Handle an Incomplete level of Spec Body Pairs
While Current_Number_Of_Units < LC_SB_Number loop
begin
-- prepare for new unit
Current_Position := Current_Position + 1;
Text_Io.Create(File => Spec_Phyl, Name =>
( File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension));
Text_Io.Create(File =>Body_Phyl,Name =>
( File_Name_Prefix & LC_Prefix_Body &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension));
Library_Capacity_Units.Generate_Spec_Body
(SB_Stmt_Array, Current_Level, Current_Position,
Total_LC_Units, Spec_Phyl,Body_Phyl);
Text_Io.Close(Spec_Phyl);
Text_Io.Close(Body_Phyl);
exception
when
Library_Capacity_Units.Library_Capacity_Error =>
raise Test_Generator_Control_Error;
when others => Text_Io.Put_Line
("### Error When accessing file: " &
File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension & " or " &
File_Name_Prefix & LC_Prefix_Body &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension & " ###");
raise Test_Generator_Control_Error;
end;
Current_Number_Of_Units := Current_Number_Of_Units + 1;
end loop;
end if;
if LC_Spec_Number > 0 then
S_Stmt_Array(Library_Capacity_Units.Enumerated_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PS_Stmts_Enumerate);
S_Stmt_Array(Library_Capacity_Units.Constant_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PS_Stmts_Constant);
S_Stmt_Array(Library_Capacity_Units.Object_Stmt) :=
User_Data.User_Data_Array
(User_Data.LC_PS_Stmts_Object);
-- Specs are at the bottom of tree
-- Handle a Complete Level of Specs (Current Level may
-- contain spec body pairs)
Max_Units_At_Level := 2** Current_Level;
While Current_Number_Of_Units +
(Max_Units_At_Level - Current_Position)
<= Total_LC_Units loop
-- prepare for new unit
Current_Position := Current_Position + 1;
For Position in Current_Position..Max_Units_At_Level
loop
begin
Text_Io.Create(File => Spec_Phyl, Name =>
( File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length)
& File_Name_Extension));
Library_Capacity_Units.Generate_Spec
(S_Stmt_Array,Current_Level, Position,
Total_LC_Units, Spec_Phyl);
Text_Io.Close(Spec_Phyl);
exception
when
Library_Capacity_Units.Library_Capacity_Error =>
raise Test_Generator_Control_Error;
when others => Text_Io.Put_Line
("### Error When accessing file: " &
File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Position)(2..Integer'image
(Position)'length)
& File_Name_Extension & " ###");
raise Test_Generator_Control_Error;
end;
end loop;
-- Allow for a partially complete level at start of
-- loop and subtract increment from start of loop
Current_Number_Of_Units := Current_Number_Of_Units +
(Max_Units_At_Level - (Current_Position - 1));
Current_Level := Current_Level + 1;
Max_Units_At_Level := 2** Current_Level;
Current_Position := 0;
end loop;
-- Current Level is the value of new level and
-- current position is zero.
-- Handle an Incomplete final level of specs
While Current_Number_Of_Units < Total_LC_Units loop
begin
-- prepare for new unit
Current_Position := Current_Position + 1;
Text_Io.Create(File => Spec_Phyl, Name =>
( File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension));
Library_Capacity_Units.Generate_Spec
(S_Stmt_Array,Current_Level, Current_Position,
Total_LC_Units, Spec_Phyl);
Text_Io.Close(Spec_Phyl);
exception
when Library_Capacity_Units.Library_Capacity_Error =>
raise Test_Generator_Control_Error;
when others => Text_Io.Put_Line
("### Error When accessing file: " &
File_Name_Prefix & LC_Prefix_Spec &
Integer'image(Current_Level)(2..Integer'image
(Current_Level)'length) & Separator &
Integer'image(Current_Position)(2..Integer'image
(Current_Position)'length)
& File_Name_Extension & " ###");
raise Test_Generator_Control_Error;
end;
Current_Number_Of_Units := Current_Number_Of_Units + 1;
end loop;
end if;
begin
Text_Io.Create(File => Comp_Phyl, Name => (File_Name_Prefix &
Comp_Phyl_Name & File_Name_Extension));
Text_Io.Create(File => Main_Phyl, Name => (File_Name_Prefix &
Main_Phyl_Name & File_Name_Extension));
Text_Io.Create(File => Start_Phyl, Name => (File_Name_Prefix &
Start_Phyl_Name & File_Name_Extension));
Library_Capacity_Units.Generate_Main_Program (Main_Phyl,
Total_LC_Units);
Library_Capacity_Units.Generate_Start(Start_Phyl);
Library_Capacity_Units.Generate_Comp_Order(Comp_Phyl,
Current_Level, Current_Position, LC_SB_Number,
LC_Prefix_Spec, LC_Prefix_Body,
File_Name_Prefix, File_Name_Extension);
Text_Io.Close(Comp_Phyl);
Text_Io.Close(Main_Phyl);
Text_Io.Close(Start_Phyl);
exception
when others => Text_Io.Put_Line
("### Error When accessing file: "
& File_Name_Prefix & Comp_Phyl_Name &
File_Name_Extension & " or "
& File_Name_Prefix & Main_Phyl_Name &
File_Name_Extension & " or "
& File_Name_Prefix & Start_Phyl_Name &
File_Name_Extension & " ###");
end;
when User_Data.Menu_Names'Pos(User_Data.Dependency_Maintenance) =>
if User_Data.User_Data_Array (User_Data.DM_Structure) > 0 then
Dependency_Structure :=
Dependency_Units.Dependency_Structure_Type'Val(
User_Data.User_Data_Array (User_Data.DM_Structure) - 1);
else
Dependency_Structure :=
Dependency_Units.Dependency_Structure_Type'Val(
User_Data.User_Data_Array (User_Data.DM_Structure));
end if;
Dependency_Level := User_Data.User_Data_Array
(User_Data.DM_Level);
For Cur_Level in 1 .. (Dependency_Level) loop
Max_Units_At_Level := 2 ** Cur_Level ;
For Current_Unit in 1 .. Max_Units_At_Level loop
begin
Text_Io.Create(File =>Spec_Phyl,Name =>
(File_Name_Prefix & DM_Prefix_Spec &
Integer'image(Cur_Level)
(2..Integer'image(Cur_Level)'length) & 'X' &
Integer'image(Current_Unit)(2..Integer'image
(Current_Unit)'length) & File_Name_Extension));
Text_Io.Create(File =>Body_Phyl,Name =>
(File_Name_Prefix & DM_Prefix_Body &
Integer'image(Cur_Level)
(2..Integer'image(Cur_Level)'length) & 'X' &
Integer'image(Current_Unit)(2..Integer'image
(Current_Unit)'length) & File_Name_Extension));
Dependency_Units.Generate_Spec_Body(
Dependency_Structure,
Cur_Level,
Current_Unit,
Dependency_Level,
Spec_Phyl,
Body_Phyl);
Text_Io.Close(Spec_Phyl);
Text_Io.Close(Body_Phyl);
exception
when Dependency_Units.Dependency_Error =>
raise Test_Generator_Control_Error;
when others => Text_Io.Put_Line
("### Error When accessing file: " &
File_Name_Prefix & DM_Prefix_Spec &
Integer'image(Cur_Level)
(2..Integer'image(Cur_Level)'length) & 'X' &
Integer'image(Current_Unit)(2..Integer'image
(Current_Unit)'length) & File_Name_Extension
& " or " &
File_Name_Prefix & DM_Prefix_Body &
Integer'image(Cur_Level)
(2..Integer'image(Cur_Level)'length) & 'X' &
Integer'image(Current_Unit)(2..Integer'image
(Current_Unit)'length) & File_Name_Extension
& " ###");
raise Test_Generator_Control_Error;
end;
end loop;
end loop;
begin
Text_Io.Create(File => Comp_Phyl, Name => (File_Name_Prefix &
Comp_Phyl_Name & File_Name_Extension));
Text_Io.Create(File => Main_Phyl, Name => (File_Name_Prefix &
Main_Phyl_Name & File_Name_Extension));
Text_Io.Create(File => Start_Phyl, Name => (File_Name_Prefix &
Start_Phyl_Name & File_Name_Extension));
Dependency_Units.Generate_Main_Program (Main_Phyl,
Dependency_Level);
Dependency_Units.Generate_Start (Start_Phyl);
Dependency_Units.Generate_Comp_Order (Comp_Phyl,
Dependency_Level,
DM_Prefix_Spec, DM_Prefix_Body,
File_Name_Prefix, File_Name_Extension);
Text_Io.Close(Comp_Phyl);
Text_Io.Close(Main_Phyl);
Text_Io.Close(Start_Phyl);
exception
when others => Text_Io.Put_Line
("### Error When accessing file: "
& File_Name_Prefix & Comp_Phyl_Name &
File_Name_Extension & " or "
& File_Name_Prefix & Main_Phyl_Name &
File_Name_Extension & " or "
& File_Name_Prefix & Start_Phyl_Name &
File_Name_Extension & " ###");
end;
when others =>
Text_IO.Put_Line("### Unrecognized Test Type - " &
Menu_Control.Menu_Index'image(Menu) & " ###");
end case;
exception
when Test_Generator_Control_Error => null;
end Generate_Compilation_Units;
end Test_Generator_Control;
::::::::::::::
test_generator_control_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Test_Generator_Control Package 17 Jul 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- This is the "smart" routine of the Benchmark Generator Tool that
-- controls the generation of the requested compilation units
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Menu_Control;
package Test_Generator_Control is
procedure Generate_Compilation_Units(Menu : in Menu_Control.Menu_Index);
procedure Display_Parameters(Menu : in Menu_Control.Menu_Index);
end Test_Generator_Control;
::::::::::::::
time_recorder_body.a
::::::::::::::
----------------------------------------------------------------------
-- Time_Recorder Package 28 Jul 87
--
--
-- Author: Steve Rainier MITRE - W94, Ada Software Engineering Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Record the delta time between Start_Time and Stop_Time routine
-- calls to determine elapsed time.
--
-- Start_Time - Obtains and returns the current time as returned
-- by Calendar.Clock.
-- Stop_Time - Obtains the current time, determines the
-- difference between Start and Stop, and
-- stores the results.
-- Report_Elapsed_Time - Report the elapsed time between start &
-- stop.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : Terminal I/O to report timings
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Text_IO;
with Calendar;
package body Time_Recorder is
Stop_Time_Value : Calendar.Time;
Start_Time_Value : Calendar.Time;
Num_Seconds : Calendar.Day_Duration;
function ">"(X, Y : in Calendar.Time) return Boolean renames
Calendar.">";
function "-"(X, Y : in Calendar.Time) return Duration renames
Calendar."-";
package Day_IO is new Text_IO.Fixed_IO(Calendar.Day_Duration);
function Start_Time return Calendar.Time is
begin
return Calendar.Clock;
end Start_Time;
procedure Stop_Time is
begin
Stop_Time_Value := Calendar.Clock;
end Stop_Time;
procedure Report_Elapsed_Time is
begin
if Start_Time_Value > Stop_Time_Value then -- Have a problem?
Text_IO.Put_Line("--- Elapsed time = ****** ---");
else
Num_Seconds := Stop_Time_Value - Start_Time_Value;
Text_IO.Put("--- Elapsed time = ");
Day_IO.Put(Num_Seconds);
Text_IO.Put(" ---");
Text_IO.New_Line;
end if;
end Report_Elapsed_Time;
begin
Start_Time_Value := Start_Time;
end Time_Recorder;
::::::::::::::
time_recorder_spec.a
::::::::::::::
----------------------------------------------------------------------
-- Time_Recorder Package 28 Jul 87
--
--
-- Author: Steve Rainier MITRE - W94, Ada Software Engineering Group
--
-- Revision History: None.
-- ----------------
--
-- Purpose:
-- -------
-- Record the delta time between Start_Time and Stop_Time routine
-- calls to determine elapsed time.
--
-- Exceptions Raised and Handled: None
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Calendar; -- Get Time
package Time_Recorder is
function Start_Time return Calendar.Time;
procedure Stop_Time;
procedure Report_Elapsed_Time;
end Time_Recorder;
::::::::::::::
user_data_spec.a
::::::::::::::
----------------------------------------------------------------------
-- User_Data Package 14 Aug 87
--
--
-- Author: MITRE - Washington, Software Engineering and Ada Group
--
-- Revision History: None.
-- ----------------
--
-- Implementation:
-- --------------
-- Storage for User menu templates (Menu_Control.Menus) and
-- other user data (application specific).
--
-- Exceptions Raised and Handled: None.
-- -----------------------------
--
-- I/O : None
-- Machine/Compiler Dependencies : None
-- -----------------------------
--
----------------------------------------------------------------------
with Menu_Control;
package User_Data is
--
-- Menu Names
--
type Menu_Names is
(Main,
Library_Capacity, -- LC
Dependency_Maintenance, -- DM
Generic_Capacity, -- GC
Subunit_Capacity, -- SC
LC_Package_Specs, -- PS
LC_PS_Stmts, -- Stmts
LC_Package_Specs_Bodys, -- PSB
LC_PSB_Statements, -- Stmts
LC_PS_Stmts_Enumerate, LC_PS_Stmts_Constant, LC_PS_Stmts_Object,
LC_PSB_Stmts_Enumerate, LC_PSB_Stmts_Constant, LC_PSB_Stmts_Object,
LC_PSB_Stmts_Subprgm, LC_PSB_Stmts_Assigns,
DM_Level,
DM_Structure);
User_Data_Array : array(Menu_Names'first .. Menu_Names'last) of Natural :=
(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
Max_Values : array(Menu_Names'first .. Menu_Names'last) of Natural :=
(0,0,0,0,0,(integer'last/2),0,(integer'last/2),0,
integer'last, integer'last, integer'last, integer'last, integer'last,
integer'last, integer'last, integer'last,(integer'size-1),0);
subtype Extension_Length is natural range 0 .. 5;
File_Extension_Length : Extension_Length := 0;
File_Extension : string(1 .. Extension_Length'last+1) := (others => ' ');
subtype Prefix_Length is natural range 0 .. 256;
Filename_Prefix_Length : Prefix_Length := 0;
Filename_Prefix : string(1 .. Prefix_Length'last+1) := (others => ' ');
User_Menus : Menu_Control.Menus(Menu_Names'pos(Menu_Names'first) ..
Menu_Names'pos(Menu_Names'last)) :=
-- Main Menu
(0 => (Num_Objects => 5, Next => -1,
Label => "Main Menu ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 1,
Label => "Library Capacity "),
2 => (Object_Type => Menu_Control.Submenu, Next_Menu => 2,
Label => "Dependency Maintenance "),
3 => (Object_Type => Menu_Control.Submenu, Next_Menu => 3,
Label => "Generic Capacity "),
4 => (Object_Type => Menu_Control.Submenu, Next_Menu => 4,
Label => "Subunit Capacity "),
5 => (Object_Type => Menu_Control.Submenu, Next_Menu => -1,
Label => "EXIT ")
)),
-- Library Capacity Menu
1 => (Num_Objects => 7, Next => 0,
Label => "Library Capacity Menu ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 5,
Label => "Select Package Specifications "),
2 => (Object_Type => Menu_Control.Submenu, Next_Menu => 6,
Label => "Select Statements for Package Specifications "),
3 => (Object_Type => Menu_Control.Submenu, Next_Menu => 7,
Label => "Select Package Specification and Body Pairs "),
4 => (Object_Type => Menu_Control.Submenu, Next_Menu => 8,
Label => "Select Statements for Package Specification and Body Pairs "),
5 => (Object_Type => Menu_Control.Execute, Next_Menu => 0,
Label => "Generate Compilation Units "),
6 => (Object_Type => Menu_Control.Display, Next_Menu => 1,
Label => "Display Parameters "),
7 => (Object_Type => Menu_Control.Submenu, Next_Menu => 0,
Label => "EXIT ")
)),
-- Dependency Maintenance Menu
2 => (Num_Objects => 5, Next => 0,
Label => "Dependency Maintenance Menu ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 17,
Label => "Select Level Depth of Compilation Units "),
2 => (Object_Type => Menu_Control.Submenu, Next_Menu => 18,
Label => "Select Dependency Structure of Compilation Units "),
3 => (Object_Type => Menu_Control.Execute, Next_Menu => 0,
Label => "Generate Compilation Units "),
4 => (Object_Type => Menu_Control.Display, Next_Menu => 2,
Label => "Display Parameters "),
5 => (Object_Type => Menu_Control.Submenu, Next_Menu => 0,
Label => "EXIT ")
)),
-- Generic Capacity Menu
3 => (Num_Objects => 1, Next => 0,
Label => "Generic Capacity Menu ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 0,
Label => "To be Implemented (EXIT) ")
)),
-- Subunit Capacity Menu
4 => (Num_Objects => 1, Next => 0,
Label => "Subunit Capacity Menu ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 0,
Label => "To be Implemented (EXIT) ")
)),
-- Library Capacity Package Specifications Menu
5 => (Num_Objects => 1, Next => 1,
Label => "Library Capacity ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Package Specifications ")
)),
-- Library Capacity Package Specification Statements
6 => (Num_Objects => 4, Next => 1,
Label => "Library Capacity Specification Statements ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 9,
Label => "Select Enumerated Type Declaration "),
2 => (Object_Type => Menu_Control.Submenu, Next_Menu => 10,
Label => "Select Constant Declaration "),
3 => (Object_Type => Menu_Control.Submenu, Next_Menu => 11,
Label => "Select Object Declaration "),
4 => (Object_Type => Menu_Control.Submenu, Next_Menu => 1,
Label => "EXIT ")
)),
-- Library Capacity Package Specification and Body Pairs Menu
7 => (Num_Objects => 1, Next => 1,
Label => "Library Capacity ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Package Specification/Body Pairs ")
)),
-- Library Capacity Package Specification and Body Pairs Stmts
8 => (Num_Objects => 5, Next => 1,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Submenu, Next_Menu => 12,
Label => "Select Enumerated Type Declaration "),
2 => (Object_Type => Menu_Control.Submenu, Next_Menu => 13,
Label => "Select Constant Declaration "),
3 => (Object_Type => Menu_Control.Submenu, Next_Menu => 14,
Label => "Select Object Declaration "),
4 => (Object_Type => Menu_Control.Submenu, Next_Menu => 15,
Label => "Select Subprogram Declaration "),
5 => (Object_Type => Menu_Control.Submenu, Next_Menu => 1,
Label => "EXIT ")
)),
-- Library Capacity Package Specification Statements Enumerated
9 => (Num_Objects => 1, Next => 6,
Label => "Library Capacity Specification Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Enumerated Type Declarations ")
)),
-- Library Capacity Package Specification Statements Constant
10 => (Num_Objects => 1, Next => 6,
Label => "Library Capacity Specification Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Constant Declarations ")
)),
-- Library Capacity Package Specification Statements Objects
11 => (Num_Objects => 1, Next => 6,
Label => "Library Capacity Specification Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Object Declarations ")
)),
-- Library Capacity Package Spec/Body Pairs Statements Enumerated
12 => (Num_Objects => 1, Next => 8,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Enumerated Type Declarations ")
)),
-- Library Capacity Package Spec/Body Pairs Statements Constant
13 => (Num_Objects => 1, Next => 8,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Constant Declarations ")
)),
-- Library Capacity Package Spec/Body Pairs Statements Objects
14 => (Num_Objects => 1, Next => 8,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Object Declarations ")
)),
-- Library Capacity Package Spec/Body Pairs Statements Subprograms
15 => (Num_Objects => 1, Next => 16,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Subprogram Declarations ")
)),
-- Library Capacity Package Spec/Body Pairs Statements Assignments
16 => (Num_Objects => 1, Next => 8,
Label => "Library Capacity Specification and Body Statements ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Number of Assignment Statements for Subprograms ")
)),
-- Dependency Maintenance Level Menu
17 => (Num_Objects => 1, Next => 2,
Label => "Dependency Maintenance ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Enter Depth level of Compilation Units ")
)),
-- Dependency Maintenance Structure Menu
18 => (Num_Objects => 4, Next => 2,
Label => "Dependency Maintenance Structure ",
Item => (1 => (Object_Type => Menu_Control.Numeric,
Label => "Predecessor Dependency "),
2 => (Object_Type => Menu_Control.Numeric,
Label => "Predecessor and Immediate Right Sibling Dependency "),
3 => (Object_Type => Menu_Control.Numeric,
Label => "Predecessor and All Right Sibling Dependency "),
4 => (Object_Type => Menu_Control.Numeric,
Label => "Predecessor, All Right Sibling and Grandparent Dependency ")
)));
end User_Data;