[multiple changes]

2014-02-25  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Update "Standard Library Routines" chapter to
	include all 2012 packages.
	Add section on pragma Reviewable.
	* sem_ch5.adb (Diagnose_Non_Variable_Lhs): Avoid wrong msgs if
	expander off.
	* exp_ch9.ads, exp_dist.adb, exp_dist.ads: Minor reformatting.
	* sem_ch6.adb (Assert_False): New function
	(Check_Statement_Sequence): Call Assert_False to check for
	pragma Assert (False) which is considered OK block of control
	for function.
	* snames.ads-tmpl (Name_False): New entry.

2014-02-25  Doug Rupp  <rupp@adacore.com>

	* init.c (VxWorks Section): Enable sigtramp for ARM.
	* sigtramp-armvxw.c: New file.

From-SVN: r208142

gcc/ada/exp_ch9.ads

@@ -90,6 +90,8 @@ package Exp_Ch9 is
    --  needed, but in fact, in Ada 2005 the subprogram may be used in a call-
    --  back, and therefore a protected version of the operation must be
    --  generated as well.
+   --
+   --  Possibly factor this with Exp_Dist.Copy_Specification ???
 
    function Build_Protected_Sub_Specification
      (N        : Node_Id;

gcc/ada/exp_dist.adb

@@ -2660,10 +2660,10 @@ package body Exp_Dist is
    ------------------------
 
    function Copy_Specification
-     (Loc         : Source_Ptr;
-      Spec        : Node_Id;
-      Ctrl_Type   : Entity_Id := Empty;
-      New_Name    : Name_Id   := No_Name) return Node_Id
+     (Loc       : Source_Ptr;
+      Spec      : Node_Id;
+      Ctrl_Type : Entity_Id := Empty;
+      New_Name  : Name_Id   := No_Name) return Node_Id
    is
       Parameters : List_Id := No_List;
 

gcc/ada/exp_dist.ads

@@ -95,15 +95,17 @@ package Exp_Dist is
    --  Build a literal representing the remote subprogram identifier of E
 
    function Copy_Specification
-     (Loc         : Source_Ptr;
-      Spec        : Node_Id;
-      Ctrl_Type   : Entity_Id := Empty;
-      New_Name    : Name_Id   := No_Name) return Node_Id;
+     (Loc       : Source_Ptr;
+      Spec      : Node_Id;
+      Ctrl_Type : Entity_Id := Empty;
+      New_Name  : Name_Id   := No_Name) return Node_Id;
    --  Build a subprogram specification from another one, or from an
    --  access-to-subprogram definition. If Ctrl_Type is not Empty, and any
    --  controlling formal of an anonymous access type is found, then it is
    --  replaced by an access to Ctrl_Type. If New_Name is given, then it will
    --  be used as the name for the newly created spec.
+   --
+   --  Possibly factor this wrt Exp_Ch9.Build_Private_Protected_Declaration???
 
    function Corresponding_Stub_Type (RACW_Type : Entity_Id) return Entity_Id;
    --  Return the stub type associated with the given RACW type

gcc/ada/init.c

@@ -1906,7 +1906,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
   sigdelset (&mask, sig);
   sigprocmask (SIG_SETMASK, &mask, NULL);
 
-#if defined (__PPC__) && defined(_WRS_KERNEL)
+#if (defined (__ARMEL__) || defined (__PPC__)) && defined(_WRS_KERNEL)
   /* On PowerPC, 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

gcc/ada/sem_ch5.adb

@@ -134,6 +134,7 @@ package body Sem_Ch5 is
                if Ekind (Ent) = E_In_Parameter then
                   Error_Msg_N
                     ("assignment to IN mode parameter not allowed", N);
+                  return;
 
                --  Renamings of protected private components are turned into
                --  constants when compiling a protected function. In the case
@@ -151,21 +152,23 @@ package body Sem_Ch5 is
                then
                   Error_Msg_N
                     ("protected function cannot modify protected object", N);
+                  return;
 
                elsif Ekind (Ent) = E_Loop_Parameter then
-                  Error_Msg_N
-                    ("assignment to loop parameter not allowed", N);
-
-               else
-                  Error_Msg_N
-                    ("left hand side of assignment must be a variable", N);
+                  Error_Msg_N ("assignment to loop parameter not allowed", N);
+                  return;
                end if;
             end;
 
-         --  For indexed components or selected components, test prefix
+         --  For indexed components, test prefix if it is in array. We do not
+         --  want to recurse for cases where the prefix is a pointer, since we
+         --  may get a message confusing the pointer and what it references.
 
-         elsif Nkind (N) = N_Indexed_Component then
+         elsif Nkind (N) = N_Indexed_Component
+           and then Is_Array_Type (Etype (Prefix (N)))
+         then
             Diagnose_Non_Variable_Lhs (Prefix (N));
+            return;
 
          --  Another special case for assignment to discriminant
 
@@ -173,17 +176,21 @@ package body Sem_Ch5 is
             if Present (Entity (Selector_Name (N)))
               and then Ekind (Entity (Selector_Name (N))) = E_Discriminant
             then
-               Error_Msg_N
-                 ("assignment to discriminant not allowed", N);
-            else
+               Error_Msg_N ("assignment to discriminant not allowed", N);
+               return;
+
+            --  For selection from record, diagnose prefix, but note that again
+            --  we only do this for a record, not e.g. for a pointer.
+
+            elsif Is_Record_Type (Etype (Prefix (N))) then
                Diagnose_Non_Variable_Lhs (Prefix (N));
+               return;
             end if;
+         end if;
 
-         else
-            --  If we fall through, we have no special message to issue
+         --  If we fall through, we have no special message to issue
 
-            Error_Msg_N ("left hand side of assignment must be a variable", N);
-         end if;
+         Error_Msg_N ("left hand side of assignment must be a variable", N);
       end Diagnose_Non_Variable_Lhs;
 
       --------------

gcc/ada/sem_ch6.adb

@@ -7160,10 +7160,45 @@ package body Sem_Ch6 is
          Stm      : Node_Id;
          Kind     : Node_Kind;
 
+         function Assert_False return Boolean;
+         --  Returns True if Last_Stm is a pragma Assert (False) that has been
+         --  rewritten as a null statement when assertions are off. The assert
+         --  is not active, but it is still enough to kill the warning.
+
+         ------------------
+         -- Assert_False --
+         ------------------
+
+         function Assert_False return Boolean is
+            Orig : constant Node_Id := Original_Node (Last_Stm);
+
+         begin
+            if Nkind (Orig) = N_Pragma
+              and then Pragma_Name (Orig) = Name_Assert
+              and then not Error_Posted (Orig)
+            then
+               declare
+                  Arg : constant Node_Id :=
+                          First (Pragma_Argument_Associations (Orig));
+                  Exp : constant Node_Id := Expression (Arg);
+               begin
+                  return Nkind (Exp) = N_Identifier
+                    and then Chars (Exp) = Name_False;
+               end;
+
+            else
+               return False;
+            end if;
+         end Assert_False;
+
+         --  Local variables
+
          Raise_Exception_Call : Boolean;
          --  Set True if statement sequence terminated by Raise_Exception call
          --  or a Reraise_Occurrence call.
 
+      --  Start of processing for Check_Statement_Sequence
+
       begin
          Raise_Exception_Call := False;
 
@@ -7453,11 +7488,20 @@ package body Sem_Ch6 is
          --  If we fall through, issue appropriate message
 
          if Mode = 'F' then
-            if not Raise_Exception_Call then
+
+            --  Kill warning if last statement is a raise exception call,
+            --  or a pragma Assert (False). Note that with assertions enabled,
+            --  such a pragma has been converted into a raise exception call
+            --  already, so the Assert_False is for the assertions off case.
+
+            if not Raise_Exception_Call and then not Assert_False then
 
                --  In GNATprove mode, it is an error to have a missing return
 
                Error_Msg_Warn := SPARK_Mode /= On;
+
+               --  Issue error message or warning
+
                Error_Msg_N
                  ("RETURN statement missing following this statement<<!",
                   Last_Stm);

gcc/ada/sigtramp-armvxw.c

+/****************************************************************************
+ *                                                                          *
+ *                         GNAT COMPILER COMPONENTS                         *
+ *                                                                          *
+ *                             S I G T R A M P                              *
+ *                                                                          *
+ *                         Asm Implementation File                          *
+ *                                                                          *
+ *           Copyright (C) 2013, Free Software Foundation, Inc.             *
+ *                                                                          *
+ * GNAT is free software;  you can  redistribute it  and/or modify it under *
+ * terms of the  GNU General Public License as published  by the Free Soft- *
+ * 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-VxWorks version of the __gnat_sigtramp service *
+ ******************************************************/
+
+#include "sigtramp.h"
+
+#include <vxWorks.h>
+#include <arch/../regs.h>
+#include <sigLib.h>
+
+/* ----------------------
+   -- General comments --
+   ----------------------
+
+   Stubs are generated from toplevel asms and .cfi directives, much simpler
+   to use and check for correctness than manual encodings of CFI byte
+   sequences.  The general idea is to establish CFA as sigcontext->sc_pregs
+   and state where to find the registers as offsets from there.
+
+   As of today, we support a single stub, providing CFI info for common
+   registers (GPRs, LR, ...). We might need variants with support for floating
+   point or altivec registers as well at some point.
+
+   Checking which variant should apply and getting at sc_pregs is simpler
+   to express in C (we can't use offsetof in toplevel asms and hardcoding
+   constants is not workable with the flurry of VxWorks variants), so this
+   is the choice for our toplevel interface.
+
+   Note that the registers we "restore" here are those to which we have
+   direct access through the system sigcontext structure, which includes
+   only a partial set of the non-volatiles ABI-wise.  */
+
+/* -----------------------------------------
+   -- Protypes for our internal asm stubs --
+   -----------------------------------------
+
+   SC_PREGS is always expected to be SIGCONTEXT->sc_pregs.  Eventhough 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 CFI info for common registers.  */
+
+extern void __gnat_sigtramp_common
+(int signo, void *siginfo, void *sigcontext,
+ sighandler_t * handler, void * sc_pregs);
+
+
+/* -------------------------------------
+   -- Common interface implementation --
+   -------------------------------------
+
+   We enforce optimization to minimize the overhead of the extra layer.  */
+
+void __gnat_sigtramp (int signo, void *si, void *sc,
+		      sighandler_t * handler)
+     __attribute__((optimize(2)));
+
+void __gnat_sigtramp (int signo, void *si, void *sc,
+		      sighandler_t * handler)
+{
+  struct sigcontext * sctx = (struct sigcontext *) sc;
+
+  __gnat_sigtramp_common (signo, si, sctx, handler, sctx->sc_pregs);
+}
+
+
+/* ---------------------------
+   -- And now the asm stubs --
+   ---------------------------
+
+   They all have a common structure with blocks of asm sequences queued one
+   after the others.  Typically:
+
+   SYMBOL_START
+
+   CFI_DIRECTIVES
+     CFI_DEF_CFA,
+     CFI_COMMON_REGISTERS,
+     ...
+
+   STUB_BODY
+     asm code to establish frame, setup the cfa reg value,
+     call the real signal handler, ...
+
+   SYMBOL_END
+*/
+
+/*--------------------------------
+  -- Misc constants and helpers --
+  -------------------------------- */
+
+/* REGNO constants, dwarf column numbers for registers of interest.  */
+
+#define REGNO_G_REG_OFFSET(N) (N)
+
+#define REGNO_PC_OFFSET  15  /* ARG_POINTER_REGNUM  */
+
+/* asm string construction helpers.  */
+
+#define STR(TEXT) #TEXT
+/* stringify expanded TEXT, surrounding it with double quotes.  */
+
+#define S(E) STR(E)
+/* stringify E, which will resolve as text but may contain macros
+   still to be expanded.  */
+
+/* asm (TEXT) outputs <tab>TEXT. These facilitate the output of
+   multine contents:  */
+#define TAB(S) "\t" S
+#define CR(S)  S "\n"
+
+#undef TCR
+#define TCR(S) TAB(CR(S))
+
+/*------------------------------
+  -- Stub construction blocks --
+  ------------------------------ */
+
+/* CFA setup block
+   ---------------
+   Only non-volatile registers are suitable for a CFA base. These are the
+   only ones we can expect to be able retrieve from the unwinding context
+   while walking up the chain, saved by at least the bottom-most exception
+   propagation services.  We use r15 here and set it to the value we need
+   in stub body that follows.  Note that r14 is inappropriate here, even
+   though it is non-volatile according to the ABI, because GCC uses it as
+   an extra SCRATCH on SPE targets.  */
+
+#define CFA_REG 8
+
+#define CFI_DEF_CFA \
+CR(".cfi_def_cfa " S(CFA_REG) ", 0")
+
+/* Register location blocks
+   ------------------------
+   Rules to find registers of interest from the CFA. This should comprise
+   all the non-volatile registers relevant to the interrupted context.
+
+   Note that we include r1 in this set, unlike the libgcc unwinding
+   fallbacks.  This is useful for fallbacks to allow the use of r1 in CFI
+   expressions and the absence of rule for r1 gets compensated by using the
+   target CFA instead.  We don't need the expression facility here and
+   setup a fake CFA to allow very simple offset expressions, so having a
+   rule for r1 is the proper thing to do.  We for sure have observed
+   crashes in some cases without it.  */
+
+#define COMMON_CFI(REG) \
+  ".cfi_offset " S(REGNO_##REG) "," S(REG_SET_##REG)
+
+#define CFI_COMMON_REGS \
+CR("# CFI for common registers\n") \
+TCR(COMMON_CFI(G_REG_OFFSET(1)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(2)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(3)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(4)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(5)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(6)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(7)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(8)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(9)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(10)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(11)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(12)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(13)))  \
+TCR(COMMON_CFI(G_REG_OFFSET(14))) \
+TCR(COMMON_CFI(PC_OFFSET)) \
+TCR(".cfi_return_column " S(REGNO_PC_OFFSET))
+
+/* Trampoline body block
+   ---------------------  */
+
+#define SIGTRAMP_BODY \
+CR("") \
+TCR("# Allocate frame and save the non-volatile") \
+TCR("# registers we're going to modify") \
+TCR("mov	ip, sp") \
+TCR("stmfd	sp!, {r"S(CFA_REG)", fp, ip, lr, pc}") \
+TCR("# Setup CFA_REG = sc_pregs, that we'll retrieve as our CFA value") \
+TCR("ldr	r"S(CFA_REG)", [ip]") \
+TCR("")                 \
+TCR("# Call the real handler. The signo, siginfo and sigcontext") \
+TCR("# arguments are the same as those we received in r0, r1 and r2") \
+TCR("sub	fp, ip, #4") \
+TCR("blx	r3") \
+TCR("# Restore our callee-saved items, release our frame and return") \
+TCR("ldmfd	sp, {r"S(CFA_REG)", fp, sp, pc}")
+
+
+/* Symbol definition block
+   -----------------------  */
+
+#define SIGTRAMP_START(SYM) \
+CR("# " S(SYM) " cfi trampoline") \
+TCR(".type " S(SYM) ", %function") \
+CR("") \
+CR(S(SYM) ":") \
+TCR(".cfi_startproc") \
+TCR(".cfi_signal_frame")
+
+/* Symbol termination block
+   ------------------------  */
+
+#define SIGTRAMP_END(SYM) \
+CR(".cfi_endproc") \
+TCR(".size " S(SYM) ", .-" S(SYM))
+
+/*----------------------------
+  -- And now, the real code --
+  ---------------------------- */
+
+/* Text section start.  The compiler isn't aware of that switch.  */
+
+asm (".text\n"
+     TCR(".align 2"));
+
+/* sigtramp stub for common registers.  */
+
+#define TRAMP_COMMON __gnat_sigtramp_common
+
+asm (SIGTRAMP_START(TRAMP_COMMON));
+asm (CFI_DEF_CFA);
+asm (CFI_COMMON_REGS);
+asm (SIGTRAMP_BODY);
+asm (SIGTRAMP_END(TRAMP_COMMON));
+
+

gcc/ada/snames.ads-tmpl

@@ -237,6 +237,7 @@ package Snames is
 
    Name_Const                          : constant Name_Id := N + $;
    Name_Error                          : constant Name_Id := N + $;
+   Name_False                          : constant Name_Id := N + $;
    Name_Go                             : constant Name_Id := N + $;
    Name_Put                            : constant Name_Id := N + $;
    Name_Put_Line                       : constant Name_Id := N + $;