diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9fdda2c0d7..588037999d1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2013-10-14 Robert Dewar + + * s-valuti.adb, prep.adb, scng.adb, errout.adb: Minor reformatting. + +2013-10-14 Eric Botcazou + + * adaint.c: Further disable __gnat_get_executable_load_address + for Linux. + +2013-10-14 Vincent Celier + + * gnat_ugn.texi: Add documentation for comparing symbols to + integers in preprocessing expressions. + +2013-10-14 Jose Ruiz + + * sem_prag.adb (Analyze_Aspect_Specification): For + Priority and CPU aspects in subprograms, the expression in the + aspect is analyzed and exported. + (Analyze_Pragma): When having a Priority pragma in the + main subprogram, load a unit that will force the initialization + of the tasking run time, which is needed for setting the required + priority. + +2013-10-14 Vincent Celier + + * prj-nmsc.adb (Check_Interfaces): Put in Other_Interfaces all + non Ada interface files. + * prj.ads (Project_Data): New component Other_Interfaces. + 2013-10-14 Arnaud Charlet * gcc-interface/Makefile.in: Target pairs clean ups. diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 2651fd07d84..ff65bd70bf1 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -3929,7 +3929,7 @@ void __gnat_cpu_set (int cpu, size_t count ATTRIBUTE_UNUSED, cpu_set_t *set) #if defined (__APPLE__) #include -#elif defined (__linux__) +#elif 0 && defined (__linux__) #include #elif defined (__AIX__) #include diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 222dffc75f8..2c783b2bddf 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1625,8 +1625,9 @@ package body Errout is Set_Standard_Error; end if; - -- Message giving total number of lines, only when Main_Source_Line - -- is known. + -- Message giving total number of lines. Don't give this message if + -- the Main_Source line is unknown (this happens in error situations, + -- e.g. when integrated preprocessing fails). if Main_Source_File /= No_Source_File then Write_Str (" "); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 407800290b1..3c0bab86cb6 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -16682,6 +16682,11 @@ In this example, @i{expression} is defined by the following grammar: @i{expression} ::= @i{expression} ::= = "" @i{expression} ::= = +@i{expression} ::= = +@i{expression} ::= > +@i{expression} ::= >= +@i{expression} ::= < +@i{expression} ::= <= @i{expression} ::= 'Defined @i{expression} ::= not @i{expression} @i{expression} ::= @i{expression} and @i{expression} @@ -16714,6 +16719,11 @@ symbol definition must be one of the (case-insensitive) literals corresponding lines are included, and if the value is false, they are excluded. +When comparing a symbol to an integer, the integer is any non negative +literal integer as defined in the Ada Reference Manual, such as 3, 16#FF# or +2#11#. The symbol value must also be a non negative integer. Integer values +in the range 0 .. 2**31-1 are supported. + The test (@i{expression} ::= @code{'Defined}) is true only if the symbol has been defined in the definition file or by a @option{-D} switch on the command line. Otherwise, the test is false. @@ -27447,7 +27457,7 @@ The preprocessing language allows such constructs as @smallexample @group -#if DEBUG or PRIORITY > 4 then +#if DEBUG or else (PRIORITY > 4) then bunch of declarations #else completely different bunch of declarations diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb index b48286e65d9..10ced63f4fd 100644 --- a/gcc/ada/prep.adb +++ b/gcc/ada/prep.adb @@ -147,21 +147,19 @@ package body Prep is 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. + -- 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. + -- The location of the #else statement (used to detect multiple #else's) 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. + -- 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; @@ -190,13 +188,13 @@ package body Prep is 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. + -- 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. + -- 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) @@ -251,6 +249,7 @@ package body Prep is -- If no character '=', then the value is True if Index = 0 then + -- Put the symbol in the name buffer Name_Len := Definition'Length; @@ -377,8 +376,8 @@ package body Prep is 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. + -- 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; @@ -405,12 +404,13 @@ package body Prep is Current_Result := False; + -- Scan current term, starting with Token + case Token is + -- Handle parenthesized expression + when Tok_Left_Paren => - - -- ( expression ) - Scan.all; Current_Result := Expression (Evaluation); @@ -422,14 +422,15 @@ package body Prep is ("`)` expected", Token_Ptr); end if; + -- Handle not expression + when Tok_Not => - - -- not expression - Scan.all; Current_Result := not Expression (Evaluation, Complemented => True); + -- Handle sequence starting with identifier + when Tok_Identifier => Symbol_Name1 := Token_Name; Symbol_Pos1 := Token_Ptr; @@ -454,11 +455,13 @@ package body Prep is Current_Result := Index_Of (Symbol_Name1) /= No_Symbol; end if; + -- Handle relational operator + elsif - Token = Tok_Equal or else - Token = Tok_Less or else + Token = Tok_Equal or else + Token = Tok_Less or else Token = Tok_Less_Equal or else - Token = Tok_Greater or else + Token = Tok_Greater or else Token = Tok_Greater_Equal then Relop := Token; @@ -476,7 +479,10 @@ package body Prep is declare Value : constant Int := UI_To_Int (Int_Literal_Value); Data : Symbol_Data; + Symbol_Value : Int; + -- Value of symbol as Int + begin if Evaluation then Symbol1 := Index_Of (Symbol_Name1); @@ -530,7 +536,7 @@ package body Prep is when Constraint_Error => Error_Msg_Name_1 := Symbol_Name1; Error_Msg - ("symbol % value is not integer", + ("symbol % value is not an integer", Symbol_Pos1); end; end if; @@ -540,9 +546,13 @@ package body Prep is Scan.all; end; + -- Error if relational operator other than = if not numbers + elsif Relop /= Tok_Equal then Error_Msg ("number expected", Token_Ptr); + -- Equality comparison of two strings + elsif Token = Tok_Identifier then -- symbol = symbol @@ -586,10 +596,11 @@ package body Prep is end if; if Symbol_Value1 /= No_String - and then Symbol_Value2 /= No_String + and then + Symbol_Value2 /= No_String then - Current_Result := Matching_Strings - (Symbol_Value1, Symbol_Value2); + Current_Result := + Matching_Strings (Symbol_Value1, Symbol_Value2); end if; end if; @@ -630,9 +641,9 @@ package body Prep is Token_Ptr); end if; - else - -- symbol (True or False) + -- Handle True or False + else if Evaluation then Symbol1 := Index_Of (Symbol_Name1); @@ -674,6 +685,8 @@ package body Prep is end if; end if; + -- Unrecognized sequence + when others => Error_Msg ("`(`, NOT or symbol expected", Token_Ptr); end case; @@ -691,7 +704,7 @@ package body Prep is Final_Result := Final_Result and Current_Result; end case; - -- Check the next operator + -- Handle AND if Token = Tok_And then if Complemented then @@ -714,6 +727,8 @@ package body Prep is end if; end if; + -- Handle OR + elsif Token = Tok_Or then if Complemented then Error_Msg @@ -735,9 +750,9 @@ package body Prep is end if; end if; - else - -- No operator: exit the term loop + -- No AND/OR operator, so exit from the loop through terms + else exit; end if; end loop; @@ -824,7 +839,6 @@ package body Prep is 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; @@ -961,6 +975,8 @@ package body Prep is -- Parse_Def_File -- -------------------- + -- This procedure REALLY needs some more comments ??? + procedure Parse_Def_File is Symbol : Symbol_Id; Symbol_Name : Name_Id; @@ -1012,7 +1028,6 @@ package body Prep is begin Start_String; - while Ptr < Scan_Ptr loop Store_String_Char (Sinput.Source (Ptr)); Ptr := Ptr + 1; @@ -1102,9 +1117,10 @@ package body Prep is Symbol := Index_Of (Symbol_Name); if Symbol /= No_Symbol then + -- If we already have an entry for this symbol, replace it - -- with the new value, except if the symbol was declared - -- on the command line. + -- with the new value, except if the symbol was declared on + -- the command line. if Mapping.Table (Symbol).On_The_Command_Line then goto Continue; @@ -1299,8 +1315,8 @@ package body Prep is Scan.all; end if; - -- It is an error to have trailing characters after - -- the condition or "then". + -- It is an error to have trailing characters after the + -- condition or "then". if Token /= Tok_End_Of_Line and then Token /= Tok_EOF @@ -1313,8 +1329,9 @@ package body Prep is Go_To_End_Of_Line; end if; - -- Depending on the value of the condition, set the - -- new values of Deleting and Match_Seen. + -- Depending on the value of the condition, set the new + -- values of Deleting and Match_Seen. + if Pp_States.Last > 0 then if Pp_States.Table (Pp_States.Last).Match_Seen then Pp_States.Table (Pp_States.Last).Deleting := True; @@ -1343,8 +1360,7 @@ package body Prep is No_Error_Found := False; end if; - -- Set the possibly new values of Deleting and - -- Match_Seen. + -- Set the possibly new values of Deleting and Match_Seen if Pp_States.Last > 0 then if Pp_States.Table (Pp_States.Last).Match_Seen then @@ -1358,8 +1374,7 @@ package body Prep is False; end if; - -- Set the Else_Ptr to check for illegal #elsif - -- later. + -- Set the Else_Ptr to check for illegal #elsif later Pp_States.Table (Pp_States.Last).Else_Ptr := Token_Ptr; @@ -1367,7 +1382,8 @@ package body Prep is Scan.all; - -- It is an error to have characters after "#else" + -- Error of character present after "#else" + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then @@ -1404,8 +1420,8 @@ package body Prep is else Scan.all; - -- It is an error to have character after - -- "#end if;". + -- Error of character present after "#end if;" + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then @@ -1535,15 +1551,14 @@ package body Prep is pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF); - -- At this point, the token is either end of line or EOF. - -- The line to possibly output stops just before the token. + -- At this point, the token is either end of line or EOF. The line to + -- possibly output stops just before the token. Output_Line (Start_Of_Processing, Token_Ptr - 1); -- If we are at the end of a line, the scan pointer is at the first - -- non blank character, not necessarily the first character of the - -- line; so, we have to deduct Start_Of_Processing from the token - -- pointer. + -- non-blank character (may not be the first character of the line), + -- so we have to deduct Start_Of_Processing from the token pointer. if Token = Tok_End_Of_Line then if (Sinput.Source (Token_Ptr) = ASCII.CR diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 12a84e55512..eb647df1492 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -2716,7 +2716,8 @@ package body Prj.Nmsc is Other : Source_Id; Unit_Found : Boolean; - Interface_ALIs : String_List_Id := Nil_String; + Interface_ALIs : String_List_Id := Nil_String; + Other_Interfaces : String_List_Id := Nil_String; begin if not Interfaces.Default then @@ -2771,6 +2772,8 @@ package body Prj.Nmsc is Other.Declared_In_Interfaces := True; end if; + -- Unit based case + if Source.Language.Config.Kind = Unit_Based then if Source.Kind = Spec and then Other_Part (Source) /= No_Source @@ -2794,6 +2797,26 @@ package body Prj.Nmsc is Interface_ALIs := String_Element_Table.Last (Shared.String_Elements); + + -- File based case + + else + String_Element_Table.Increment_Last + (Shared.String_Elements); + + Shared.String_Elements.Table + (String_Element_Table.Last + (Shared.String_Elements)) := + (Value => Name_Id (Source.File), + Index => 0, + Display_Value => Name_Id (Source.Display_File), + Location => No_Location, + Flag => False, + Next => Other_Interfaces); + + Other_Interfaces := + String_Element_Table.Last + (Shared.String_Elements); end if; Debug_Output @@ -2825,6 +2848,7 @@ package body Prj.Nmsc is Project.Interfaces_Defined := True; Project.Lib_Interface_ALIs := Interface_ALIs; + Project.Other_Interfaces := Other_Interfaces; elsif Project.Library and then not Library_Interface.Default then diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index a1da52bdff7..e39c40c3caa 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -165,8 +165,8 @@ package Prj is -- The defined kinds of variables Ignored : constant Variable_Kind; - -- Used to indicate that a package declaration must be ignored - -- while processing the project tree (unknown package name). + -- Used to indicate that a package declaration must be ignored while + -- processing the project tree (unknown package name). type Variable_Value (Kind : Variable_Kind := Undefined) is record Project : Project_Id := No_Project; @@ -262,7 +262,7 @@ package Prj is Attributes => No_Variable, Arrays => No_Array, Packages => No_Package); - -- Default value of Declarations: indicates that there is no declarations + -- Default value of Declarations: used if there are no declarations type Package_Element is record Name : Name_Id := No_Name; @@ -435,8 +435,8 @@ package Prj is function Other_Part (Source : Source_Id) return Source_Id; pragma Inline (Other_Part); - -- Source ID for the other part, if any: for a spec, indicates its body; - -- for a body, indicates its spec. + -- Source ID for the other part, if any: for a spec, returns its body; + -- for a body, returns its spec. No_Source : constant Source_Id := null; @@ -595,9 +595,9 @@ package Prj is -- spec pattern. Config_File_Unique : Boolean := False; - -- Indicate if the config file specified to the compiler needs to be - -- unique. If it is unique, then all config files are concatenated into - -- a temp config file. + -- True if the config file specified to the compiler needs to be unique. + -- If it is unique, then all config files are concatenated into a temp + -- config file. Binder_Driver : File_Name_Type := No_File; -- The name of the binder driver for the language, if any @@ -1345,19 +1345,20 @@ package Prj is -- Indicate that this is a Standalone Library Project File Lib_Interface_ALIs : String_List_Id := Nil_String; - -- For Standalone Library Project Files, indicate the list of Interface - -- ALI files. + -- For Standalone Library Project Files, list of Interface ALI files. + + Other_Interfaces : String_List_Id := Nil_String; + -- List of non unit based sources in attribute Interfaces Lib_Auto_Init : Boolean := False; - -- For non static Stand-Alone Library Project Files, indicate if - -- the library initialisation should be automatic. + -- For non static Stand-Alone Library Project Files, True if the library + -- initialisation should be automatic. Symbol_Data : Symbol_Record := No_Symbols; -- Symbol file name, reference symbol file name, symbol policy Need_To_Build_Lib : Boolean := False; - -- Indicates that the library of a Library Project needs to be built or - -- rebuilt. + -- True if the library of a Library Project needs to be built or rebuilt ------------- -- Sources -- @@ -1415,8 +1416,8 @@ package Prj is -- The path name of the configuration pragmas file, if any Config_File_Temp : Boolean := False; - -- An indication that the configuration pragmas file is a temporary file - -- that must be deleted at the end. + -- True if the configuration pragmas file is a temporary file that must + -- be deleted at the end. Config_Checked : Boolean := False; -- A flag to avoid checking repetitively the configuration pragmas file @@ -1972,8 +1973,7 @@ private -- setting the env var to the same value. When different from No_Path, -- this indicates that logical names (VMS) or environment variables were -- created and should be deassigned to avoid polluting the environment - -- on VMS. - -- gnatmake only + -- on VMS. This is for gnatmake only. Current_Object_Path_File : Path_Name_Type := No_Path; -- Current value of project object path file env var. Used to avoid diff --git a/gcc/ada/s-valuti.adb b/gcc/ada/s-valuti.adb index e25f78c4501..ce6db6fecb4 100644 --- a/gcc/ada/s-valuti.adb +++ b/gcc/ada/s-valuti.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2013, 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- -- @@ -134,9 +134,9 @@ package body System.Val_Util is -- Scan out the exponent value as an unsigned integer. Values larger -- than (Integer'Last / 10) are simply considered large enough here. - -- This assumption is correct for all machines we know of (e.g. in - -- the case of 16 bit integers it allows exponents up to 3276, which - -- is large enough for the largest floating types in base 2.) + -- This assumption is correct for all machines we know of (e.g. in the + -- case of 16 bit integers it allows exponents up to 3276, which is + -- large enough for the largest floating types in base 2.) X := 0; @@ -222,8 +222,8 @@ package body System.Val_Util is P : Natural := Ptr.all; begin - -- Deal with case of null string (all blanks!). As per spec, we - -- raise constraint error, with Ptr unchanged, and thus > Max. + -- Deal with case of null string (all blanks!). As per spec, we raise + -- constraint error, with Ptr unchanged, and thus > Max. if P > Max then Bad_Value (Str); @@ -300,16 +300,16 @@ package body System.Val_Util is begin P := P + 1; - -- If underscore is at the end of string, then this is an error and - -- we raise Constraint_Error, leaving the pointer past the underscore. - -- This seems a bit strange. It means e.g. that if the field is: + -- If underscore is at the end of string, then this is an error and we + -- raise Constraint_Error, leaving the pointer past the underscore. This + -- seems a bit strange. It means e.g. that if the field is: -- 345_ - -- that Constraint_Error is raised. You might think that the RM in - -- this case would scan out the 345 as a valid integer, leaving the - -- pointer at the underscore, but the ACVC suite clearly requires - -- an error in this situation (see for example CE3704M). + -- that Constraint_Error is raised. You might think that the RM in this + -- case would scan out the 345 as a valid integer, leaving the pointer + -- at the underscore, but the ACVC suite clearly requires an error in + -- this situation (see for example CE3704M). if P > Max then Ptr.all := P; diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb index e05d1d692ad..ef3d665554a 100644 --- a/gcc/ada/scng.adb +++ b/gcc/ada/scng.adb @@ -592,14 +592,12 @@ package body Scng is -- which the digit was expected on input, and is unchanged on return. procedure Scan_Integer; - -- Procedure to scan integer literal. On entry, Scan_Ptr points to a - -- digit, on exit Scan_Ptr points past the last character of the - -- integer. + -- Scan integer literal. On entry, Scan_Ptr points to a digit, on + -- exit Scan_Ptr points past the last character of the integer. -- -- For each digit encountered, UI_Int_Value is multiplied by 10, and - -- the value of the digit added to the result. In addition, the - -- value in Scale is decremented by one for each actual digit - -- scanned. + -- the value of the digit added to the result. In addition, the value + -- in Scale is decremented by one for each actual digit scanned. -------------------------- -- Error_Digit_Expected -- diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 308685ff829..21e476599fc 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -16162,16 +16162,24 @@ package body Sem_Prag is Set_Main_Priority (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg))); - -- Load an arbitrary entity from System.Tasking to make sure - -- this package is implicitly with'ed, since we need to have - -- the tasking run-time active for the pragma Priority to have - -- any effect. + -- Load an arbitrary entity from System.Tasking.Stages or + -- System.Tasking.Restricted.Stages (depending on the + -- supported profile) to make sure that one of these packages + -- is implicitly with'ed, since we need to have the tasking + -- run time active for the pragma Priority to have any effect. + -- Previously with with'ed the package System.Tasking, but + -- this package does not trigger the required initialization + -- of the run-time library. declare Discard : Entity_Id; pragma Warnings (Off, Discard); begin - Discard := RTE (RE_Task_List); + if Restricted_Profile then + Discard := RTE (RE_Activate_Restricted_Tasks); + else + Discard := RTE (RE_Activate_Tasks); + end if; end; -- Task or Protected, must be of type Integer