Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                                 P R E P                                  --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 2002-2009, 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 3,  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 COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Csets;    use Csets;

with Err_Vars; use Err_Vars;

with Opt;      use Opt;

with Osint;    use Osint;

with Output;   use Output;

with Scans;    use Scans;

with Snames;   use Snames;

with Sinput;

with Stringt;  use Stringt;

with Table;

with GNAT.Heap_Sort_G;

package body Prep is

   use Symbol_Table;

   type Token_Name_Array is array (Token_Type) of Name_Id;

   Token_Names : constant Token_Name_Array :=

     (Tok_Abort     => Name_Abort,

      Tok_Abs       => Name_Abs,

      Tok_Abstract  => Name_Abstract,

      Tok_Accept    => Name_Accept,

      Tok_Aliased   => Name_Aliased,

      Tok_All       => Name_All,

      Tok_Array     => Name_Array,

      Tok_And       => Name_And,

      Tok_At        => Name_At,

      Tok_Begin     => Name_Begin,

      Tok_Body      => Name_Body,

      Tok_Case      => Name_Case,

      Tok_Constant  => Name_Constant,

      Tok_Declare   => Name_Declare,

      Tok_Delay     => Name_Delay,

      Tok_Delta     => Name_Delta,

      Tok_Digits    => Name_Digits,

      Tok_Else      => Name_Else,

      Tok_Elsif     => Name_Elsif,

      Tok_End       => Name_End,

      Tok_Entry     => Name_Entry,

      Tok_Exception => Name_Exception,

      Tok_Exit      => Name_Exit,

      Tok_For       => Name_For,

      Tok_Function  => Name_Function,

      Tok_Generic   => Name_Generic,

      Tok_Goto      => Name_Goto,

      Tok_If        => Name_If,

      Tok_Is        => Name_Is,

      Tok_Limited   => Name_Limited,

      Tok_Loop      => Name_Loop,

      Tok_Mod       => Name_Mod,

      Tok_New       => Name_New,

      Tok_Null      => Name_Null,

      Tok_Of        => Name_Of,

      Tok_Or        => Name_Or,

      Tok_Others    => Name_Others,

      Tok_Out       => Name_Out,

      Tok_Package   => Name_Package,

      Tok_Pragma    => Name_Pragma,

      Tok_Private   => Name_Private,

      Tok_Procedure => Name_Procedure,

      Tok_Protected => Name_Protected,

      Tok_Raise     => Name_Raise,

      Tok_Range     => Name_Range,

      Tok_Record    => Name_Record,

      Tok_Rem       => Name_Rem,

      Tok_Renames   => Name_Renames,

      Tok_Requeue   => Name_Requeue,

      Tok_Return    => Name_Return,

      Tok_Reverse   => Name_Reverse,

      Tok_Select    => Name_Select,

      Tok_Separate  => Name_Separate,

      Tok_Subtype   => Name_Subtype,

      Tok_Tagged    => Name_Tagged,

      Tok_Task      => Name_Task,

      Tok_Terminate => Name_Terminate,

      Tok_Then      => Name_Then,

      Tok_Type      => Name_Type,

      Tok_Until     => Name_Until,

      Tok_Use       => Name_Use,

      Tok_When      => Name_When,

      Tok_While     => Name_While,

      Tok_With      => Name_With,

      Tok_Xor       => Name_Xor,

      others        => No_Name);

   Already_Initialized : Boolean := False;

   --  Used to avoid repetition of the part of the initialisation that needs

   --  to be done only once.

   Empty_String : String_Id;

   --  "", as a string_id

   String_False : String_Id;

   --  "false", as a string_id

   ---------------

   -- Behaviour --

   ---------------

   --  Accesses to procedure specified by procedure Initialize

   Error_Msg : Error_Msg_Proc;

   --  Report an error

   Scan : Scan_Proc;

   --  Scan one token

   Set_Ignore_Errors : Set_Ignore_Errors_Proc;

   --  Indicate if error should be taken into account

   Put_Char : Put_Char_Proc;

   --  Output one character

   New_EOL : New_EOL_Proc;

   --  Output an end of line indication

   -------------------------------

   -- State of the Preprocessor --

   -------------------------------

   type Pp_State is record

      If_Ptr : Source_Ptr;

      --  The location of the #if statement.

      --  Used to flag #if with no corresponding #end if, at the end.

      Else_Ptr : Source_Ptr;

      --  The location of the #else statement.

      --  Used to detect multiple #else.

      Deleting : Boolean;

      --  Set to True when the code should be deleted or commented out

      Match_Seen : Boolean;

      --  Set to True when a condition in an #if or an #elsif is True.

      --  Also set to True if Deleting at the previous level is True.

      --  Used to decide if Deleting should be set to True in a following

      --  #elsif or #else.

   end record;

   type Pp_Depth is new Nat;

   Ground : constant Pp_Depth := 0;

   package Pp_States is new Table.Table

     (Table_Component_Type => Pp_State,

      Table_Index_Type     => Pp_Depth,

      Table_Low_Bound      => 1,

      Table_Initial        => 10,

      Table_Increment      => 100,

      Table_Name           => "Prep.Pp_States");

   --  A stack of the states of the preprocessor, for nested #if

   type Operator is (None, Op_Or, Op_And);

   -----------------

   -- Subprograms --

   -----------------

   function Deleting return Boolean;

   --  Return True if code should be deleted or commented out

   function Expression

     (Evaluate_It  : Boolean;

      Complemented : Boolean := False) return Boolean;

   --  Evaluate a condition in an #if or an #elsif statement.

   --  If Evaluate_It is False, the condition is effectively evaluated,

   --  otherwise, only the syntax is checked.

   procedure Go_To_End_Of_Line;

   --  Advance the scan pointer until we reach an end of line or the end

   --  of the buffer.

   function Matching_Strings (S1, S2 : String_Id) return Boolean;

   --  Returns True if the two string parameters are equal (case insensitive)

   ---------------------------------------

   -- Change_Reserved_Keyword_To_Symbol --

   ---------------------------------------

   procedure Change_Reserved_Keyword_To_Symbol

     (All_Keywords : Boolean := False)

   is

      New_Name : constant Name_Id := Token_Names (Token);

   begin

      if New_Name /= No_Name then

         case Token is

            when Tok_If  | Tok_Else | Tok_Elsif | Tok_End |

                 Tok_And | Tok_Or   | Tok_Then =>

               if All_Keywords then

                  Token := Tok_Identifier;

                  Token_Name := New_Name;

               end if;

            when others =>

               Token := Tok_Identifier;

               Token_Name := New_Name;

         end case;

      end if;

   end Change_Reserved_Keyword_To_Symbol;

   ------------------------------------------

   -- Check_Command_Line_Symbol_Definition --

   ------------------------------------------

   procedure Check_Command_Line_Symbol_Definition

     (Definition  : String;

      Data        : out Symbol_Data)

   is

      Index       : Natural := 0;

      Result      : Symbol_Data;

   begin

      --  Look for the character '='

      for J in Definition'Range loop

         if Definition (J) = '=' then

            Index := J;

            exit;

         end if;

      end loop;

      --  If no character '=', then the value is True

      if Index = 0 then

         --  Put the symbol in the name buffer

         Name_Len := Definition'Length;

         Name_Buffer (1 .. Name_Len) := Definition;

         Result := True_Value;

      elsif Index = Definition'First then

         Fail ("invalid symbol definition """ & Definition & """");

      else

         --  Put the symbol in the name buffer

         Name_Len := Index - Definition'First;

         Name_Buffer (1 .. Name_Len) :=

           String'(Definition (Definition'First .. Index - 1));

         --  Check the syntax of the value

         if Definition (Index + 1) /= '"'

           or else Definition (Definition'Last) /= '"'

         then

            for J in Index + 1 .. Definition'Last loop

               case Definition (J) is

                  when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>

                     null;

                  when others =>

                     Fail ("illegal value """

                           & Definition (Index + 1 .. Definition'Last)

                           & """");

               end case;

            end loop;

         end if;

         --  And put the value in the result

         Result.Is_A_String := False;

         Start_String;

         Store_String_Chars (Definition (Index + 1 .. Definition'Last));

         Result.Value := End_String;

      end if;

      --  Now, check the syntax of the symbol (we don't allow accented and

      --  wide characters)

      if Name_Buffer (1) not in 'a' .. 'z'

        and then Name_Buffer (1) not in 'A' .. 'Z'

      then

         Fail ("symbol """

               & Name_Buffer (1 .. Name_Len)

               & """ does not start with a letter");

      end if;

      for J in 2 .. Name_Len loop

         case Name_Buffer (J) is

            when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>

               null;

            when '_' =>

               if J = Name_Len then

                  Fail ("symbol """

                        & Name_Buffer (1 .. Name_Len)

                        & """ end with a '_'");

               elsif Name_Buffer (J + 1) = '_' then

                  Fail ("symbol """

                        & Name_Buffer (1 .. Name_Len)

                        & """ contains consecutive '_'");

               end if;

            when others =>

               Fail ("symbol """

                     & Name_Buffer (1 .. Name_Len)

                     & """ contains illegal character(s)");

         end case;

      end loop;

      Result.On_The_Command_Line := True;

      --  Put the symbol name in the result

      declare

         Sym : constant String := Name_Buffer (1 .. Name_Len);

      begin

         for Index in 1 .. Name_Len loop

            Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));

         end loop;

         Result.Symbol := Name_Find;

         Name_Len := Sym'Length;

         Name_Buffer (1 .. Name_Len) := Sym;

         Result.Original := Name_Find;

      end;

      Data := Result;

   end Check_Command_Line_Symbol_Definition;

   --------------

   -- Deleting --

   --------------

   function Deleting return Boolean is

   begin

      --  Always return False when not inside an #if statement

      if Pp_States.Last = Ground then

         return False;

      else

         return Pp_States.Table (Pp_States.Last).Deleting;

      end if;

   end Deleting;

   ----------------

   -- Expression --

   ----------------

   function Expression

     (Evaluate_It  : Boolean;

      Complemented : Boolean := False) return Boolean

   is

      Evaluation : Boolean := Evaluate_It;

      --  Is set to False after an "or else" when left term is True and

      --  after an "and then" when left term is False.

      Final_Result : Boolean := False;

      Current_Result : Boolean := False;

      --  Value of a term

      Current_Operator : Operator := None;

      Symbol1          : Symbol_Id;

      Symbol2          : Symbol_Id;

      Symbol_Name1     : Name_Id;

      Symbol_Name2     : Name_Id;

      Symbol_Pos1      : Source_Ptr;

      Symbol_Pos2      : Source_Ptr;

      Symbol_Value1    : String_Id;

      Symbol_Value2    : String_Id;

   begin

      --  Loop for each term

      loop

         Change_Reserved_Keyword_To_Symbol;

         Current_Result := False;

         case Token is

            when Tok_Left_Paren =>

               --  ( expression )

               Scan.all;

               Current_Result := Expression (Evaluation);

               if Token = Tok_Right_Paren then

                  Scan.all;

               else

                  Error_Msg ("`)` expected", Token_Ptr);

               end if;

            when Tok_Not =>

               --  not expression

               Scan.all;

               Current_Result :=

                 not Expression (Evaluation, Complemented => True);

            when Tok_Identifier =>

               Symbol_Name1 := Token_Name;

               Symbol_Pos1  := Token_Ptr;

               Scan.all;

               if Token = Tok_Apostrophe then

                  --  symbol'Defined

                  Scan.all;

                  if Token = Tok_Identifier

                    and then Token_Name = Name_Defined

                  then

                     Scan.all;

                  else

                     Error_Msg ("identifier `Defined` expected", Token_Ptr);

                  end if;

                  if Evaluation then

                     Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;

                  end if;

               elsif Token = Tok_Equal then

                  Scan.all;

                  Change_Reserved_Keyword_To_Symbol;

                  if Token = Tok_Identifier then

                     --  symbol = symbol

                     Symbol_Name2 := Token_Name;

                     Symbol_Pos2  := Token_Ptr;

                     Scan.all;

                     if Evaluation then

                        Symbol1 := Index_Of (Symbol_Name1);

                        if Symbol1 = No_Symbol then

                           if Undefined_Symbols_Are_False then

                              Symbol_Value1 := String_False;

                           else

                              Error_Msg_Name_1 := Symbol_Name1;

                              Error_Msg ("unknown symbol %", Symbol_Pos1);

                              Symbol_Value1 := No_String;

                           end if;

                        else

                           Symbol_Value1 :=

                             Mapping.Table (Symbol1).Value;

                        end if;

                        Symbol2 := Index_Of (Symbol_Name2);

                        if Symbol2 = No_Symbol then

                           if Undefined_Symbols_Are_False then

                              Symbol_Value2 := String_False;

                           else

                              Error_Msg_Name_1 := Symbol_Name2;

                              Error_Msg ("unknown symbol %", Symbol_Pos2);

                              Symbol_Value2 := No_String;

                           end if;

                        else

                           Symbol_Value2 := Mapping.Table (Symbol2).Value;

                        end if;

                        if Symbol_Value1 /= No_String

                          and then Symbol_Value2 /= No_String

                        then

                           Current_Result := Matching_Strings

                                               (Symbol_Value1, Symbol_Value2);

                        end if;

                     end if;

                  elsif Token = Tok_String_Literal then

                     --  symbol = "value"

                     if Evaluation then

                        Symbol1 := Index_Of (Symbol_Name1);

                        if Symbol1 = No_Symbol then

                           if Undefined_Symbols_Are_False then

                              Symbol_Value1 := String_False;

                           else

                              Error_Msg_Name_1 := Symbol_Name1;

                              Error_Msg ("unknown symbol %", Symbol_Pos1);

                              Symbol_Value1 := No_String;

                           end if;

                        else

                           Symbol_Value1 := Mapping.Table (Symbol1).Value;

                        end if;

                        if Symbol_Value1 /= No_String then

                           Current_Result :=

                             Matching_Strings

                               (Symbol_Value1,

                                String_Literal_Id);

                        end if;

                     end if;

                     Scan.all;

                  else

                     Error_Msg

                       ("symbol or literal string expected", Token_Ptr);

                  end if;

               else

                  --  symbol (True or False)

                  if Evaluation then

                     Symbol1 := Index_Of (Symbol_Name1);

                     if Symbol1 = No_Symbol then

                        if Undefined_Symbols_Are_False then

                           Symbol_Value1 := String_False;

                        else

                           Error_Msg_Name_1 := Symbol_Name1;

                           Error_Msg ("unknown symbol %", Symbol_Pos1);

                           Symbol_Value1 := No_String;

                        end if;

                     else

                        Symbol_Value1 := Mapping.Table (Symbol1).Value;

                     end if;

                     if Symbol_Value1 /= No_String then

                        String_To_Name_Buffer (Symbol_Value1);

                        for Index in 1 .. Name_Len loop

                           Name_Buffer (Index) :=

                             Fold_Lower (Name_Buffer (Index));

                        end loop;

                        if Name_Buffer (1 .. Name_Len) = "true" then

                           Current_Result := True;

                        elsif Name_Buffer (1 .. Name_Len) = "false" then

                           Current_Result := False;

                        else

                           Error_Msg_Name_1 := Symbol_Name1;

                           Error_Msg

                             ("value of symbol % is not True or False",

                              Symbol_Pos1);

                        end if;

                     end if;

                  end if;

               end if;

            when others =>

               Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);

         end case;

         --  Update the cumulative final result

         case Current_Operator is

            when None =>

               Final_Result := Current_Result;

            when Op_Or =>

               Final_Result := Final_Result or Current_Result;

            when Op_And =>

               Final_Result := Final_Result and Current_Result;

         end case;

         --  Check the next operator

         if Token = Tok_And then

            if Complemented then

               Error_Msg

                ("mixing NOT and AND is not allowed, parentheses are required",

                 Token_Ptr);

            elsif Current_Operator = Op_Or then

               Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);

            end if;

            Current_Operator := Op_And;

            Scan.all;

            if Token = Tok_Then then

               Scan.all;

               if Final_Result = False then

                  Evaluation := False;

               end if;

            end if;

         elsif Token = Tok_Or then

            if Complemented then

               Error_Msg

                 ("mixing NOT and OR is not allowed, parentheses are required",

                  Token_Ptr);

            elsif Current_Operator = Op_And then

               Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);

            end if;

            Current_Operator := Op_Or;

            Scan.all;

            if Token = Tok_Else then

               Scan.all;

               if Final_Result then

                  Evaluation := False;

               end if;

            end if;

         else

            --  No operator: exit the term loop

            exit;

         end if;

      end loop;

      return Final_Result;

   end Expression;

   -----------------------

   -- Go_To_End_Of_Line --

   -----------------------

   procedure Go_To_End_Of_Line is

   begin

      --  Scan until we get an end of line or we reach the end of the buffer

      while Token /= Tok_End_Of_Line

        and then Token /= Tok_EOF

      loop

         Scan.all;

      end loop;

   end Go_To_End_Of_Line;

   --------------

   -- Index_Of --

   --------------

   function Index_Of (Symbol : Name_Id) return Symbol_Id is

   begin

      if Mapping.Table /= null then

         for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop

            if Mapping.Table (J).Symbol = Symbol then

               return J;

            end if;

         end loop;

      end if;

      return No_Symbol;

   end Index_Of;

   ----------------

   -- Initialize --

   ----------------

   procedure Initialize is

   begin

      if not Already_Initialized then

         Start_String;

         Store_String_Chars ("True");

         True_Value.Value := End_String;

         Start_String;

         Empty_String := End_String;

         Start_String;

         Store_String_Chars ("False");

         String_False := End_String;

         Already_Initialized := True;

      end if;

   end Initialize;

   ------------------

   -- List_Symbols --

   ------------------

   procedure List_Symbols (Foreword : String) is

      Order : array (0 ..  Integer (Symbol_Table.Last (Mapping)))

                 of Symbol_Id;

      --  After alphabetical sorting, this array stores the indices of

      --  the symbols in the order they are displayed.

      function Lt (Op1, Op2 : Natural) return Boolean;

      --  Comparison routine for sort call

      procedure Move (From : Natural; To : Natural);

      --  Move routine for sort call

      --------

      -- Lt --

      --------

      function Lt (Op1, Op2 : Natural) return Boolean is

         S1 : constant String :=

                Get_Name_String (Mapping.Table (Order (Op1)).Symbol);

         S2 : constant String :=

                Get_Name_String (Mapping.Table (Order (Op2)).Symbol);

      begin

         return S1 < S2;

      end Lt;

      ----------

      -- Move --

      ----------

      procedure Move (From : Natural; To : Natural) is

      begin

         Order (To) := Order (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

      if Symbol_Table.Last (Mapping) = 0 then

         return;

      end if;

      if Foreword'Length > 0 then

         Write_Eol;

         Write_Line (Foreword);

         for J in Foreword'Range loop

            Write_Char ('=');

         end loop;

      end if;

      --  Initialize the order

      for J in Order'Range loop

         Order (J) := Symbol_Id (J);

      end loop;

      --  Sort alphabetically

      Sort_Syms.Sort (Order'Last);

      Max_L := 7;

      for J in 1 .. Symbol_Table.Last (Mapping) loop

         Get_Name_String (Mapping.Table (J).Original);

         Max_L := Integer'Max (Max_L, Name_Len);

      end loop;

      Write_Eol;

      Write_Str ("Symbol");

      for J in 1 .. Max_L - 5 loop

         Write_Char (' ');

      end loop;

      Write_Line ("Value");

      Write_Str ("------");

      for J in 1 .. Max_L - 5 loop

         Write_Char (' ');

      end loop;

      Write_Line ("------");

      for J in 1 .. Order'Last loop

         declare

            Data : constant Symbol_Data := Mapping.Table (Order (J));