|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Find_Exceptions, seg_0043ff
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Io;
with Log;
with Profile;
with Common;
with Hyper_Table;
with Create_Null_Document;
with Lrm_Utilities;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
with Errors;
with Simple_Status;
package body Find_Exceptions is
function In_Scope_Of_Given_Units
(Units : Object.Iterator; Elem : Ada.Element) return Boolean is
begin
return (Object.Has (Iter => Units,
An_Object =>
Ada.Conversion.To_Directory_Object
(Comp_Units.Parent_Compilation_Unit (Elem))));
end In_Scope_Of_Given_Units;
procedure Add (Units : String := "";
To_Document : in out Abstract_Document.Handle;
Response : String := "<PROFILE>") is
Units_Iter : Object.Iterator := Naming.Resolution (Units);
-- need to declare a second copy of the iterator because object.has
-- will only search through an iterator from its current position
-- to the end.
Units_Iter2 : Object.Iterator := Naming.Resolution (Units);
type Columns is (Exception_Name, Type_Of_Ref, Visible, Unit_Name);
-- Exception_references are all stored in this list because they
-- may come from outside the scope of 'units'. These will be
-- added to the table by add_hyper_table after the traversal
Exception_References : Ada.Element_List := Ada.Nil_List;
function Is_Integer_Column (C : Columns) return Boolean is
begin
case C is
when others =>
return False;
end case;
end Is_Integer_Column;
function Is_Included (Elem : Ada.Element) return Boolean is
begin
case Ada.Id_Kind (Elem) is
when Ada.An_Identifier_Definition =>
if Decls.Kind (Decls.Enclosing_Declaration (Elem)) =
Decls.An_Exception_Declaration then
Ada.Append (Ada.Usage (Elem), Exception_References);
return True;
else
return False;
end if;
when Ada.An_Identifier_Reference =>
declare
Decl : Ada.Declaration := Ada.Definition (Elem);
begin
if Decls.Kind (Decl) = Decls.
An_Exception_Declaration then
if In_Scope_Of_Given_Units (Units_Iter2, Decl) then
-- we've already got this reference
return False;
else
-- Its a reference to an exception that is
-- declared outside the scope of the given
-- units so we need to include this reference
-- now.
return True;
end if;
else
return False;
end if;
end;
when Ada.Not_An_Identifier =>
return False;
end case;
end Is_Included;
function Column_Image (C : Columns; Elem : Ada.Element) return String is
begin
case C is
when Exception_Name =>
case Ada.Id_Kind (Elem) is
when Ada.An_Identifier_Definition =>
return Ada.Image
(Lrm_Utilities.Comp_Unit_Id (Elem)) &
"." & Ada.Image (Elem);
when Ada.An_Identifier_Reference =>
return Ada.Image (Lrm_Utilities.Comp_Unit_Id
(Ada.Definition (Elem))) &
"." & Ada.Image (Elem);
when others =>
return
("*** unexpected element fed to column_image ***");
end case;
when Type_Of_Ref =>
case Ada.Id_Kind (Elem) is
when Ada.An_Identifier_Definition =>
return "Definition";
when Ada.An_Identifier_Reference =>
if Ada.Kind (Ada.Parent (Elem)) =
Ada.A_Statement then
-- it must be a raise stmt
return ("Raised");
else
-- it must be in a handler
return ("Handled");
end if;
when others =>
return "";
end case;
when Visible =>
if Ada.Id_Kind (Elem) = Ada.An_Identifier_Definition then
if Decls.Is_Visible (Elem) then
return ("Yes");
else
return ("No");
end if;
else
return ("");
end if;
when Unit_Name =>
return Ada.Image (Lrm_Utilities.Comp_Unit_Id (Elem));
end case;
end Column_Image;
function Explanation (C : Columns; Elem : Ada.Element) return String is
begin
case C is
when Exception_Name =>
return ("The full ada name of the exception.");
when Type_Of_Ref =>
return ("The type of exception reference or declaration.");
when Visible =>
return ("Indicates if this exception is " &
"declared in a package spec.");
when Unit_Name =>
return ("The name of the Ada unit containing " &
"the declaration or reference.");
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 Ada.Id_Kind (Elem) is
when Ada.An_Identifier_Definition =>
-- same link for all columns
Linkage_Element := Elem;
when Ada.An_Identifier_Reference =>
case C is
when Exception_Name =>
Linkage_Element := Ada.Definition (Elem);
when others =>
Linkage_Element := Elem;
end case;
when others =>
null;
end case;
end Linkage;
function Add_References return Ada.Element_List is
begin
return Exception_References;
end Add_References;
procedure Add_Hyper_Table_To_Doc is
new Hyper_Table.Add_Hyper_Table
(Is_Included,
Columns,
Is_Integer_Column,
Column_Image,
Explanation,
Linkage,
Additional_Included_Elements => Add_References,
Table_Title => "Exceptions Information");
begin
if Object.Is_Bad (Units_Iter) then
Log.Put_Line (Units & " is not a valid pathname",
Profile.Error_Msg);
else
while not Object.Done (Units_Iter) loop
Io.Echo_Line (Naming.Unique_Full_Name
(Object.Value (Units_Iter)));
Object.Next (Units_Iter);
end loop;
Object.Reset (Units_Iter);
Add_Hyper_Table_To_Doc (Units_Iter, To_Document, Response);
end if;
end Add;
procedure Display (Units : String := "";
To_Preview_Object : String := "Exception_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_Exceptions;
nblk1=b
nid=0
hdr6=16
[0x00] rec0=21 rec1=00 rec2=01 rec3=050
[0x01] rec0=19 rec1=00 rec2=02 rec3=01c
[0x02] rec0=13 rec1=00 rec2=03 rec3=044
[0x03] rec0=18 rec1=00 rec2=04 rec3=038
[0x04] rec0=12 rec1=00 rec2=05 rec3=058
[0x05] rec0=1c rec1=00 rec2=06 rec3=03e
[0x06] rec0=15 rec1=00 rec2=07 rec3=014
[0x07] rec0=00 rec1=00 rec2=0b rec3=002
[0x08] rec0=1b rec1=00 rec2=08 rec3=03e
[0x09] rec0=17 rec1=00 rec2=09 rec3=03c
[0x0a] rec0=18 rec1=00 rec2=0a rec3=000
tail 0x215003304815c637710b7 0x42a00088462061e03