|
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: 12671 (0x317f)
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, Text_Io, String_Pkg;
-----------------------------------
package body Compilation_Unit_Lists is
-----------------------------------
use Type_Definitions, Text_Io, String_Pkg;
package Int_Io is new Integer_Io (Integer);
use Int_Io;
type Program_Unit_List;
type Next_Program_Units is access Program_Unit_List;
type Program_Unit_List is
record
Name : Ada_Name; --| the name of this PU
Number :
Program_Unit_Number_Range; --| assigned by source instrumenter
Next :
Next_Program_Units; --| pointer to next PU for this CU
end record;
type Compilation_Unit_List;
type Next_Compilation_Units is access Compilation_Unit_List;
type Compilation_Unit_List is
record
Name : Ada_Name; --| the name of this CU
Number_Of_Breakpoints :
Breakpoint_Number_Range;--| the no of breakpoints
Next : Next_Compilation_Units; --| pointer to next CU
Program_Unit_List : Next_Program_Units; --| the PU's for this CU
end record;
Current_Compilation_Unit : Next_Compilation_Units := null;
Last_Compilation_Unit : Next_Compilation_Units := null;
Root : Next_Compilation_Units := null;
Current_Program_Unit : Next_Program_Units := null;
Last_Program_Unit : Next_Program_Units := null;
Debug : Boolean := False;
-- if DEBUG statements are removed, Text_IO
-- is not needed.
------------------------------
procedure Set_Compilation_Unit (--| Set list pointer to current Comp Unit
Compilation_Unit_Name : in Ada_Name
) is
begin
Current_Compilation_Unit := Root;
if Debug then
Put ("In Set_Compilation_Unit ");
Put ("Find ");
Put_Line (Value (Compilation_Unit_Name));
end if;
loop
if Current_Compilation_Unit = null then
-- The Compilation Unit is not in the list. Exit with
-- Current_Compilation_Unit positioned at the null node
-- so it can be allocated, if necessary.
if Debug then
Put_Line ("** No Match **");
end if;
exit;
elsif Equal (Current_Compilation_Unit.Name,
Compilation_Unit_Name) then
-- Found a match.
if Debug then
Put_Line ("** CU Matched **");
end if;
exit;
else
if Debug then
Put ("** CU Cell Used by ");
Put_Line (Value (Current_Compilation_Unit.Name));
end if;
Last_Compilation_Unit := Current_Compilation_Unit;
Current_Compilation_Unit := Current_Compilation_Unit.Next;
end if;
end loop;
end Set_Compilation_Unit;
------------------------------
procedure Add_Compilation_Unit
(--| ADD Compilation Unit to the list
Compilation_Unit_Name : in Ada_Name;
Number_Of_Breakpoints : in Breakpoint_Number_Range
) is
begin
-- Position the list pointer to the node containing the compilation
-- unit name specified in Unit_ID. If it is not already in the list,
-- leave the list pointer on a null node.
Set_Compilation_Unit (Compilation_Unit_Name);
if Current_Compilation_Unit = null then
-- Add the new compilation unit to the list.
if Debug then
Put_Line ("** Add CU **");
end if;
if Root = null then
-- the list is empty
Root := new Compilation_Unit_List;
Current_Compilation_Unit := Root;
else
Current_Compilation_Unit := new Compilation_Unit_List;
Last_Compilation_Unit.Next := Current_Compilation_Unit;
end if;
Current_Compilation_Unit.Name :=
Make_Persistent (Compilation_Unit_Name);
Current_Compilation_Unit.Next := null;
Current_Compilation_Unit.Program_Unit_List := null;
Current_Compilation_Unit.Number_Of_Breakpoints :=
Number_Of_Breakpoints;
if Debug then
Put_Line ("** CU Added **");
end if;
end if;
end Add_Compilation_Unit;
-----------------------------------
procedure Get_Number_Of_Breakpoints
(--| Get the number of breakpoints
--| in the compilation unit
Compilation_Unit_Name : in Ada_Name;
Number_Of_Breakpoints : out Breakpoint_Number_Range
) is
begin
-- Position the list pointer to the node containing the compilation
-- unit name specified in Unit_ID. If it is not already in the list,
-- then raise the exception Undefined_Compilation_Unit.
Set_Compilation_Unit (Compilation_Unit_Name);
if Current_Compilation_Unit = null then
Put_Line ("Undefined Compilation Unit Error");
Put ("Unit = ");
Put (Value (Compilation_Unit_Name));
New_Line;
raise Undefined_Compilation_Unit;
end if;
Number_Of_Breakpoints := Current_Compilation_Unit.Number_Of_Breakpoints;
end Get_Number_Of_Breakpoints;
--------------------------
procedure Set_Program_Unit (--| Set list pointer to specified program unit
Unit_Id : in Program_Unit_Unique_Identifier
) is
Compilation_Unit_Name : Ada_Name;
begin
-- Position the list pointer to the node containing the compilation
-- unit name specified in Unit_ID. If it is not already in the list,
-- then leave the list pointer on a null node.
if Debug then
Put ("In Set_Program_Unit ");
Put ("Find ");
Put (Value (Unit_Id.Enclosing_Unit_Identifier));
Put (' ');
Put (Unit_Id.Program_Unit_Number);
New_Line;
end if;
Compilation_Unit_Name := Unit_Id.Enclosing_Unit_Identifier;
Set_Compilation_Unit (Compilation_Unit_Name);
if Current_Compilation_Unit /= null then
Current_Program_Unit := Current_Compilation_Unit.Program_Unit_List;
loop
if Current_Program_Unit = null then
-- The program unit is not in the list.
if Debug then
Put_Line ("** PU Not Matched PU **");
end if;
exit;
elsif Current_Program_Unit.Number =
Unit_Id.Program_Unit_Number then
-- Found a match.
if Debug then
Put_Line ("** PU Matched **");
end if;
exit;
else
if Debug then
Put_Line ("** PU Cell Used **");
end if;
Last_Program_Unit := Current_Program_Unit;
Current_Program_Unit := Current_Program_Unit.Next;
end if;
end loop;
end if;
end Set_Program_Unit;
--------------------------
procedure Add_Program_Unit (--| Add Program Unit to the list
Unit_Id : in Program_Unit_Unique_Identifier;
Program_Unit_Name : in Ada_Name
) is
Compilation_Unit_Name : Ada_Name;
begin
-- Position the list pointer to the node containing the compilation
-- unit name and program unit number specified in Unit_ID.
Set_Program_Unit (Unit_Id);
if Current_Program_Unit = null then
-- The program unit is not in the list. Allocate a new node.
if Debug then
Put_Line ("** Allocate PU Node **");
end if;
Current_Program_Unit := new Program_Unit_List;
if Current_Compilation_Unit.Program_Unit_List = null then
Current_Compilation_Unit.Program_Unit_List :=
Current_Program_Unit;
Last_Program_Unit := Current_Compilation_Unit.Program_Unit_List;
end if;
Last_Program_Unit.Next := Current_Program_Unit;
Current_Program_Unit.Name := Make_Persistent (Program_Unit_Name);
Current_Program_Unit.Number := Unit_Id.Program_Unit_Number;
Current_Program_Unit.Next := null;
if Debug then
Put_Line ("** PU Added **");
end if;
end if;
end Add_Program_Unit;
-------------------------------
procedure Get_Program_Unit_Name
(--| Get the program unit name for the
--| Specified program unit
Unit_Id : in Program_Unit_Unique_Identifier;
Program_Unit_Name : out Ada_Name
) is
begin
--| Position the list pointer to the node containing the compilation
--| unit name and program unit number specified in Unit_ID.
Set_Program_Unit (Unit_Id);
--| If the list pointer is null then this program unit is not in
--| the list. That means that this is the main procedure in
--| the compilation unit or that the unit is undefined.
if Current_Program_Unit = null then
if Unit_Id.Program_Unit_Number = 0 then
--| If the program unit number is zero then this is the
--| main program unit for the compilation unit. It should
--| have the same name as the compilation unit
Program_Unit_Name := Unit_Id.Enclosing_Unit_Identifier;
else
--| The unit is undefined. Nothing else can be done but
--| raise an exception. Before raising the exception
--| display the compilation unit name and unit number
--| of the offender
Put_Line ("Undefined Program Unit Error");
Put ("Unit = ");
Put (Value (Unit_Id.Enclosing_Unit_Identifier));
Put (" Program Unit = ");
Put (Unit_Id.Program_Unit_Number);
New_Line;
raise Undefined_Program_Unit;
end if;
else
--| The program unit has been found
Program_Unit_Name := Current_Program_Unit.Name;
end if;
end Get_Program_Unit_Name;
-------------------
procedure Dump_List is
--| Debug procedure to dump the list
Cu_Number : Natural := 0;
Pu_Number : Program_Unit_Number_Range;
begin
Current_Compilation_Unit := Root;
while Current_Compilation_Unit /= null loop
Cu_Number := Cu_Number + 1;
Put (Cu_Number, 0);
Put (' ');
Put (Value (Current_Compilation_Unit.Name));
Put (' ');
Put (Current_Compilation_Unit.Number_Of_Breakpoints, 0);
Put (' ');
if Current_Compilation_Unit.Next = null then
Put ("null");
else
Put (Cu_Number + 1, 0);
end if;
Put (' ');
if Current_Compilation_Unit.Program_Unit_List = null then
Put ("null");
else
Put (1, 0);
end if;
Put (' ');
New_Line;
Current_Program_Unit := Current_Compilation_Unit.Program_Unit_List;
while Current_Program_Unit /= null loop
Pu_Number := Current_Program_Unit.Number;
Put (Pu_Number, 0);
Put (' ');
Put (Value (Current_Program_Unit.Name));
Put (' ');
if Current_Program_Unit.Next = null then
Put ("null");
else
Put (Pu_Number + 1, 0);
end if;
Put (' ');
New_Line;
Current_Program_Unit := Current_Program_Unit.Next;
end loop;
New_Line;
Current_Compilation_Unit := Current_Compilation_Unit.Next;
end loop;
end Dump_List;
end Compilation_Unit_Lists;