------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T P R E P -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-2002, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings.Fixed; with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with GNAT.Heap_Sort_G; with GNAT.Command_Line; with Gnatvsn; procedure GNATprep is type Strptr is access String; Usage_Error : exception; -- Raised if a usage error is detected, causes termination of processing -- with an appropriate error message and error exit status set. Fatal_Error : exception; -- Exception raised if fatal error detected Expression_Error : exception; -- Exception raised when an invalid boolean expression is found -- on a preprocessor line ------------------------ -- Argument Line Data -- ------------------------ Outfile_Name : Strptr; Deffile_Name : Strptr; -- Names of files type Input; type Input_Ptr is access Input; type Input is record File : File_Type; Next : Input_Ptr; Prev : Input_Ptr; Name : Strptr; Line_Num : Natural := 0; end record; -- Data for the current input file (main input file or included file -- or definition file). Infile : Input_Ptr := new Input; Outfile : File_Type; Deffile : File_Type; Opt_Comment_Deleted_Lines : Boolean := False; -- Set if -c switch set Blank_Deleted_Lines : Boolean := False; -- Set if -b switch set List_Symbols : Boolean := False; -- Set if -s switch set Source_Ref_Pragma : Boolean := False; -- Set if -r switch set Undefined_Is_False : Boolean := False; -- Set if -u switch set -- Record command line options --------------------------- -- Definitions File Data -- --------------------------- Num_Syms : Natural := 0; -- Number of symbols defined in definitions file Symbols : array (0 .. 10_000) of Strptr; Values : array (0 .. 10_000) of Strptr; -- Symbol names and values. Note that the zero'th element is used only -- during the call to Sort (to hold a temporary value, as required by -- the GNAT.Heap_Sort_G interface). --------------------- -- Input File Data -- --------------------- Current_File_Name : Strptr; -- Holds name of file being read (definitions file or input file) Line_Buffer : String (1 .. 20_000); -- Hold one line Line_Length : Natural; -- Length of line in Line_Buffer Ptr : Natural; -- Input scan pointer for line in Line_Buffer type Keyword is (K_Not, K_Then, K_If, K_Else, K_End, K_Elsif, K_And, K_Or, K_Open_Paren, K_Close_Paren, K_Defined, K_Andthen, K_Orelse, K_Equal, K_Include, K_None); -- Keywords that are recognized on preprocessor lines. K_None indicates -- that no keyword was present. K : Keyword; -- Scanned keyword Start_Sym, End_Sym : Natural; -- First and last positions of scanned symbol Num_Errors : Natural := 0; -- Number of errors detected ----------------------- -- Preprocessor Data -- ----------------------- -- The following record represents the state of an #if structure: type PP_Rec is record If_Line : Positive; -- Line number for #if line If_Name : Strptr; -- File name of #if line Else_Line : Natural; -- Line number for #else line, zero = no else seen yet Deleting : Boolean; -- True if lines currently being deleted Match_Seen : Boolean; -- True if either the #if condition or one of the previously seen -- #elsif lines was true, meaning that any future #elsif sections -- or the #else section, is to be deleted. end record; PP_Depth : Natural; -- Preprocessor #if nesting level. A value of zero means that we are -- outside any #if structure. PP : array (0 .. 100) of PP_Rec; -- Stack of records showing state of #if structures. PP (1) is the -- outer level entry, and PP (PP_Depth) is the active entry. PP (0) -- contains a dummy entry whose Deleting flag is always set to False. ----------------- -- Subprograms -- ----------------- function At_End_Of_Line return Boolean; -- First advances Ptr using Skip_Spaces. Then returns True if Ptr is -- either at the end of the line, or at a -- comment sequence. procedure Error (Msg : String); -- Post error message with given text. The line number is taken from -- Infile.Line_Num, and the column number from Ptr. function Eval_Condition (Parenthesis : Natural := 0; Do_Eval : Boolean := True) return Boolean; -- Eval the condition found in the current Line. The condition can -- include any of the 'and', 'or', 'not', and parenthesis subexpressions. -- If Line is an invalid expression, then Expression_Error is raised, -- after an error message has been printed. Line can include 'then' -- followed by a comment, which is automatically ignored. If Do_Eval -- is False, then the expression is not evaluated at all, and symbols -- are just skipped. function Eval_Symbol (Do_Eval : Boolean) return Boolean; -- Read and evaluate the next symbol or expression (A, A'Defined, A=...) -- If it is followed by 'Defined or an equality test, read as many symbols -- as needed. Do_Eval has the same meaning as in Eval_Condition procedure Help_Page; -- Print a help page to summarize the usage of gnatprep function Image (N : Natural) return String; -- Returns Natural'Image (N) without the initial space function Is_Preprocessor_Line return Boolean; -- Tests if current line is a preprocessor line, i.e. that its first -- non-blank character is a # character. If so, then a result of True -- is returned, and Ptr is set to point to the character following the -- # character. If not, False is returned and Ptr is undefined. procedure No_Junk; -- Make sure no junk is present on a preprocessor line. Ptr points past -- the scanned preprocessor syntax. function OK_Identifier (S : String) return Boolean; -- Tests if given referenced string is valid Ada identifier function Matching_Strings (S1, S2 : String) return Boolean; -- Check if S1 and S2 are the same string (this is a case independent -- comparison, lower and upper case letters are considered to match). -- Duplicate quotes in S2 are considered as a single quote ("" => ") procedure Parse_Def_File; -- Parse the deffile given by the user function Scan_Keyword return Keyword; -- Advances Ptr to end of line or next non-blank using Skip_Spaces. Then -- attempts to scan out a recognized keyword. if a recognized keyword is -- found, sets Ptr past it, and returns the code for the keyword, if not, -- then Ptr is left unchanged pointing to a non-blank character or to the -- end of the line. function Symbol_Scanned return Boolean; -- On entry, Start_Sym is set to the first character of an identifier -- symbol to be scanned out. On return, End_Sym is set to the last -- character of the identifier, and the result indicates if the scanned -- symbol is a valid identifier (True = valid). Ptr is not changed. procedure Skip_Spaces; -- Skips Ptr past tabs and spaces to next non-blank, or one character -- past the end of line. function Variable_Index (Name : String) return Natural; -- Returns the index of the variable in the table. If the variable is not -- found, returns Natural'Last -------------------- -- At_End_Of_Line -- -------------------- function At_End_Of_Line return Boolean is begin Skip_Spaces; return Ptr > Line_Length or else (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) = "--"); end At_End_Of_Line; ----------- -- Error -- ----------- procedure Error (Msg : String) is L : constant String := Natural'Image (Infile.Line_Num); C : constant String := Natural'Image (Ptr); begin Put (Standard_Error, Current_File_Name.all); Put (Standard_Error, ':'); Put (Standard_Error, L (2 .. L'Length)); Put (Standard_Error, ':'); Put (Standard_Error, C (2 .. C'Length)); Put (Standard_Error, ": "); Put_Line (Standard_Error, Msg); Num_Errors := Num_Errors + 1; end Error; -------------------- -- Eval_Condition -- -------------------- function Eval_Condition (Parenthesis : Natural := 0; Do_Eval : Boolean := True) return Boolean is Symbol_Is_True : Boolean := False; -- init to avoid warning K : Keyword; begin -- Find the next subexpression K := Scan_Keyword; case K is when K_None => Symbol_Is_True := Eval_Symbol (Do_Eval); when K_Not => -- Not applies to the next subexpression (either a simple -- evaluation like A or A'Defined, or a parenthesis expression) K := Scan_Keyword; if K = K_Open_Paren then Symbol_Is_True := not Eval_Condition (Parenthesis + 1, Do_Eval); elsif K = K_None then Symbol_Is_True := not Eval_Symbol (Do_Eval); else Ptr := Start_Sym; -- Puts the keyword back end if; when K_Open_Paren => Symbol_Is_True := Eval_Condition (Parenthesis + 1, Do_Eval); when others => Ptr := Start_Sym; Error ("invalid syntax in preprocessor line"); raise Expression_Error; end case; -- Do we have a compound expression with AND, OR, ... K := Scan_Keyword; case K is when K_None => if not At_End_Of_Line then Error ("Invalid Syntax at end of line"); raise Expression_Error; end if; if Parenthesis /= 0 then Error ("Unmatched opening parenthesis"); raise Expression_Error; end if; return Symbol_Is_True; when K_Then => if Parenthesis /= 0 then Error ("Unmatched opening parenthesis"); raise Expression_Error; end if; return Symbol_Is_True; when K_Close_Paren => if Parenthesis = 0 then Error ("Unmatched closing parenthesis"); raise Expression_Error; end if; return Symbol_Is_True; when K_And => return Symbol_Is_True and Eval_Condition (Parenthesis, Do_Eval); when K_Andthen => if not Symbol_Is_True then -- Just skip the symbols for the remaining part Symbol_Is_True := Eval_Condition (Parenthesis, False); return False; else return Eval_Condition (Parenthesis, Do_Eval); end if; when K_Or => return Symbol_Is_True or Eval_Condition (Parenthesis, Do_Eval); when K_Orelse => if Symbol_Is_True then -- Just skip the symbols for the remaining part Symbol_Is_True := Eval_Condition (Parenthesis, False); return True; else return Eval_Condition (Parenthesis, Do_Eval); end if; when others => Error ("invalid syntax in preprocessor line"); raise Expression_Error; end case; end Eval_Condition; ----------------- -- Eval_Symbol -- ----------------- function Eval_Symbol (Do_Eval : Boolean) return Boolean is Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); K : Keyword; Index : Natural; Symbol_Defined : Boolean := False; Symbol_Is_True : Boolean := False; begin -- Read the symbol Skip_Spaces; Start_Sym := Ptr; if not Symbol_Scanned then Error ("invalid symbol name"); raise Expression_Error; end if; Ptr := End_Sym + 1; -- Test if we have a simple test (A) or a more complicated one -- (A'Defined) K := Scan_Keyword; if K /= K_Defined and then K /= K_Equal then Ptr := Start_Sym; -- Puts the keyword back end if; Index := Variable_Index (Sym); case K is when K_Defined => Symbol_Defined := Index /= Natural'Last; Symbol_Is_True := Symbol_Defined; when K_Equal => -- Read the second part of the statement Skip_Spaces; Start_Sym := Ptr; if not Symbol_Scanned and then End_Sym < Start_Sym then Error ("No right part for the equality test"); raise Expression_Error; end if; Ptr := End_Sym + 1; -- If the variable was not found if Do_Eval then if Index = Natural'Last then if not Undefined_Is_False then Error ("symbol name """ & Sym & """ is not defined in definitions file"); end if; else declare Right : constant String := Line_Buffer (Start_Sym .. End_Sym); Index_R : Natural; begin if Right (Right'First) = '"' then Symbol_Is_True := Matching_Strings (Values (Index).all, Right (Right'First + 1 .. Right'Last - 1)); else Index_R := Variable_Index (Right); if Index_R = Natural'Last then Error ("Variable " & Right & " in test is " & "not defined"); raise Expression_Error; else Symbol_Is_True := Matching_Strings (Values (Index).all, Values (Index_R).all); end if; end if; end; end if; end if; when others => if Index = Natural'Last then Symbol_Defined := False; if Do_Eval and then not Symbol_Defined then if Undefined_Is_False then Symbol_Defined := True; Symbol_Is_True := False; else Error ("symbol name """ & Sym & """ is not defined in definitions file"); end if; end if; elsif not Do_Eval then Symbol_Is_True := True; elsif Matching_Strings (Values (Index).all, "True") then Symbol_Is_True := True; elsif Matching_Strings (Values (Index).all, "False") then Symbol_Is_True := False; else Error ("symbol value is not True or False"); Symbol_Is_True := False; end if; end case; return Symbol_Is_True; end Eval_Symbol; --------------- -- Help_Page -- --------------- procedure Help_Page is begin Put_Line (Standard_Error, "GNAT Preprocessor " & Gnatvsn.Gnat_Version_String & " Copyright 1996-2002 Free Software Foundation, Inc."); Put_Line (Standard_Error, "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " & "outfile [deffile]"); New_Line (Standard_Error); Put_Line (Standard_Error, " infile Name of the input file"); Put_Line (Standard_Error, " outfile Name of the output file"); Put_Line (Standard_Error, " deffile Name of the definition file"); New_Line (Standard_Error); Put_Line (Standard_Error, "gnatprep switches:"); Put_Line (Standard_Error, " -b Replace preprocessor lines by " & "blank lines"); Put_Line (Standard_Error, " -c Keep preprocessor lines as comments"); Put_Line (Standard_Error, " -D Associate symbol with value"); Put_Line (Standard_Error, " -r Generate Source_Reference pragma"); Put_Line (Standard_Error, " -s Print a sorted list of symbol names " & "and values"); Put_Line (Standard_Error, " -u Treat undefined symbols as FALSE"); New_Line (Standard_Error); end Help_Page; ----------- -- Image -- ----------- function Image (N : Natural) return String is Result : constant String := Natural'Image (N); begin return Result (Result'First + 1 .. Result'Last); end Image; -------------------------- -- Is_Preprocessor_Line -- -------------------------- function Is_Preprocessor_Line return Boolean is begin Ptr := 1; while Ptr <= Line_Length loop if Line_Buffer (Ptr) = '#' then Ptr := Ptr + 1; return True; elsif Line_Buffer (Ptr) > ' ' then return False; else Ptr := Ptr + 1; end if; end loop; return False; end Is_Preprocessor_Line; ---------------------- -- Matching_Strings -- ---------------------- function Matching_Strings (S1, S2 : String) return Boolean is S2_Index : Integer := S2'First; begin for S1_Index in S1'Range loop if To_Upper (S1 (S1_Index)) /= To_Upper (S2 (S2_Index)) then return False; else if S2 (S2_Index) = '"' and then S2_Index < S2'Last and then S2 (S2_Index + 1) = '"' then S2_Index := S2_Index + 2; else S2_Index := S2_Index + 1; end if; -- If S2 was too short then if S2_Index > S2'Last and then S1_Index < S1'Last then return False; end if; end if; end loop; return S2_Index = S2'Last + 1; end Matching_Strings; ------------- -- No_Junk -- ------------- procedure No_Junk is begin Skip_Spaces; if Ptr = Line_Length or else (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) /= "--") then Error ("extraneous text on preprocessor line ignored"); end if; end No_Junk; ------------------- -- OK_Identifier -- ------------------- function OK_Identifier (S : String) return Boolean is P : Natural := S'First; begin if S'Length /= 0 and then S (P) = Character'Val (39) then -- ''' P := P + 1; end if; if S'Length = 0 or else not Is_Letter (S (P)) then return False; else while P <= S'Last loop if Is_Letter (S (P)) or Is_Digit (S (P)) then null; elsif S (P) = '_' and then P < S'Last and then S (P + 1) /= '_' then null; else return False; end if; P := P + 1; end loop; return True; end if; end OK_Identifier; -------------------- -- Parse_Def_File -- -------------------- procedure Parse_Def_File is begin Open (Deffile, In_File, Deffile_Name.all); -- Initialize data for procedure Error Infile.Line_Num := 0; Current_File_Name := Deffile_Name; -- Loop through lines in symbol definitions file while not End_Of_File (Deffile) loop Get_Line (Deffile, Line_Buffer, Line_Length); Infile.Line_Num := Infile.Line_Num + 1; Ptr := 1; Skip_Spaces; if Ptr > Line_Length or else (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) = "--") then goto Continue; end if; Start_Sym := Ptr; if not Symbol_Scanned then Error ("invalid symbol identifier """ & Line_Buffer (Start_Sym .. End_Sym) & '"'); goto Continue; end if; Ptr := End_Sym + 1; Skip_Spaces; if Ptr >= Line_Length or else Line_Buffer (Ptr .. Ptr + 1) /= ":=" then Error ("missing "":="" in symbol definition line"); goto Continue; end if; Ptr := Ptr + 2; Skip_Spaces; Num_Syms := Num_Syms + 1; Symbols (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); Start_Sym := Ptr; End_Sym := Ptr - 1; if At_End_Of_Line then null; elsif Line_Buffer (Start_Sym) = '"' then End_Sym := End_Sym + 1; loop End_Sym := End_Sym + 1; if End_Sym > Line_Length then Error ("no closing quote for string constant"); goto Continue; elsif End_Sym < Line_Length and then Line_Buffer (End_Sym .. End_Sym + 1) = """""" then End_Sym := End_Sym + 1; elsif Line_Buffer (End_Sym) = '"' then exit; end if; end loop; else End_Sym := Ptr - 1; while End_Sym < Line_Length and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) or else Line_Buffer (End_Sym + 1) = '_' or else Line_Buffer (End_Sym + 1) = '.') loop End_Sym := End_Sym + 1; end loop; Ptr := End_Sym + 1; if not At_End_Of_Line then Error ("incorrect symbol value syntax"); goto Continue; end if; end if; Values (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); <> null; end loop; exception -- Could not open the file when Name_Error => Put_Line (Standard_Error, "cannot open " & Deffile_Name.all); raise Fatal_Error; end Parse_Def_File; ------------------ -- Scan_Keyword -- ------------------ function Scan_Keyword return Keyword is Kptr : constant Natural := Ptr; begin Skip_Spaces; Start_Sym := Ptr; if Symbol_Scanned then -- If the symbol was the last thing on the line, End_Sym will -- point too far in Line_Buffer if End_Sym > Line_Length then End_Sym := Line_Length; end if; Ptr := End_Sym + 1; declare Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); begin if Matching_Strings (Sym, "not") then return K_Not; elsif Matching_Strings (Sym, "then") then return K_Then; elsif Matching_Strings (Sym, "if") then return K_If; elsif Matching_Strings (Sym, "else") then return K_Else; elsif Matching_Strings (Sym, "end") then return K_End; elsif Matching_Strings (Sym, "elsif") then return K_Elsif; elsif Matching_Strings (Sym, "and") then if Scan_Keyword = K_Then then Start_Sym := Kptr; return K_Andthen; else Ptr := Start_Sym; -- Put back the last keyword read Start_Sym := Kptr; return K_And; end if; elsif Matching_Strings (Sym, "or") then if Scan_Keyword = K_Else then Start_Sym := Kptr; return K_Orelse; else Ptr := Start_Sym; -- Put back the last keyword read Start_Sym := Kptr; return K_Or; end if; elsif Matching_Strings (Sym, "'defined") then return K_Defined; elsif Matching_Strings (Sym, "include") then return K_Include; elsif Sym = "(" then return K_Open_Paren; elsif Sym = ")" then return K_Close_Paren; elsif Sym = "=" then return K_Equal; end if; end; end if; Ptr := Kptr; return K_None; end Scan_Keyword; ----------------- -- Skip_Spaces -- ----------------- procedure Skip_Spaces is begin while Ptr <= Line_Length loop if Line_Buffer (Ptr) /= ' ' and then Line_Buffer (Ptr) /= ASCII.HT then return; else Ptr := Ptr + 1; end if; end loop; end Skip_Spaces; -------------------- -- Symbol_Scanned -- -------------------- function Symbol_Scanned return Boolean is begin End_Sym := Start_Sym - 1; case Line_Buffer (End_Sym + 1) is when '(' | ')' | '=' => End_Sym := End_Sym + 1; return True; when '"' => End_Sym := End_Sym + 1; while End_Sym < Line_Length loop if Line_Buffer (End_Sym + 1) = '"' then if End_Sym + 2 < Line_Length and then Line_Buffer (End_Sym + 2) = '"' then End_Sym := End_Sym + 2; else exit; end if; else End_Sym := End_Sym + 1; end if; end loop; if End_Sym >= Line_Length then Error ("Invalid string "); raise Expression_Error; end if; End_Sym := End_Sym + 1; return False; when ''' => End_Sym := End_Sym + 1; when others => null; end case; while End_Sym < Line_Length and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) or else Line_Buffer (End_Sym + 1) = '_') loop End_Sym := End_Sym + 1; end loop; return OK_Identifier (Line_Buffer (Start_Sym .. End_Sym)); end Symbol_Scanned; -------------------- -- Variable_Index -- -------------------- function Variable_Index (Name : String) return Natural is begin for J in 1 .. Num_Syms loop if Matching_Strings (Symbols (J).all, Name) then return J; end if; end loop; return Natural'Last; end Variable_Index; -- Start of processing for GNATprep begin -- Parse the switches loop case GNAT.Command_Line.Getopt ("D: b c r s u") is when ASCII.NUL => exit; when 'D' => declare S : String := GNAT.Command_Line.Parameter; Index : Natural; begin Index := Ada.Strings.Fixed.Index (S, "="); if Index = 0 then Num_Syms := Num_Syms + 1; Symbols (Num_Syms) := new String'(S); Values (Num_Syms) := new String'("True"); else Num_Syms := Num_Syms + 1; Symbols (Num_Syms) := new String'(S (S'First .. Index - 1)); Values (Num_Syms) := new String'(S (Index + 1 .. S'Last)); end if; end; when 'b' => Blank_Deleted_Lines := True; when 'c' => Opt_Comment_Deleted_Lines := True; when 'r' => Source_Ref_Pragma := True; when 's' => List_Symbols := True; when 'u' => Undefined_Is_False := True; when others => raise Usage_Error; end case; end loop; -- Get the file names loop declare S : constant String := GNAT.Command_Line.Get_Argument; begin exit when S'Length = 0; if Infile.Name = null then Infile.Name := new String'(S); elsif Outfile_Name = null then Outfile_Name := new String'(S); elsif Deffile_Name = null then Deffile_Name := new String'(S); else raise Usage_Error; end if; end; end loop; -- Test we had all the arguments needed if Infile.Name = null or else Outfile_Name = null then raise Usage_Error; end if; if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then Blank_Deleted_Lines := True; end if; -- Get symbol definitions if Deffile_Name /= null then Parse_Def_File; end if; if Num_Errors > 0 then raise Fatal_Error; elsif List_Symbols and then Num_Syms > 0 then List_Symbols_Case : declare function Lt (Op1, Op2 : Natural) return Boolean; -- Comparison routine for sort call procedure Move (From : Natural; To : Natural); -- Move routine for sort call function Lt (Op1, Op2 : Natural) return Boolean is L1 : constant Natural := Symbols (Op1)'Length; L2 : constant Natural := Symbols (Op2)'Length; MinL : constant Natural := Natural'Min (L1, L2); C1, C2 : Character; begin for J in 0 .. MinL - 1 loop C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J)); C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J)); if C1 < C2 then return True; elsif C1 > C2 then return False; end if; end loop; return L1 < L2; end Lt; procedure Move (From : Natural; To : Natural) is begin Symbols (To) := Symbols (From); Values (To) := Values (From); end Move; package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt); Max_L : Natural; -- Maximum length of any symbol -- Start of processing for List_Symbols_Case begin Sort_Syms.Sort (Num_Syms); Max_L := 7; for J in 1 .. Num_Syms loop Max_L := Natural'Max (Max_L, Symbols (J)'Length); end loop; New_Line; Put ("Symbol"); for J in 1 .. Max_L - 5 loop Put (' '); end loop; Put_Line ("Value"); Put ("------"); for J in 1 .. Max_L - 5 loop Put (' '); end loop; Put_Line ("------"); for J in 1 .. Num_Syms loop Put (Symbols (J).all); for K in 1 .. Max_L - Symbols (J)'Length + 1 loop Put (' '); end loop; Put_Line (Values (J).all); end loop; New_Line; end List_Symbols_Case; end if; -- Open files and initialize preprocessing begin Open (Infile.File, In_File, Infile.Name.all); exception when Name_Error => Put_Line (Standard_Error, "cannot open " & Infile.Name.all); raise Fatal_Error; end; begin Create (Outfile, Out_File, Outfile_Name.all); exception when Name_Error => Put_Line (Standard_Error, "cannot create " & Outfile_Name.all); raise Fatal_Error; end; Infile.Line_Num := 0; Current_File_Name := Infile.Name; PP_Depth := 0; PP (0).Deleting := False; -- We return here after we start reading an include file and after -- we have finished reading an include file. <> -- If we generate Source_Reference pragmas, then generate one -- either with line number 1 for a newly included file, or -- with the number of the next line when we have returned to the -- including file. if Source_Ref_Pragma then Put_Line (Outfile, "pragma Source_Reference (" & Image (Infile.Line_Num + 1) & ", """ & Infile.Name.all & """);"); end if; -- Loop through lines in input file while not End_Of_File (Infile.File) loop Get_Line (Infile.File, Line_Buffer, Line_Length); Infile.Line_Num := Infile.Line_Num + 1; -- Handle preprocessor line if Is_Preprocessor_Line then K := Scan_Keyword; case K is -- Include file when K_Include => -- Ignore if Deleting is True if PP (PP_Depth).Deleting then goto Output; end if; Skip_Spaces; if Ptr >= Line_Length then Error ("no file to include"); elsif Line_Buffer (Ptr) /= '"' then Error ("file to include must be specified as a literal string"); else declare Start_File : constant Positive := Ptr + 1; begin Ptr := Line_Length; while Line_Buffer (Ptr) = ' ' or else Line_Buffer (Ptr) = ASCII.HT loop Ptr := Ptr - 1; end loop; if Ptr <= Start_File or else Line_Buffer (Ptr) /= '"' then Error ("no string literal for included file"); else if Infile.Next = null then Infile.Next := new Input; Infile.Next.Prev := Infile; end if; Infile := Infile.Next; Infile.Name := new String'(Line_Buffer (Start_File .. Ptr - 1)); -- Check for circularity: an file including itself, -- either directly or indirectly. declare File : Input_Ptr := Infile.Prev; begin while File /= null and then File.Name.all /= Infile.Name.all loop File := File.Prev; end loop; if File /= null then Infile := Infile.Prev; Error ("circularity in included files"); while File.Prev /= null loop File := File.Prev; end loop; while File /= Infile.Next loop Error ('"' & File.Name.all & """ includes """ & File.Next.Name.all & '"'); File := File.Next; end loop; else -- We have a file name and no circularity. -- Open the file and record an error if the -- file cannot be opened. begin Open (Infile.File, In_File, Infile.Name.all); Current_File_Name := Infile.Name; Infile.Line_Num := 0; -- If we use Source_Reference pragma, -- we need to output one for this new file. goto Read_In_File; exception when Name_Error => -- We need to set the input file to -- the including file, so that the -- line number is correct when reporting -- the error. Infile := Infile.Prev; Error ("cannot open """ & Infile.Next.Name.all & '"'); end; end if; end; end if; end; end if; -- If/Elsif processing when K_If | K_Elsif => -- If differs from elsif only in that an initial stack entry -- must be made for the new if range. We set the match seen -- entry to a copy of the deleting status in the range above -- us. If we are deleting in the range above us, then we want -- all the branches of the nested #if to delete. if K = K_If then PP_Depth := PP_Depth + 1; PP (PP_Depth) := (If_Line => Infile.Line_Num, If_Name => Infile.Name, Else_Line => 0, Deleting => False, Match_Seen => PP (PP_Depth - 1).Deleting); elsif PP_Depth = 0 then Error ("no matching #if for this #elsif"); goto Output; end if; PP (PP_Depth).Deleting := True; if not PP (PP_Depth).Match_Seen and then Eval_Condition = True then -- Case of match and no match yet in this #if PP (PP_Depth).Deleting := False; PP (PP_Depth).Match_Seen := True; No_Junk; end if; -- Processing for #else when K_Else => if PP_Depth = 0 then Error ("no matching #if for this #else"); elsif PP (PP_Depth).Else_Line /= 0 then Error ("duplicate #else line (previous was on line" & Natural'Image (PP (PP_Depth).Else_Line) & ")"); else PP (PP_Depth).Else_Line := Infile.Line_Num; PP (PP_Depth).Deleting := PP (PP_Depth).Match_Seen; end if; No_Junk; -- Process for #end when K_End => if PP_Depth = 0 then Error ("no matching #if for this #end"); else Skip_Spaces; if Scan_Keyword /= K_If then Error ("expected if after #end"); Ptr := Line_Length + 1; end if; Skip_Spaces; if Ptr > Line_Length or else Line_Buffer (Ptr) /= ';' then Error ("missing semicolon after #end if"); else Ptr := Ptr + 1; end if; No_Junk; PP_Depth := PP_Depth - 1; end if; when others => Error ("invalid preprocessor keyword syntax"); end case; -- Handle symbol substitution -- Substitution is not allowed in string (which we simply skip), -- but is allowed inside character constants. The last case is -- because there is no way to know whether the user want to -- substitute the name of an attribute ('Min or 'Max for instance) -- or actually meant to substitue a character ('$name' is probably -- a character constant, but my_type'$name'Min is probably an -- attribute, with $name=Base) else Ptr := 1; while Ptr < Line_Length loop exit when At_End_Of_Line; case Line_Buffer (Ptr) is when ''' => -- Two special cases here: -- '"' => we don't want the " sign to appear as belonging -- to a string. -- '$' => this is obviously not a substitution, just skip it if Ptr < Line_Length - 1 and then Line_Buffer (Ptr + 1) = '"' then Ptr := Ptr + 2; elsif Ptr < Line_Length - 2 and then Line_Buffer (Ptr + 1 .. Ptr + 2) = "$'" then Ptr := Ptr + 2; end if; when '"' => -- The special case of "" inside the string is easy to -- handle: just ignore them. The second one will be seen -- as the beginning of a second string Ptr := Ptr + 1; while Ptr < Line_Length and then Line_Buffer (Ptr) /= '"' loop Ptr := Ptr + 1; end loop; when '$' => -- $ found, so scan out possible following symbol Start_Sym := Ptr + 1; if Symbol_Scanned then -- Look up symbol in table and if found do replacement for J in 1 .. Num_Syms loop if Matching_Strings (Symbols (J).all, Line_Buffer (Start_Sym .. End_Sym)) then declare OldL : constant Positive := End_Sym - Start_Sym + 2; NewL : constant Positive := Values (J)'Length; AdjL : constant Integer := NewL - OldL; NewP : constant Positive := Ptr + NewL - 1; begin Line_Buffer (NewP + 1 .. Line_Length + AdjL) := Line_Buffer (End_Sym + 1 .. Line_Length); Line_Buffer (Ptr .. NewP) := Values (J).all; Ptr := NewP; Line_Length := Line_Length + AdjL; end; exit; end if; end loop; end if; when others => null; end case; Ptr := Ptr + 1; end loop; end if; -- Here after dealing with preprocessor line, output current line <> if Is_Preprocessor_Line or else PP (PP_Depth).Deleting then if Blank_Deleted_Lines then New_Line (Outfile); elsif Opt_Comment_Deleted_Lines then if Line_Length = 0 then Put_Line (Outfile, "--!"); else Put (Outfile, "--! "); Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); end if; end if; else Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); end if; end loop; -- If we have finished reading an included file, close it and continue -- with the next line of the including file. if Infile.Prev /= null then Close (Infile.File); Infile := Infile.Prev; Current_File_Name := Infile.Name; goto Read_In_File; end if; for J in 1 .. PP_Depth loop if PP (J).If_Name = Infile.Name then Error ("no matching #end for #if at line" & Natural'Image (PP (J).If_Line)); else Error ("no matching #end for #if at line" & Natural'Image (PP (J).If_Line) & " of file """ & PP (J).If_Name.all & '"'); end if; end loop; if Num_Errors = 0 then Close (Outfile); Set_Exit_Status (0); else Delete (Outfile); Set_Exit_Status (1); end if; exception when Usage_Error => Help_Page; Set_Exit_Status (1); when GNAT.Command_Line.Invalid_Parameter => Put_Line (Standard_Error, "No parameter given for -" & GNAT.Command_Line.Full_Switch); Help_Page; Set_Exit_Status (1); when GNAT.Command_Line.Invalid_Switch => Put_Line (Standard_Error, "Invalid Switch: -" & GNAT.Command_Line.Full_Switch); Help_Page; Set_Exit_Status (1); when Fatal_Error => Set_Exit_Status (1); when Expression_Error => Set_Exit_Status (1); end GNATprep;