re PR ada/21053 (Warnings from init.c)

2005-08-29  Arnaud Charlet  <charlet@adacore.com>
	    Doug Rupp  <rupp@adacore.com>

	* s-stalib.adb: Add missing pragma Warnings (On) to reenable Warnings
	when needed.
	(Inside_Elab_Final_Code): Moved to init.c to avoid having to keep
	this code in the GNAT run-time.

	* decl.c, fe.h: Replace GCC_ZCX by Back_End_Exceptions.

	PR ada/21053
	* init.c (__gnat_error_handler [many]): Mark "msg" as const
	(__gnat_error_handler [HPUX]): Mark siginfo parameter as unused

	(__gnat_inside_elab_final_code): Moved here from
	Standard_Library and only defined for the compiler.
	__gnat_error_handler [VMS]: Adjust sigargs to account for PC & PSL.
	(__gnat_inum_to_ivec): Do not define this function on VxWorks when
	using RTPs because directly vectored Interrupt routines are not
	supported on this configuration.
	(getpid): Do not redefine this function on VxWorks when using RTPs
	because this primitive is well supported by the RTP libraries.
	(copy_msg): Correct the code that checks for buffer overflow.
	Discovered during code reading.

From-SVN: r103606

gcc/ada/decl.c

@@ -497,6 +497,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		 || Present (Renamed_Object (gnat_entity))));
 	bool inner_const_flag = const_flag;
 	bool static_p = Is_Statically_Allocated (gnat_entity);
+	bool mutable_p = false;
 	tree gnu_ext_name = NULL_TREE;
 	tree renamed_obj = NULL_TREE;
 
@@ -594,7 +595,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			     (Etype
 			      (Expression (Declaration_Node (gnat_entity)))));
 	    else
-	      gnu_size = max_size (TYPE_SIZE (gnu_type), true);
+	      {
+		gnu_size = max_size (TYPE_SIZE (gnu_type), true);
+		mutable_p = true;
+	      }
 	  }
 
 	/* If the size is zero bytes, make it one byte since some linkers have
@@ -928,7 +932,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	       If we have a template initializer only (that we made above),
 	       pretend there is none and rely on what build_allocator creates
 	       again anyway.  Otherwise (if we have a full initializer), get
-	       the data part and feed that to build_allocator.  */
+	       the data part and feed that to build_allocator.
+
+	       If we are elaborating a mutable object, tell build_allocator to
+	       ignore a possibly simpler size from the initializer, if any, as
+	       we must allocate the maximum possible size in this case.  */
 
 	    if (definition)
 	      {
@@ -959,7 +967,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			      gnat_entity);
 
 		gnu_expr = build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
-					    0, 0, gnat_entity, false);
+					    0, 0, gnat_entity, mutable_p);
 	      }
 	    else
 	      {
@@ -1104,7 +1112,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	   exception handler, we must force this variable in memory to
 	   suppress an invalid optimization.  */
 	if (Has_Nested_Block_With_Handler (Scope (gnat_entity))
-	    && Exception_Mechanism != GCC_ZCX)
+	    && Exception_Mechanism != Back_End_Exceptions)
 	  TREE_ADDRESSABLE (gnu_decl) = 1;
 
 	/* Back-annotate the Alignment of the object if not already in the

gcc/ada/fe.h

@@ -155,7 +155,7 @@ extern Boolean In_Same_Source_Unit              (Node_Id, Node_Id);
 #define Exception_Mechanism            opt__exception_mechanism
 #define Back_Annotate_Rep_Info         opt__back_annotate_rep_info
 
-typedef enum {Setjmp_Longjmp, Front_End_ZCX, GCC_ZCX} Exception_Mechanism_Type;
+typedef enum {Setjmp_Longjmp, Back_End_Exceptions} Exception_Mechanism_Type;
 
 extern Boolean Global_Discard_Names;
 extern Boolean Exception_Locations_Suppressed;

gcc/ada/init.c

@@ -80,10 +80,6 @@ extern void (*Lock_Task) (void);
 #define Unlock_Task system__soft_links__unlock_task
 extern void (*Unlock_Task) (void);
 
-#define Get_Machine_State_Addr \
-                      system__soft_links__get_machine_state_addr
-extern struct Machine_State *(*Get_Machine_State_Addr) (void);
-
 #define Check_Abort_Status     \
                       system__soft_links__check_abort_status
 extern int (*Check_Abort_Status) (void);
@@ -92,12 +88,6 @@ extern int (*Check_Abort_Status) (void);
                       ada__exceptions__raise_from_signal_handler
 extern void Raise_From_Signal_Handler (struct Exception_Data *, const char *);
 
-#define Propagate_Signal_Exception \
-                      __gnat_propagate_sig_exc
-extern void Propagate_Signal_Exception (struct Machine_State *,
-                                        struct Exception_Data *,
-                                        const char *);
-
 /* Copies of global values computed by the binder */
 int   __gl_main_priority            = -1;
 int   __gl_time_slice_val           = -1;
@@ -117,6 +107,12 @@ int   __gl_detect_blocking          = 0;
    installed by a previous call to adainit */
 int  __gnat_handler_installed      = 0;
 
+#ifndef IN_RTS
+int __gnat_inside_elab_final_code = 0;
+/* ??? This variable is obsolete since 2001-08-29 but is kept to allow
+   bootstrap from old GNAT versions (< 3.15). */
+#endif
+
 /* HAVE_GNAT_INIT_FLOAT must be set on every targets where a __gnat_init_float
    is defined. If this is not set them a void implementation will be defined
    at the end of this unit. */
@@ -405,18 +401,14 @@ __gnat_install_handler (void)
 static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
 extern char *__gnat_get_code_loc (struct sigcontext *);
 extern void __gnat_set_code_loc (struct sigcontext *, char *);
-extern void __gnat_enter_handler (struct sigcontext *, char *);
 extern size_t __gnat_machine_state_length (void);
 
-extern long exc_lookup_gp (char *);
-extern void exc_resume (struct sigcontext *);
-
 static void
-__gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
+__gnat_error_handler
+  (int sig, siginfo_t *sip, struct sigcontext *context ATTRIBUTE_UNUSED)
 {
   struct Exception_Data *exception;
   static int recurse = 0;
-  struct sigcontext *mstate;
   const char *msg;
 
   /* If this was an explicit signal from a "kill", just resignal it.  */
@@ -474,10 +466,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
     }
 
   recurse = 0;
-  mstate = (struct sigcontext *) (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    *mstate = *context;
-
   Raise_From_Signal_Handler (exception, (char *) msg);
 }
 
@@ -526,14 +514,6 @@ __gnat_set_code_loc (struct sigcontext *context, char *pc)
 }
 
 
-void
-__gnat_enter_handler (struct sigcontext *context, char *pc)
-{
-  context->sc_pc = (long) pc;
-  context->sc_regs[SC_GP] = exc_lookup_gp (pc);
-  exc_resume (context);
-}
-
 size_t
 __gnat_machine_state_length (void)
 {
@@ -569,10 +549,11 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext)
 }
 
 static void
-__gnat_error_handler (int sig, siginfo_t *siginfo, void *ucontext)
+__gnat_error_handler
+  (int sig, siginfo_t *siginfo ATTRIBUTE_UNUSED, void *ucontext)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {
@@ -800,7 +781,7 @@ static void
 __gnat_error_handler (int sig)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {
@@ -870,11 +851,6 @@ __gnat_install_handler (void)
 #define SIGNAL_STACK_SIZE 4096
 #define SIGNAL_STACK_ALIGNMENT 64
 
-struct Machine_State
-{
-  sigcontext_t context;
-};
-
 static void __gnat_error_handler (int, int, sigcontext_t *);
 
 /* We are not setting the SA_SIGINFO bit in the sigaction flags when
@@ -890,9 +866,8 @@ static void __gnat_error_handler (int, int, sigcontext_t *);
 */
 
 static void
-__gnat_error_handler (int sig, int code, sigcontext_t *sc)
+__gnat_error_handler (int sig, int code, sigcontext_t *sc ATTRIBUTE_UNUSED)
 {
-  struct Machine_State  *mstate;
   struct Exception_Data *exception;
   const char *msg;
 
@@ -967,10 +942,6 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc)
       msg = "unhandled signal";
     }
 
-  mstate = (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    memcpy ((void *) mstate, (const void *) sc, sizeof (sigcontext_t));
-
   Raise_From_Signal_Handler (exception, msg);
 }
 
@@ -1389,7 +1360,7 @@ copy_msg (msgdesc, message)
   /* Check for buffer overflow and truncate if necessary */
   copy_len = (len + msgdesc->len <= Default_Exception_Msg_Max_Length - 1 ?
 	      msgdesc->len :
-	      len + msgdesc->len - Default_Exception_Msg_Max_Length);
+	      Default_Exception_Msg_Max_Length - 1 - len);
   strncpy (&message [len], msgdesc->adr, copy_len);
   message [len + copy_len] = 0;
 
@@ -1404,10 +1375,9 @@ __gnat_error_handler (int *sigargs, void *mechargs)
   struct descriptor_s gnat_facility = {4,0,"GNAT"};
   char message [Default_Exception_Msg_Max_Length];
 
-  char *msg = "";
+  const char *msg = "";
   char curr_icb[544];
   long curr_invo_handle;
-  long *mstate;
 
   /* Check for conditions to resignal which aren't effected by pragma
      Import_Exception.  */
@@ -1423,7 +1393,11 @@ __gnat_error_handler (int *sigargs, void *mechargs)
   if (exception)
     {
       message [0] = 0;
+
+      /* Subtract PC & PSL fields which messes with PUTMSG */
+      sigargs [0] -= 2;
       SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
+      sigargs [0] += 2;
       msg = message;
 
       exception->Name_Length = 19;
@@ -1470,24 +1444,20 @@ __gnat_error_handler (int *sigargs, void *mechargs)
 	{
 	  int i;
 
-	  /* Scan the DEC Ada exception condition table for a match and fetch the
-	     associated GNAT exception pointer */
+	  /* Scan the DEC Ada exception condition table for a match and fetch
+	     the associated GNAT exception pointer */
 	  for (i = 0;
 	       dec_ada_cond_except_table [i].cond &&
-	       !LIB$MATCH_COND (&sigargs [1], &dec_ada_cond_except_table [i].cond);
+	       !LIB$MATCH_COND (&sigargs [1],
+			        &dec_ada_cond_except_table [i].cond);
 	       i++);
-	  exception = (struct Exception_Data *) dec_ada_cond_except_table [i].except;
-
-	  if (exception)
-	    /* DEC Ada exceptions never have a PC and PSL appended, but LIB$STOP
-	       (which is how we got here from Bliss code)
-	       allows slots for them and the result is 2 words of garbage on the
-	       end, so the count must be decremented. */
-	    sigargs [0] -= 2;
-	  else
+	  exception = (struct Exception_Data *)
+	    dec_ada_cond_except_table [i].except;
+
+	  if (!exception)
 	    {
-	      /* Scan the VMS standard condition table for a match and fetch the
-		 associated GNAT exception pointer */
+	      /* Scan the VMS standard condition table for a match and fetch
+		 the associated GNAT exception pointer */
 	      for (i = 0;
 		   cond_except_table [i].cond &&
 		   !LIB$MATCH_COND (&sigargs [1], &cond_except_table [i].cond);
@@ -1504,20 +1474,14 @@ __gnat_error_handler (int *sigargs, void *mechargs)
 	exception = &program_error;
 #endif
 	message [0] = 0;
+	/* Subtract PC & PSL fields which messes with PUTMSG */
+	sigargs [0] -= 2;
 	SYS$PUTMSG (sigargs, copy_msg, &gnat_facility, message);
+	sigargs [0] += 2;
 	msg = message;
 	break;
       }
 
-  mstate = (long *) (*Get_Machine_State_Addr) ();
-  if (mstate != 0)
-    {
-      lib_get_curr_invo_context (&curr_icb);
-      lib_get_prev_invo_context (&curr_icb);
-      lib_get_prev_invo_context (&curr_icb);
-      curr_invo_handle = lib_get_invo_handle (&curr_icb);
-      *mstate = curr_invo_handle;
-    }
   Raise_From_Signal_Handler (exception, msg);
 }
 
@@ -1618,21 +1582,37 @@ __gnat_install_handler ()
 
 #include <signal.h>
 #include <taskLib.h>
+
+#ifndef __RTP__
 #include <intLib.h>
 #include <iv.h>
+#endif
 
 #ifdef VTHREADS
 #include "private/vThreadsP.h"
 #endif
 
-extern int __gnat_inum_to_ivec (int);
 static void __gnat_error_handler (int, int, struct sigcontext *);
 void __gnat_map_signal (int);
 
-#ifndef __alpha_vxworks
+#ifndef __RTP__
+
+/* Directly vectored Interrupt routines are not supported when using RTPs */
+
+extern int __gnat_inum_to_ivec (int);
+
+/* This is needed by the GNAT run time to handle Vxworks interrupts */
+int
+__gnat_inum_to_ivec (int num)
+{
+  return INUM_TO_IVEC (num);
+}
+#endif
+
+#if !defined(__alpha_vxworks) && (_WRS_VXWORKS_MAJOR != 6) && !defined(__RTP__)
 
 /* getpid is used by s-parint.adb, but is not defined by VxWorks, except
-   on Alpha VxWorks */
+   on Alpha VxWorks and VxWorks 6.x (including RTPs). */
 
 extern long getpid (void);
 
@@ -1643,13 +1623,6 @@ getpid (void)
 }
 #endif
 
-/* This is needed by the GNAT run time to handle Vxworks interrupts */
-int
-__gnat_inum_to_ivec (int num)
-{
-  return INUM_TO_IVEC (num);
-}
-
 /* VxWorks expects the field excCnt to be zeroed when a signal is handled.
    The VxWorks version of longjmp does this; gcc's builtin_longjmp does not */
 void
@@ -1662,13 +1635,13 @@ __gnat_clear_exception_count (void)
 #endif
 }
 
-/* Exported to 5zintman.adb in order to handle different signal
+/* Exported to s-intman-vxworks.adb in order to handle different signal
    to exception mappings in different VxWorks versions */
 void
 __gnat_map_signal (int sig)
 {
   struct Exception_Data *exception;
-  char *msg;
+  const char *msg;
 
   switch (sig)
     {

gcc/ada/s-stalib.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1995-2004 Free Software Foundation, Inc.          --
+--          Copyright (C) 1995-2005 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- --
@@ -36,13 +36,13 @@
 --  of System.Standard_Library, since this would cause order of elaboration
 --  problems (Elaborate_Body would have the same problem).
 
-pragma Warnings (Off);
---  Kill warnings from unused withs
-
 pragma Polling (Off);
 --  We must turn polling off for this unit, because otherwise we get
 --  elaboration circularities with Ada.Exceptions if polling is on.
 
+pragma Warnings (Off);
+--  Kill warnings from unused withs
+
 with System.Soft_Links;
 --  Referenced directly from generated code using external symbols so it
 --  must always be present in a build, even if no unit has a direct with
@@ -56,17 +56,14 @@ with System.Memory;
 --  must always be present in a build, even if no unit has a direct with
 --  of this unit.
 
+pragma Warnings (On);
+
 package body System.Standard_Library is
 
    Runtime_Finalized : Boolean := False;
    --  Set to True when adafinal is called. Used to ensure that subsequent
    --  calls to adafinal after the first have no effect.
 
-   Inside_Elab_Final_Code : Integer := 0;
-   pragma Export (C, Inside_Elab_Final_Code, "__gnat_inside_elab_final_code");
-   --  ???This variable is obsolete since 2001-08-29 but cannot be removed
-   --  ???right away due to the bootstrap problems
-
    --------------------------
    -- Abort_Undefer_Direct --
    --------------------------