diff options
36 files changed, 333 insertions, 173 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6986a47..4c260ca 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,67 @@ +2014-07-30 Olivier Hainque <hainque@adacore.com> + + * vxworks-ppc-link.spec: New file. Extra link + instructions for ppc-vxworks. + * vxworks-crtbe-link.spec: Likewise, for ZCX related support. + * system-vxworks-ppc.ads: Adjust linker options to use spec files. + * system-vxworks-arm.ads: Likewise. + * gcc-interface/Makefile.in: Enable .spec files. + +2014-07-30 Ed Schonberg <schonberg@adacore.com> + + * sem_aggr.adb: Minor comment reformatting. + +2014-07-30 Robert Dewar <dewar@adacore.com> + + * sem_util.ads, sem_util.adb (Is_Junk_Name): Removed. + * sem_warn.adb (Has_Junk_Name): New function + (Check_References): Use Has_Junk_Name to delete junk warnings + (Check_Unset_Reference): ditto. + (Warn_On_Unreferenced_Entity): ditto. + (Warn_On_Useless_Assignment): ditto. + +2014-07-30 Ed Schonberg <schonberg@adacore.com> + + * checks.adb (Insert_Valid_Check): Do not check for the packed + array type of a prefix that is an access type. + +2014-07-30 Ed Schonberg <schonberg@adacore.com> + + * sem_attr.adb (Eval_Attribute): Evaluate the GNAT attribute + Unconstrained_Array even if prefix is not frozen yet, as can + occur with a private subtype used as a generic actual. + +2014-07-30 Gary Dismukes <dismukes@adacore.com> + + * sem_attr.adb: Minor reformatting. + +2014-07-30 Pat Rogers <rogers@adacore.com> + + * gnat_rm.texi: Corrected minor wording error in description + of No_Exception_Registration. + +2014-07-30 Yannick Moy <moy@adacore.com> + + * einfo.ads, einfo.adb: New flag Is_Inlined_Always for use in GNATprove + mode. Realphabetize two subprograms. + * inline.adb (Cannot_Inline): Use Is_Inlined_Always in GNATprove mode. + (Can_Be_Inlined_In_GNATprove_Mode): Adapt to possible Empty Body_Id. + (Check_And_Build_Body_To_Inline): Use Is_Inlined_Always in GNATprove + mode. + (Expand_Inline_Call): Use Is_Inlined_Always in GNATprove mode. + * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not use + Is_Inline in GNATprove mode. + (Analyze_Subprogram_Specification): + Set Is_Inlined_Always at subprogram entity creation. + * sem_res.adb (Resolve_Call): Do not deal with inlining during + pre-analysis. Issue warning on call to possibly inlined + subprogram when body not seen. + +2014-07-30 Yannick Moy <moy@adacore.com> + + * lib-xref.adb (Generate_Reference): Add special + case for compiler-generated formals in GNATprove mode. + 2014-07-30 Yannick Moy <moy@adacore.com> * sem_ch6.adb: Add comments. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index d9a6c9d..27862d5 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6554,7 +6554,8 @@ package body Checks is -- A rather specialized test. If PV is an analyzed expression which -- is an indexed component of a packed array that has not been -- properly expanded, turn off its Analyzed flag to make sure it - -- gets properly reexpanded. + -- gets properly reexpanded. If the prefix is an access value, + -- the dereference will be added later. -- The reason this arises is that Duplicate_Subexpr_No_Checks did -- an analyze with the old parent pointer. This may point e.g. to @@ -6562,6 +6563,7 @@ package body Checks is if Analyzed (PV) and then Nkind (PV) = N_Indexed_Component + and then Is_Array_Type (Etype (Prefix (PV))) and then Present (Packed_Array_Impl_Type (Etype (Prefix (PV)))) then Set_Analyzed (PV, False); @@ -8053,8 +8055,10 @@ package body Checks is if Vax_Float (E) then return True; + elsif Kill_Range_Checks (E) then return True; + elsif Checks_May_Be_Suppressed (E) then return Is_Check_Suppressed (E, Range_Check); end if; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index c815c18..95d94ec 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -270,6 +270,7 @@ package body Einfo is -- sense for them to be set true for certain subsets of entity kinds. See -- the spec of Einfo for further details. + -- Is_Inlined_Always Flag1 -- Is_Frozen Flag4 -- Has_Discriminants Flag5 -- Is_Dispatching_Operation Flag6 @@ -568,7 +569,6 @@ package body Einfo is -- (SSO_Set_Low_By_Default) Flag272 -- (SSO_Set_Low_By_Default) Flag273 - -- (unused) Flag1 -- (unused) Flag2 -- (unused) Flag3 @@ -2107,6 +2107,12 @@ package body Einfo is return Flag11 (Id); end Is_Inlined; + function Is_Inlined_Always (Id : E) return B is + begin + pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + return Flag1 (Id); + end Is_Inlined_Always; + function Is_Interface (Id : E) return B is begin return Flag186 (Id); @@ -3518,6 +3524,13 @@ package body Einfo is Set_Flag38 (Id, V); end Set_Can_Never_Be_Null; + procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is + begin + pragma Assert + (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id)); + Set_Flag229 (Id, V); + end Set_Can_Use_Internal_Rep; + procedure Set_Checks_May_Be_Suppressed (Id : E; V : B := True) is begin Set_Flag31 (Id, V); @@ -3559,6 +3572,22 @@ package body Einfo is Set_Node20 (Id, V); end Set_Component_Type; + procedure Set_Contract (Id : E; V : N) is + begin + pragma Assert + (Ekind_In (Id, E_Entry, + E_Entry_Family, + E_Generic_Package, + E_Package, + E_Package_Body, + E_Subprogram_Body, + E_Variable, + E_Void) + or else Is_Generic_Subprogram (Id) + or else Is_Subprogram (Id)); + Set_Node34 (Id, V); + end Set_Contract; + procedure Set_Corresponding_Concurrent_Type (Id : E; V : E) is begin pragma Assert @@ -3849,22 +3878,6 @@ package body Einfo is Set_Node18 (Id, V); end Set_Entry_Index_Constant; - procedure Set_Contract (Id : E; V : N) is - begin - pragma Assert - (Ekind_In (Id, E_Entry, - E_Entry_Family, - E_Generic_Package, - E_Package, - E_Package_Body, - E_Subprogram_Body, - E_Variable, - E_Void) - or else Is_Generic_Subprogram (Id) - or else Is_Subprogram (Id)); - Set_Node34 (Id, V); - end Set_Contract; - procedure Set_Entry_Parameters_Type (Id : E; V : E) is begin Set_Node15 (Id, V); @@ -3951,13 +3964,6 @@ package body Einfo is Set_Node28 (Id, V); end Set_Extra_Formals; - procedure Set_Can_Use_Internal_Rep (Id : E; V : B := True) is - begin - pragma Assert - (Is_Access_Subprogram_Type (Id) and then Is_Base_Type (Id)); - Set_Flag229 (Id, V); - end Set_Can_Use_Internal_Rep; - procedure Set_Finalization_Master (Id : E; V : E) is begin pragma Assert (Is_Access_Type (Id) and then Is_Base_Type (Id)); @@ -4888,6 +4894,12 @@ package body Einfo is Set_Flag11 (Id, V); end Set_Is_Inlined; + procedure Set_Is_Inlined_Always (Id : E; V : B := True) is + begin + pragma Assert (Ekind (Id) = E_Function or else Ekind (Id) = E_Procedure); + Set_Flag1 (Id, V); + end Set_Is_Inlined_Always; + procedure Set_Is_Interface (Id : E; V : B := True) is begin pragma Assert (Is_Record_Type (Id)); @@ -8389,6 +8401,7 @@ package body Einfo is W ("Is_Imported", Flag24 (Id)); W ("Is_Independent", Flag268 (Id)); W ("Is_Inlined", Flag11 (Id)); + W ("Is_Inlined_Always", Flag1 (Id)); W ("Is_Instantiated", Flag126 (Id)); W ("Is_Interface", Flag186 (Id)); W ("Is_Internal", Flag17 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d6f6bec..6969bf8 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2476,10 +2476,12 @@ package Einfo is -- be compiled. Is_Inlined is also set on generic subprograms and is -- inherited by their instances. It is also set on the body entities -- of inlined subprograms. See also Has_Pragma_Inline. --- --- Is_Inlined is also set for subprograms that are always inlined in --- GNATprove mode. GNATprove uses this flag to know when a body does not --- need to be analyzed. + +-- Is_Inlined_Always (Flag1) +-- Defined in subprograms. Set for functions and procedures which are +-- always inlined in GNATprove mode. GNATprove uses this flag to know +-- when a body does not need to be analyzed. The value of this flag is +-- only meaningful if Body_To_Inline is not Empty for the subprogram. -- Is_Instantiated (Flag126) -- Defined in generic packages and generic subprograms. Set if the unit @@ -5673,6 +5675,7 @@ package Einfo is -- Is_Discrim_SO_Function (Flag176) -- Is_Discriminant_Check_Function (Flag264) -- Is_Eliminated (Flag124) + -- Is_Inlined_Always (Flag1) (non-generic case only) -- Is_Instantiated (Flag126) (generic case only) -- Is_Intrinsic_Subprogram (Flag64) -- Is_Invariant_Procedure (Flag257) (non-generic case only) @@ -5964,6 +5967,7 @@ package Einfo is -- Is_Called (Flag102) (non-generic case only) -- Is_Constructor (Flag76) -- Is_Eliminated (Flag124) + -- Is_Inlined_Always (Flag1) (non-generic case only) -- Is_Instantiated (Flag126) (generic case only) -- Is_Interrupt_Handler (Flag89) -- Is_Intrinsic_Subprogram (Flag64) @@ -6683,6 +6687,7 @@ package Einfo is function Is_Imported (Id : E) return B; function Is_Independent (Id : E) return B; function Is_Inlined (Id : E) return B; + function Is_Inlined_Always (Id : E) return B; function Is_Instantiated (Id : E) return B; function Is_Interface (Id : E) return B; function Is_Internal (Id : E) return B; @@ -7320,6 +7325,7 @@ package Einfo is procedure Set_Is_Imported (Id : E; V : B := True); procedure Set_Is_Independent (Id : E; V : B := True); procedure Set_Is_Inlined (Id : E; V : B := True); + procedure Set_Is_Inlined_Always (Id : E; V : B := True); procedure Set_Is_Instantiated (Id : E; V : B := True); procedure Set_Is_Interface (Id : E; V : B := True); procedure Set_Is_Internal (Id : E; V : B := True); @@ -8090,6 +8096,7 @@ package Einfo is pragma Inline (Is_Incomplete_Type); pragma Inline (Is_Independent); pragma Inline (Is_Inlined); + pragma Inline (Is_Inlined_Always); pragma Inline (Is_Instantiated); pragma Inline (Is_Integer_Type); pragma Inline (Is_Interface); @@ -8545,6 +8552,7 @@ package Einfo is pragma Inline (Set_Is_Imported); pragma Inline (Set_Is_Independent); pragma Inline (Set_Is_Inlined); + pragma Inline (Set_Is_Inlined_Always); pragma Inline (Set_Is_Instantiated); pragma Inline (Set_Is_Interface); pragma Inline (Set_Is_Internal); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1abda22..9649505 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -3141,7 +3141,6 @@ package body Exp_Ch7 is Decl : Node_Id; Dummy : Entity_Id; - pragma Unreferenced (Dummy); -- This variable captures an unused dummy internal entity, see the -- comment associated with its use. diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index f0ca3e3..a2d02e8 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -961,7 +961,6 @@ package body Exp_Intr is -- them to the tree, and that can disturb current value settings. Dummy : Entity_Id; - pragma Unreferenced (Dummy); -- This variable captures an unused dummy internal entity, see the -- comment associated with its use. diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index 20ee73c..440b5d1 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -584,7 +584,6 @@ package body GNAT.Command_Line is Parser : Opt_Parser := Command_Line_Parser) return Character is Dummy : Boolean; - pragma Unreferenced (Dummy); begin <<Restart>> diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 63f9e30..fb06b6b 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -623,6 +623,9 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(target_cpu) $(target_vendor) $ EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o EXTRA_LIBGNAT_OBJS+=vx_stack_info.o + + GCC_SPEC_FILES+=vxworks-$(ARCH_STR)-link.spec + GCC_SPEC_FILES+=vxworks-crtbe-link.spec endif # PowerPC and e500v2 VxWorks 653 @@ -1024,6 +1027,8 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(target_cpu) $(target_vendor) $(ta EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o EXTRA_LIBGNAT_OBJS+=vx_stack_info.o + + GCC_SPEC_FILES+=vxworks-crtbe-link.spec endif # MIPS VxWorks diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index f417d39..36444ec 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -10586,7 +10586,7 @@ statements (raise with no operand) are not permitted. [GNAT] This restriction ensures at compile time that no stream operations for types Exception_Id or Exception_Occurrence are used. This also makes it impossible to pass exceptions to or from a partition with this restriction -in a distributed environment. If this exception is active, then the generated +in a distributed environment. If this restriction is active, the generated code is simplified by omitting the otherwise-required global registration of exceptions when they are declared. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 86704dc..44cdec4 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1445,11 +1445,11 @@ package body Inline is null; -- In GNATprove mode, issue a warning, and indicate that the - -- subprogram is not always inlined by setting flag Is_Inlined + -- subprogram is not always inlined by setting flag Is_Inlined_Always -- to False. elsif GNATprove_Mode then - Set_Is_Inlined (Subp, False); + Set_Is_Inlined_Always (Subp, False); Error_Msg_NE (Msg & "p?", N, Subp); elsif Has_Pragma_Inline_Always (Subp) then @@ -1474,10 +1474,10 @@ package body Inline is Error_Msg_NE (Msg (Msg'First .. Msg'Last - 1), N, Subp); -- In GNATprove mode, issue a warning, and indicate that the subprogram - -- is not always inlined by setting flag Is_Inlined to False. + -- is not always inlined by setting flag Is_Inlined_Always to False. elsif GNATprove_Mode then - Set_Is_Inlined (Subp, False); + Set_Is_Inlined_Always (Subp, False); Error_Msg_NE (Msg & "p?", N, Subp); -- Do not issue errors/warnings when compiling with optimizations @@ -1630,6 +1630,8 @@ package body Inline is -- Start of Can_Be_Inlined_In_GNATprove_Mode begin + pragma Assert (Present (Spec_Id) or else Present (Body_Id)); + if Present (Spec_Id) then Id := Spec_Id; else @@ -1663,7 +1665,8 @@ package body Inline is -- body. Use the contract(s) instead in GNATprove. elsif (Present (Spec_Id) and then Has_Some_Contract (Spec_Id)) - or else Has_Some_Contract (Body_Id) + or else + (Present (Body_Id) and then Has_Some_Contract (Body_Id)) then return False; @@ -1671,7 +1674,8 @@ package body Inline is -- prover level. elsif (Present (Spec_Id) and then Is_Expression_Function (Spec_Id)) - or else Is_Expression_Function (Body_Id) + or else + (Present (Body_Id) and then Is_Expression_Function (Body_Id)) then return False; @@ -1684,8 +1688,10 @@ package body Inline is -- Only inline subprograms whose body is marked SPARK_Mode On. Other -- subprogram bodies should not be analyzed. - elsif No (SPARK_Pragma (Body_Id)) - or else Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On + elsif Present (Body_Id) + and then (No (SPARK_Pragma (Body_Id)) + or else + Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On) then return False; @@ -2781,8 +2787,16 @@ package body Inline is if Is_Subprogram (P_Ent) then Set_Is_Inlined (P_Ent, False); + -- In GNATprove mode, issue a warning, and indicate that + -- the subprogram is not always inlined by setting flag + -- Is_Inlined_Always to False. + + if GNATprove_Mode then + Set_Is_Inlined_Always (P_Ent, False); + end if; + if Comes_From_Source (P_Ent) - and then Has_Pragma_Inline (P_Ent) + and then (Has_Pragma_Inline (P_Ent) or else GNATprove_Mode) then Cannot_Inline ("cannot inline& (nested subprogram)?", N, P_Ent, @@ -3519,6 +3533,15 @@ package body Inline is if In_Open_Scopes (Subp) then Error_Msg_N ("call to recursive subprogram cannot be inlined??", N); Set_Is_Inlined (Subp, False); + + -- In GNATprove mode, issue a warning, and indicate that the + -- subprogram is not always inlined by setting flag Is_Inlined_Always + -- to False. + + if GNATprove_Mode then + Set_Is_Inlined_Always (Subp, False); + end if; + return; -- Skip inlining if this is not a true inlining since the attribute @@ -3724,13 +3747,13 @@ package body Inline is -- inlining will not happen, and mark the subprogram as not always -- inlined. - if Expander_Active then - Error_Msg_N - ("cannot inline call to recursive subprogram", N); - else + if GNATprove_Mode then Cannot_Inline ("cannot inline call to recursive subprogram?", N, Subp); - Set_Is_Inlined (Subp, False); + Set_Is_Inlined_Always (Subp, False); + else + Error_Msg_N + ("cannot inline call to recursive subprogram", N); end if; return; diff --git a/gcc/ada/inline.ads b/gcc/ada/inline.ads index a4a9527..24ffd6f 100644 --- a/gcc/ada/inline.ads +++ b/gcc/ada/inline.ads @@ -238,8 +238,11 @@ package Inline is function Can_Be_Inlined_In_GNATprove_Mode (Spec_Id : Entity_Id; Body_Id : Entity_Id) return Boolean; - -- Returns True if the subprogram identified by Spec_Id (possibly Empty) - -- and Body_Id (not Empty) can be inlined in GNATprove mode. GNATprove - -- relies on this to adapt its treatment of the subprogram. + -- Returns True if the subprogram identified by Spec_Id and Body_Id can + -- be inlined in GNATprove mode. One but not both of Spec_Id and Body_Id + -- can be Empty. Body_Id is Empty when doing a partial check on a call + -- to a subprogram whose body has not been seen yet, to know whether this + -- subprogram could possibly be inlined. GNATprove relies on this to adapt + -- its treatment of the subprogram. end Inline; diff --git a/gcc/ada/lib-xref-spark_specific.adb b/gcc/ada/lib-xref-spark_specific.adb index 7e7d52b..28677060 100644 --- a/gcc/ada/lib-xref-spark_specific.adb +++ b/gcc/ada/lib-xref-spark_specific.adb @@ -485,7 +485,6 @@ package body SPARK_Specific is declare Dummy : constant SPARK_Scope_Record := SPARK_Scope_Table.Table (Index); - pragma Unreferenced (Dummy); begin return True; end; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 8cc8e2f..a913884 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -955,6 +955,14 @@ package body Lib.Xref is if Comes_From_Source (E) then Ent := E; + -- Because a declaration may be generated for a subprogram body + -- without declaration in GNATprove mode, for inlining, some + -- parameters may end up being marked as not coming from source + -- although they are. Take these into account specially. + + elsif GNATprove_Mode and then Ekind (E) in Formal_Kind then + Ent := E; + -- Entity does not come from source, but is a derived subprogram and -- the derived subprogram comes from source (after one or more -- derivations) in which case the reference is to parent subprogram. diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 7f7d060..3fde64d 100644 --- a/gcc/ada/makeutl.adb +++ b/gcc/ada/makeutl.adb @@ -1434,8 +1434,6 @@ package body Makeutl is In_Tree : Project_Tree_Ref; Dummy : in out Boolean) is - pragma Unreferenced (Dummy); - Linker_Package : Package_Id; Options : Variable_Value; @@ -2621,7 +2619,6 @@ package body Makeutl is Iter : Source_Iterator; Dummy : Boolean; - pragma Unreferenced (Dummy); begin if not Insert_No_Roots (Source) then diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 72395f8..d7faeba 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, 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- -- @@ -197,8 +197,6 @@ package body Osint.C is procedure Create_Output_Library_Info is Dummy : Boolean; - pragma Unreferenced (Dummy); - begin Set_Library_Info_Name; Delete_File (Name_Buffer (1 .. Name_Len), Dummy); diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 0bb0eb1..76398608 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2014, 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- -- @@ -131,7 +131,6 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Dummy : in out Boolean) is - pragma Unreferenced (Dummy); begin Add_To_Path (Project.Source_Dirs, In_Tree.Shared, Buffer, Buffer_Last); @@ -201,7 +200,7 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Dummy : in out Boolean) is - pragma Unreferenced (Dummy, In_Tree); + pragma Unreferenced (In_Tree); Path : constant Path_Name_Type := Get_Object_Directory @@ -1259,7 +1258,7 @@ package body Prj.Env is Tree : Project_Tree_Ref; Dummy : in out Integer) is - pragma Unreferenced (Dummy, Tree); + pragma Unreferenced (Tree); begin -- ??? Set_Ada_Paths has a different behavior for library project @@ -1304,8 +1303,6 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Dummy : in out Integer) is - pragma Unreferenced (Dummy); - Current : String_List_Id := Prj.Source_Dirs; The_String : String_Element; @@ -1676,7 +1673,7 @@ package body Prj.Env is In_Tree : Project_Tree_Ref; Dummy : in out Boolean) is - pragma Unreferenced (Dummy, In_Tree); + pragma Unreferenced (In_Tree); Path : Path_Name_Type; diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index e4c7784..0562587 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -1714,7 +1714,7 @@ package body Prj is Context : Project_Context; Dummy : in out Boolean) is - pragma Unreferenced (Dummy, Tree); + pragma Unreferenced (Tree); List : Project_List; Prj2 : Project_Id; diff --git a/gcc/ada/s-asthan-vms-alpha.adb b/gcc/ada/s-asthan-vms-alpha.adb index 8ecdd8c..1f09a71 100644 --- a/gcc/ada/s-asthan-vms-alpha.adb +++ b/gcc/ada/s-asthan-vms-alpha.adb @@ -320,7 +320,6 @@ package body System.AST_Handling is procedure Allocate_New_AST_Server is Dummy : AST_Server_Task_Ptr; - pragma Unreferenced (Dummy); begin if Num_AST_Servers = Max_AST_Servers then diff --git a/gcc/ada/s-asthan-vms-ia64.adb b/gcc/ada/s-asthan-vms-ia64.adb index 5e20123..0fd29b1 100644 --- a/gcc/ada/s-asthan-vms-ia64.adb +++ b/gcc/ada/s-asthan-vms-ia64.adb @@ -325,7 +325,6 @@ package body System.AST_Handling is procedure Allocate_New_AST_Server is Dummy : AST_Server_Task_Ptr; - pragma Unreferenced (Dummy); begin if Num_AST_Servers = Max_AST_Servers then diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index eec3a9d..52d12d5 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -1298,7 +1298,6 @@ package body System.Task_Primitives.Operations is C : Task_Id; Dummy : int; - pragma Unreferenced (Dummy); begin Dummy := Int_Lock; diff --git a/gcc/ada/s-tasdeb.adb b/gcc/ada/s-tasdeb.adb index 5c084b5..e2256f7 100644 --- a/gcc/ada/s-tasdeb.adb +++ b/gcc/ada/s-tasdeb.adb @@ -77,10 +77,8 @@ package body System.Tasking.Debug is ------------------------ procedure Continue_All_Tasks is - C : Task_Id; - + C : Task_Id; Dummy : Boolean; - pragma Unreferenced (Dummy); begin STPO.Lock_RTS; @@ -218,7 +216,6 @@ package body System.Tasking.Debug is procedure Resume_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is C : Task_Id; Dummy : Boolean; - pragma Unreferenced (Dummy); begin STPO.Lock_RTS; @@ -267,10 +264,8 @@ package body System.Tasking.Debug is -------------------- procedure Stop_All_Tasks is - C : Task_Id; - + C : Task_Id; Dummy : Boolean; - pragma Unreferenced (Dummy); begin STPO.Lock_RTS; @@ -300,7 +295,6 @@ package body System.Tasking.Debug is procedure Suspend_All_Tasks (Thread_Self : OS_Interface.Thread_Id) is C : Task_Id; Dummy : Boolean; - pragma Unreferenced (Dummy); begin STPO.Lock_RTS; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index bc0ed54..a597f73 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -112,7 +112,7 @@ package body Sem_Aggr is -- expressions allowed for a limited component association (namely, an -- aggregate, function call, or <> notation). Report error for violations. -- Expression is also OK in an instance or inlining context, because we - -- have already analyzed and checked it. + -- have already pre-analyzed and it is known to be type correct. procedure Check_Qualified_Aggregate (Level : Nat; Expr : Node_Id); -- Given aggregate Expr, check that sub-aggregates of Expr that are nested diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index bc4f1e2..b9a0fa6 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7386,13 +7386,19 @@ package body Sem_Attr is -- If we are asked to evaluate an attribute where the prefix is a -- non-frozen generic actual type whose RM_Size is still set to zero, - -- then abandon the effort. It seems wrong that this can ever happen, - -- but we see it happen, so this is a defense! ??? + -- then abandon the effort. if Is_Type (P_Entity) and then (not Is_Frozen (P_Entity) and then Is_Generic_Actual_Type (P_Entity) and then RM_Size (P_Entity) = 0) + + -- However, the attribute Unconstrained_Array must be evaluated, + -- since it is documented to be a static attribute (and can for + -- example appear in a Compile_Time_Warning pragma). The frozen + -- status of the type does not affect its evaluation. + + and then Id /= Attribute_Unconstrained_Array then return; end if; diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index cd110c9..189695c 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5694,13 +5694,11 @@ package body Sem_Ch10 is ------------------- procedure Process_State (State : Node_Id) is - Loc : constant Source_Ptr := Sloc (State); - Elmt : Node_Id; - Id : Entity_Id; - Name : Name_Id; - + Loc : constant Source_Ptr := Sloc (State); + Elmt : Node_Id; + Id : Entity_Id; + Name : Name_Id; Dummy : Entity_Id; - pragma Unreferenced (Dummy); begin -- Multiple abstract states appear as an aggregate @@ -5709,9 +5707,9 @@ package body Sem_Ch10 is Elmt := First (Expressions (State)); while Present (Elmt) loop Process_State (Elmt); - Next (Elmt); end loop; + return; -- A null state has no abstract view diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index ad59f58..0e47f97 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2140,7 +2140,6 @@ package body Sem_Ch3 is Spec_Id : Entity_Id; Dummy : Entity_Id; - pragma Unreferenced (Dummy); -- A dummy variable used to capture the unused result of subprogram -- spec analysis. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c7b01b4..393d557 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3512,7 +3512,6 @@ package body Sem_Ch6 is and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id) and then not Body_Has_Contract then - Set_Is_Inlined (Spec_Id, True); Build_Body_To_Inline (N, Spec_Id); end if; @@ -3540,7 +3539,6 @@ package body Sem_Ch6 is and then Can_Be_Inlined_In_GNATprove_Mode (Spec_Id, Body_Id) and then not Body_Has_Contract then - Set_Is_Inlined (Spec_Id, True); Check_And_Build_Body_To_Inline (N, Spec_Id, Body_Id); end if; @@ -3675,7 +3673,7 @@ package body Sem_Ch6 is and then Nkind (Parent (Parent (Spec_Id))) = N_Subprogram_Declaration then Set_Body_To_Inline (Parent (Parent (Spec_Id)), Empty); - Set_Is_Inlined (Spec_Id, False); + Set_Is_Inlined_Always (Spec_Id, False); end if; -- Check completion, and analyze the statements @@ -4268,6 +4266,14 @@ package body Sem_Ch6 is Set_Etype (Designator, Standard_Void_Type); end if; + -- Flag Is_Inlined_Always is True by default, and reversed to False for + -- those subprograms which could be inlined in GNATprove mode (because + -- Body_To_Inline is non-Empty) but cannot be inlined. + + if GNATprove_Mode then + Set_Is_Inlined_Always (Designator); + end if; + -- Introduce new scope for analysis of the formals and the return type Set_Scope (Designator, Current_Scope); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 6c41a4e..9a83ca5 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -2128,7 +2128,7 @@ package body Sem_Eval is Alt := First (Alternatives (N)); Search : loop - -- We must find a match among the alternatives, If not this must + -- We must find a match among the alternatives. If not, this must -- be due to other errors, so just ignore, leaving as non-static. if No (Alt) then @@ -2381,7 +2381,7 @@ package body Sem_Eval is return; end if; - -- If condition raises constraint error then we have already signalled + -- If condition raises constraint error then we have already signaled -- an error, and we just propagate to the result and do not fold. if Raises_Constraint_Error (Condition) then @@ -4980,9 +4980,9 @@ package body Sem_Eval is -- non-static or raise Constraint_Error, return Non_Static. -- -- Otherwise check if the selecting expression matches any of the given - -- discrete choices. If so the alternative is executed and we return - -- Open, otherwise, the alternative can never be executed, and so we - -- return Closed. + -- discrete choices. If so, the alternative is executed and we return + -- Match, otherwise, the alternative can never be executed, and so we + -- return No_Match. --------------------------------- -- Check_Case_Expr_Alternative -- @@ -4998,7 +4998,7 @@ package body Sem_Eval is begin pragma Assert (Nkind (Case_Exp) = N_Case_Expression); - -- Check selecting expression is static + -- Check that selecting expression is static if not Is_OK_Static_Expression (Expression (Case_Exp)) then return Non_Static; @@ -5014,7 +5014,7 @@ package body Sem_Eval is Choice := First (Discrete_Choices (CEA)); while Present (Choice) loop - -- Check various possibilities for choice, returning Closed if we + -- Check various possibilities for choice, returning Match if we -- find the selecting value matches any of the choices. Note that -- we know we are the last choice, so we don't have to keep going. @@ -5048,8 +5048,8 @@ package body Sem_Eval is Next (Choice); end loop; - -- If we get through that loop then all choices were static, and - -- none of them matched the selecting expression. So return Closed. + -- If we get through that loop then all choices were static, and none + -- of them matched the selecting expression. So return No_Match. return No_Match; end Check_Case_Expr_Alternative; @@ -5125,11 +5125,11 @@ package body Sem_Eval is -- This refers to cases like - -- (if 1 then 1 elsif 1/0=2 then 2 else 3) + -- (if True then 1 elsif 1/0=2 then 2 else 3) -- But we expand elsif's out anyway, so the above looks like: - -- (if 1 then 1 else (if 1/0=2 then 2 else 3)) + -- (if True then 1 else (if 1/0=2 then 2 else 3)) -- So for us this is caught by the above check for the 32.3 case. @@ -5287,7 +5287,7 @@ package body Sem_Eval is and then not In_Inlined_Body and then Ada_Version >= Ada_95 then - -- No message if we are staticallly unevaluated + -- No message if we are statically unevaluated if Is_Statically_Unevaluated (N) then null; diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index fd9dce0..64d2529 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -74,7 +74,7 @@ package Sem_Eval is -- definition, they are sometimes folded anyway, but of course in this case -- Is_Static_Expression is not set. - -- When we are analyzing and evaluating static expressions, we proopagate + -- When we are analyzing and evaluating static expressions, we propagate -- both flags accurately. Usually if a subexpression raises a constraint -- error, then so will its parent expression, and Raise_Constraint_Error -- will be propagated to this parent. The exception is conditional cases diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e68310b..88356fd 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6210,6 +6210,7 @@ package body Sem_Res is if GNATprove_Mode and then Is_Overloadable (Nam) and then SPARK_Mode = On + and then Full_Analysis then -- Retrieve the body to inline from the ultimate alias of Nam, if -- there is one, otherwise calls that should be inlined end up not @@ -6220,13 +6221,22 @@ package body Sem_Res is Decl : constant Node_Id := Unit_Declaration_Node (Nam_Alias); begin if Nkind (Decl) = N_Subprogram_Declaration + and then Can_Be_Inlined_In_GNATprove_Mode (Nam_Alias, Empty) + and then No (Corresponding_Body (Decl)) + then + Error_Msg_NE + ("?cannot inline call to & (body not seen yet)", N, Nam); + Set_Is_Inlined_Always (Nam_Alias, False); + + elsif Nkind (Decl) = N_Subprogram_Declaration and then Present (Body_To_Inline (Decl)) + and then Is_Inlined (Nam_Alias) then if Is_Potentially_Unevaluated (N) then Error_Msg_NE ("?cannot inline call to &", N, Nam); Error_Msg_N ("\call appears in potentially unevaluated context", N); - Set_Is_Inlined (Nam, False); + Set_Is_Inlined_Always (Nam_Alias, False); else Expand_Inlined_Call (N, Nam_Alias, Nam); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5aa63a9..487ac3a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10493,45 +10493,6 @@ package body Sem_Util is end if; end Is_Iterator; - ------------------ - -- Is_Junk_Name -- - ------------------ - - function Is_Junk_Name (N : Name_Id) return Boolean is - function Match (S : String) return Boolean; - -- Return true if substring S is found in Name_Buffer (1 .. Name_Len) - - ----------- - -- Match -- - ----------- - - function Match (S : String) return Boolean is - Slen1 : constant Integer := S'Length - 1; - - begin - for J in 1 .. Name_Len - S'Length + 1 loop - if Name_Buffer (J .. J + Slen1) = S then - return True; - end if; - end loop; - - return False; - end Match; - - -- Start of processing for Is_Junk_Name - - begin - Get_Unqualified_Decoded_Name_String (N); - Set_All_Upper_Case; - - return - Match ("DISCARD") or else - Match ("DUMMY") or else - Match ("IGNORE") or else - Match ("JUNK") or else - Match ("UNUSED"); - end Is_Junk_Name; - ------------ -- Is_LHS -- ------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 68746d6..f659b98 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1203,16 +1203,6 @@ package Sem_Util is -- AI05-0139-2: Check whether Typ is one of the predefined interfaces in -- Ada.Iterator_Interfaces, or it is derived from one. - function Is_Junk_Name (N : Name_Id) return Boolean; - -- Returns True if the given name contains any of the following substrings - -- discard - -- dummy - -- ignore - -- junk - -- unused - -- Used to suppress warnings on names matching these patterns. The contents - -- of Name_Buffer and Name_Len are destroyed by this call. - type Is_LHS_Result is (Yes, No, Unknown); function Is_LHS (N : Node_Id) return Is_LHS_Result; -- Returns Yes if N is definitely used as Name in an assignment statement. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 8b47332..8db6835 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -128,6 +128,16 @@ package body Sem_Warn is -- If E is a parameter entity for a subprogram body, then this function -- returns the corresponding spec entity, if not, E is returned unchanged. + function Has_Junk_Name (E : Entity_Id) return Boolean; + -- Return True if the entity name contains any of the following substrings: + -- discard + -- dummy + -- ignore + -- junk + -- unused + -- Used to suppress warnings on names matching these patterns. The contents + -- of Name_Buffer and Name_Len are destroyed by this call. + function Has_Pragma_Unmodified_Check_Spec (E : Entity_Id) return Boolean; -- Tests Has_Pragma_Unmodified flag for entity E. If E is not a formal, -- this is simply the setting of the flag Has_Pragma_Unmodified. If E is @@ -1060,7 +1070,8 @@ package body Sem_Warn is -- We are only interested in source entities. We also don't issue -- warnings within instances, since the proper place for such - -- warnings is on the template when it is compiled. + -- warnings is on the template when it is compiled, and we don't + -- issue warnings for variables with names like Junk, Discard etc. if Comes_From_Source (E1) and then Instantiation_Location (Sloc (E1)) = No_Location @@ -1145,7 +1156,9 @@ package body Sem_Warn is and then not Has_Pragma_Unreferenced_Check_Spec (E1) and then not Has_Pragma_Unmodified_Check_Spec (E1) then - if not Warnings_Off_E1 then + if not Warnings_Off_E1 + and then not Has_Junk_Name (E1) + then Error_Msg_N -- CODEFIX ("?k?& is not modified, " & "could be declared constant!", @@ -1267,7 +1280,11 @@ package body Sem_Warn is -- the formal is not modified. else - In_Out_Warnings.Append (E1); + -- Suppress the warnings for a junk name + + if not Has_Junk_Name (E1) then + In_Out_Warnings.Append (E1); + end if; end if; -- Other cases of formals @@ -1277,6 +1294,7 @@ package body Sem_Warn is if Referenced_Check_Spec (E1) then if not Has_Pragma_Unmodified_Check_Spec (E1) and then not Warnings_Off_E1 + and then not Has_Junk_Name (E1) then Output_Reference_Error ("?f?formal parameter& is read but " @@ -1285,6 +1303,7 @@ package body Sem_Warn is elsif not Has_Pragma_Unreferenced_Check_Spec (E1) and then not Warnings_Off_E1 + and then not Has_Junk_Name (E1) then Output_Reference_Error ("?f?formal parameter& is not referenced!"); @@ -1297,7 +1316,7 @@ package body Sem_Warn is if Referenced (E1) then if not Has_Unmodified (E1) and then not Warnings_Off_E1 - and then not Is_Junk_Name (Chars (E1)) + and then not Has_Junk_Name (E1) then Output_Reference_Error ("?v?variable& is read but never assigned!"); @@ -1306,7 +1325,7 @@ package body Sem_Warn is elsif not Has_Unreferenced (E1) and then not Warnings_Off_E1 - and then not Is_Junk_Name (Chars (E1)) + and then not Has_Junk_Name (E1) then Output_Reference_Error -- CODEFIX ("?v?variable& is never read and never assigned!"); @@ -1373,7 +1392,9 @@ package body Sem_Warn is if Nkind (UR) = N_Simple_Return_Statement and then not Has_Pragma_Unmodified_Check_Spec (E1) then - if not Warnings_Off_E1 then + if not Warnings_Off_E1 + and then not Has_Junk_Name (E1) + then Error_Msg_NE ("?v?OUT parameter& not set before return", UR, E1); @@ -1593,7 +1614,9 @@ package body Sem_Warn is (E1, Body_Formal (E1, Accept_Statement => Anod)); end if; - elsif not Warnings_Off_E1 then + elsif not Warnings_Off_E1 + and then not Has_Junk_Name (E1) + then Unreferenced_Entities.Append (E1); end if; end if; @@ -1609,7 +1632,7 @@ package body Sem_Warn is and then Instantiation_Depth (Sloc (E1)) = 0 and then Warn_On_Redundant_Constructs then - if not Warnings_Off_E1 then + if not Warnings_Off_E1 and then not Has_Junk_Name (E1) then Unreferenced_Entities.Append (E1); -- Force warning on entity @@ -1755,6 +1778,7 @@ package body Sem_Warn is (Sloc (N), Sloc (Unset_Reference (E)))) and then not Has_Pragma_Unmodified_Check_Spec (E) and then not Warnings_Off_Check_Spec (E) + and then not Has_Junk_Name (E) then -- We may have an unset reference. The first test is whether -- this is an access to a discriminant of a record or a @@ -2660,6 +2684,44 @@ package body Sem_Warn is end if; end Goto_Spec_Entity; + ------------------- + -- Has_Junk_Name -- + ------------------- + + function Has_Junk_Name (E : Entity_Id) return Boolean is + function Match (S : String) return Boolean; + -- Return true if substring S is found in Name_Buffer (1 .. Name_Len) + + ----------- + -- Match -- + ----------- + + function Match (S : String) return Boolean is + Slen1 : constant Integer := S'Length - 1; + + begin + for J in 1 .. Name_Len - S'Length + 1 loop + if Name_Buffer (J .. J + Slen1) = S then + return True; + end if; + end loop; + + return False; + end Match; + + -- Start of processing for Has_Junk_Name + + begin + Get_Unqualified_Decoded_Name_String (Chars (E)); + + return + Match ("discard") or else + Match ("dummy") or else + Match ("ignore") or else + Match ("junk") or else + Match ("unused"); + end Has_Junk_Name; + -------------------------------------- -- Has_Pragma_Unmodified_Check_Spec -- -------------------------------------- @@ -3910,7 +3972,7 @@ package body Sem_Warn is if not Referenced_Check_Spec (E) and then not Has_Pragma_Unreferenced_Check_Spec (E) and then not Warnings_Off_Check_Spec (E) - and then not Is_Junk_Name (Chars (Spec_E)) + and then not Has_Junk_Name (Spec_E) then case Ekind (E) is when E_Variable => @@ -4115,7 +4177,7 @@ package body Sem_Warn is and then not Is_Exported (Ent) and then Safe_To_Capture_Value (N, Ent) and then not Has_Pragma_Unreferenced_Check_Spec (Ent) - and then not Is_Junk_Name (Chars (Ent)) + and then not Has_Junk_Name (Ent) then -- Before we issue the message, check covering exception handlers. -- Search up tree for enclosing statement sequences and handlers. diff --git a/gcc/ada/system-vxworks-arm.ads b/gcc/ada/system-vxworks-arm.ads index e7418a8..3b455d2 100644 --- a/gcc/ada/system-vxworks-arm.ads +++ b/gcc/ada/system-vxworks-arm.ads @@ -115,6 +115,10 @@ package System is private + pragma Linker_Options ("--specs=vxworks-crtbe-link.spec"); + -- Pull in crtbegin/crtend objects and register exceptions for ZCX. + -- This is commented out by our Makefile for SJLJ runtimes. + type Address is mod Memory_Size; Null_Address : constant Address := 0; @@ -151,6 +155,6 @@ private Always_Compatible_Rep : constant Boolean := False; Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := True; - ZCX_By_Default : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; end System; diff --git a/gcc/ada/system-vxworks-ppc.ads b/gcc/ada/system-vxworks-ppc.ads index 62d604f..9461577 100644 --- a/gcc/ada/system-vxworks-ppc.ads +++ b/gcc/ada/system-vxworks-ppc.ads @@ -7,7 +7,7 @@ -- S p e c -- -- (VxWorks 5 Version PPC) -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -115,14 +115,12 @@ package System is private - -- Note: we now more closely rely on the VxWorks mechanisms to register - -- exception tables for ZCX support in kernel mode, thanks to crt objects - -- featuring dedicated constructors triggered by linker options below. + pragma Linker_Options ("--specs=vxworks-crtbe-link.spec"); + -- Pull in crtbegin/crtend objects and register exceptions for ZCX. + -- This is commented out by our Makefile for SJLJ runtimes. - -- Commenting the pragma for the sjlj runtimes is performed automatically - -- by our Makefiles, so this line needs to be manipulated with care. - - pragma Linker_Options ("-crtbe" & ASCII.NUL & "-auto-register"); + pragma Linker_Options ("--specs=vxworks-ppc-link.spec"); + -- Setup proper set of -L's for this configuration type Address is mod Memory_Size; Null_Address : constant Address := 0; diff --git a/gcc/ada/vxworks-crtbe-link.spec b/gcc/ada/vxworks-crtbe-link.spec new file mode 100644 index 0000000..8c4398d --- /dev/null +++ b/gcc/ada/vxworks-crtbe-link.spec @@ -0,0 +1,13 @@ +*self_spec: ++ %{!auto-register:%{!noauto-register:-auto-register}} \ + %{!crtbe:%{!nocrtbe:-crtbe}} + +*startfile: ++ %{crtbe:%{!nocrtbe: \ + %{!noauto-register:crtbegin.o%s} \ + %{noauto-register:crtbeginT.o%s} \ + }} + +*endfile: ++ %{crtbe:%{!nocrtbe:crtend.o%s}} + diff --git a/gcc/ada/vxworks-ppc-link.spec b/gcc/ada/vxworks-ppc-link.spec new file mode 100644 index 0000000..8f6263c --- /dev/null +++ b/gcc/ada/vxworks-ppc-link.spec @@ -0,0 +1,6 @@ +*lib: ++ %{mrtp:%{!shared: \ + -L%:if-exists-else( \ + %:getenv(WIND_BASE /target/lib/usr/lib/ppc/PPC32/common) \ + %:getenv(WIND_BASE /target/usr/lib/ppc/PPC32/common)) \ + }} |