|
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 - download
Length: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Find_Objects, seg_004407
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Log;
with Profile;
with Common;
with Add_Hyper_Table;
with Create_Null_Document;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
with Errors;
with Simple_Status;
with Id_Referencers;
with Lrm_Utilities;
with Size_Utilities;
package body Find_Objects is
type Reference_Data is
record
Sets : Ada.Element_List;
Uses : Ada.Element_List;
end record;
Nil_Data : constant Reference_Data := (Ada.Nil_List, Ada.Nil_List);
function Is_Id (Elem : Ada.Element) return Boolean is
begin
return (Ada.Id_Kind (Elem) = Ada.An_Identifier_Definition);
end Is_Id;
procedure Pre_Op (Program_Element : Ada.Element;
State : in out Reference_Data;
Control : in out Ada.Traversal_Control) is
begin
if (Ada.Id_Kind (Program_Element) = Ada.An_Identifier_Reference) then
case Id_Referencers.Kind (Program_Element) is
when Id_Referencers.Set =>
Ada.Append (Program_Element, State.Sets);
when Id_Referencers.Used =>
Ada.Append (Program_Element, State.Uses);
when Id_Referencers.Set_And_Used =>
Ada.Append (Program_Element, State.Sets);
Ada.Append (Program_Element, State.Uses);
end case;
end if;
end Pre_Op;
procedure Post_Op (Program_Element : Ada.Element;
State : in out Reference_Data;
Control : in out Ada.Traversal_Control) is
begin
Control := Ada.Continue;
end Post_Op;
procedure Traverse_References is new Ada.Depth_First_Traversal
(Reference_Data, Pre_Op, Post_Op);
function Has_Ancestor_Subprogram (Element : Ada.Element) return Boolean is
Parent : Ada.Element := Ada.Parent (Element);
begin
if Ada.Is_Nil (Parent) then
return False; -- we never hit a subprogram
elsif Ada."=" (Ada.Kind (Parent), Ada.A_Statement) then
return True; -- decl was in a declare block
elsif Decls.Is_Subprogram (Parent) then
return True;
else
return Has_Ancestor_Subprogram (Parent);
end if;
end Has_Ancestor_Subprogram;
procedure Collect_References (For_Decl_Id : Ada.Element;
Into : in out Reference_Data) is
Dependent_Units : Ada.Element_List :=
Ada.Usage (Reference => For_Decl_Id,
Global => True,
Limit => "<ALL_WORLDS>",
Closure => False);
begin
while not Ada.Done (Dependent_Units) loop
Traverse_References (Ada.Value (Dependent_Units), Into, False);
Ada.Next (Dependent_Units);
end loop;
end Collect_References;
procedure Add (Units : String := "";
Do_Set_Used_Analysis : Boolean := True;
To_Document : in out Abstract_Document.Handle;
Response : String := "<PROFILE>") is
Units_Iter : Object.Iterator := Naming.Resolution (Units);
type Columns is (Obj_Size, Obj_Name, Obj_Type, C_Or_V, Set, Used);
Data : Reference_Data;
function Is_Integer_Column (C : Columns) return Boolean is
begin
case C is
when Obj_Size | Set | Used =>
return True;
when others =>
return False;
end case;
end Is_Integer_Column;
function Is_Included (Elem : Ada.Element) return Boolean is
Enclosing : Ada.Element;
begin
if Is_Id (Elem) then
Enclosing := Decls.Enclosing_Declaration (Elem);
case Decls.Kind (Enclosing) is
when Decls.A_Variable_Declaration |
Decls.A_Constant_Declaration |
Decls.A_Deferred_Constant_Declaration |
Decls.An_Integer_Number_Declaration |
Decls.A_Real_Number_Declaration =>
if Lrm_Utilities.Is_Actual_Variable_Declaration
(Enclosing) then
if Do_Set_Used_Analysis then
Data := Nil_Data;
Collect_References (Elem, Data);
if Decls.Is_Initialized (Enclosing) then
Ada.Append (Decls.Initial_Value (Enclosing),
Data.Sets);
end if;
end if;
return True;
else
return False;
end if;
when others =>
return False;
end case;
else
return False;
end if;
end Is_Included;
function Explanation (C : Columns; Elem : Ada.Element) return String is
begin
case C is
when Obj_Name =>
return "Name of the object declaration";
when Obj_Type =>
case Decls.Kind (Elem) is
when Decls.An_Integer_Number_Declaration |
Decls.A_Real_Number_Declaration =>
return
"Integer and Real number declarations have no explicit type";
when others =>
return "Name of the object's type";
end case;
when Obj_Size =>
case Decls.Kind (Elem) is
when Decls.An_Integer_Number_Declaration |
Decls.A_Deferred_Constant_Declaration |
Decls.A_Real_Number_Declaration =>
return "This declaration has no size";
when others =>
return
"Size of the object in bytes. Zero indicates non-static size";
end case;
when C_Or_V =>
case Decls.Kind (Elem) is
when Decls.A_Variable_Declaration =>
if Has_Ancestor_Subprogram (Elem) then
return "Subprogram local variable";
else
return "Variable declaration in a package";
end if;
when Decls.An_Integer_Number_Declaration =>
return "An Integer Number declaration";
when Decls.A_Real_Number_Declaration =>
return "A Real Number declaration";
when others =>
if Has_Ancestor_Subprogram (Elem) then
return "Constant declared in a subprogram";
else
return "Constant declared in a package";
end if;
end case;
when Set =>
return "Number of places where the object is set";
when Used =>
return "Number of places where the object is used";
end case;
end Explanation;
function Column_Image (C : Columns; Elem : Ada.Element) return String is
Object_Size : Size_Utilities.Long_Natural;
Static : Boolean := True;
begin
case C is
when Obj_Name =>
return Decls.Name (Elem);
when Obj_Type =>
case Decls.Kind (Elem) is
when Decls.An_Integer_Number_Declaration |
Decls.A_Real_Number_Declaration =>
return "[NO TYPE]";
when Decls.A_Deferred_Constant_Declaration =>
return Decls.Name
(Decls.Enclosing_Declaration
(Ada.Definition
(Decls.Type_Mark (Elem))));
when others =>
return Decls.Name (Decls.Enclosing_Declaration
(Ada.Definition
(Decls.Object_Type (Elem))));
end case;
when Obj_Size =>
case Decls.Kind (Elem) is
when Decls.An_Integer_Number_Declaration |
Decls.A_Deferred_Constant_Declaration |
Decls.A_Real_Number_Declaration =>
return " 0";
when others =>
Size_Utilities.Object_Size
(For_Object =>
Decls.Enclosing_Declaration (Elem),
Result => Object_Size,
Static => Static);
return Long_Integer'Image (Object_Size / 8);
end case;
when C_Or_V =>
case Decls.Kind (Elem) is
when Decls.A_Variable_Declaration =>
if Has_Ancestor_Subprogram (Elem) then
return "Variable";
else
return "Pkg Variable";
end if;
when Decls.An_Integer_Number_Declaration =>
return "Integer Number";
when Decls.A_Real_Number_Declaration =>
return "Real Number";
when others =>
if Has_Ancestor_Subprogram (Elem) then
return "Constant";
else
return "Pkg Constant";
end if;
end case;
when Set =>
return Integer'Image (Lrm_Utilities.Count (Data.Sets));
when Used =>
return Integer'Image (Lrm_Utilities.Count (Data.Uses));
end case;
end Column_Image;
procedure Linkage (C : Columns;
Elem : Ada.Element;
Linkage_Element : out Ada.Element;
Linkage_Elements : out Ada.Element_List) is
begin
-- default values changed within the case statement as necessary
Linkage_Element := Ada.Nil_Element;
Linkage_Elements := Ada.Nil_List;
case C is
when Obj_Name =>
Linkage_Element := Elem;
when Obj_Type =>
case Decls.Kind (Elem) is
when Decls.An_Integer_Number_Declaration |
Decls.A_Deferred_Constant_Declaration | Decls.A_Real_Number_Declaration =>
Linkage_Element := Ada.Nil_Element;
when others =>
Linkage_Element :=
Decls.Enclosing_Declaration
(Ada.Definition (Decls.Object_Type (Elem)));
end case;
when C_Or_V | Obj_Size =>
Linkage_Element := Ada.Nil_Element;
when Set =>
Linkage_Elements := Data.Sets;
when Used =>
Linkage_Elements := Data.Uses;
end case;
end Linkage;
procedure Add_Hyper_Table_To_Doc is
new Add_Hyper_Table
(Is_Included,
Columns,
Is_Integer_Column, Column_Image, Explanation, Linkage,
Table_Title => "OBJECT DECLARATIONS");
begin
if Object.Is_Bad (Units_Iter) then
Log.Put_Line (Units & " is not a valid pathname",
Profile.Error_Msg);
else
Add_Hyper_Table_To_Doc (Units_Iter, To_Document);
end if;
end Add;
procedure Display (Units : String := "";
Do_Set_Used_Analysis : Boolean := True;
To_Preview_Object : String := "Object_Info";
Response : String := "<PROFILE>") is
Document : Abstract_Document.Handle;
Condition : Errors.Condition;
begin
Create_Null_Document (Named => To_Preview_Object,
Error_Info => Condition,
Document_Handle => Document);
case Errors.Severity (Condition) is
when Simple_Status.Problem | Simple_Status.Fatal =>
Log.Put_Line ("Problem creating object " & To_Preview_Object &
". " & Errors.Info (Condition),
Profile.Error_Msg);
when others =>
Add (Units, Do_Set_Used_Analysis, Document, Response);
Abstract_Document.Close (Document);
Common.Definition (To_Preview_Object);
end case;
end Display;
end Find_Objects;
nblk1=11
nid=0
hdr6=22
[0x00] rec0=24 rec1=00 rec2=01 rec3=00e
[0x01] rec0=16 rec1=00 rec2=02 rec3=092
[0x02] rec0=18 rec1=00 rec2=03 rec3=086
[0x03] rec0=1d rec1=00 rec2=04 rec3=044
[0x04] rec0=15 rec1=00 rec2=05 rec3=074
[0x05] rec0=1b rec1=00 rec2=06 rec3=0b4
[0x06] rec0=13 rec1=00 rec2=07 rec3=028
[0x07] rec0=13 rec1=00 rec2=08 rec3=018
[0x08] rec0=17 rec1=00 rec2=09 rec3=002
[0x09] rec0=00 rec1=00 rec2=11 rec3=00a
[0x0a] rec0=12 rec1=00 rec2=0a rec3=03a
[0x0b] rec0=15 rec1=00 rec2=0b rec3=026
[0x0c] rec0=15 rec1=00 rec2=0c rec3=08c
[0x0d] rec0=01 rec1=00 rec2=10 rec3=002
[0x0e] rec0=18 rec1=00 rec2=0d rec3=012
[0x0f] rec0=17 rec1=00 rec2=0e rec3=070
[0x10] rec0=0d rec1=00 rec2=0f rec3=000
tail 0x2170016cc815c638cd1fd 0x42a00088462061e03