Commit 8c1b16bc by Arnaud Charlet

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
parent b794e321
......@@ -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
......
......@@ -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;
......
......@@ -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)
{
......
......@@ -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 --
--------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment