+2016-05-02 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch4.adb (Find_Indexing_Operations): Use the underlying type
+ of the container base type in case the container is a subtype.
+ * sem_ch5.adb (Analyze_Iterator_Specification): Ensure that
+ the selector has an entity when checking for a component of a
+ mutable object.
+
+2016-05-02 Arnaud Charlet <charlet@adacore.com>
+
+ Remove dead code.
+ * opt.ads (Latest_Ada_Only): New flag.
+ * sem_prag.adb, par-prag.adb: Ignore pragma Ada_xx under this flag.
+ * usage.adb, switch-c.adb: Disable support for -gnatxx under this flag.
+ * einfo.ads (Has_Predicates, Predicate_Function):
+ Clarify that Has_Predicates does not imply that Predicate_Function
+ will return a non-empty entity.
+
+2016-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_res.adb (Resolve_Qualified_Expression): Generate a predicate
+ check if type requires it.
+ * checks.adb (Apply_Predicate_Check): Disable checks in the
+ object declaration created for an expression with side-effects
+ that requires a predicate check to prevent infinite recursion
+ during expansion.
+
+2016-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch6.adb (Process_Formals): Check properly the type of a
+ formal to determine whether a given convention applies to it.
+
+2016-05-02 Doug Rupp <rupp@adacore.com>
+
+ * tracebak.c: Add incantations for arm-vxworks[67] traceback.
+
+2016-05-02 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb (Check_Component_Storage_Order): Make it a warning, not an
+ error, to have a component with implicit SSO within a composite type
+ that has explicit SSO.
+
+2016-05-02 Bob Duff <duff@adacore.com>
+
+ * s-stposu.adb (Allocate_Any_Controlled): Don't lock/unlock twice.
+
+2016-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * repinfo.adb (List_Entities): Make procedure recursive, to
+ provide representation information for subprograms declared
+ within subprogram bodies.
+
2016-05-02 Arnaud Charlet <charlet@adacore.com>
* exp_ch5.adb, layout.adb, gnatcmd.adb exp_attr.adb, make.adb,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
S : Entity_Id;
begin
- if Present (Predicate_Function (Typ)) then
+ if Predicate_Checks_Suppressed (Empty) then
+ return;
+ elsif Present (Predicate_Function (Typ)) then
S := Current_Scope;
while Present (S) and then not Is_Subprogram (S) loop
S := Scope (S);
Check_Expression_Against_Static_Predicate (N, Typ);
- Insert_Action (N,
- Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
+ if Is_Entity_Name (N) then
+ Insert_Action (N,
+ Make_Predicate_Check
+ (Typ, New_Occurrence_Of (Entity (N), Sloc (N))));
+
+ -- If the expression is not an entity it may have side-effects,
+ -- and the following call will create an object declaration for
+ -- it. We disable checks during its analysis, to prevent an
+ -- infinite recursion.
+
+ else
+ Insert_Action (N,
+ Make_Predicate_Check (Typ, Duplicate_Subexpr (N)),
+ Suppress => All_Checks);
+ end if;
end if;
end if;
end Apply_Predicate_Check;
-- Defined in type and subtype entities. Set if a pragma Predicate or
-- Predicate aspect applies to the type or subtype, or if it inherits a
-- Predicate aspect from its parent or progenitor types.
+--
+-- Note: this flag is set on both partial and full view of types to which
+-- a Predicate pragma or aspect applies.
-- Has_Primitive_Operations (Flag120) [base type only]
-- Defined in all type entities. Set if at least one primitive operation
-- which takes a single argument of the given type, and returns True if
-- the predicate holds and False if it does not.
--
+-- Note: flag Has_Predicate does not imply that Predicate_Function is set
+-- to a non-empty entity; this happens, for example, for itypes created
+-- when instantiating generic units with private types with predicates.
+-- However, if an explicit pragma Predicate or Predicate aspect is given
+-- either for private or full type declaration then both Has_Predicates
+-- and a non-empty Predicate_Function will be set on both the partial and
+-- full views of the type.
+--
-- Note: the reason this is marked as a synthesized attribute is that the
-- way this is stored is as an element of the Subprograms_For_Type field.
& "parent", Err_Node);
end if;
- -- If enclosing composite has explicit SSO then nested composite must
- -- have explicit SSO as well.
-
- elsif Present (ADC) and then No (Comp_ADC) then
- Error_Msg_N ("nested composite must have explicit scalar "
- & "storage order", Err_Node);
-
-- If component and composite SSO differs, check that component
-- falls on byte boundaries and isn't packed.
Error_Msg_N
("type of non-byte-aligned component must have same scalar "
& "storage order as enclosing composite", Err_Node);
+
+ -- Warn if specified only for the outer composite
+
+ elsif Present (ADC) and then No (Comp_ADC) then
+ Error_Msg_NE
+ ("scalar storage order specified for& doesn''t "
+ & "apply to component?", Err_Node, Encl_Type);
end if;
end if;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- case of some binder variables, Gnatbind.Scan_Bind_Arg may modify
-- the default values.
+ Latest_Ada_Only : Boolean := False;
+ -- If True, the only value valid for Ada_Version is Ada_Version_Type'Last,
+ -- trying to specify other values will be ignored (in case of pragma
+ -- Ada_xxx) or generate an error (in case of -gnat83/95/xx switches).
+
type Ada_Version_Type is (Ada_83, Ada_95, Ada_2005, Ada_2012);
pragma Ordered (Ada_Version_Type);
-- Versions of Ada for Ada_Version below. Note that these are ordered,
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- Ada version syntax.
when Pragma_Ada_83 =>
- Ada_Version := Ada_83;
- Ada_Version_Explicit := Ada_83;
- Ada_Version_Pragma := Pragma_Node;
+ if not Latest_Ada_Only then
+ Ada_Version := Ada_83;
+ Ada_Version_Explicit := Ada_83;
+ Ada_Version_Pragma := Pragma_Node;
+ end if;
------------
-- Ada_95 --
-- Ada version syntax.
when Pragma_Ada_95 =>
- Ada_Version := Ada_95;
- Ada_Version_Explicit := Ada_95;
- Ada_Version_Pragma := Pragma_Node;
+ if not Latest_Ada_Only then
+ Ada_Version := Ada_95;
+ Ada_Version_Explicit := Ada_95;
+ Ada_Version_Pragma := Pragma_Node;
+ end if;
---------------------
-- Ada_05/Ada_2005 --
-- must be processed at parse time.
when Pragma_Ada_05 | Pragma_Ada_2005 =>
- if Arg_Count = 0 then
+ if Arg_Count = 0 and not Latest_Ada_Only then
Ada_Version := Ada_2005;
Ada_Version_Explicit := Ada_2005;
Ada_Version_Pragma := Pragma_Node;
-- Called before outputting anything for an entity. Ensures that
-- a blank line precedes the output for a particular entity.
- procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
+ procedure List_Entities
+ (Ent : Entity_Id;
+ Bytes_Big_Endian : Boolean;
+ In_Subprogram : Boolean := False);
-- This procedure lists the entities associated with the entity E, starting
-- with the First_Entity and using the Next_Entity link. If a nested
-- package is found, entities within the package are recursively processed.
+ -- When recursing within a subprogram body, Is_Subprogram suppresses
+ -- duplicate information about signature.
procedure List_Name (Ent : Entity_Id);
-- List name of entity Ent in appropriate case. The name is listed with
-- List_Entities --
-------------------
- procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
+ procedure List_Entities
+ (Ent : Entity_Id;
+ Bytes_Big_Endian : Boolean;
+ In_Subprogram : Boolean := False)
+ is
Body_E : Entity_Id;
E : Entity_Id;
and then Nkind (Declaration_Node (Ent)) not in N_Renaming_Declaration
then
-- If entity is a subprogram and we are listing mechanisms,
- -- then we need to list mechanisms for this entity.
+ -- then we need to list mechanisms for this entity. We skip this
+ -- if it is a nested subprogram, as the information has already
+ -- been produced when listing the enclosing scope.
if List_Representation_Info_Mechanisms
and then (Is_Subprogram (Ent)
or else Ekind (Ent) = E_Entry
or else Ekind (Ent) = E_Entry_Family)
+ and then not In_Subprogram
then
Need_Blank_Line := True;
List_Mechanisms (Ent);
List_Mechanisms (E);
end if;
+ -- Recurse into entities local to subprogram
+
+ List_Entities (E, Bytes_Big_Endian, True);
+
+ elsif Ekind (E) in Formal_Kind and then In_Subprogram then
+ null;
+
elsif Ekind_In (E, E_Entry,
E_Entry_Family,
E_Subprogram_Type)
-- --
-- B o d y --
-- --
--- Copyright (C) 2011-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2016, 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- --
N_Size : Storage_Count;
Subpool : Subpool_Handle := null;
- Allocation_Locked : Boolean;
- -- This flag stores the state of the associated collection
-
Header_And_Padding : Storage_Offset;
-- This offset includes the size of a FM_Node plus any additional
-- padding due to a larger alignment.
else
-- If the master is missing, then the expansion of the access type
- -- failed to create one. This is a serious error.
+ -- failed to create one. This is a compiler bug.
- if Context_Master = null then
- raise Program_Error
- with "missing master in pool allocation";
+ pragma Assert
+ (Context_Master /= null, "missing master in pool allocation");
-- If a subpool is present, then this is the result of erroneous
-- allocator expansion. This is not a serious error, but it should
-- still be detected.
- elsif Context_Subpool /= null then
+ if Context_Subpool /= null then
raise Program_Error
with "subpool not required in pool allocation";
+ end if;
-- If the allocation is intended to be on a subpool, but the access
-- type's pool does not support subpools, then this is the result of
- -- erroneous end-user code.
+ -- incorrect end-user code.
- elsif On_Subpool then
+ if On_Subpool then
raise Program_Error
with "pool of access type does not support subpools";
end if;
-- Write - finalization
Lock_Task.all;
- Allocation_Locked := Finalization_Started (Master.all);
- Unlock_Task.all;
-- Do not allow the allocation of controlled objects while the
-- associated master is being finalized.
- if Allocation_Locked then
+ if Finalization_Started (Master.all) then
raise Program_Error with "allocation after finalization started";
end if;
-- Check whether primitive Finalize_Address is available. If it is
-- not, then either the expansion of the designated type failed or
- -- the expansion of the allocator failed. This is a serious error.
+ -- the expansion of the allocator failed. This is a compiler bug.
- if Fin_Address = null then
- raise Program_Error
- with "primitive Finalize_Address not available";
- end if;
+ pragma Assert
+ (Fin_Address /= null, "primitive Finalize_Address not available");
-- The size must acount for the hidden header preceding the object.
-- Account for possible padding space before the header due to a
-- Step 4: Attachment
if Is_Controlled then
- Lock_Task.all;
+ -- Note that we already did "Lock_Task.all;" in Step 2 above.
-- Map the allocated memory into a FM_Node record. This converts the
-- top of the allocated bits into a list header. If there is padding
else
Addr := N_Addr;
end if;
+
+ exception
+ when others =>
+ -- If we locked, we want to unlock
+
+ if Is_Controlled then
+ Unlock_Task.all;
+ end if;
+
+ raise;
end Allocate_Any_Controlled;
------------
if Is_Controlled then
Lock_Task.all;
- -- Destroy the relation pair object - Finalize_Address since it is no
- -- longer needed.
+ begin
+ -- Destroy the relation pair object - Finalize_Address since it is
+ -- no longer needed.
- if Finalize_Address_Table_In_Use then
+ if Finalize_Address_Table_In_Use then
- -- Synchronization:
- -- Read - finalization
- -- Write - allocation, deallocation
+ -- Synchronization:
+ -- Read - finalization
+ -- Write - allocation, deallocation
- Delete_Finalize_Address_Unprotected (Addr);
- end if;
+ Delete_Finalize_Address_Unprotected (Addr);
+ end if;
- -- Account for possible padding space before the header due to a
- -- larger alignment.
+ -- Account for possible padding space before the header due to a
+ -- larger alignment.
- Header_And_Padding := Header_Size_With_Padding (Alignment);
+ Header_And_Padding := Header_Size_With_Padding (Alignment);
- -- N_Addr N_Ptr Addr (from input)
- -- | | |
- -- V V V
- -- +-------+---------------+----------------------+
- -- |Padding| Header | Object |
- -- +-------+---------------+----------------------+
- -- ^ ^ ^
- -- | +- Header_Size -+
- -- | |
- -- +- Header_And_Padding --+
+ -- N_Addr N_Ptr Addr (from input)
+ -- | | |
+ -- V V V
+ -- +-------+---------------+----------------------+
+ -- |Padding| Header | Object |
+ -- +-------+---------------+----------------------+
+ -- ^ ^ ^
+ -- | +- Header_Size -+
+ -- | |
+ -- +- Header_And_Padding --+
- -- Convert the bits preceding the object into a list header
+ -- Convert the bits preceding the object into a list header
- N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size);
+ N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size);
- -- Detach the object from the related finalization master. This
- -- action does not need to know the prior context used during
- -- allocation.
+ -- Detach the object from the related finalization master. This
+ -- action does not need to know the prior context used during
+ -- allocation.
- -- Synchronization:
- -- Write - allocation, deallocation, finalization
+ -- Synchronization:
+ -- Write - allocation, deallocation, finalization
- Detach_Unprotected (N_Ptr);
+ Detach_Unprotected (N_Ptr);
- -- Move the address from the object to the beginning of the list
- -- header.
+ -- Move the address from the object to the beginning of the list
+ -- header.
- N_Addr := Addr - Header_And_Padding;
+ N_Addr := Addr - Header_And_Padding;
- -- The size of the deallocated object must include the size of the
- -- hidden list header.
+ -- The size of the deallocated object must include the size of the
+ -- hidden list header.
- N_Size := Storage_Size + Header_And_Padding;
+ N_Size := Storage_Size + Header_And_Padding;
- Unlock_Task.all;
+ Unlock_Task.all;
+ exception
+ when others =>
+ -- If we locked, we want to unlock
+
+ Unlock_Task.all;
+ raise;
+ end;
else
N_Addr := Addr;
N_Size := Storage_Size;
begin
Typ := T;
+ -- Use the specific type when the parameter type is class-wide
+
if Is_Class_Wide_Type (Typ) then
Typ := Root_Type (Typ);
end if;
Ref := Empty;
- Typ := Underlying_Type (Typ);
+ Typ := Underlying_Type (Base_Type (Typ));
Inspect_Primitives (Typ, Ref);
Inspect_Declarations (Typ, Ref);
Bas : Entity_Id;
Typ : Entity_Id;
- -- Start of processing for Analyze_iterator_Specification
+ -- Start of processing for Analyze_Iterator_Specification
begin
Enter_Name (Def_Id);
-- be performed.
if Nkind (Orig_Iter_Name) = N_Selected_Component
+ and then
+ Present (Entity (Selector_Name (Orig_Iter_Name)))
and then Ekind_In
(Entity (Selector_Name (Orig_Iter_Name)),
E_Component,
-- Force call by reference if aliased
- if Is_Aliased (Formal) then
- Set_Mechanism (Formal, By_Reference);
+ declare
+ Conv : constant Convention_Id := Convention (Etype (Formal));
+ begin
+ if Is_Aliased (Formal) then
+ Set_Mechanism (Formal, By_Reference);
- -- Warn if user asked this to be passed by copy
+ -- Warn if user asked this to be passed by copy
- if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then
- Error_Msg_N
- ("cannot pass aliased parameter & by copy??", Formal);
- end if;
+ if Conv = Convention_Ada_Pass_By_Copy then
+ Error_Msg_N
+ ("cannot pass aliased parameter & by copy??", Formal);
+ end if;
- -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy
+ -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy
- elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then
- Set_Mechanism (Formal, By_Copy);
+ elsif Conv = Convention_Ada_Pass_By_Copy then
+ Set_Mechanism (Formal, By_Copy);
- elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Reference then
- Set_Mechanism (Formal, By_Reference);
- end if;
+ elsif Conv = Convention_Ada_Pass_By_Reference then
+ Set_Mechanism (Formal, By_Reference);
+ end if;
+ end;
<<Next_Parameter>>
Next (Param_Spec);
Handler_Proc := Find_Unique_Parameterless_Procedure (Arg1_X, Arg1);
Proc_Scope := Scope (Handler_Proc);
- -- On AAMP only, a pragma Interrupt_Handler is supported for
- -- nonprotected parameterless procedures.
-
- if not AAMP_On_Target
- or else Prag_Id = Pragma_Attach_Handler
- then
- if Ekind (Proc_Scope) /= E_Protected_Type then
- Error_Pragma_Arg
- ("argument of pragma% must be protected procedure", Arg1);
- end if;
+ if Ekind (Proc_Scope) /= E_Protected_Type then
+ Error_Pragma_Arg
+ ("argument of pragma% must be protected procedure", Arg1);
+ end if;
- -- For pragma case (as opposed to access case), check placement.
- -- We don't need to do that for aspects, because we have the
- -- check that they aspect applies an appropriate procedure.
+ -- For pragma case (as opposed to access case), check placement.
+ -- We don't need to do that for aspects, because we have the
+ -- check that they aspect applies an appropriate procedure.
- if not From_Aspect_Specification (N)
- and then Parent (N) /= Protected_Definition (Parent (Proc_Scope))
- then
- Error_Pragma ("pragma% must be in protected definition");
- end if;
+ if not From_Aspect_Specification (N)
+ and then Parent (N) /= Protected_Definition (Parent (Proc_Scope))
+ then
+ Error_Pragma ("pragma% must be in protected definition");
end if;
- if not Is_Library_Level_Entity (Proc_Scope)
- or else (AAMP_On_Target
- and then not Is_Library_Level_Entity (Handler_Proc))
- then
+ if not Is_Library_Level_Entity (Proc_Scope) then
Error_Pragma_Arg
("argument for pragma% must be library level entity", Arg1);
end if;
Mark_Pragma_As_Ghost (N, Handler);
Set_Is_Interrupt_Handler (Handler);
- -- If the pragma is not associated with a handler procedure within a
- -- protected type, then it must be for a nonprotected procedure for
- -- the AAMP target, in which case we don't associate a representation
- -- item with the procedure's scope.
+ pragma Assert (Ekind (Prot_Typ) = E_Protected_Type);
- if Ekind (Prot_Typ) = E_Protected_Type then
- Record_Rep_Item (Prot_Typ, N);
- end if;
+ Record_Rep_Item (Prot_Typ, N);
-- Chain the pragma on the contract for completeness
-- Now set Ada 83 mode
- Ada_Version := Ada_83;
- Ada_Version_Explicit := Ada_83;
- Ada_Version_Pragma := N;
+ if not Latest_Ada_Only then
+ Ada_Version := Ada_83;
+ Ada_Version_Explicit := Ada_83;
+ Ada_Version_Pragma := N;
+ end if;
------------
-- Ada_95 --
-- Now set Ada 95 mode
- Ada_Version := Ada_95;
- Ada_Version_Explicit := Ada_95;
- Ada_Version_Pragma := N;
+ if not Latest_Ada_Only then
+ Ada_Version := Ada_95;
+ Ada_Version_Explicit := Ada_95;
+ Ada_Version_Pragma := N;
+ end if;
---------------------
-- Ada_05/Ada_2005 --
-- Now set appropriate Ada mode
- Ada_Version := Ada_2005;
- Ada_Version_Explicit := Ada_2005;
- Ada_Version_Pragma := N;
+ if not Latest_Ada_Only then
+ Ada_Version := Ada_2005;
+ Ada_Version_Explicit := Ada_2005;
+ Ada_Version_Pragma := N;
+ end if;
end if;
end;
begin
-- If first character is asterisk, this is a link name, and we leave it
-- completely unmodified. We also ignore null strings (the latter case
- -- happens only in error cases) and no encoding should occur for AAMP
- -- interface names.
+ -- happens only in error cases).
if Len = 0
or else Get_String_Char (Str, 1) = Get_Char_Code ('*')
- or else AAMP_On_Target
then
Set_Interface_Name (E, S);
if Nkind (N) = N_Qualified_Expression and then Is_Scalar_Type (Typ) then
Apply_Scalar_Range_Check (Expr, Typ);
end if;
+
+ -- Finally, check whether a predicate applies to the target type.
+ -- This comes from AI12-0100. As for type conversions, check the
+ -- enclosing context to prevent an infinite expansion.
+
+ if Has_Predicates (Target_Typ) then
+ if Nkind (Parent (N)) = N_Function_Call
+ and then Present (Name (Parent (N)))
+ and then (Is_Predicate_Function (Entity (Name (Parent (N))))
+ or else
+ Is_Predicate_Function_M (Entity (Name (Parent (N)))))
+ then
+ null;
+
+ elsif Nkind (N) = N_Qualified_Expression then
+ Apply_Predicate_Check (N, Target_Typ);
+ end if;
+ end if;
end Resolve_Qualified_Expression;
------------------------------
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2016, 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- --
Ptr := Ptr + 1;
- if Switch_Chars (Ptr) /= '3' then
+ if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ptr := Ptr + 1;
- if Switch_Chars (Ptr) /= '5' then
+ if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ptr := Ptr + 1;
- if Switch_Chars (Ptr) /= '5' then
+ if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
if Ptr > Max - 3 then
Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
- elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then
+ elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
+ and then not Latest_Ada_Only
+ then
Ada_Version := Ada_2005;
elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
#define PC_ADJUST -2
/* The minimum size of call instructions on this architecture is 2 bytes */
-/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
+/*---------------------- ARM VxWorks ------------------------------------*/
+#elif (defined (ARMEL) && defined (__vxworks))
+
+#include "vxWorks.h"
+#include "version.h"
+
+#define USE_GCC_UNWINDER
+#define PC_ADJUST -2
+
+#if (_WRS_VXWORKS_MAJOR >= 7)
+#define USING_ARM_UNWINDING 1
+#endif
+
+/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin --------------*/
#elif ((defined (_POWER) && defined (_AIX)) || \
(defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
(defined (__ppc__) && defined (__APPLE__)))
The condition is expressed the way above because we cannot reliably rely on
any other macro from the base compiler when compiling stage1. */
+#ifdef USING_ARM_UNWINDING
+/* This value is not part of the enumerated reason codes defined in unwind.h
+ for ARM style unwinding, but is used in the included "C" code, so we
+ define it to a reasonable value to avoid a compilation error. */
+#define _URC_NORMAL_STOP 0
+#endif
#include "tb-gcc.c"
/*------------------------------------------------------------------*
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2015, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2016, 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- --
-- Warning: the output of this usage for warnings is duplicated in the GNAT
-- reference manual. Be sure to update that if you change the warning list.
-with Targparm; use Targparm;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
Write_Eol;
- -- Common GCC switches not available for AAMP targets
-
- if not AAMP_On_Target then
- Write_Switch_Char ("fstack-check ", "");
- Write_Line ("Generate stack checking code");
-
- Write_Switch_Char ("fno-inline ", "");
- Write_Line ("Inhibit all inlining (makes executable smaller)");
-
- Write_Switch_Char ("fpreserve-control-flow ", "");
- Write_Line ("Preserve control flow for coverage analysis");
- end if;
-
-- Common switches available everywhere
Write_Switch_Char ("g ", "");
Write_Switch_Char ("zr");
Write_Line ("Distribution stub generation for receiver stubs");
- -- Line for -gnat83 switch
+ if not Latest_Ada_Only then
+ -- Line for -gnat83 switch
- Write_Switch_Char ("83");
- Write_Line ("Ada 83 mode");
+ Write_Switch_Char ("83");
+ Write_Line ("Ada 83 mode");
- -- Line for -gnat95 switch
+ -- Line for -gnat95 switch
- Write_Switch_Char ("95");
+ Write_Switch_Char ("95");
- if Ada_Version_Default = Ada_95 then
- Write_Line ("Ada 95 mode (default)");
- else
- Write_Line ("Ada 95 mode");
- end if;
+ if Ada_Version_Default = Ada_95 then
+ Write_Line ("Ada 95 mode (default)");
+ else
+ Write_Line ("Ada 95 mode");
+ end if;
- -- Line for -gnat2005 switch
+ -- Line for -gnat2005 switch
- Write_Switch_Char ("2005");
+ Write_Switch_Char ("2005");
- if Ada_Version_Default = Ada_2005 then
- Write_Line ("Ada 2005 mode (default)");
- else
- Write_Line ("Ada 2005 mode");
+ if Ada_Version_Default = Ada_2005 then
+ Write_Line ("Ada 2005 mode (default)");
+ else
+ Write_Line ("Ada 2005 mode");
+ end if;
end if;
-- Line for -gnat2012 switch
projects / gcc.git / commitdiff