|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 9216 (0x2400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Test_Id_Referencers, seg_00460f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Compilation_Units;
with Io;
with Profile;
with Log;
with String_Utilities;
with Id_Referencers;
with Debug_Tools;
with Directory_Tools;
with Ada_Program;
with Table_Formatter;
with Declarations;
procedure Test_Id_Referencers (Units : String := "") is
package Ada renames Ada_Program;
package Decls renames Declarations;
package Object renames Directory_Tools.Object;
package Naming renames Directory_Tools.Naming;
function "=" (Left, Right : Directory_Tools.Ada_Object.Unit_Kind)
return Boolean renames Directory_Tools.Ada_Object."=";
type Columns is (Decl_Unit, Object_Decl, Ref_Line, Ref_Unit, Set_Used);
Rows : array (Columns) of Integer;
package Table is new Table_Formatter (Rows'Length);
Fields : Table.Field_List (1 .. Columns'Pos (Columns'Last) + 1);
Iter : Object.Iterator := Naming.Resolution (Units);
Unit : Object.Handle;
Bool : Boolean := True;
function Unit_Name (Of_Elem : Ada.Element) return String is
begin
return Declarations.Name
(Compilation_Units.Unit_Declaration
(Compilation_Units.Parent_Compilation_Unit (Of_Elem)));
end Unit_Name;
procedure Pre_Op (Elem : Ada_Program.Element;
State : in out Boolean;
Control : in out Ada_Program.Traversal_Control) is
procedure Add_Referencers is
Refs : Id_Referencers.Object_References :=
Id_Referencers.Initialize_References (Elem);
Object_Id : constant String :=
Ada.Image (Elem) & "(" &
String_Utilities.Strip
(Integer'Image (Ada.Line_Number (Elem))) & ")";
Parent_Name : constant String := Unit_Name (Elem);
Ref : Ada_Program.Element;
begin
while not Id_Referencers.Done (Refs) loop
Ref := Id_Referencers.Value (Refs);
Table.Item (Parent_Name);
Table.Item (Object_Id);
Table.Item (Integer'Image (Ada.Line_Number (Ref)));
Table.Item (Unit_Name (Ref));
case Id_Referencers.Kind (Ref) is
when Id_Referencers.Set =>
Table.Item ("SET");
when Id_Referencers.Used =>
Table.Item ("USED");
when Id_Referencers.Set_And_Used =>
Table.Item ("SET/USED");
end case;
Id_Referencers.Next (Refs);
end loop;
end Add_Referencers;
begin
-- check first if we have an identifier definition
case Ada_Program.Id_Kind (Elem) is
when Ada.An_Identifier_Definition =>
case Decls.Kind (Elem) is
when Decls.A_Variable_Declaration =>
-- due to a bug in decls this may not really be
-- a variable_decl - it may be a record field.
-- Weed out those by seeing if the parent is a type.
if Ada."=" (Ada.Kind (Ada.Parent (Elem)),
Ada.A_Declaration) and then
Decls."=" (Decls.Kind (Ada.Parent (Elem)),
Decls.A_Type_Declaration) then
null;
else
Add_Referencers;
end if;
when Decls.A_Constant_Declaration |
Decls.A_Deferred_Constant_Declaration |
Decls.An_Integer_Number_Declaration |
Decls.A_Real_Number_Declaration =>
Add_Referencers;
when others =>
null;
end case;
when others =>
null;
end case;
Control := Ada_Program.Continue;
exception
when others =>
Log.Put_Line ("UNEXPECTED ERROR, EXCEPTION:" &
Debug_Tools.Get_Exception_Name, Profile.Error_Msg);
Log.Put_Line ("DIAGNOSIS: " & Ada_Program.Diagnosis,
Profile.Error_Msg);
Log.Put_Line ("UNIT: " & Naming.Unique_Full_Name (Unit),
Profile.Error_Msg);
Log.Put_Line ("On line: " &
Natural'Image (Ada_Program.Line_Number (Elem)),
Profile.Error_Msg);
Control := Ada_Program.Continue;
end Pre_Op;
procedure Post_Op (Program_Element : Ada_Program.Element;
State : in out Boolean;
Control : in out Ada_Program.Traversal_Control) is
begin
Control := Ada_Program.Continue;
end Post_Op;
procedure Traverse is new Ada_Program.Depth_First_Traversal
(Boolean, Pre_Op, Post_Op);
begin
if Object.Is_Bad (Iter) then
Log.Put_Line (Units & ": is not a valid pathname", Profile.Error_Msg);
else
for C in Columns loop
Fields (Columns'Pos (C) + 1) := Columns'Pos (C) + 1;
Table.Header (Columns'Image (C));
end loop;
while not Object.Done (Iter) loop
Unit := Object.Value (Iter);
if Directory_Tools.Ada_Object.Kind (Unit) =
Directory_Tools.Ada_Object.Not_Class_Ada then
Log.Put_Line (Naming.Unique_Full_Name (Unit) &
" is not an Ada unit", Profile.Warning_Msg);
elsif Directory_Tools.Ada_Object.Is_Installed (Unit) then
Traverse (Ada_Program.Conversion.To_Compilation_Unit (Unit),
Bool, False);
else
Log.Put_Line (Naming.Unique_Full_Name (Unit) &
" is not installed", Profile.Warning_Msg);
end if;
Object.Next (Iter);
end loop;
Table.Sort (Fields);
Table.Display (Io.Standard_Output);
end if;
end Test_Id_Referencers;
nblk1=8
nid=0
hdr6=10
[0x00] rec0=23 rec1=00 rec2=01 rec3=000
[0x01] rec0=19 rec1=00 rec2=08 rec3=00e
[0x02] rec0=00 rec1=00 rec2=02 rec3=012
[0x03] rec0=1a rec1=00 rec2=03 rec3=012
[0x04] rec0=12 rec1=00 rec2=04 rec3=00e
[0x05] rec0=18 rec1=00 rec2=05 rec3=034
[0x06] rec0=18 rec1=00 rec2=06 rec3=04a
[0x07] rec0=0b rec1=00 rec2=07 rec3=000
tail 0x2150041cc815c65aa8ccb 0x42a00088462061e03