-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : generic package Context_Directed_Update_Utilities -- Version : 1.1 (FRAN246) -- Author : Geoffrey O. Mendal -- : Stanford University -- : Computer Systems Laboratory -- : Stanford, CA 94305 -- : (415) 723-1414 or 723-1175 -- DDN Address : Mendal@SU-SIERRA.ARPA -- Copyright : (c) 1985, 1986 Geoffrey O. Mendal -- Date created : Sat 28 Dec 85 -- Release date : Sun 29 Dec 85 -- Last update : MENDAL Fri 24 Jan 86 -- Machine/System Compiled/Run on : DG MV10000, ROLM ADE -- VAX 11/780, DEC ACS -- RATIONAL R1000 -- Dependent Units : package TEXT_IO -- -* --------------------------------------------------------------- -- -* -- Keywords : REVISION CONTROL ----------------: CDUPDATE -- -- Abstract : This generic package contains routines to ----------------: perform file revision control. Given a ----------------: baseline ASCII file, and one or more ----------------: update decks stored in a single file, it ----------------: generates an updated or downdated version of ----------------: the baseline. The update decks can be generated ----------------: automatically by the package File_Compare_Utilities -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 12/29/85 1.0 (SAEC285) Mendal Initial Release -- 01/24/86 1.1 (FRAN246) Mendal Bug fixes, enhancements -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- Context_Directed_Update_Utilities is an implementation independent -- revision control facility for ASCII files. It takes a baseline -- file and context directed update deck as input and produces a new -- file which is the result of the mapping between the baseline file -- and the CDUPDATE deck. -- This utility is best used in conjunction with File_Compare_Utilities -- which itself can generate CDUPDATE decks. Of course, a user can -- construct and/or edit such CDUPDATE decks himself. The CDUPDATE -- decks are also ASCII files and hence can be ported between Ada -- environments and different machines. -- Many CDUPDATE decks can be chained together in one file, one -- after the other. Context_Directed_Update_Utilities will -- then perform repeated updates until all decks have been -- exhausted. This achieves the same semantics as running -- Context_Directed_Update_Utilities subprograms once per -- CDUPDATE deck, where each CDUPDATE deck is in its own file. -- This package requires the use of temporary ASCII files, -- generated according to the Ada Reference Manual's TEXT_IO.CREATE -- semantics for null file names. An implementation must also be -- able to support various "reset" and "rewrite" operations on -- ASCII files (see below for details). generic Maximum_File_Name_Length : in POSITIVE := 100; Maximum_Line_Length : in POSITIVE := 256; -- The above values are used to specify the maximum length -- of strings. Such strings are used in the package body. package Context_Directed_Update_Utilities is Context_Directed_Update_Utilities_Version : constant STRING := "1.1 (FRAN246)"; -- The following type can be used to retrieve statistics generated -- by the first Cdupdate subprogram below. type Statistics_Type is record Number_Base_Lines, -- number of lines in the base file Number_Deck_Lines, -- number of lines in the deck file Number_New_Lines, -- number of lines in the new file Total_Begin_Commands, -- number of Begin commands Total_Comment_Commands, -- number of Comment commands Total_Copy_Commands, -- number of Copy commands Total_Delete_Commands, -- number of Delete commands Total_Echo_Commands, -- number of Echo commands Total_Edit_Commands, -- number of Edit commands Total_End_Commands, -- number of End commands Total_Error_Commands, -- number of commands in error Total_Insertions, -- number of insertions Total_Decks : NATURAL; -- number of CDUPDATE decks end record; -- The following type can be used to specify options to the -- Cdupdate subprograms. Note that a default options record -- is provided below. type Options_Type is record Print_Errors, Case_Sensitive : BOOLEAN; end record; Default_Options : Options_Type := (Print_Errors => TRUE, Case_Sensitive => TRUE); -- Notes on the options: -- (1) Print_Errors will cause all commands that are in error -- to be reported on the error file. If this option is -- set to FALSE, no error messages will be generated and -- the error file itself will not be created. Hence, when -- this option is set to FALSE, a user need only provide -- a null string literal as the error file name. (Any value -- provided when this option is FALSE will be ignored.) -- (2) Case_Sensitive causes lines to be analyzed with regard -- for upper and lower case. If a case insensitive analysis -- is desired, this option should be set to FALSE. This option -- only has an effect for Edit commands. If this option is -- set to FALSE, Edit commands will still be processed -- with case sensitivity. Thus, this option has the effect -- of only analyzing a substitution pattern without regard -- to upper and lower case; the replacement pattern will -- always be output with case sensitivity. File_Name_Length_Error, Base_File_Open_Error, Deck_File_Open_Error, New_File_Create_Error, New_File_Reset_Error, New_File_Rewrite_Error, Error_File_Create_Error, Temporary_File_Create_Error, Temporary_File_Reset_Error, Temporary_File_Rewrite_Error : exception; -- Notes on the exceptions: -- (1) The "Open_Error" exceptions are propagated when the -- subprograms perform TEXT_IO.OPENs on the base and -- deck files as TEXT_IO.IN_FILEs but a TEXT_IO exception -- was raised. The most probable error is that the file -- doesn't exist or access to it is not allowed. -- (2) The "Create_Error" exceptions are propagated when the -- subprograms perform TEXT_IO.CREATEs on the list and -- deck files as TEXT_IO.OUT_FILEs but a TEXT_IO exception was -- raised. -- (3) The "Reset_Error" and "Rewrite_Error" exceptions are -- propagated when the subprograms perform successive -- TEXT_IO file operations. Such operations attempt to -- change the mode of the file from OUT_FILE to IN_FILE -- (resets), and from IN_FILE to OUT_FILE (rewrites). -- For a reset operation, TEXT_IO.CLOSE and TEXT_IO.OPEN are -- used. For a rewrite operation, TEXT_IO.CLOSE and -- TEXT_IO.CREATE are used. For the temporary file, -- TEXT_IO.RESET is used for reset operations since a -- TEXT_IO.CLOSE followed by a TEXT_IO.OPEN cannot work. -- (4) The File_Name_Length_Error exception is propagated by a -- subprogram when the length of a passed file name is -- greater than Maximum_File_Name_Length. -- The following character is used to denote the command code -- for CDUPDATE commands. Its default is the same as the -- File_Compare_Utilities package's default. The subtype allows -- for only non-blank printable characters. subtype Code_Character_Type is CHARACTER range '!' .. '~'; Command_Code : Code_Character_Type := '/'; -- The following subprogram takes a base, deck, new, and error -- file as input, and (depending on the options set), returns -- statistics, a new file, and an error file. The base and -- deck files will be OPENed, the error file will CREATed, -- and the new file will be CREATed, and possibly "reset" and -- "rewritten". All files will be CLOSEd upon normal termination. procedure Cdupdate ( Base_File_Name, Deck_File_Name, New_File_Name, Error_File_Name : in STRING; Statistics : out Statistics_Type; Options : in Options_Type := Default_Options); -- The following overloading should be used when no statistics -- are required. See above for detailed semantics on the -- on the file operations. procedure Cdupdate ( Base_File_Name, Deck_File_Name, New_File_Name, Error_File_Name : in STRING; Options : in Options_Type := Default_Options); end Context_Directed_Update_Utilities; ------------------------------------------------------------------------ -- Example uses: -- Example #1: Update a base file -- with Context_Directed_Update_Utilities; -- procedure Main is -- package Cdupdate_Utilities is new Context_Directed_Update_Utilities; -- begin -- Cdupdate_Utilities.Cdupdate ("Base.Ada","Deck","New.Ada","Errors"); -- end Main; -- --------------------------------------------------------------------- -- Example #2: Update a base file and generate all possible output -- with Context_Directed_Update_Utilities; -- procedure Main is -- package Cdupdate_Utilities is new Context_Directed_Update_Utilities; -- Statistics : Cdupdate_Utilities.Statistics_Type; -- begin -- Cdupdate_Utilities.Cdupdate ("Base.Ada","Deck","New.Ada","Errors", -- Statistics); -- end Main; -- --------------------------------------------------------------------- -- Example #3: Update a base file, and alter the maximum line length, -- the command code character, and options. -- procedure Main is -- package Cdupdate_Utilities is new Context_Directed_Update_Utilities ( -- Maximum_Line_Length => 80); -- begin -- Cdupdate_Utilities.Command_Code := '#'; -- Cdupdate_Utilities.Default_Options.Print_Errors := FALSE; -- Cdupdate_Utilities.Default_Options.Case_Sensitive := FALSE; -- Cdupdate_Utilities.Cdupdate ("Base.Ada","Deck","New.Ada",""); -- end Main; with TEXT_IO; -- predefined I/O package package body Context_Directed_Update_Utilities is -- Global constants, types, and objects used throughout the -- package body follow below. The constants eliminate the use -- of "magic numbes" in the code, thus increasing readability -- and reliability. Number_of_Command_Forms : constant POSITIVE := 30; Squote : constant CHARACTER := '''; Dquote : constant CHARACTER := '"'; Blank : constant CHARACTER := ' '; Period : constant CHARACTER := '.'; Uc_Lc_Offset : constant POSITIVE := CHARACTER'POS (ASCII.LC_A) - CHARACTER'POS ('A'); Terminate_Abnormally : exception; -- Used as an error escape in the -- processing routines below. subtype Set_of_Lower_Case_Letters is CHARACTER range ASCII.LC_A .. ASCII.LC_Z; subtype File_Name_Type is STRING (1 .. Maximum_File_Name_Length); type Files_Type is record Base_File_Name, Deck_File_Name, New_File_Name, Error_File_Name : File_Name_Type; Base_File_Length, Deck_File_Length, New_File_Length, Error_File_Length : NATURAL; Base_File, Deck_File, New_File, Error_File, Temporary_File : TEXT_IO.FILE_TYPE; end record; subtype Line_Type is STRING (1 .. Maximum_Line_Length); type Data_Line_Type is record Line : Line_Type; Length : NATURAL; end record; type Type_of_Error_Type is (Invalid_Command, Missing_Begin, Extra_Begin, Unsequenced, End_of_File, Invalid_Parameter, Nonexistant_Column, Pattern_Failure, Missing_Parameter, Extra_Parameter, Resultant_Overflow); type Deck_Info_Type is record Deck_Line : Data_Line_Type; Deck_Line_Number, Column : NATURAL; end record; Curr_Base_Line_Number : POSITIVE; Read_From_Temp_File : BOOLEAN; Expecting_Begin : BOOLEAN; type Command_Forms_Array_Type is array (POSITIVE range <>) of Data_Line_Type; Command_Forms_Array : Command_Forms_Array_Type (1 .. Number_of_Command_Forms); subtype Begin_Range is POSITIVE range 1 .. 5; subtype Comment_Range is POSITIVE range 6 .. 12; subtype Copy_Range is POSITIVE range 13 .. 16; subtype Delete_Range is POSITIVE range 17 .. 22; subtype Echo_Range is POSITIVE range 23 .. 25; subtype Edit_Range is POSITIVE range 26 .. 28; -- The following procedure takes a data record and converts all -- lower case characters to upper case. procedure Convert_to_Upper_Case (Line : in out Data_Line_Type) is begin for I in 1 .. Line.Length loop if Line.Line (I) in Set_of_Lower_Case_Letters then Line.Line (I) := CHARACTER'VAL (CHARACTER'POS (Line.Line (I)) - Uc_Lc_Offset); end if; end loop; end Convert_to_Upper_Case; ---------------------------------------------------------------------- -- The following procedure reads the next line in the CDUPDATE deck -- file and returns it in a data record. procedure Read_a_Line ( Input_File : in out TEXT_IO.FILE_TYPE; Number_Lines : in out NATURAL; Output_Line : out Data_Line_Type) is begin TEXT_IO.GET_LINE (Input_File,Output_Line.Line,Output_Line.Length); Number_Lines := Number_Lines + 1; end Read_a_Line; ---------------------------------------------------------------------- -- The following procedure grabs the next parameter off the current -- CDUPDATE command line being processed. Several options are -- specified to check for the command name itself, and delimiters -- in the case of the EDIT command. procedure Get_Next_Word ( Command_Word : in BOOLEAN; Line : in Data_Line_Type; Delimiter1, Delimiter2 : in CHARACTER; Line_Pointer : in out POSITIVE; Word : out Data_Line_Type) is Word_Pointer : POSITIVE := 1; Delimiter : CHARACTER; begin Word := (Line => (others => Blank), Length => 0); -- Skip over initial blanks, unless we are looking for a CDUPDATE -- command (which must start in column 1). if not Command_Word then while (Line_Pointer <= Line.Length) and then (Line.Line (Line_Pointer) = Blank) loop Line_Pointer := Line_Pointer + 1; end loop; end if; -- Store the delimiter we are currently at. if (Line_Pointer <= Line.Length) and then (((Delimiter1 /= Blank) or (Delimiter2 /= Blank)) and ((Line.Line (Line_Pointer) = Delimiter1) or (Line.Line (Line_Pointer) = Delimiter2)) ) then -- EDIT pattern parameters Word.Line (Word_Pointer) := Line.Line (Line_Pointer); Delimiter := Line.Line (Line_Pointer); Word_Pointer := Word_Pointer + 1; Line_Pointer := Line_Pointer + 1; else -- all other parameters Delimiter := Blank; end if; -- Store the parameter. while (Line_Pointer <= Line.Length) and then (Line.Line (Line_Pointer) /= Delimiter) loop Word.Line (Word_Pointer) := Line.Line (Line_Pointer); Word_Pointer := Word_Pointer + 1; Line_Pointer := Line_Pointer + 1; end loop; -- Special case check for EDIT pattern parameters. if (Line_Pointer <= Line.Length) and then ((Delimiter /= Blank) and (Line.Line (Line_Pointer) = Delimiter) ) then Word.Line (Word_Pointer) := Line.Line (Line_Pointer); Word_Pointer := Word_Pointer + 1; Line_Pointer := Line_Pointer + 1; end if; Word.Length := Word_Pointer - 1; end Get_Next_Word; ---------------------------------------------------------------------- -- The following procedure handles the printing of all error messages -- to the error file. procedure Print_Error ( Deck_Info : in Deck_Info_Type; Type_of_Error : in Type_of_Error_Type; Options : in Options_Type; Error_File : in out TEXT_IO.FILE_TYPE; Total_Error_Commands : in out NATURAL) is begin Total_Error_Commands := Total_Error_Commands + 1; if Options.Print_Errors then case Type_of_Error is when Invalid_Command => TEXT_IO.PUT (Error_File,"--> Invalid CDUPDATE command"); when Missing_Begin => TEXT_IO.PUT (Error_File,"--> Missing " & Command_Code & "BEGIN command"); when Extra_Begin => TEXT_IO.PUT (Error_File,"--> Extra " & Command_Code & "BEGIN command (ignored)"); when Unsequenced => TEXT_IO.PUT (Error_File,"--> Unsequenced line number parameter"); when End_of_File => TEXT_IO.PUT (Error_File,"--> Line specified beyond EOF(baseline)"); when Invalid_Parameter => TEXT_IO.PUT (Error_File,"--> Invalid parameter encountered"); when Nonexistant_Column => TEXT_IO.PUT (Error_File,"--> Column specified beyond line length"); when Pattern_Failure => TEXT_IO.PUT (Error_File,"--> Substitution pattern not found"); when Missing_Parameter => TEXT_IO.PUT (Error_File,"--> Expecting to find another parameter"); when Extra_Parameter => TEXT_IO.PUT (Error_File,"--> Extra parameter (ignored)"); when Resultant_Overflow => TEXT_IO.PUT (Error_File,"--> New pattern causes overflow of maximum line length"); end case; TEXT_IO.PUT_LINE (Error_File," at line" & NATURAL'IMAGE (Deck_Info.Deck_Line_Number) & Period); TEXT_IO.PUT_LINE (Error_File, Deck_Info.Deck_Line.Line (1 .. Deck_Info.Deck_Line.Length)); for I in 1 .. Deck_Info.Column - 2 loop TEXT_IO.PUT (Error_File,Period); end loop; TEXT_IO.PUT (Error_File,ASCII.CIRCUMFLEX); TEXT_IO.NEW_LINE (Error_File); TEXT_IO.NEW_LINE (Error_File); end if; end Print_Error; -- The following procedure processes all BEGIN commands. procedure Process_Begin ( Options : in Options_Type; Deck_Info : in Deck_Info_Type; Expecting_Begin : in out BOOLEAN; Files : in out Files_Type; Statistics : in out Statistics_Type) is begin if not Expecting_Begin then -- A BEGIN command has already appeared. Print_Error (Deck_Info,Extra_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); else begin TEXT_IO.CLOSE (Files.New_File); TEXT_IO.CREATE (Files.New_File,TEXT_IO.OUT_FILE, Files.New_File_Name (1 .. Files.New_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise New_File_Rewrite_Error; end; Statistics.Number_New_Lines := 0; Statistics.Total_Begin_Commands := Statistics.Total_Begin_Commands + 1; Statistics.Total_Decks := Statistics.Total_Decks + 1; Expecting_Begin := FALSE; end if; end Process_Begin; ---------------------------------------------------------------------- -- The following procedure processes all COPY commands. procedure Process_Copy ( Options : in Options_Type; Read_From_Temp_File, Expecting_Begin : in BOOLEAN; Deck_Info : in out Deck_Info_Type; Curr_Base_Line_Number : in out POSITIVE; Files : in out Files_Type; Statistics : in out Statistics_Type) is Line, Par1, Par2, Par3, Par4 : Data_Line_Type; Par1_Column, Par3_Column, First_Line, Last_Line : POSITIVE; begin if Expecting_Begin then -- BEGIN command is required first Print_Error (Deck_Info,Missing_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; -- Get and check for validity all parameters. Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par1); Par1_Column := Deck_Info.Column; if Par1.Length = 0 then Print_Error(Deck_Info,Missing_Parameter,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; begin First_Line := POSITIVE'VALUE (Par1.Line (1 .. Par1.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; if First_Line < Curr_Base_Line_Number then Print_Error (Deck_Info,Unsequenced,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par2); Convert_to_Upper_Case (Par2); if Par2.Length = 0 then Par3 := Par1; elsif (Par2.Line (1 .. Par2.Length) /= "THROUGH") and (Par2.Line (1 .. Par2.Length) /= "TO") and (Par2.Line (1 .. Par2.Length) /= "THRU") and (Par2.Line (1 .. Par2.Length) /= "..") then Par3 := Par2; else Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par3); end if; Par3_Column := Deck_Info.Column; begin Last_Line := POSITIVE'VALUE (Par3.Line (1 .. Par3.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; if Last_Line < First_Line then Print_Error(Deck_Info,Unsequenced,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par4); if Par4.Length /= 0 then Print_Error (Deck_Info,Extra_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); end if; -- Delete all lines not explicitly accounted for thus far. -- (This can happen if no DELETE commands appear in the -- CDUPDATE deck.) for I in Curr_Base_Line_Number .. First_Line - 1 loop if Read_From_Temp_File then if TEXT_IO.END_OF_FILE (Files.Temporary_File) then Deck_Info.Column := Par1_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := I; raise Terminate_Abnormally; end if; TEXT_IO.SKIP_LINE (Files.Temporary_File); else if TEXT_IO.END_OF_FILE (Files.Base_File) then Deck_Info.Column := Par1_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := I; raise Terminate_Abnormally; end if; TEXT_IO.SKIP_LINE (Files.Base_File); end if; end loop; -- Copy the lines specified. for I in First_Line .. Last_Line loop if Read_From_Temp_File then if TEXT_IO.END_OF_FILE (Files.Temporary_File) then Deck_Info.Column := Par3_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Last_Line := I - 1; exit; end if; TEXT_IO.GET_LINE (Files.Temporary_File,Line.Line,Line.Length); TEXT_IO.PUT_LINE (Files.New_File,Line.Line (1 .. Line.Length)); else if TEXT_IO.END_OF_FILE (Files.Base_File) then Deck_Info.Column := Par3_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Last_Line := I - 1; exit; end if; TEXT_IO.GET_LINE (Files.Base_File,Line.Line,Line.Length); TEXT_IO.PUT_LINE (Files.New_File,Line.Line (1 .. Line.Length)); end if; end loop; Statistics.Number_New_Lines := Statistics.Number_New_Lines + (Last_Line - First_Line + 1); Curr_Base_Line_Number := Last_Line + 1; Statistics.Total_Copy_Commands := Statistics.Total_Copy_Commands + 1; Statistics.Number_Base_Lines := Statistics.Number_Base_Lines + (Last_Line - Curr_Base_Line_Number + 1); exception when Terminate_Abnormally => null; -- Simply exit this subprogram. end Process_Copy; ---------------------------------------------------------------------- -- The following procedure processes all DELETE commands. procedure Process_Deletion ( Options : in Options_Type; Read_From_Temp_File, Expecting_Begin : in BOOLEAN; Deck_Info : in out Deck_Info_Type; Curr_Base_Line_Number : in out NATURAL; Files : in out Files_Type; Statistics : in out Statistics_Type) is Par1, Par2, Par3, Par4 : Data_Line_Type; Par3_Column, First_Line, Last_Line : POSITIVE; begin if Expecting_Begin then -- A BEGIN command is required first. Print_Error (Deck_Info,Missing_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; -- Get and check for validity all parameters. Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par1); if Par1.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; begin First_Line := POSITIVE'VALUE (Par1.Line (1 .. Par1.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; if First_Line < Curr_Base_Line_Number then Print_Error (Deck_Info,Unsequenced,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par2); Convert_to_Upper_Case (Par2); if Par2.Length = 0 then Par3 := Par1; elsif (Par2.Line (1 .. Par2.Length) /= "THROUGH") and (Par2.Line (1 .. Par2.Length) /= "TO") and (Par2.Line (1 .. Par2.Length) /= "THRU") and (Par2.Line (1 .. Par2.Length) /= "..") then Par3 := Par2; else Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par3); end if; Par3_Column := Deck_Info.Column; begin Last_Line := POSITIVE'VALUE (Par3.Line (1 .. Par3.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; if Last_Line < First_Line then Print_Error (Deck_Info,Unsequenced,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par4); if Par4.Length /= 0 then Print_Error (Deck_Info,Extra_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); end if; -- Delete any lines not explicitly accounted for thus far. if First_Line > Curr_Base_Line_Number then First_Line := Curr_Base_Line_Number; end if; -- Delete the lines specified. for I in First_Line .. Last_Line loop if Read_From_Temp_File then if TEXT_IO.END_OF_FILE (Files.Temporary_File) then Deck_Info.Column := Par3_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Last_Line := I - 1; exit; end if; TEXT_IO.SKIP_LINE (Files.Temporary_File); else if TEXT_IO.END_OF_FILE (Files.Base_File) then Deck_Info.Column := Par3_Column; Print_Error(Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Last_Line := I - 1; exit; end if; TEXT_IO.SKIP_LINE (Files.Base_File); end if; end loop; Curr_Base_Line_Number := Last_Line + 1; Statistics.Total_Delete_Commands := Statistics.Total_Delete_Commands + 1; Statistics.Number_Base_Lines := Statistics.Number_Base_Lines + (Last_Line - First_Line + 1); exception when Terminate_Abnormally => null; -- Simply exit this subprogram. end Process_Deletion; ---------------------------------------------------------------------- -- The following procedure processes ECHO commands. procedure Process_Echo ( Options : in Options_Type; Deck_Info : in out Deck_Info_Type; Files : in out Files_Type; Statistics : in out Statistics_Type) is Column : POSITIVE := Deck_Info.Column; Par1 : Data_Line_Type; begin Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par1); if Par1.Length = 0 then -- At least one parameter is required. Print_Error (Deck_Info,Missing_Parameter,Options,Files.Error_File, Statistics.Total_Error_Commands); else -- Echo the command line on the current TEXT_IO output file. TEXT_IO.PUT_LINE (TEXT_IO.CURRENT_OUTPUT, Deck_Info.Deck_Line.Line (Column + 1 .. Deck_Info.Deck_Line.Length)); Statistics.Total_Echo_Commands := Statistics.Total_Echo_Commands + 1; end if; end Process_Echo; ---------------------------------------------------------------------- -- The following procedure processes EDIT commands. procedure Process_Edit ( Options : in Options_Type; Read_From_Temp_File, Expecting_Begin : in BOOLEAN; Deck_Info : in out Deck_Info_Type; Curr_Base_Line_Number : in out NATURAL; Files : in out Files_Type; Statistics : in out Statistics_Type) is Line, Line_Copy, Editted_Line, Par1, Par2, Par3, Par4, Par5, Par5_Copy, Par6, Par7 : Data_Line_Type; Par1_Column, Par3_Column, Par4_Column, Line_Number, Line_Start, Edit_Start, Column_Number : POSITIVE; Found_Pattern : BOOLEAN := TRUE; begin if Expecting_Begin then -- A BEGIN command is required first. Print_Error (Deck_Info,Missing_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; -- Get and check for validity all parameters. Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par1); Par1_Column := Deck_Info.Column; if Par1.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; begin Line_Number := POSITIVE'VALUE (Par1.Line (1 .. Par1.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; if Line_Number < Curr_Base_Line_Number then Print_Error (Deck_Info,Unsequenced,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par2); Convert_to_Upper_Case(Par2); if Par2.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; elsif Par2.Line (1 .. Par2.Length) /= "AT" then Par3 := Par2; else Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par3); end if; Par3_Column := Deck_Info.Column; if Par3.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; begin Column_Number := POSITIVE'VALUE (Par3.Line (1 .. Par3.Length)); exception when CONSTRAINT_ERROR => Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Squote,Dquote, Deck_Info.Column,Par4); Par4_Column := Deck_Info.Column; if Par4.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; elsif ((Par4.Line (1) /= Squote) and (Par4.Line (1) /= Dquote)) or ((Par4.Line (Par4.Length) /= Squote) and (Par4.Line (Par4.Length) /= Dquote)) or (Par4.Line (1) /= Par4.Line (Par4.Length)) then Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Squote,Dquote, Deck_Info.Column,Par5); Par5_Copy := Par5; Convert_to_Upper_Case (Par5); if Par5.Length = 0 then Print_Error (Deck_Info,Missing_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; elsif (Par5.Line (1 .. Par5.Length) /= "BECOMES") and (Par5.Line (1 .. Par5.Length) /= "TO") then Par6 := Par5_Copy; else Get_Next_Word (FALSE,Deck_Info.Deck_Line,Squote,Dquote, Deck_Info.Column,Par6); end if; if ((Par6.Line (1) /= Squote) and (Par6.Line (1) /= Dquote)) or ((Par6.Line (Par6.Length) /= Squote) and (Par6.Line (Par6.Length) /= Dquote)) or (Par6.Line (1) /= Par6.Line (Par6.Length)) then Print_Error (Deck_Info,Invalid_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; Get_Next_Word (FALSE,Deck_Info.Deck_Line,Blank,Blank, Deck_Info.Column,Par7); if Par7.Length /= 0 then Print_Error (Deck_Info,Extra_Parameter,Options, Files.Error_File,Statistics.Total_Error_Commands); end if; -- Delete any lines not explicitly accounted for thus far. for I in Curr_Base_Line_Number .. Line_Number - 1 loop if Read_From_Temp_File then if TEXT_IO.END_OF_FILE (Files.Temporary_File) then Deck_Info.Column := Par1_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := I; raise Terminate_Abnormally; end if; TEXT_IO.SKIP_LINE (Files.Temporary_File); else if TEXT_IO.END_OF_FILE (Files.Base_File) then Deck_Info.Column := Par1_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := I; raise Terminate_Abnormally; end if; TEXT_IO.SKIP_LINE (Files.Base_File); end if; end loop; -- Read in the line to edit. if Read_From_Temp_File then if TEXT_IO.END_OF_FILE (Files.Temporary_File) then Deck_Info.Column := Par1_Column; Print_Error (Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; TEXT_IO.GET_LINE (Files.Temporary_File,Line.Line,Line.Length); else if TEXT_IO.END_OF_FILE (Files.Base_File) then Deck_Info.Column := Par1_Column; Print_Error(Deck_Info,End_of_File,Options, Files.Error_File,Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; TEXT_IO.GET_LINE (Files.Base_File,Line.Line,Line.Length); end if; -- Perform error checking on this line and the EDIT command -- parameters specified. if Column_Number > Line.Length then Deck_Info.Column := Par3_Column; Print_Error (Deck_Info,Nonexistant_Column,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := Line_Number + 1; raise Terminate_Abnormally; end if; Editted_Line := (Line => (others => Blank), Length => 0); for I in 1 .. Column_Number - 1 loop Editted_Line.Line (I) := Line.Line (I); end loop; -- Try to match the specified substitution pattern. if Options.Case_Sensitive then for I in 1 .. Par4.Length - 2 loop if Par4.Line (I+1) /= Line.Line (Column_Number+I-1) then Found_Pattern := FALSE; end if; end loop; else Line_Copy := Line; Convert_to_Upper_Case (Line_Copy); Convert_to_Upper_Case (Par4); for I in 1 .. Par4.Length - 2 loop if Par4.Line (I+1) /= Line_Copy.Line (Column_Number+I-1) then Found_Pattern := FALSE; end if; end loop; end if; if not Found_Pattern then Deck_Info.Column := Par4_Column; Print_Error (Deck_Info,Pattern_Failure,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := Line_Number + 1; raise Terminate_Abnormally; end if; if (Column_Number + Par6.Length - 3) > Maximum_Line_Length then Print_Error (Deck_Info,Resultant_Overflow,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := Line_Number + 1; raise Terminate_Abnormally; end if; -- Make the replacement, checking for length errors. for I in 1 .. Par6.Length - 2 loop Editted_Line.Line (Column_Number+I-1) := Par6.Line (I+1); end loop; Edit_Start := Column_Number + Par6.Length - 2; Line_Start := Column_Number + Par4.Length - 2; if (Edit_Start + Line.Length - Line_Start) > Maximum_Line_Length then Print_Error (Deck_Info,Resultant_Overflow,Options, Files.Error_File,Statistics.Total_Error_Commands); Curr_Base_Line_Number := Line_Number + 1; raise Terminate_Abnormally; end if; for I in 1 .. Line.Length + 1 - Line_Start loop Editted_Line.Line (Edit_Start+I-1) := Line.Line (Line_Start+I-1); end loop; Editted_Line.Length := Edit_Start + Line.Length - Line_Start; TEXT_IO.PUT_LINE (Files.New_File,Editted_Line.Line (1 .. Editted_Line.Length)); Statistics.Total_Edit_Commands := Statistics.Total_Edit_Commands + 1; Statistics.Number_Base_Lines := Statistics.Number_Base_Lines + Line_Number - Curr_Base_Line_Number + 1; Statistics.Number_New_Lines := Statistics.Number_New_Lines + 1; Curr_Base_Line_Number := Line_Number + 1; exception when Terminate_Abnormally => null; -- Simply exit this subprogram. end Process_Edit; ---------------------------------------------------------------------- -- The following procedure processes all END commands. procedure Process_End ( Options : in Options_Type; Deck_Info : in Deck_Info_Type; Read_From_Temp_File, Expecting_Begin : in out BOOLEAN; Curr_Base_Line_Number : in out NATURAL; Files : in out Files_Type; Statistics : in out Statistics_Type) is Line : Data_Line_Type; begin if Expecting_Begin then -- A BEGIN command is required first. Print_Error (Deck_Info,Missing_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; begin TEXT_IO.CLOSE (Files.New_File); TEXT_IO.OPEN (Files.New_File,TEXT_IO.IN_FILE, Files.New_File_Name (1 .. Files.New_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise New_File_Reset_Error; end; begin TEXT_IO.DELETE (Files.Temporary_File); TEXT_IO.CREATE (Files.Temporary_File,TEXT_IO.OUT_FILE); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Temporary_File_Rewrite_Error; end; while not TEXT_IO.END_OF_FILE (Files.New_File) loop TEXT_IO.GET_LINE (Files.New_File,Line.Line,Line.Length); TEXT_IO.PUT_LINE (Files.Temporary_File,Line.Line (1 .. Line.Length)); end loop; begin TEXT_IO.RESET (Files.Temporary_File,TEXT_IO.IN_FILE); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.USE_ERROR => raise Temporary_File_Reset_Error; end; Read_From_Temp_File := TRUE; Expecting_Begin := TRUE; Curr_Base_Line_Number := 1; Statistics.Total_End_Commands := Statistics.Total_End_Commands + 1; exception when Terminate_Abnormally => null; -- Simply exit this subprogram. end Process_End; ---------------------------------------------------------------------- -- The following procedure processes all insertions. procedure Process_Insertion ( Options : in Options_Type; Deck_Info : in Deck_Info_Type; Expecting_Begin : in BOOLEAN; Files : in out Files_Type; Statistics : in out Statistics_Type) is Deck_Line_Copy : Data_Line_Type; begin if Expecting_Begin then -- A BEGIN command is required first. Print_Error (Deck_Info,Missing_Begin,Options,Files.Error_File, Statistics.Total_Error_Commands); raise Terminate_Abnormally; end if; -- Check for the special case of two adjacent command code -- characters, and a line <= 1 character. if Deck_Info.Deck_Line.Length <= 1 then TEXT_IO.PUT_LINE (Files.New_File, Deck_Info.Deck_Line.Line (1 .. Deck_Info.Deck_Line.Length)); elsif (Deck_Info.Deck_Line.Line (1) = Command_Code) and (Deck_Info.Deck_Line.Line (2) = Command_Code) then for I in 2 .. Deck_Info.Deck_Line.Length loop Deck_Line_Copy.Line (I-1) := Deck_Info.Deck_Line.Line (I); Deck_Line_Copy.Length := Deck_Info.Deck_Line.Length - 1; TEXT_IO.PUT_LINE (Files.New_File, Deck_Line_Copy.Line (1 .. Deck_Line_Copy.Length)); end loop; else TEXT_IO.PUT_LINE (Files.New_File, Deck_Info.Deck_Line.Line (1 .. Deck_Info.Deck_Line.Length)); end if; Statistics.Number_New_Lines := Statistics.Number_New_Lines + 1; Statistics.Total_Insertions := Statistics.Total_Insertions + 1; exception when Terminate_Abnormally => null; -- Simply exit this subprogram. end Process_Insertion; ---------------------------------------------------------------------- -- The following subprogram analyzes all CDUPDATE deck lines, and -- calls the appropriate processing routine above. procedure Analyze_and_Process ( Options : in Options_Type; Deck_Line : in Data_Line_Type; Files : in out Files_Type; Statistics : in out Statistics_Type) is type Type_of_Command_Type is (Begn,Comment,Copy,Delete,Echo, Edit,En,Error,Insert); Command : Data_Line_Type; Column, Deck_Line_Pointer : NATURAL; Deck_Info : Deck_Info_Type; -- The following inner function returns the command name matched -- (if any). function Find_Command (Command_Name : in Data_Line_Type) return Type_of_Command_Type is Index : POSITIVE := Command_Forms_Array'FIRST; begin loop exit when (Index >= Command_Forms_Array'LAST) or else (Command_Forms_Array (Index).Line (1 .. Command_Forms_Array (Index).Length) = Command_Name.Line (1 .. Command_Name.Length)); Index := Index + 1; end loop; if Command_Forms_Array (Index).Line (1 .. Command_Forms_Array (Index).Length) = Command_Name.Line (1 .. Command_Name.Length) then if Index in Begin_Range then return Begn; elsif Index in Comment_Range then return Comment; elsif Index in Copy_Range then return Copy; elsif Index in Delete_Range then return Delete; elsif Index in Echo_Range then return Echo; elsif Index in Edit_Range then return Edit; else return En; end if; elsif Command_Name.Length = 0 then return Insert; elsif (Command_Name.Length = 1) and (Command_Name.Line (1) = Command_Code) then return Error; elsif (Command_Name.Line (1) = Command_Code) and (Command_Name.Line (2) = Command_Code) then return Insert; elsif Command_Name.Line (1) = Command_Code then return Error; else return Insert; end if; end Find_Command; begin -- Analyze_and_Process Deck_Info.Column := 1; Deck_Info.Deck_Line := Deck_Line; Deck_Info.Deck_Line_Number := Statistics.Number_Deck_Lines; Get_Next_Word (TRUE,Deck_Line,Blank,Blank,Deck_Info.Column,Command); Convert_to_Upper_Case (Command); case Find_Command (Command) is when Begn => Process_Begin (Options,Deck_Info,Expecting_Begin,Files,Statistics); when Comment => Statistics.Total_Comment_Commands := Statistics.Total_Comment_Commands + 1; when Copy => Process_Copy (Options,Read_From_Temp_File,Expecting_Begin, Deck_Info,Curr_Base_Line_Number,Files,Statistics); when Delete => Process_Deletion (Options,Read_From_Temp_File,Expecting_Begin, Deck_Info,Curr_Base_Line_Number,Files,Statistics); when Echo => Process_Echo (Options,Deck_Info,Files,Statistics); when Edit => Process_Edit (Options,Read_From_Temp_File,Expecting_Begin, Deck_Info,Curr_Base_Line_Number,Files,Statistics); when En => Process_End (Options,Deck_Info,Read_From_Temp_File, Expecting_Begin,Curr_Base_Line_Number,Files,Statistics); when Error => Print_Error (Deck_Info,Invalid_Command,Options, Files.Error_File,Statistics.Total_Error_Commands); when Insert => Process_Insertion (Options,Deck_Info,Expecting_Begin, Files,Statistics); end case; end Analyze_and_Process; -- The following procedure is used to handle all special cases -- of assigning the file name parameters to the Files record. procedure Assign ( In_File : in STRING; Out_File : in out STRING; Length : out NATURAL) is begin if In_File'LENGTH > Out_File'LENGTH then Out_File := In_File (In_File'FIRST .. In_File'FIRST + Out_File'LENGTH - 1); Length := Out_File'LENGTH; else Out_File (1 .. In_File'LENGTH) := In_File; Length := In_File'LENGTH; end if; end Assign; ---------------------------------------------------------------------- -- The following visible procedure is a driver for the package -- body. procedure Cdupdate ( Base_File_Name, Deck_File_Name, New_File_Name, Error_File_Name : in STRING; Statistics : out Statistics_Type; Options : in Options_Type := Default_Options) is Deck_Line : Data_Line_Type; Stats : Statistics_Type := (others => 0); Files : Files_Type; begin if (Base_File_Name'LENGTH > Maximum_File_Name_Length) or (Deck_File_Name'LENGTH > Maximum_File_Name_Length) or (New_File_Name'LENGTH > Maximum_File_Name_Length) or (Error_File_Name'LENGTH > Maximum_File_Name_Length) then raise File_Name_Length_Error; end if; Command_Forms_Array ( 1).Line (1..2) := Command_Code & "B"; Command_Forms_Array ( 1).Length := 2; Command_Forms_Array ( 2).Line (1..3) := Command_Code & "BE"; Command_Forms_Array ( 2).Length := 3; Command_Forms_Array ( 3).Line (1..4) := Command_Code & "BEG"; Command_Forms_Array ( 3).Length := 4; Command_Forms_Array ( 4).Line (1..5) := Command_Code & "BEGI"; Command_Forms_Array ( 4).Length := 5; Command_Forms_Array ( 5).Line (1..6) := Command_Code & "BEGIN"; Command_Forms_Array ( 5).Length := 6; Command_Forms_Array ( 6).Line (1..2) := Command_Code & "*"; Command_Forms_Array ( 6).Length := 2; Command_Forms_Array ( 7).Line (1..3) := Command_Code & "--"; Command_Forms_Array ( 7).Length := 3; Command_Forms_Array ( 8).Line (1..4) := Command_Code & "COM"; Command_Forms_Array ( 8).Length := 4; Command_Forms_Array ( 9).Line (1..5) := Command_Code & "COMM"; Command_Forms_Array ( 9).Length := 5; Command_Forms_Array (10).Line (1..6) := Command_Code & "COMME"; Command_Forms_Array (10).Length := 6; Command_Forms_Array (11).Line (1..7) := Command_Code & "COMMEN"; Command_Forms_Array (11).Length := 7; Command_Forms_Array (12).Line (1..8) := Command_Code & "COMMENT"; Command_Forms_Array (12).Length := 8; Command_Forms_Array (13).Line (1..2) := Command_Code & "C"; Command_Forms_Array (13).Length := 2; Command_Forms_Array (14).Line (1..3) := Command_Code & "CO"; Command_Forms_Array (14).Length := 3; Command_Forms_Array (15).Line (1..4) := Command_Code & "COP"; Command_Forms_Array (15).Length := 4; Command_Forms_Array (16).Line (1..5) := Command_Code & "COPY"; Command_Forms_Array (16).Length := 5; Command_Forms_Array (17).Line (1..2) := Command_Code & "D"; Command_Forms_Array (17).Length := 2; Command_Forms_Array (18).Line (1..3) := Command_Code & "DE"; Command_Forms_Array (18).Length := 3; Command_Forms_Array (19).Line (1..4) := Command_Code & "DEL"; Command_Forms_Array (19).Length := 4; Command_Forms_Array (20).Line (1..5) := Command_Code & "DELE"; Command_Forms_Array (20).Length := 5; Command_Forms_Array (21).Line (1..6) := Command_Code & "DELET"; Command_Forms_Array (21).Length := 6; Command_Forms_Array (22).Line (1..7) := Command_Code & "DELETE"; Command_Forms_Array (22).Length := 7; Command_Forms_Array (23).Line (1..3) := Command_Code & "EC"; Command_Forms_Array (23).Length := 3; Command_Forms_Array (24).Line (1..4) := Command_Code & "ECH"; Command_Forms_Array (24).Length := 4; Command_Forms_Array (25).Line (1..5) := Command_Code & "ECHO"; Command_Forms_Array (25).Length := 5; Command_Forms_Array (26).Line (1..3) := Command_Code & "ED"; Command_Forms_Array (26).Length := 3; Command_Forms_Array (27).Line (1..4) := Command_Code & "EDI"; Command_Forms_Array (27).Length := 4; Command_Forms_Array (28).Line (1..5) := Command_Code & "EDIT"; Command_Forms_Array (28).Length := 5; Command_Forms_Array (29).Line (1..3) := Command_Code & "EN"; Command_Forms_Array (29).Length := 3; Command_Forms_Array (30).Line (1..4) := Command_Code & "END"; Command_Forms_Array (30).Length := 4; Assign (Base_File_Name,Files.Base_File_Name,Files.Base_File_Length); Assign (Deck_File_Name,Files.Deck_File_Name,Files.Deck_File_Length); Assign (New_File_Name,Files.New_File_Name,Files.New_File_Length); Assign (Error_File_Name,Files.Error_File_Name,Files.Error_File_Length); begin TEXT_IO.OPEN (Files.Base_File,TEXT_IO.IN_FILE, Files.Base_File_Name (1 .. Files.Base_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Base_File_Open_Error; end; begin TEXT_IO.OPEN (Files.Deck_File,TEXT_IO.IN_FILE, Files.Deck_File_Name (1 .. Files.Deck_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Deck_File_Open_Error; end; begin TEXT_IO.CREATE (Files.New_File,TEXT_IO.OUT_FILE, Files.New_File_Name (1 .. Files.New_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise New_File_Create_Error; end; begin TEXT_IO.CREATE (Files.Temporary_File,TEXT_IO.OUT_FILE); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Temporary_File_Create_Error; end; if Options.Print_Errors then begin TEXT_IO.CREATE (Files.Error_File,TEXT_IO.OUT_FILE, Files.Error_File_Name (1 .. Files.Error_File_Length)); exception when TEXT_IO.STATUS_ERROR | TEXT_IO.NAME_ERROR | TEXT_IO.USE_ERROR => raise Error_File_Create_Error; end; end if; Curr_Base_Line_Number := 1; Read_From_Temp_File := FALSE; Expecting_Begin := TRUE; -- Iterate over all CDUPDATE deck lines. while not TEXT_IO.END_OF_FILE (Files.Deck_File) loop Read_a_Line (Files.Deck_File, Stats.Number_Deck_Lines,Deck_Line); Analyze_and_Process (Options,Deck_Line,Files,Stats); end loop; TEXT_IO.CLOSE (Files.Base_File); TEXT_IO.CLOSE (Files.Deck_File); TEXT_IO.CLOSE (Files.New_File); TEXT_IO.CLOSE (Files.Temporary_File); if Options.Print_Errors then TEXT_IO.CLOSE (Files.Error_File); end if; Statistics := Stats; end Cdupdate; ---------------------------------------------------------------------- -- The following visible procedure performs the same functions as -- the procedure above, except that it doesn not return a -- statistics record. procedure Cdupdate ( Base_File_Name, Deck_File_Name, New_File_Name, Error_File_Name : in STRING; Options : in Options_Type := Default_Options) is Dummy_Statistics : Statistics_Type; begin Cdupdate (Base_File_Name,Deck_File_Name,New_File_Name, Error_File_Name,Dummy_Statistics,Options); end Cdupdate; end Context_Directed_Update_Utilities;