[multiple changes]

2015-11-13  Eric Botcazou  <ebotcazou@adacore.com>

	* init.c [Darwin/arm64]: Move __gnat_sigtramp implementation to...
	(__gnat_map_signal): New function.
	(__gnat_error_handler):
	Adjust the context and call above function.
	* sigtramp-armios.c: ...here.  New file.

2015-11-13  Arnaud Charlet  <charlet@adacore.com>

	* bcheck.adb (Check_Consistent_Restrictions): Do not check
	consistency of No_Dependence for runtime units.

2015-11-13  Tristan Gingold  <gingold@adacore.com>

	* s-rident.ads (Restriction_Id): Add Pure_Barriers.
	* restrict.ads (Implementation_Restriction): Add Pure_Barriers.
	* exp_ch9.adb (Expand_Entry_Barrier): Create
	Is_Simple_Barrier_Name function, add Is_Pure_Barrier and
	Check_Pure_Barriers.

2015-11-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Get_Cursor_Type): To determine whether a function
	First is the proper Iterable primitive, use the base type of the
	first formal rather than the type. This is needed in the unusual
	case where the Iterable aspect is specified for an integer type.

From-SVN: r230305

8 files changed, 265 insertions, 90 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 90910ca..324d4dc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2015-11-13  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* init.c [Darwin/arm64]: Move __gnat_sigtramp implementation to...
+	(__gnat_map_signal): New function.
+	(__gnat_error_handler):
+	Adjust the context and call above function.
+	* sigtramp-armios.c: ...here.  New file.
+
+2015-11-13  Arnaud Charlet  <charlet@adacore.com>
+
+	* bcheck.adb (Check_Consistent_Restrictions): Do not check
+	consistency of No_Dependence for runtime units.
+
+2015-11-13  Tristan Gingold  <gingold@adacore.com>
+
+	* s-rident.ads (Restriction_Id): Add Pure_Barriers.
+	* restrict.ads (Implementation_Restriction): Add Pure_Barriers.
+	* exp_ch9.adb (Expand_Entry_Barrier): Create
+	Is_Simple_Barrier_Name function, add Is_Pure_Barrier and
+	Check_Pure_Barriers.
+
+2015-11-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Get_Cursor_Type): To determine whether a function
+	First is the proper Iterable primitive, use the base type of the
+	first formal rather than the type. This is needed in the unusual
+	case where the Iterable aspect is specified for an integer type.
+
 2015-11-13  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch4.adb (Constant_Indexing_OK): If the indexing is the
diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb
index 2cae840..4170b0e 100644
--- a/gcc/ada/bcheck.adb
+++ b/gcc/ada/bcheck.adb
@@ -979,23 +979,27 @@ package body Bcheck is
             for J in ALIs.First .. ALIs.Last loop
                declare
                   A : ALIs_Record renames ALIs.Table (J);
-
                begin
                   for K in A.First_Unit .. A.Last_Unit loop
                      declare
                         U : Unit_Record renames Units.Table (K);
                      begin
-                        for L in U.First_With .. U.Last_With loop
-                           if Same_Unit
-                             (Withs.Table (L).Uname, ND_Unit)
-                           then
-                              Error_Msg_File_1 := U.Sfile;
-                              Error_Msg_Name_1 := ND_Unit;
-                              Consistency_Error_Msg
-                                ("file { violates restriction " &
-                                 "No_Dependence => %");
-                           end if;
-                        end loop;
+                        --  Exclude runtime units from this check since the
+                        --  user does not care how a runtime unit is
+                        --  implemented.
+
+                        if not Is_Internal_File_Name (U.Sfile) then
+                           for L in U.First_With .. U.Last_With loop
+                              if Same_Unit (Withs.Table (L).Uname, ND_Unit)
+                              then
+                                 Error_Msg_File_1 := U.Sfile;
+                                 Error_Msg_Name_1 := ND_Unit;
+                                 Consistency_Error_Msg
+                                   ("file { violates restriction " &
+                                    "No_Dependence => %");
+                              end if;
+                           end loop;
+                        end if;
                      end;
                   end loop;
                end;
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 2fd6592..f985019 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6306,6 +6306,14 @@ package body Exp_Ch9 is
       --  Check whether entity in Barrier is external to protected type.
       --  If so, barrier may not be properly synchronized.
 
+      function Is_Pure_Barrier (N : Node_Id) return Traverse_Result;
+      --  Check whether N follow the Pure_Barriers restriction. Return OK if
+      --  so.
+
+      function Is_Simple_Barrier_Name (N : Node_Id) return Boolean;
+      --  Check wether entity name N denotes a component of the protected
+      --  object. This is used to check the Simple_Barrier restriction.
+
       ----------------------
       -- Is_Global_Entity --
       ----------------------
@@ -6356,6 +6364,81 @@ package body Exp_Ch9 is
       procedure Check_Unprotected_Barrier is
         new Traverse_Proc (Is_Global_Entity);
 
+      ----------------------------
+      -- Is_Simple_Barrier_Name --
+      ----------------------------
+
+      function Is_Simple_Barrier_Name (N : Node_Id) return Boolean is
+         Renamed : Node_Id;
+      begin
+         if not Expander_Active then
+            return Scope (Entity (N)) = Current_Scope;
+
+         --  Check for case of _object.all.field (note that the explicit
+         --  dereference gets inserted by analyze/expand of _object.field)
+
+         else
+            Renamed := Renamed_Object (Entity (N));
+            return Present (Renamed)
+              and then Nkind (Renamed) = N_Selected_Component
+              and then Chars (Prefix (Prefix (Renamed))) = Name_uObject;
+         end if;
+      end Is_Simple_Barrier_Name;
+
+      ---------------------
+      -- Is_Pure_Barrier --
+      ---------------------
+
+      function Is_Pure_Barrier (N : Node_Id) return Traverse_Result is
+      begin
+         case Nkind (N) is
+            when N_Identifier
+              | N_Expanded_Name =>
+
+               if No (Entity (N)) then
+                  return Abandon;
+               end if;
+
+               case Ekind (Entity (N)) is
+                  when E_Constant
+                    | E_Discriminant
+                    | E_Named_Integer
+                    | E_Named_Real
+                    | E_Enumeration_Literal =>
+                     return OK;
+
+                  when E_Variable =>
+                     if Is_Simple_Barrier_Name (N) then
+                        return OK;
+                     end if;
+
+                  when others =>
+                     null;
+               end case;
+
+            when N_Integer_Literal
+              | N_Real_Literal
+              | N_Character_Literal =>
+               return OK;
+
+            when N_Op_Boolean
+              | N_Op_Not =>
+               if Ekind (Entity (N)) = E_Operator then
+                  return OK;
+               end if;
+
+            when N_Short_Circuit =>
+               return OK;
+
+            when others =>
+               null;
+         end case;
+
+         return Abandon;
+      end Is_Pure_Barrier;
+
+      function Check_Pure_Barriers is new Traverse_Func (Is_Pure_Barrier);
+
    --  Start of processing for Expand_Entry_Barrier
 
    begin
@@ -6393,6 +6476,12 @@ package body Exp_Ch9 is
          Analyze_And_Resolve (Cond, Any_Boolean);
       end if;
 
+      --  Check Pure_Barriers restriction
+
+      if Check_Pure_Barriers (Cond) = Abandon then
+         Check_Restriction (Pure_Barriers, Cond);
+      end if;
+
       --  The Ravenscar profile restricts barriers to simple variables declared
       --  within the protected object. We also allow Boolean constants, since
       --  these appear in several published examples and are also allowed by
@@ -6421,22 +6510,7 @@ package body Exp_Ch9 is
          then
             return;
 
-         elsif not Expander_Active
-           and then Scope (Entity (Cond)) = Current_Scope
-         then
-            return;
-
-         --  Check for case of _object.all.field (note that the explicit
-         --  dereference gets inserted by analyze/expand of _object.field)
-
-         elsif Present (Renamed_Object (Entity (Cond)))
-           and then
-             Nkind (Renamed_Object (Entity (Cond))) = N_Selected_Component
-           and then
-             Chars
-               (Prefix
-                 (Prefix (Renamed_Object (Entity (Cond))))) = Name_uObject
-         then
+         elsif Is_Simple_Barrier_Name (Cond) then
             return;
          end if;
       end if;
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index f0afc40..dcd5c3d 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -2299,45 +2299,7 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
 
 #ifdef __arm64__
 #include <sys/ucontext.h>
-
-/* Trampoline inserted before raising the exception.  It modifies the
-   stack so that it looks to be called directly from the fault point.
-   Note that LR may be incorrectly restored by unwinding.  */
-void __gnat_sigtramp (struct Exception_Data *d, const char *m,
-		      mcontext_t ctxt,
-		      void (*proc)(struct Exception_Data *, const char *));
-
-asm("\n"
-"	.section	__TEXT,__text,regular,pure_instructions\n"
-"	.align  2\n"
-"___gnat_sigtramp:\n"
-"	.cfi_startproc\n"
-	/* Restore callee saved registers.  */
-"	ldp	x19, x20, [x2, #168]\n"
-"	ldp	x21, x22, [x2, #184]\n"
-"	ldp	x23, x24, [x2, #200]\n"
-"	ldp	x25, x26, [x2, #216]\n"
-"	ldp	x27, x28, [x2, #232]\n"
-"	ldp	q8, q9, [x2, #416]\n"
-"	ldp	q10, q11, [x2, #448]\n"
-"	ldp	q12, q13, [x2, #480]\n"
-"	ldp	q14, q15, [x2, #512]\n"
-	/* Read FP from mcontext.  */
-"	ldr	fp, [x2, #248]\n"
-	/* Read SP and PC from mcontext.  */
-"	ldp	x6, lr, [x2, #264]\n"
-"	mov	sp, x6\n"
-	/* Create a minimal frame.  */
-"	stp	fp, lr, [sp, #-16]!\n"
-"	.cfi_def_cfa_offset 16\n"
-"	.cfi_offset	30, -8\n"
-"	.cfi_offset	29, -16\n"
-"	blr	x3\n"
-	/* Release our frame and return (should never get here!).  */
-"	ldp	fp, lr, [sp, #16]\n"
-"	ret\n"
-"	.cfi_endproc\n"
-);
+#include "sigtramp.h"
 #endif
 
 /* Return true if ADDR is within a stack guard area.  */
@@ -2425,13 +2387,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED,
 }
 
 static void
-__gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
+__gnat_map_signal (int sig, siginfo_t *si, void *ucontext ATTRIBUTE_UNUSED)
 {
   struct Exception_Data *exception;
   const char *msg;
 
-  __gnat_adjust_context_for_raise (sig, ucontext);
-
   switch (sig)
     {
     case SIGSEGV:
@@ -2446,29 +2406,11 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
 	  exception = &constraint_error;
 	  msg = "erroneous memory access";
 	}
+
       /* Reset the use of alt stack, so that the alt stack will be used
 	 for the next signal delivery.
          The stack can't be used in case of stack checking.  */
       syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
-
-#ifdef __arm64__
-      /* ??? Temporary kludge to make stack checking work.  The problem is
-	 that the trampoline doesn't restore LR and, consequently, doesn't
-	 make it possible to unwind past an interrupted frame which hasn"t
-	 saved LR on the stack yet.  */
-      if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
-	{
-	  ucontext_t *uc = (ucontext_t *)ucontext;
-	  uc->uc_mcontext->__ss.__pc = uc->uc_mcontext->__ss.__lr;
-	}
-
-      /* On arm64, use a trampoline so that the unwinder won't see the
-	 signal frame.  */
-      __gnat_sigtramp (exception, msg,
-		       ((ucontext_t *)ucontext)->uc_mcontext,
-		       Raise_From_Signal_Handler);
-      return;
-#endif
       break;
 
     case SIGFPE:
@@ -2484,6 +2426,30 @@ __gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
   Raise_From_Signal_Handler (exception, msg);
 }
 
+static void
+__gnat_error_handler (int sig, siginfo_t *si, void *ucontext)
+{
+  __gnat_adjust_context_for_raise (sig, ucontext);
+
+#ifdef __arm64__
+  /* ??? Temporary kludge to make stack checking work.  The problem is
+     that the trampoline doesn't restore LR and, consequently, doesn't
+     make it possible to unwind past an interrupted frame which hasn"t
+     saved LR on the stack yet.  */
+  if (__gnat_is_stack_guard ((unsigned long)si->si_addr))
+    {
+      ucontext_t *uc = (ucontext_t *)ucontext;
+      uc->uc_mcontext->__ss.__pc = uc->uc_mcontext->__ss.__lr;
+    }
+
+    /* Use a trampoline so that the unwinder won't see the signal frame.  */
+  __gnat_sigtramp (sig, (void *)si, ucontext,
+		   (__sigtramphandler_t *)&__gnat_map_signal);
+#else
+  __gnat_map_signal (sig, si, ucontext);
+#endif
+}
+
 void
 __gnat_install_handler (void)
 {
diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads
index 6ce7908..c8c050c 100644
--- a/gcc/ada/restrict.ads
+++ b/gcc/ada/restrict.ads
@@ -147,6 +147,7 @@ package Restrict is
       No_Wide_Characters                 => True,
       Static_Priorities                  => True,
       Static_Storage_Size                => True,
+      Pure_Barriers                      => True,
       SPARK_05                           => True,
       others                             => False);
 
diff --git a/gcc/ada/s-rident.ads b/gcc/ada/s-rident.ads
index 58c69d8..66aa10e 100644
--- a/gcc/ada/s-rident.ads
+++ b/gcc/ada/s-rident.ads
@@ -182,6 +182,7 @@ package System.Rident is
       No_Elaboration_Code,                       -- GNAT
       No_Obsolescent_Features,                   -- Ada 2005 AI-368
       No_Wide_Characters,                        -- GNAT
+      Pure_Barriers,                             -- GNAT
       SPARK_05,                                  -- GNAT
 
       --  The following cases require a parameter value
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 59194cf..36dfc4d 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7553,13 +7553,16 @@ package body Sem_Util is
       Cursor := Any_Type;
 
       --  Locate function with desired name and profile in scope of type
+      --  In the rare case where the type is an integer type, a base type
+      --  is created for it, check that the base type of the first formal
+      --  of First matches the base type of the domain.
 
       Func := First_Entity (Scope (Typ));
       while Present (Func) loop
          if Chars (Func) = Chars (First_Op)
            and then Ekind (Func) = E_Function
            and then Present (First_Formal (Func))
-           and then Etype (First_Formal (Func)) = Typ
+           and then Base_Type (Etype (First_Formal (Func))) = Base_Type (Typ)
            and then No (Next_Formal (First_Formal (Func)))
          then
             if Cursor /= Any_Type then
diff --git a/gcc/ada/sigtramp-armios.c b/gcc/ada/sigtramp-armios.c
new file mode 100644
index 0000000..3206256
--- /dev/null
+++ b/gcc/ada/sigtramp-armios.c
@@ -0,0 +1,98 @@
+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                             S I G T R A M P                              *
+ *                                                                          *
+ *                         Asm Implementation File                          *
+ *                                                                          *
+ *           Copyright (C) 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- *
+ * ware  Foundation;  either version 3,  or (at your option) any later ver- *
+ * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
+ * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
+ * or FITNESS FOR A PARTICULAR PURPOSE.                                     *
+ *                                                                          *
+ * As a special exception under Section 7 of GPL version 3, you are granted *
+ * additional permissions described in the GCC Runtime Library Exception,   *
+ * version 3.1, as published by the Free Software Foundation.               *
+ *                                                                          *
+ * In particular,  you can freely  distribute your programs  built with the *
+ * GNAT Pro compiler, including any required library run-time units,  using *
+ * any licensing terms  of your choosing.  See the AdaCore Software License *
+ * for full details.                                                        *
+ *                                                                          *
+ * GNAT was originally developed  by the GNAT team at  New York University. *
+ * Extensive contributions were provided by Ada Core Technologies Inc.      *
+ *                                                                          *
+ ****************************************************************************/
+
+/**************************************************
+ * ARM-IOS version of the __gnat_sigtramp service *
+ **************************************************/
+
+#include <sys/ucontext.h>
+
+#include "sigtramp.h"
+/* See sigtramp.h for a general explanation of functionality.  */
+
+/* -----------------------------------------
+   -- Protypes for our internal asm stubs --
+   -----------------------------------------
+
+   The registers are expected to be at SIGCONTEXT + OFFSET (reference to the
+   machine context structure).  Even though our symbols will remain local, the
+   prototype claims "extern" and not "static" to prevent compiler complaints
+   about a symbol used but never defined.  */
+
+/* sigtramp stub providing unwind info for common registers.  */
+
+extern void __gnat_sigtramp_common
+  (int signo, void *siginfo, void *sigcontext,
+   __sigtramphandler_t * handler);
+
+void __gnat_sigtramp (int signo, void *si, void *ucontext,
+                      __sigtramphandler_t * handler)
+     __attribute__((optimize(2)));
+
+void __gnat_sigtramp (int signo, void *si, void *ucontext,
+                      __sigtramphandler_t * handler)
+{
+  mcontext_t mcontext = ((ucontext_t *) ucontext)->uc_mcontext;
+
+  __gnat_sigtramp_common (signo, si, mcontext, handler);
+}
+
+asm("\n"
+"	.section	__TEXT,__text,regular,pure_instructions\n"
+"	.align  2\n"
+"___gnat_sigtramp_common:\n"
+"	.cfi_startproc\n"
+	/* Restore callee saved registers.  */
+"	ldp	x19, x20, [x2, #168]\n"
+"	ldp	x21, x22, [x2, #184]\n"
+"	ldp	x23, x24, [x2, #200]\n"
+"	ldp	x25, x26, [x2, #216]\n"
+"	ldp	x27, x28, [x2, #232]\n"
+"	ldp	q8, q9, [x2, #416]\n"
+"	ldp	q10, q11, [x2, #448]\n"
+"	ldp	q12, q13, [x2, #480]\n"
+"	ldp	q14, q15, [x2, #512]\n"
+	/* Read FP from mcontext.  */
+"	ldr	fp, [x2, #248]\n"
+	/* Read SP and PC from mcontext.  */
+"	ldp	x6, lr, [x2, #264]\n"
+"	mov	sp, x6\n"
+	/* Create a minimal frame.  */
+"	stp	fp, lr, [sp, #-16]!\n"
+"	.cfi_def_cfa_offset 16\n"
+"	.cfi_offset	30, -8\n"
+"	.cfi_offset	29, -16\n"
+"	blr	x3\n"
+	/* Release our frame and return (should never get here!).  */
+"	ldp	fp, lr, [sp, #16]\n"
+"	ret\n"
+"	.cfi_endproc\n"
+);