|
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: 15360 (0x3c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Find_Generics, seg_004401
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with More_String_Utilities;
with Log;
with Profile;
with Common;
with Errors;
with Simple_Status;
with Add_Hyper_Table;
with Create_Null_Document;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
package body Find_Generics is
function In_A_Dynamic_Scope (E : Ada.Element) return Boolean is
Parent : Ada.Element := Ada.Parent (E);
begin
while not Ada.Is_Nil (Parent) loop
case Ada.Kind (Parent) is
when Ada.A_Declaration =>
case Decls.Kind (Parent) is
when Decls.A_Procedure_Body_Declaration |
Decls.A_Function_Body_Declaration =>
return True;
when others =>
null;
end case;
when Ada.A_Statement =>
case Stmts.Kind (Parent) is
when Stmts.A_Block_Statement =>
return True;
when others =>
null;
end case;
when others =>
null;
end case;
Parent := Ada.Parent (Parent);
end loop;
return False;
end In_A_Dynamic_Scope;
procedure Add (Units : String := "";
To_Document : in out Abstract_Document.Handle;
Response : String := "<PROFILE>") is
Is_A_Generic : Boolean;
Is_Dynamic : Boolean;
The_Generic : Ada.Element;
Gen_Parameters : Ada.Element_Iterator;
Current_Gen_Param : Ada.Element;
Actual_Parameters : Ada.Element_Iterator;
Current_Actual_Param : Ada.Element;
Units_Iter : Object.Iterator := Naming.Resolution (Units);
type Columns is (Generic_Unit,
Instantiation,
Dynamic,
P1,
P2,
P3,
P4);
function Is_Integer_Column (C : Columns) return Boolean is
begin
return False;
end Is_Integer_Column;
procedure Step_Parameters is
begin
if Is_A_Generic then
if Ada.Done (Gen_Parameters) then
Current_Gen_Param := Ada.Nil_Element;
else
Current_Gen_Param := Ada.Value (Gen_Parameters);
Ada.Next (Gen_Parameters);
end if;
else
if Ada.Done (Actual_Parameters) then
Current_Actual_Param := Ada.Nil_Element;
else
Current_Actual_Param := Ada.Value (Actual_Parameters);
Ada.Next (Actual_Parameters);
end if;
end if;
end Step_Parameters;
function Is_Included (Elem : Ada.Element) return Boolean is
begin
if Ada.Kind (Elem) = Ada.A_Declaration then
Is_A_Generic := Decls.Is_Generic (Elem);
if Is_A_Generic then
The_Generic := Elem;
Gen_Parameters := Decls.Generic_Parameters (Elem);
Step_Parameters;
return True;
elsif Decls.Is_Generic_Instantiation (Elem) then
The_Generic := Ada.Definition (Elem);
Is_Dynamic := In_A_Dynamic_Scope (Elem);
Actual_Parameters := Decls.Generic_Actual_Parameters (Elem);
Current_Actual_Param := Ada.Value (Actual_Parameters);
Step_Parameters;
return True;
else
return False;
end if;
else
return False;
end if;
end Is_Included;
function Actual_Reference (Actual_Param : Ada.Element) return String is
Def : Ada.Element;
begin
if Ada.Is_Nil (Actual_Param) then
return "";
else
Def := Ada.Definition (Actual_Param);
if Ada.Is_Nil (Def) then
return Ada.Image (Actual_Param);
else
return Decls.Name (Def);
end if;
end if;
end Actual_Reference;
function Image (Gen_Param : Ada.Element) return String is
begin
if Ada.Is_Nil (Gen_Param) then
return "";
else
return More_String_Utilities.Replaced
(Decls.Generic_Parameter_Kinds'Image
(Decls.Generic_Parameter_Kind (Gen_Param)));
end if;
end Image;
function Column_Image (C : Columns; Elem : Ada.Element) return String is
begin
case C is
when Generic_Unit =>
return Decls.Name (The_Generic);
when Instantiation =>
if Is_A_Generic then
return "";
else
return Decls.Name (Elem);
end if;
when Dynamic =>
if Is_A_Generic then
return "";
else
if Is_Dynamic then
return "YES";
else
return "NO ";
end if;
end if;
when P1 .. P4 =>
if Is_A_Generic then
declare
Col_Image : constant String :=
Image (Current_Gen_Param);
begin
Step_Parameters;
return (Col_Image);
end;
else
declare
Col_Image : constant String :=
Actual_Reference (Current_Actual_Param);
begin
Step_Parameters;
return (Col_Image);
end;
end if;
end case;
end Column_Image;
function Explanation (C : Columns; Elem : Ada.Element) return String is
begin
case C is
when Generic_Unit =>
return "Name of the generic unit";
when Instantiation =>
return "Name of the Instantiation";
when Dynamic =>
if Is_A_Generic then
return "";
else
if Is_Dynamic then
return
"Instantiation is declared in a subuprogram and is dynamically instantiated";
else
return "Instantiation is not dynamic";
end if;
end if;
when P1 .. P4 =>
if Is_A_Generic then
return "Kind of the generic parameter";
else
return
"Reference to the declaration used for the actual parameter";
end if;
end case;
end Explanation;
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 Generic_Unit =>
Linkage_Element := The_Generic;
when Instantiation =>
if Is_A_Generic then
null;
else
Linkage_Element := Elem;
end if;
when Dynamic =>
if Is_A_Generic then
Linkage_Element := The_Generic;
else
Linkage_Element := Elem;
end if;
when P1 .. P4 =>
if Is_A_Generic then
Linkage_Element := Curret_Gen_Param;
else
Linkage_Element := Current_Actual_Param;
end if;
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 => "Generics and their Instantiations");
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, Response);
end if;
end Add;
procedure Display (Units : String := "";
To_Preview_Object : String := "generic_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, Document, Response);
Abstract_Document.Close (Document);
Common.Definition (To_Preview_Object);
end case;
end Display;
end Find_Generics;
nblk1=e
nid=0
hdr6=1c
[0x00] rec0=20 rec1=00 rec2=01 rec3=040
[0x01] rec0=20 rec1=00 rec2=02 rec3=050
[0x02] rec0=01 rec1=00 rec2=0c rec3=016
[0x03] rec0=1b rec1=00 rec2=03 rec3=006
[0x04] rec0=19 rec1=00 rec2=04 rec3=014
[0x05] rec0=00 rec1=00 rec2=0e rec3=008
[0x06] rec0=1c rec1=00 rec2=05 rec3=08c
[0x07] rec0=1d rec1=00 rec2=06 rec3=044
[0x08] rec0=19 rec1=00 rec2=07 rec3=01a
[0x09] rec0=17 rec1=00 rec2=08 rec3=036
[0x0a] rec0=18 rec1=00 rec2=09 rec3=060
[0x0b] rec0=00 rec1=00 rec2=0d rec3=002
[0x0c] rec0=1b rec1=00 rec2=0a rec3=048
[0x0d] rec0=17 rec1=00 rec2=0b rec3=000
tail 0x215003330815c637bf11f 0x42a00088462061e03