aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog42
-rw-r--r--gcc/ada/a-cfdlli.adb4
-rw-r--r--gcc/ada/a-cfdlli.ads2
-rw-r--r--gcc/ada/a-cfhase.adb4
-rw-r--r--gcc/ada/a-cfhase.ads2
-rw-r--r--gcc/ada/a-cfinve.adb4
-rw-r--r--gcc/ada/a-cfinve.ads4
-rw-r--r--gcc/ada/a-cforse.adb4
-rw-r--r--gcc/ada/a-cforse.ads2
-rw-r--r--gcc/ada/a-cofove.adb4
-rw-r--r--gcc/ada/a-cofove.ads2
-rw-r--r--gcc/ada/exp_ch9.adb30
-rw-r--r--gcc/ada/fe.h4
-rw-r--r--gcc/ada/g-debpoo.adb177
-rw-r--r--gcc/ada/init.c7
-rw-r--r--gcc/ada/restrict.adb18
-rw-r--r--gcc/ada/restrict.ads9
-rw-r--r--gcc/ada/s-rident.ads2
-rw-r--r--gcc/ada/sem_res.adb2
-rw-r--r--gcc/ada/sem_util.adb25
-rw-r--r--gcc/ada/sem_util.ads3
21 files changed, 256 insertions, 95 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fda8e8b..65e6c4c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,45 @@
+2015-10-20 Jerome Lambourg <lambourg@adacore.com>
+
+ * init.c (__gnat_vxsim_error_handler): Completely disable on
+ VxWorks-7 as the VSBs used to build gcc do not support vxsim
+ architecture.
+
+2015-10-20 Claire Dross <dross@adacore.com>
+
+ * a-cfdlli.ads, a-cfinve.ads, a-cofove.ads (Generic_Sorting): Explicit
+ SPARK_Mode.
+ * a-cfhase.ads, a-cforse.ads (Generic_Keys): Explicit SPARK_Mode.
+
+2015-10-20 Tristan Gingold <gingold@adacore.com>
+
+ * exp_ch9.adb (Expand_N_Protected_Type_Declaration):
+ Check for No_Implicit_Protected_Object_Allocations.
+ * fe.h (Check_No_Implicit_Task_Alloc,
+ Check_No_Implicit_Protected_Alloc): Define and declare.
+ * restrict.ads, restrict.adb (Check_No_Implicit_Task_Alloc,
+ Check_No_Implicit_Protected_Alloc): New procedures to check the
+ restrictions.
+ * s-rident.ads (No_Implicit_Task_Allocations)
+ (No_Implicit_Protected_Object_Allocations): Declare new
+ restrictions.
+
+2015-10-20 Yannick Moy <moy@adacore.com>
+
+ * sem_res.adb (Resolve_Selected_Component): Only set flag
+ when component is defined in a variant part.
+ * sem_util.adb,
+ * sem_util.ads (Is_Declared_Within_Variant): Promote local query
+ as publicy visible one for use in Resolve_Selected_Component.
+
+2015-10-20 Philippe Gil <gil@adacore.com>
+
+ * g-debpoo.adb: allow instrumented System.Memory to use Debug_Pool
+ from foreign threads.
+ * g-debpoo.adb (Print_Traceback): NEW print traceback if available
+ added to support Stack_Trace_Depth = 0.
+ (Print_Address): NEW print System.Address without no secondary
+ stack use (Address_Image uses secondary stack)
+
2015-10-20 Yannick Moy <moy@adacore.com>
* exp_ch9.adb (Expand_Entry_Barrier): Default initialize local variable
diff --git a/gcc/ada/a-cfdlli.adb b/gcc/ada/a-cfdlli.adb
index 2e8676b..7b19dd6 100644
--- a/gcc/ada/a-cfdlli.adb
+++ b/gcc/ada/a-cfdlli.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -581,7 +581,7 @@ is
-- Generic_Sorting --
---------------------
- package body Generic_Sorting is
+ package body Generic_Sorting with SPARK_Mode => Off is
---------------
-- Is_Sorted --
diff --git a/gcc/ada/a-cfdlli.ads b/gcc/ada/a-cfdlli.ads
index f4a2586..e0b96a3 100644
--- a/gcc/ada/a-cfdlli.ads
+++ b/gcc/ada/a-cfdlli.ads
@@ -299,7 +299,7 @@ is
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
- package Generic_Sorting is
+ package Generic_Sorting with SPARK_Mode is
function Is_Sorted (Container : List) return Boolean with
Global => null;
diff --git a/gcc/ada/a-cfhase.adb b/gcc/ada/a-cfhase.adb
index 8d73a2c..ac2ea61 100644
--- a/gcc/ada/a-cfhase.adb
+++ b/gcc/ada/a-cfhase.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -1387,7 +1387,7 @@ is
end;
end Vet;
- package body Generic_Keys is
+ package body Generic_Keys with SPARK_Mode => Off is
-----------------------
-- Local Subprograms --
diff --git a/gcc/ada/a-cfhase.ads b/gcc/ada/a-cfhase.ads
index e0d210e..0c43cf2 100644
--- a/gcc/ada/a-cfhase.ads
+++ b/gcc/ada/a-cfhase.ads
@@ -279,7 +279,7 @@ is
with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
- package Generic_Keys is
+ package Generic_Keys with SPARK_Mode is
function Key (Container : Set; Position : Cursor) return Key_Type with
Global => null;
diff --git a/gcc/ada/a-cfinve.adb b/gcc/ada/a-cfinve.adb
index f088b9e..da23a44 100644
--- a/gcc/ada/a-cfinve.adb
+++ b/gcc/ada/a-cfinve.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2015, 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- --
@@ -174,7 +174,7 @@ is
-- Generic_Sorting --
---------------------
- package body Generic_Sorting is
+ package body Generic_Sorting with SPARK_Mode => Off is
function "<" (X, Y : Holder) return Boolean is (E (X) < E (Y));
package Def_Sorting is new Def.Generic_Sorting ("<");
diff --git a/gcc/ada/a-cfinve.ads b/gcc/ada/a-cfinve.ads
index 7559df6..2fef4af 100644
--- a/gcc/ada/a-cfinve.ads
+++ b/gcc/ada/a-cfinve.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2014-2015, 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 --
@@ -198,7 +198,7 @@ is
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
- package Generic_Sorting is
+ package Generic_Sorting with SPARK_Mode is
function Is_Sorted (Container : Vector) return Boolean with
Global => null;
diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb
index e120321..2b09018 100644
--- a/gcc/ada/a-cforse.adb
+++ b/gcc/ada/a-cforse.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -674,7 +674,7 @@ is
-- Generic_Keys --
------------------
- package body Generic_Keys is
+ package body Generic_Keys with SPARK_Mode => Off is
-----------------------
-- Local Subprograms --
diff --git a/gcc/ada/a-cforse.ads b/gcc/ada/a-cforse.ads
index a69aa4f..a3cbae1 100644
--- a/gcc/ada/a-cforse.ads
+++ b/gcc/ada/a-cforse.ads
@@ -288,7 +288,7 @@ is
with function "<" (Left, Right : Key_Type) return Boolean is <>;
- package Generic_Keys is
+ package Generic_Keys with SPARK_Mode is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean with
Global => null;
diff --git a/gcc/ada/a-cofove.adb b/gcc/ada/a-cofove.adb
index ef37cc0..c713bbc 100644
--- a/gcc/ada/a-cofove.adb
+++ b/gcc/ada/a-cofove.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2015, 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- --
@@ -355,7 +355,7 @@ is
-- Generic_Sorting --
---------------------
- package body Generic_Sorting is
+ package body Generic_Sorting with SPARK_Mode => Off is
---------------
-- Is_Sorted --
diff --git a/gcc/ada/a-cofove.ads b/gcc/ada/a-cofove.ads
index 284f034..622454e 100644
--- a/gcc/ada/a-cofove.ads
+++ b/gcc/ada/a-cofove.ads
@@ -203,7 +203,7 @@ is
generic
with function "<" (Left, Right : Element_Type) return Boolean is <>;
- package Generic_Sorting is
+ package Generic_Sorting with SPARK_Mode is
function Is_Sorted (Container : Vector) return Boolean with
Global => null;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 3e13126..b0bf000 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -9140,6 +9140,8 @@ package body Exp_Ch9 is
-- is OK to miss this check in -gnatc mode.
Check_Restriction (No_Implicit_Heap_Allocations, Priv);
+ Check_Restriction
+ (No_Implicit_Protected_Object_Allocations, Priv);
elsif Restriction_Active (No_Implicit_Heap_Allocations) then
if not Discriminated_Size (Defining_Identifier (Priv))
@@ -9162,6 +9164,34 @@ package body Exp_Ch9 is
& " restriction No_Implicit_Heap_Allocations??",
Priv, Prot_Typ);
end if;
+
+ -- Likewise for No_Implicit_Protected_Object_Allocations
+
+ elsif Restriction_Active
+ (No_Implicit_Protected_Object_Allocations)
+ then
+ if not Discriminated_Size (Defining_Identifier (Priv))
+ then
+
+ -- Any object of the type will be non-static.
+
+ Error_Msg_N ("component has non-static size??", Priv);
+ Error_Msg_NE
+ ("\creation of protected object of type& will"
+ & " violate restriction "
+ & "No_Implicit_Protected_Object_Allocations??",
+ Priv, Prot_Typ);
+ else
+
+ -- Object will be non-static if discriminants are.
+
+ Error_Msg_NE
+ ("creation of protected object of type& with "
+ & "non-static discriminants will violate "
+ & " restriction"
+ & " No_Implicit_Protected_Object_Allocations??",
+ Priv, Prot_Typ);
+ end if;
end if;
end if;
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 1df23b5..36befa6 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -194,11 +194,15 @@ extern Boolean No_Strict_Aliasing_CP;
#define No_Exception_Handlers_Set restrict__no_exception_handlers_set
#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc
+#define Check_No_Implicit_Task_Alloc restrict__check_no_implicit_task_alloc
+#define Check_No_Implicit_Protected_Alloc restrict__check_no_implicit_protected_alloc
#define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed
#define Check_Implicit_Dynamic_Code_Allowed restrict__check_implicit_dynamic_code_allowed
extern Boolean No_Exception_Handlers_Set (void);
extern void Check_No_Implicit_Heap_Alloc (Node_Id);
+extern void Check_No_Implicit_Task_Alloc (Node_Id);
+extern void Check_No_Implicit_Protected_Alloc (Node_Id);
extern void Check_Elaboration_Code_Allowed (Node_Id);
extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id);
diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb
index 8768e3e..5857094 100644
--- a/gcc/ada/g-debpoo.adb
+++ b/gcc/ada/g-debpoo.adb
@@ -302,6 +302,20 @@ package body GNAT.Debug_Pools is
-- Wrapper for Put_Line that ensures we always write to stdout instead of
-- the current output file defined in GNAT.IO.
+ procedure Print_Traceback
+ (Output_File : File_Type;
+ Prefix : String;
+ Traceback : Traceback_Htable_Elem_Ptr);
+ -- Output Prefix & Traceback & EOL.
+ -- Print nothing if Traceback is null.
+
+ procedure Print_Address (File : File_Type; Addr : Address);
+ -- Output System.Address without using secondary stack.
+ -- When System.Memory uses Debug_Pool, secondary stack cannot be used
+ -- during Allocate calls, as some Allocate calls are done to
+ -- register/initialize a secondary stack for a foreign thread.
+ -- During these calls, the secondary stack is not available yet.
+
package Validity is
function Is_Handled (Storage : System.Address) return Boolean;
pragma Inline (Is_Handled);
@@ -460,6 +474,18 @@ package body GNAT.Debug_Pools is
end if;
end Output_File;
+ -------------------
+ -- Print_Address --
+ -------------------
+
+ procedure Print_Address (File : File_Type; Addr : Address) is
+ type My_Address is mod Memory_Size;
+ function To_My_Address is new Ada.Unchecked_Conversion
+ (System.Address, My_Address);
+ begin
+ Put (File, My_Address'Image (To_My_Address (Addr)));
+ end Print_Address;
+
--------------
-- Put_Line --
--------------
@@ -481,7 +507,8 @@ package body GNAT.Debug_Pools is
procedure Print (Tr : Tracebacks_Array) is
begin
for J in Tr'Range loop
- Put (File, "0x" & Address_Image (PC_For (Tr (J))) & ' ');
+ Print_Address (File, PC_For (Tr (J)));
+ Put (File, ' ');
end loop;
Put (File, ASCII.LF);
end Print;
@@ -964,12 +991,16 @@ package body GNAT.Debug_Pools is
if Pool.Low_Level_Traces then
Put (Output_File (Pool),
"info: Allocated"
- & Storage_Count'Image (Size_In_Storage_Elements)
- & " bytes at 0x" & Address_Image (Storage_Address)
- & " (physically:"
- & Storage_Count'Image (Local_Storage_Array'Length)
- & " bytes at 0x" & Address_Image (P.all'Address)
- & "), at ");
+ & Storage_Count'Image (Size_In_Storage_Elements)
+ & " bytes at ");
+ Print_Address (Output_File (Pool), Storage_Address);
+ Put (Output_File (Pool),
+ " (physically:"
+ & Storage_Count'Image (Local_Storage_Array'Length)
+ & " bytes at ");
+ Print_Address (Output_File (Pool), P.all'Address);
+ Put (Output_File (Pool),
+ "), at ");
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
Allocate_Label'Address,
Code_Address_For_Deallocate_End);
@@ -1151,13 +1182,15 @@ package body GNAT.Debug_Pools is
Next := Header.Next;
if Pool.Low_Level_Traces then
- Put_Line
+ Put
(Output_File (Pool),
"info: Freeing physical memory "
- & Storage_Count'Image
+ & Storage_Count'Image
((abs Header.Block_Size) + Extra_Allocation)
- & " bytes at 0x"
- & Address_Image (Header.Allocation_Address));
+ & " bytes at ");
+ Print_Address (Output_File (Pool),
+ Header.Allocation_Address);
+ Put_Line (Output_File (Pool), "");
end if;
if System_Memory_Debug_Pool_Enabled then
@@ -1343,6 +1376,21 @@ package body GNAT.Debug_Pools is
end Get_Size;
+ ---------------------
+ -- Print_Traceback --
+ ---------------------
+
+ procedure Print_Traceback
+ (Output_File : File_Type;
+ Prefix : String;
+ Traceback : Traceback_Htable_Elem_Ptr) is
+ begin
+ if Traceback /= null then
+ Put (Output_File, Prefix);
+ Put_Line (Output_File, 0, Traceback.Traceback);
+ end if;
+ end Print_Traceback;
+
----------------
-- Deallocate --
----------------
@@ -1411,12 +1459,11 @@ package body GNAT.Debug_Pools is
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
Deallocate_Label'Address,
Code_Address_For_Deallocate_End);
- Put (Output_File (Pool), " Memory already deallocated at ");
- Put_Line
- (Output_File (Pool), 0,
- To_Traceback (Header.Dealloc_Traceback).Traceback);
- Put (Output_File (Pool), " Memory was allocated at ");
- Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
+ Print_Traceback (Output_File (Pool),
+ " Memory already deallocated at ",
+ To_Traceback (Header.Dealloc_Traceback));
+ Print_Traceback (Output_File (Pool), " Memory was allocated at ",
+ Header.Alloc_Traceback);
end if;
else
@@ -1439,16 +1486,20 @@ package body GNAT.Debug_Pools is
Put (Output_File (Pool),
"info: Deallocated"
& Storage_Count'Image (Header.Block_Size)
- & " bytes at 0x" & Address_Image (Storage_Address)
- & " (physically"
+ & " bytes at ");
+ Print_Address (Output_File (Pool), Storage_Address);
+ Put (Output_File (Pool),
+ " (physically"
& Storage_Count'Image (Header.Block_Size + Extra_Allocation)
- & " bytes at 0x" & Address_Image (Header.Allocation_Address)
- & "), at ");
+ & " bytes at ");
+ Print_Address (Output_File (Pool), Header.Allocation_Address);
+ Put (Output_File (Pool), "), at ");
+
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
Deallocate_Label'Address,
Code_Address_For_Deallocate_End);
- Put (Output_File (Pool), " Memory was allocated at ");
- Put_Line (Output_File (Pool), 0, Header.Alloc_Traceback.Traceback);
+ Print_Traceback (Output_File (Pool), " Memory was allocated at ",
+ Header.Alloc_Traceback);
end if;
-- Remove this block from the list of used blocks
@@ -1594,14 +1645,10 @@ package body GNAT.Debug_Pools is
(Output_File (Pool), Pool.Stack_Trace_Depth, null,
Dereference_Label'Address,
Code_Address_For_Dereference_End);
- Put (Output_File (Pool), " First deallocation at ");
- Put_Line
- (Output_File (Pool),
- 0, To_Traceback (Header.Dealloc_Traceback).Traceback);
- Put (Output_File (Pool), " Initial allocation at ");
- Put_Line
- (Output_File (Pool),
- 0, Header.Alloc_Traceback.Traceback);
+ Print_Traceback (Output_File (Pool), " First deallocation at ",
+ To_Traceback (Header.Dealloc_Traceback));
+ Print_Traceback (Output_File (Pool), " Initial allocation at ",
+ Header.Alloc_Traceback);
end if;
end if;
end if;
@@ -1787,10 +1834,12 @@ package body GNAT.Debug_Pools is
Put ("Size: " & Storage_Count'Image (Header.Block_Size) & " at: ");
- for T in Header.Alloc_Traceback.Traceback'Range loop
- Put ("0x" & Address_Image
- (PC_For (Header.Alloc_Traceback.Traceback (T))) & ' ');
- end loop;
+ if Header.Alloc_Traceback /= null then
+ for T in Header.Alloc_Traceback.Traceback'Range loop
+ Put ("0x" & Address_Image
+ (PC_For (Header.Alloc_Traceback.Traceback (T))) & ' ');
+ end loop;
+ end if;
Put_Line ("");
Current := Header.Next;
@@ -2090,16 +2139,16 @@ package body GNAT.Debug_Pools is
else
Header := Header_Of (Storage);
- Put_Line (Standard_Output, "0x" & Address_Image (A)
- & " allocated at:");
- Put_Line (Standard_Output, 0, Header.Alloc_Traceback.Traceback);
+ Print_Address (Standard_Output, A);
+ Put_Line (Standard_Output, " allocated at:");
+ Print_Traceback (Standard_Output, "", Header.Alloc_Traceback);
if To_Traceback (Header.Dealloc_Traceback) /= null then
- Put_Line (Standard_Output, "0x" & Address_Image (A)
- & " logically freed memory, deallocated at:");
- Put_Line
- (Standard_Output, 0,
- To_Traceback (Header.Dealloc_Traceback).Traceback);
+ Print_Address (Standard_Output, A);
+ Put_Line (Standard_Output,
+ " logically freed memory, deallocated at:");
+ Print_Traceback (Standard_Output, "",
+ To_Traceback (Header.Dealloc_Traceback));
end if;
end if;
end Print_Pool;
@@ -2180,30 +2229,34 @@ package body GNAT.Debug_Pools is
Actual_Size := size_t (Header.Block_Size);
Tracebk := Header.Alloc_Traceback.Traceback;
- Num_Calls := Tracebk'Length;
- -- (Code taken from memtrack.adb in GNAT's sources)
+ if Header.Alloc_Traceback /= null then
+ Num_Calls := Tracebk'Length;
- -- Logs allocation call using the format:
+ -- (Code taken from memtrack.adb in GNAT's sources)
- -- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
+ -- Logs allocation call using the format:
- fputc (Character'Pos ('A'), File);
- fwrite (Current'Address, Address_Size, 1, File);
- fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements, 1,
- File);
- fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements, 1,
- File);
- fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
- File);
+ -- 'A' <mem addr> <size chunk> <len backtrace> <addr1> ... <addrn>
- for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
- declare
- Ptr : System.Address := PC_For (Tracebk (J));
- begin
- fwrite (Ptr'Address, Address_Size, 1, File);
- end;
- end loop;
+ fputc (Character'Pos ('A'), File);
+ fwrite (Current'Address, Address_Size, 1, File);
+ fwrite (Actual_Size'Address, size_t'Max_Size_In_Storage_Elements,
+ 1, File);
+ fwrite (Dummy_Time'Address, Duration'Max_Size_In_Storage_Elements,
+ 1, File);
+ fwrite (Num_Calls'Address, Integer'Max_Size_In_Storage_Elements, 1,
+ File);
+
+ for J in Tracebk'First .. Tracebk'First + Num_Calls - 1 loop
+ declare
+ Ptr : System.Address := PC_For (Tracebk (J));
+ begin
+ fwrite (Ptr'Address, Address_Size, 1, File);
+ end;
+ end loop;
+
+ end if;
Current := Header.Next;
end loop;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 1db3009..e905a0b 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -1902,7 +1902,8 @@ __gnat_map_signal (int sig, siginfo_t *si ATTRIBUTE_UNUSED,
Raise_From_Signal_Handler (exception, msg);
}
-#if defined (__i386__) && !defined (VTHREADS)
+#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR < 7
+
extern void
__gnat_vxsim_error_handler (int sig, siginfo_t *si, void *sc);
@@ -1939,7 +1940,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
sigdelset (&mask, sig);
sigprocmask (SIG_SETMASK, &mask, NULL);
-#if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__)
+#if defined (__ARMEL__) || defined (__PPC__) || (defined (__i386__) && _WRS_VXWORKS_MAJOR < 7)
/* On certain targets, kernel mode, we process signals through a Call Frame
Info trampoline, voiding the need for myriads of fallback_frame_state
variants in the ZCX runtime. We have no simple way to distinguish ZCX
@@ -2039,7 +2040,7 @@ __gnat_install_handler (void)
trap_0_entry->inst_fourth = 0xa1480000;
#endif
-#if defined (__i386__) && !defined (VTHREADS)
+#if defined (__i386__) && !defined (VTHREADS) && _WRS_VXWORKS_MAJOR != 7
/* By experiment, found that sysModel () returns the following string
prefix for vxsim when running on Linux and Windows. */
model = sysModel ();
diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb
index 8c0f902..1dbd3d5 100644
--- a/gcc/ada/restrict.adb
+++ b/gcc/ada/restrict.adb
@@ -285,6 +285,24 @@ package body Restrict is
Check_Restriction (No_Implicit_Heap_Allocations, N);
end Check_No_Implicit_Heap_Alloc;
+ ----------------------------------
+ -- Check_No_Implicit_Task_Alloc --
+ ----------------------------------
+
+ procedure Check_No_Implicit_Task_Alloc (N : Node_Id) is
+ begin
+ Check_Restriction (No_Implicit_Task_Allocations, N);
+ end Check_No_Implicit_Task_Alloc;
+
+ ---------------------------------------
+ -- Check_No_Implicit_Protected_Alloc --
+ ---------------------------------------
+
+ procedure Check_No_Implicit_Protected_Alloc (N : Node_Id) is
+ begin
+ Check_Restriction (No_Implicit_Protected_Object_Allocations, N);
+ end Check_No_Implicit_Protected_Alloc;
+
-----------------------------------
-- Check_Obsolescent_2005_Entity --
-----------------------------------
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index ac0a09e..48a531d 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -337,6 +337,15 @@ package Restrict is
-- Equivalent to Check_Restriction (No_Implicit_Heap_Allocations, N).
-- Provided for easy use by back end, which has to check this restriction.
+ procedure Check_No_Implicit_Task_Alloc (N : Node_Id);
+ -- Equivalent to Check_Restriction (No_Implicit_Task_Allocations, N).
+ -- Provided for easy use by back end, which has to check this restriction.
+
+ procedure Check_No_Implicit_Protected_Alloc (N : Node_Id);
+ -- Equivalent to:
+ -- Check_Restriction (No_Implicit_Protected_Object_Allocations, N)
+ -- Provided for easy use by back end, which has to check this restriction.
+
procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id);
-- This routine checks if the entity E is one of the obsolescent entries
-- in Ada.Characters.Handling in Ada 2005 and No_Obsolescent_Features
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index 7537387..4fdb6ac 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -119,6 +119,8 @@ package System.Rident is
No_Implicit_Conditionals, -- GNAT
No_Implicit_Dynamic_Code, -- GNAT
No_Implicit_Heap_Allocations, -- (RM D.8(8), H.4(3))
+ No_Implicit_Task_Allocations, -- GNAT
+ No_Implicit_Protected_Object_Allocations, -- GNAT
No_Implicit_Loops, -- GNAT
No_Initialize_Scalars, -- GNAT
No_Local_Allocators, -- (RM H.4(8))
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 2f5b8ca95..7ff465a 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -9883,6 +9883,8 @@ package body Sem_Res is
and then Ekind_In (Entity (S), E_Component, E_Discriminant)
and then Present (Original_Record_Component (Entity (S)))
and then Ekind (Original_Record_Component (Entity (S))) = E_Component
+ and then
+ Is_Declared_Within_Variant (Original_Record_Component (Entity (S)))
and then not Discriminant_Checks_Suppressed (T)
and then not Init_Component
then
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cc17f01..b2f1f10 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11125,6 +11125,17 @@ package body Sem_Util is
end case;
end Is_Declaration;
+ --------------------------------
+ -- Is_Declared_Within_Variant --
+ --------------------------------
+
+ function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean is
+ Comp_Decl : constant Node_Id := Parent (Comp);
+ Comp_List : constant Node_Id := Parent (Comp_Decl);
+ begin
+ return Nkind (Parent (Comp_List)) = N_Variant;
+ end Is_Declared_Within_Variant;
+
----------------------------------------------
-- Is_Dependent_Component_Of_Mutable_Object --
----------------------------------------------
@@ -11132,20 +11143,6 @@ package body Sem_Util is
function Is_Dependent_Component_Of_Mutable_Object
(Object : Node_Id) return Boolean
is
- function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
- -- Returns True if and only if Comp is declared within a variant part
-
- --------------------------------
- -- Is_Declared_Within_Variant --
- --------------------------------
-
- function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean is
- Comp_Decl : constant Node_Id := Parent (Comp);
- Comp_List : constant Node_Id := Parent (Comp_Decl);
- begin
- return Nkind (Parent (Comp_List)) = N_Variant;
- end Is_Declared_Within_Variant;
-
P : Node_Id;
Prefix_Type : Entity_Id;
P_Aliased : Boolean := False;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index e882f16..872bded 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1262,6 +1262,9 @@ package Sem_Util is
function Is_Declaration (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N denotes a declaration
+ function Is_Declared_Within_Variant (Comp : Entity_Id) return Boolean;
+ -- Returns True iff component Comp is declared within a variant part
+
function Is_Dependent_Component_Of_Mutable_Object
(Object : Node_Id) return Boolean;
-- Returns True if Object is the name of a subcomponent that depends on
generated by cgit v1.1 at 2024-11-08 20:02:35 +0000