|
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: 21221 (0x52e5)
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 Text_Io, Character_Set, Count_Of_Ada_Statements;
package body Pager_Support is
--
-- Common variables and exceptions
--
Max_String : constant := 1024;
New_File : Text_Io.File_Type;
Paged_File : Text_Io.File_Type;
Last : Natural;
Line : String (1 .. Max_String);
type File_Name_String is
record
Name : String (1 .. File_Name_Length);
Length : Natural;
end record;
File_Create_Error : exception;
File_Open_Error : exception;
-- ==============================================================
package Fn_List is
--
-- This package provides simple manipulation for a singly-linked list
-- of objects of type FILE_NAME_STRING
--
procedure Initialize_List;
--
-- Initialize the list
--
procedure Append_Element (Element : File_Name_String);
--
-- Add element onto the end of the list
--
procedure Set_First;
--
-- Goto the front of the list
--
function Return_Current_Element return File_Name_String;
--
-- Return the current element in the list
--
function Current_Next return Boolean;
--
-- Advance to next element in the list; return TRUE if done
--
end Fn_List;
package body Fn_List is
type File_Name_Element;
type Element_Pointer is access File_Name_Element;
type File_Name_Element is
record
Data : File_Name_String;
Next : Element_Pointer;
end record;
First_Element : Element_Pointer;
Current_Element : Element_Pointer;
procedure Initialize_List is
begin
First_Element := null;
end Initialize_List;
procedure Append_Element (Element : File_Name_String) is
begin
if First_Element = null then
First_Element := new File_Name_Element;
Current_Element := First_Element;
Current_Element.Next := null;
Current_Element.Data := Element;
else
Current_Element.Next := new File_Name_Element;
Current_Element := Current_Element.Next;
Current_Element.Next := null;
Current_Element.Data := Element;
end if;
end Append_Element;
procedure Set_First is
begin
Current_Element := First_Element;
end Set_First;
function Return_Current_Element return File_Name_String is
begin
return Current_Element.Data;
end Return_Current_Element;
function Current_Next return Boolean is
begin
if Current_Element = null then
return False;
elsif Current_Element.Next = null then
return False;
else
Current_Element := Current_Element.Next;
return True;
end if;
end Current_Next;
end Fn_List;
-- ==============================================================
package Nat_Io is new Text_Io.Integer_Io (Natural);
--
-- Open the input file
--
procedure Open_Input (Input_File_Name : String) is
begin
Text_Io.Open (Paged_File, Text_Io.In_File, Input_File_Name);
exception
when others =>
raise File_Open_Error;
end Open_Input;
--
-- Create the paged output file
--
procedure Create_File (Output_File_Name : String) is
begin
Text_Io.Create (Paged_File, Text_Io.Out_File, Output_File_Name);
exception
when others =>
raise File_Create_Error;
end Create_File;
--
-- Close the paged file if it is open
--
procedure Close_Paged_File is
begin
if Text_Io.Is_Open (Paged_File) then
Text_Io.Close (Paged_File);
end if;
end Close_Paged_File;
--
-- Test to see if current line denotes another file
--
function File_Name_Line return Boolean is
begin
if Last >= 10 and then (Line (1 .. 10) = "::::::::::" or
Line (1 .. 10) = "--::::::::") then
return True;
else
return False;
end if;
end File_Name_Line;
--
-- PAGE accepts a number of file names and generates a paged file
-- containing each of the indicated files prefixed by the form:
-- ::::::::::
-- filename
-- ::::::::::
--
procedure Page (Output_File_Name : String) is
--
-- Variables for PAGE
--
File_Name_Entry : File_Name_String;
File_Name : String (1 .. File_Name_Length);
Length : Natural;
--
-- Append indicated file to end of output file
--
procedure Append_File (File_Name : String) is
Input_File : Text_Io.File_Type;
Inline : String (1 .. Max_String);
Length : Natural;
Line_Count : Natural := 0;
begin
Text_Io.Open (Input_File, Text_Io.In_File, File_Name);
if Comment_Prefix then
Text_Io.Put (Paged_File, "--");
end if;
Text_Io.Put_Line (Paged_File, "::::::::::");
if Comment_Prefix then
Text_Io.Put (Paged_File, "--");
end if;
Text_Io.Put_Line (Paged_File, File_Name);
if Comment_Prefix then
Text_Io.Put (Paged_File, "--");
end if;
Text_Io.Put_Line (Paged_File, "::::::::::");
while not Text_Io.End_Of_File (Input_File) loop
Text_Io.Get_Line (Input_File, Inline, Length);
Text_Io.Put_Line (Paged_File, Inline (1 .. Length));
begin
Line_Count := Line_Count + 1;
exception
when others =>
null; -- trap overflow
end;
end loop;
Text_Io.Close (Input_File);
if Verbose then
Text_Io.Put (" ");
Nat_Io.Put (Line_Count, 8);
Text_Io.Put_Line (" Lines");
end if;
exception
when Text_Io.Name_Error =>
Text_Io.Put_Line (" File Name Error");
Text_Io.Close (Input_File);
raise File_Open_Error;
when others =>
Text_Io.Close (Input_File);
raise File_Open_Error;
end Append_File;
--
-- Process the indicated file as an include file; ie, this file
-- contains a list of files to be included
--
procedure Include_File (File_Name : String) is
Ifile : Text_Io.File_Type;
Ifile_Name : String (1 .. File_Name_Length);
Length : Natural;
procedure Name_Include_File is
begin
if Verbose then
Text_Io.Put (" ");
Text_Io.Put_Line (File_Name_Entry.Name
(1 .. File_Name_Entry.Length));
end if;
end Name_Include_File;
begin
if Verbose then
Text_Io.Put (" Include File: ");
Text_Io.Put_Line (File_Name);
end if;
--
-- Try to open include file
--
Text_Io.Open (Ifile, Text_Io.In_File, File_Name);
--
-- If INCLUDE_FILE_PREFIX is true, add the include file itself
--
if Include_File_Prefix then
File_Name_Entry.Name (1 .. File_Name'Length) := File_Name;
File_Name_Entry.Length := File_Name'Length;
Fn_List.Append_Element (File_Name_Entry);
Name_Include_File;
end if;
--
-- Add each file in the include file; omit blank lines and
-- lines beginning with - (comment lines)
--
loop
begin
Text_Io.Get_Line (Ifile, Ifile_Name, Length);
if Length /= 0 and Ifile_Name (1) /= '-' then
--
-- Allow for include file nesting
--
if Ifile_Name (1) = Include_File_Prefix_Char then
Include_File (Ifile_Name (2 .. Length));
--
-- Include a conventional file
--
else
File_Name_Entry.Name := Ifile_Name;
File_Name_Entry.Length := Length;
Fn_List.Append_Element (File_Name_Entry);
Name_Include_File;
end if;
end if;
exception
when Text_Io.End_Error =>
Text_Io.Close (Ifile);
if Verbose then
Text_Io.Put (" End of Include File ");
Text_Io.Put_Line (File_Name);
end if;
exit;
when Text_Io.Name_Error =>
Text_Io.Close (Ifile);
Text_Io.Put_Line (" File Name Error");
when others =>
Text_Io.Close (Ifile);
raise;
end;
end loop;
exception
when Text_Io.End_Error =>
Text_Io.Put_Line (" Include File ");
Text_Io.Put (File_Name);
Text_Io.Put_Line (" NOT Found");
when others =>
raise;
end Include_File;
--
-- Mainline of PAGE
--
begin
Create_File (Output_File_Name);
Fn_List.Initialize_List;
Text_Io.Put_Line ("Enter Names of Files (RETURN when done)");
loop
Text_Io.Put (" Input File Name > ");
Text_Io.Get_Line (File_Name, Length);
exit when Length = 0;
if File_Name (1) = Include_File_Prefix_Char then
Include_File (File_Name (2 .. Length));
else
File_Name_Entry.Name := File_Name;
File_Name_Entry.Length := Length;
Fn_List.Append_Element (File_Name_Entry);
end if;
end loop;
Text_Io.New_Line;
Text_Io.Put_Line (" Component Files --");
Fn_List.Set_First;
loop
begin
File_Name_Entry := Fn_List.Return_Current_Element;
Text_Io.Put (" ");
Text_Io.Put_Line (File_Name_Entry.Name
(1 .. File_Name_Entry.Length));
Append_File (File_Name_Entry.Name
(1 .. File_Name_Entry.Length));
exit when not Fn_List.Current_Next;
exception
when File_Open_Error =>
Text_Io.Put (" -- File NOT Found");
exit when not Fn_List.Current_Next;
when others =>
raise;
end;
end loop;
Close_Paged_File;
exception
when File_Create_Error =>
Text_Io.Put (" Error in creating output file ");
Text_Io.Put_Line (Output_File_Name);
Close_Paged_File;
when File_Open_Error =>
Text_Io.Put (" Error in opening input file ");
Text_Io.Put_Line (File_Name_Entry.Name
(1 .. File_Name_Entry.Length));
Close_Paged_File;
when others =>
Close_Paged_File;
end Page;
--
-- UNPAGE extracts the component files from a paged file and writes them
-- out to their respective files
--
procedure Unpage (Input_File_Name : String) is
Line_Count : Natural;
--
-- Open new file for output
--
procedure Open_New_File is
Name_Start : Integer;
begin
Text_Io.Get_Line (Paged_File, Line, Last);
Text_Io.Put (" ");
Text_Io.Put_Line (Line (1 .. Last));
if Line (1 .. 2) = "--" then
Name_Start := 3;
else
Name_Start := 1;
end if;
loop
begin
Text_Io.Create (New_File, Text_Io.Out_File,
Line (Name_Start .. Last));
exit;
exception
when Text_Io.Name_Error =>
Text_Io.New_Line;
Text_Io.Put (" Invalid File Name (");
Text_Io.Put (Line (Name_Start .. Last));
Text_Io.Put_Line (")");
Text_Io.Put (" Enter Valid File Name > ");
Text_Io.Get_Line (Line, Last);
Name_Start := 1;
when others =>
raise;
end;
end loop;
--Skip over the trailing ":::::::::::::" line
Text_Io.Get_Line (Paged_File, Line, Last);
exception
when others =>
raise File_Create_Error;
end Open_New_File;
--
-- Mainline of UNPAGE
--
begin
Open_Input (Input_File_Name);
--
-- Search for first component in paged file
--
loop
Text_Io.Get_Line (Paged_File, Line, Last);
exit when File_Name_Line;
end loop;
--
-- Process each component in paged file
--
Open_New_File;
Line_Count := 0;
loop
Text_Io.Get_Line (Paged_File, Line, Last);
if File_Name_Line then
Text_Io.Close (New_File);
if Verbose then
Text_Io.Put (" ");
Nat_Io.Put (Line_Count, 8);
Text_Io.Put_Line (" Lines");
end if;
Line_Count := 0;
Open_New_File;
else
begin
Line_Count := Line_Count + 1;
exception
when others =>
null; -- trap overflow
end;
Text_Io.Put_Line (New_File, Line (1 .. Last));
end if;
end loop;
exception
when File_Create_Error =>
Text_Io.Put_Line (" Error in creating output file");
Close_Paged_File;
when File_Open_Error =>
Text_Io.Put_Line (" Error in opening input file");
Close_Paged_File;
when Text_Io.End_Error =>
if Text_Io.Is_Open (New_File) then
Text_Io.Close (New_File);
if Verbose then
Text_Io.Put (" ");
Nat_Io.Put (Line_Count, 8);
Text_Io.Put_Line (" Lines");
end if;
end if;
Close_Paged_File;
when others =>
Close_Paged_File;
end Unpage;
--
-- ADA_CHECK computes and displays the number of Ada statements, Ada
-- comments, text lines, and a checksum hash code for the indicated file
--
procedure Ada_Check (Input_File_Name : String) is
Statements : Natural;
Lines : Natural;
Comments : Natural;
Hash : Natural;
begin
Count_Of_Ada_Statements
(Input_File_Name, Statements, Lines, Comments, Hash);
Text_Io.Put ("Input File: ");
Text_Io.Put_Line (Input_File_Name);
Text_Io.Put (" Ada Statements: ");
Nat_Io.Put (Statements, 6);
Text_Io.New_Line;
Text_Io.Put (" Ada Comments: ");
Nat_Io.Put (Comments, 6);
Text_Io.New_Line;
Text_Io.Put (" Text Lines: ");
Nat_Io.Put (Lines, 6);
Text_Io.New_Line;
Text_Io.Put (" Checksum: ");
Nat_Io.Put (Hash, 6);
Text_Io.New_Line;
end Ada_Check;
--
-- SCANPAGE scans a paged file and prints out the names of the files
-- contained therein
--
procedure Scanpage (Input_File_Name : String) is
--
-- Variables et al
--
Line_Count : Natural;
--
-- Advance to a new file
--
procedure New_File is
Name_Start : Natural;
begin
-- Get file name
Text_Io.Get_Line (Paged_File, Line, Last);
-- Print file name
if Line (1 .. 2) = "--" then
Name_Start := 3;
else
Name_Start := 1;
end if;
Text_Io.Put (" ");
Text_Io.Put (Line (Name_Start .. Last));
Line_Count := 0;
-- Skip over the trailing ":::::::::::::" line
Text_Io.Get_Line (Paged_File, Line, Last);
end New_File;
--
-- Print value of LINE_COUNT
--
procedure Print_Line_Count is
begin
Text_Io.New_Line;
if Verbose then
Text_Io.Put (" ");
Nat_Io.Put (Line_Count, 8);
Text_Io.Put_Line (" Lines");
end if;
end Print_Line_Count;
--
-- Mainline of SCANPAGE
--
begin
Ada_Check (Input_File_Name);
Open_Input (Input_File_Name);
--
-- Search for first component in paged file
--
loop
Text_Io.Get_Line (Paged_File, Line, Last);
exit when File_Name_Line;
end loop;
Text_Io.Put_Line (" Component Files -- ");
--
-- Process each component in paged file
--
New_File;
loop
begin
Text_Io.Get_Line (Paged_File, Line, Last);
begin
Line_Count := Line_Count + 1;
exception
when others =>
null; -- trap overflow
end;
if File_Name_Line then
begin
Line_Count := Line_Count - 1;
exception
when others =>
null; -- trap overflow
end;
Print_Line_Count;
New_File;
end if;
exception
when Text_Io.End_Error =>
Print_Line_Count;
exit;
when others =>
raise;
end;
end loop;
Close_Paged_File;
exception
when File_Create_Error =>
Text_Io.Put_Line (" Error in creating output file");
Close_Paged_File;
when File_Open_Error =>
Text_Io.Put_Line (" Error in opening input file");
Close_Paged_File;
when Text_Io.End_Error =>
Close_Paged_File;
when others =>
Close_Paged_File;
end Scanpage;
--
-- COMMAND inputs and does a simple parse of the command line
--
function Command return Character is
Index : Natural;
Fn_Index : Natural;
Command_Line : String (1 .. 256);
Command_Length : Natural;
Command_Character : Character;
begin
loop
Text_Io.Get_Line (Command_Line, Command_Length);
Command_Line (Command_Length + 1) := Ascii.Nul;
if Command_Length > 0 then
Command_Character := Command_Line (1);
Index := 1;
-- Skip over command name
loop
exit when Character_Set.Is_Space (Command_Line (Index)) or
Command_Line (Index) = Ascii.Nul;
Index := Index + 1;
end loop;
-- Skip over space chars
loop
exit when (not Character_Set.Is_Space
(Command_Line (Index))) or
Command_Line (Index) = Ascii.Nul;
Index := Index + 1;
end loop;
-- Save file name
Fn_Index := 1;
loop
exit when Command_Line (Index) = Ascii.Nul;
Input_File_Name (Fn_Index) := Command_Line (Index);
Index := Index + 1;
Fn_Index := Fn_Index + 1;
end loop;
Input_File_Name (Fn_Index) := Ascii.Nul;
Input_File_Name_Length := Fn_Index - 1;
exit;
end if;
end loop;
return Character_Set.To_Upper (Command_Character);
end Command;
end Pager_Support;