|
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: 9205 (0x23f5)
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⟧
separate (Build_Release)
procedure Generate_Archive_Of (This_Version : in Full_Name) is
--
Unfiltered_Catalog : Structure.Catalog;
--
The_Catalog : Structure.Catalog;
--
The_Indirect_File : Io.File_Type;
--
procedure Write_Catalog_Node
(This_Catalog : in Structure.Catalog;
This_Indirect_File : in out Io.File_Type;
Control_Result : out Structure.Traversal_Control) is
begin
Io.Put_Line (This_Indirect_File,
Structure.Full_Location_Of (This_Catalog));
Control_Result := Structure.Continue;
end Write_Catalog_Node;
--
procedure Write_Section_Node
(This_Section : in Structure.Section;
This_Indirect_File : in out Io.File_Type;
Control_Result : out Structure.Traversal_Control) is
begin
Io.Put_Line (This_Indirect_File,
Structure.Full_Location_Of (This_Section));
Control_Result := Structure.Continue;
end Write_Section_Node;
--
procedure Write_Free_Form_Item (This_Item : in Structure.Item;
This_Indirect_File : in out Io.File_Type) is
begin
Io.Put_Line (This_Indirect_File,
Names.All_Objects_In
(This_Library => Structure.Full_Location_Of (This_Item),
Include_Object_Itself => True,
Transitive => True));
end Write_Free_Form_Item;
function Is_Allowable_Spec_View
(This_View_Name : in Full_Name; This_Item : in Structure.Item)
return Boolean is
--
The_Spec_Views : Structure.Object_List :=
Structure.Spec_Views_For (This_Item);
--
begin
Structure.Reset (The_Spec_Views);
while (not Structure.Done (The_Spec_Views)) loop
if (Structure.Name_Of (Structure.Current_Object (The_Spec_Views)) =
This_View_Name) then
return (True);
end if;
Structure.Next (The_Spec_Views);
end loop;
return (False);
end Is_Allowable_Spec_View;
function Is_Allowable_Load_View
(This_View_Name : in Full_Name; This_Item : in Structure.Item)
return Boolean is
--
The_Load_Views : Structure.Object_List :=
Structure.Load_Views_For (This_Item);
--
begin
Structure.Reset (The_Load_Views);
while (not Structure.Done (The_Load_Views)) loop
if (Structure.Name_Of (Structure.Current_Object (The_Load_Views)) =
This_View_Name) then
return (True);
end if;
Structure.Next (The_Load_Views);
end loop;
return (False);
end Is_Allowable_Load_View;
procedure Write_Non_Free_Form_Item
(This_Item : in Structure.Item;
This_Indirect_File : in out Io.File_Type) is
--
-- We need to make sure to write to the indirect file only those views
-- which are listed in the data file.
--
begin
Io.Put_Line (This_Indirect_File,
Structure.Full_Location_Of (This_Item));
declare
The_Objects : Object_Info.Objects :=
Directory_Tools.Naming.Resolution
(Names.All_Objects_In
(This_Library => Structure.Full_Location_Of (This_Item),
Include_Object_Itself => False,
Transitive => False));
begin
Directory_Tools.Object.Reset (The_Objects);
while (not Directory_Tools.Object.Done (The_Objects)) loop
declare
Current_Object : Object_Info.Object :=
Directory_Tools.Object.Value (The_Objects);
Current_Object_Name : constant Full_Name :=
Directory_Tools.Naming.Full_Name (Current_Object);
begin
if (not Object_Info.Any.Is_View (Current_Object)) then
Io.Put_Line (This_Indirect_File,
Names.All_Objects_In
(This_Library => Current_Object_Name,
Include_Object_Itself => True,
Transitive => True));
elsif (Is_Allowable_Spec_View
(Current_Object_Name, This_Item)) then
Io.Put_Line (This_Indirect_File,
Names.All_Objects_In
(This_Library => Current_Object_Name,
Include_Object_Itself => True,
Transitive => True));
elsif (Is_Allowable_Load_View
(Current_Object_Name, This_Item)) then
Io.Put_Line (This_Indirect_File,
Names.All_Objects_In
(This_Library => Current_Object_Name,
Include_Object_Itself => True,
Transitive => True));
end if;
end;
Directory_Tools.Object.Next (The_Objects);
end loop;
end;
end Write_Non_Free_Form_Item;
procedure Write_Item_Node
(This_Item : in Structure.Item;
This_Indirect_File : in out Io.File_Type;
Control_Result : out Structure.Traversal_Control) is
begin
case (Structure.Kind_Of (This_Item)) is
when Syntax.Free_Form =>
Write_Free_Form_Item (This_Item, This_Indirect_File);
when Syntax.Visible_Units | Syntax.Code_Only =>
Write_Non_Free_Form_Item (This_Item, This_Indirect_File);
when others =>
null;
end case;
Control_Result := Structure.Continue;
end Write_Item_Node;
--
procedure Finalize (This_Catalog : in Structure.Catalog;
This_Indirect_File : in out Io.File_Type) is
begin
Low_Level_File_Operations.Close (This_Indirect_File);
end Finalize;
--
procedure Generate_Indirect_File is
new Structure.Traverse (Io.File_Type,
Write_Catalog_Node,
Write_Section_Node,
Write_Item_Node,
Finalize);
--
function Options_For (This_Catalog : in Structure.Catalog) return String is
begin
return ("R1000 NONRECURSIVE LABEL=(" &
Structure.Version_Of (This_Catalog) & ")");
end Options_For;
--
begin
Log.Put_Line ("Creating archive of catalog");
Log.Put_Line ("Parsing data file");
Unfiltered_Catalog := Structure_Utilities.Catalog_For (This_Version);
Structure.Assert_Is_Good (Unfiltered_Catalog);
Structure_Utilities.Display_Diagnostic
(Unfiltered_Catalog, Response, Display_Warning_Messages => True);
Log.Put_Line ("Data file parsed", Profile.Positive_Msg);
Log.Put_Line ("Filtering catalog");
The_Catalog := Structure_Utilities.Filtered_Catalog_From
(Unfiltered_Catalog);
Log.Put_Line ("Catalog filtered", Profile.Positive_Msg);
begin
Log.Put_Line ("Verifying filtered catalog");
Structure_Utilities.Verify (The_Catalog, Response => Response);
Log.Put_Line ("Filtered catalog verified", Profile.Positive_Msg);
--
exception
when others =>
Error.Report ("Unable to verify filtered catalog, quitting",
Nested => True);
--
end;
Log.Put_Line ("Generating indirect file");
The_Indirect_File :=
Low_Level_File_Operations.Open_To_Write
(Pathnames.Archive_Directives_File_For (This_Version));
Generate_Indirect_File (The_Catalog, The_Indirect_File);
Log.Put_Line ("Indirect file generated", Profile.Positive_Msg);
begin
Log.Put_Line ("Archiving contents of indirect file");
Archive.Save (Objects => Names.Indirect_File_Name_For
(Pathnames.Archive_Directives_File_For
(This_Version)),
Options => Options_For (The_Catalog),
Device => This_Version,
Response => "PROPAGATE,<PROFILE>");
--
exception
when others =>
Error.Report ("Archive failed, quitting", Nested => True);
--
end;
Log.Put_Line ("Catalog archive created successfully", Profile.Positive_Msg);
--
exception
when Structure.Bad_Element =>
Structure_Utilities.Display_Diagnostic
(Unfiltered_Catalog, Response, Display_Warning_Messages => True);
Error.Report (Error.Nil_Message, Nested => True);
when others =>
raise;
--
end Generate_Archive_Of;