|
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: 7737 (0x1e39)
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 String_Table;
with Table_Sort_Generic;
with Names_And_Expressions;
with Type_Information;
with String_Utilities;
with Ada_Program;
with Declarations;
with Representation_Elements;
with Representation_Clauses;
with Lines;
package body Analyze_Generic is
package Re renames Representation_Elements;
package Reps renames Representation_Clauses;
package Ti renames Type_Information;
package Ap renames Ada_Program;
package Ne renames Names_And_Expressions;
package Su renames String_Utilities;
Filler : constant String := " -- ";
procedure Sort_On_Position (List : in out Re.Data) is
function "<" (Left, Right : Re.Record_Rep) return Boolean is
begin
if Re.Word_Position (Left) = Re.Word_Position (Right) then
return Re.Start_Bit (Left) < Re.Start_Bit (Right);
else
return Re.Word_Position (Left) < Re.Word_Position (Right);
end if;
end "<";
procedure Sort_Position is
new Table_Sort_Generic (Re.Record_Rep, Positive, Re.Data, "<");
begin
Sort_Position (List);
end Sort_On_Position;
procedure Sort_On_Index (List : in out Re.Data) is
function "<" (Left, Right : Re.Record_Rep) return Boolean is
begin
return Re.Index (Left) < Re.Index (Right);
end "<";
procedure Sort_Index is new Table_Sort_Generic
(Re.Record_Rep, Positive, Re.Data, "<");
begin
Sort_Index (List);
end Sort_On_Index;
procedure Sort_On_Name (List : in out Re.Data) is
function "<" (Left, Right : Re.Record_Rep) return Boolean is
begin
return Re.Name (Left) < Re.Name (Right);
end "<";
procedure Sort_Name is new Table_Sort_Generic
(Re.Record_Rep, Positive, Re.Data, "<");
begin
Sort_Name (List);
end Sort_On_Name;
procedure Check_For_Duplicate_Names (Rep_List : in out Re.Data) is
Comp1, Comp2 : Re.Record_Rep;
begin
Sort_On_Name (List => Rep_List);
for I in Rep_List'First .. Rep_List'Last - 1 loop
Comp1 := Rep_List (I);
Comp2 := Rep_List (I + 1);
if Re.Name (Comp1) = Re.Name (Comp2) then
Re.Add_Error (Rep_List (I), Filler & "Duplicate Name");
Re.Add_Error (Rep_List (I + 1), Filler & "Duplicate Name");
end if;
end loop;
end Check_For_Duplicate_Names;
procedure Check_For_Undefined
(Type_List : Re.Record_Kind_List; Rep_List : in out Re.Data) is
Table : String_Table.Table := String_Table.New_Table;
Item : String_Table.Item;
Type_Iter : Re.Record_Kind_Iterator;
begin
Re.Init (Type_Iter, Type_List);
while not Re.Done (Type_Iter) loop
Item := String_Table.Unique (Re.Name (Re.Value (Type_Iter)), Table);
Re.Next (Type_Iter);
end loop;
for I in Rep_List'Range loop
if String_Table.Is_Nil (String_Table.Find
(Re.Name (Rep_List (I)), Table)) then
Re.Add_Error (Rep_List (I), Filler &
"Component Not Defined in Type");
end if;
end loop;
end Check_For_Undefined;
procedure Check_For_Position (Rep_List : in out Re.Data) is
Comp1, Comp2 : Re.Record_Rep;
begin
Sort_On_Position (Rep_List);
for I in Rep_List'Range loop
if Re.End_Bit (Rep_List (I)) > Long_Integer (Word_Size - 1) then
Re.Add_Error (Rep_List (I), Filler &
"End Bit Exceeds Word_Size");
end if;
end loop;
for I in Rep_List'First .. Rep_List'Last - 1 loop
Comp1 := Rep_List (I);
Comp2 := Rep_List (I + 1);
if Re.Word_Position (Comp1) = Re.Word_Position (Comp2) then
if Re.Start_Bit (Comp2) <= Re.End_Bit (Comp1) then
Re.Add_Error (Rep_List (I), Filler & "Bits Overlap");
Re.Add_Error (Rep_List (I + 1), Filler & "Bits Overlap");
end if;
end if;
end loop;
end Check_For_Position;
procedure Check_For_Sizes (Type_List : Re.Record_Kind_List;
Rep_List : in out Re.Data;
The_Record : Ada_Program.Element;
Warnings : in out Lines.Lines_Type) is
Type_Iter : Re.Record_Kind_Iterator;
Rep_Comp : Re.Record_Rep;
Type_Comp : Re.Record_Kind;
Reped_Size : Natural;
Not_Found : Boolean;
begin
Re.Init (Type_Iter, Type_List);
while not Re.Done (Type_Iter) loop
Type_Comp := Re.Value (Type_Iter);
for I in Rep_List'Range loop
Not_Found := True;
Rep_Comp := Rep_List (I);
if Re.Name (Type_Comp) = Re.Name (Rep_Comp) then
Not_Found := False;
if Re.Size (Type_Comp) /= Re.Size (Rep_Comp) then
Re.Add_Error
(Rep_List (I),
Filler & "Size Mismatch; Type's size of " &
Su.Number_To_String (Re.Size (Type_Comp)) &
" vs Rep's size of " &
Su.Number_To_String (Re.Size (Rep_Comp)));
end if;
exit;
end if;
end loop;
if Not_Found then
Lines.Add ("Warning - Type's component " & Re.Name (Type_Comp) &
" Is not defined in Rep Clause", Warnings);
end if;
Re.Next (Type_Iter);
end loop;
end Check_For_Sizes;
procedure Build_Output (Record_Element : Ap.Element;
Errors : in out Re.Data;
Warnings : Lines.Lines_Type;
Result : in out Lines.Lines_Type) is
Liter : Lines.Line_Iterator;
begin
Result := Lines.Make;
Sort_On_Index (Errors);
Lines.Add
("for " &
Declarations.Name
(Type_Information.Parent_Declaration (Record_Element)) & " use",
Result);
Lines.Add (" record", Result);
for I in Errors'Range loop
Lines.Add (" " & Re.Component_Image (Errors (I)), Result);
Liter := Lines.Initialize (Re.Errors (Errors (I)));
while not Lines.Done (Liter) loop
Lines.Add (Lines.Value (Liter), Result);
Lines.Next (Liter);
end loop;
end loop;
Lines.Add (" end record;", Result);
Lines.Add ("", Result);
Liter := Lines.Initialize (Warnings);
while not Lines.Done (Liter) loop
Lines.Add (Lines.Value (Liter), Result);
Lines.Next (Liter);
end loop;
Lines.Add ("", Result);
end Build_Output;
procedure Record_Representation_Clause
(For_Clause : Representation_Clause;
Result : in out Lines.Lines_Type) is separate;
procedure Length_Clause (For_Clause : Representation_Clause;
Result : in out Lines.Lines_Type) is separate;
procedure Enumeration_Clause (For_Clause : Representation_Clause;
Result : in out Lines.Lines_Type) is separate;
end Analyze_Generic;