Commit d935a36e by Arnaud Charlet

[multiple changes]

2004-04-29  Ed Schonberg  <schonberg@gnat.com>

	* checks.adb (Enable_Range_Check): If the prefix of an index component
	is an access to an unconstrained array, perform check unconditionally.

2004-04-29  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* decl.c (gnat_to_gnu_field): Also call make_packable_type if
	Component_Clause.

2004-04-29  Olivier Hainque  <hainque@act-europe.fr>

	* init.c (__gnat_install_handler, __gnat_error_handler): Remove
	alternate stack setting. There was no support for the tasking cases
	and the changes eventually caused a number of side-effect failures in
	the non-tasking case too.

2004-04-29  Eric Botcazou  <ebotcazou@act-europe.fr>

	lang-specs.h: Redirect output to /dev/null if -gnatc or -gnatz or
	-gnats is passed.

2004-04-29  Vincent Celier  <celier@gnat.com>

	* make.adb (Gnatmake): Increase max size of argument array for
	gnatbind for the potential addition of -F.
	If there are Stand-Alone Library projects, invoke gnatbind with -F to
	be sure that elaboration flags will be checked.

	* switch-c.adb: Correct call to Scan_Pos for -gnateI

2004-04-29  Thomas Quinot  <quinot@act-europe.fr>

	* sem_warn.adb (Check_References): Move '<access-variable> may be
	null' warning out of under Warn_On_No_Value_Assigned.

2004-04-29  Ed Falis  <falis@gnat.com>

	* gnat_ugn.texi: Fixed texi error

2004-04-29  Robert Dewar  <dewar@gnat.com>

	* sem_ch4.adb (Remove_Abstract_Operations): Unconditionally remove
	abstract operations if they come from predefined files.

	* gnat_rm.texi: Fix bad doc for pragma Elaboration_Checks (should be
	Dynamic, not RM).

	* s-addope.adb: Correct obvious error in mod function

From-SVN: r81289
parent 56141a6a
2004-04-29 Ed Schonberg <schonberg@gnat.com>
* checks.adb (Enable_Range_Check): If the prefix of an index component
is an access to an unconstrained array, perform check unconditionally.
2004-04-29 Richard Kenner <kenner@vlsi1.ultra.nyu.edu>
* decl.c (gnat_to_gnu_field): Also call make_packable_type if
Component_Clause.
2004-04-29 Olivier Hainque <hainque@act-europe.fr>
* init.c (__gnat_install_handler, __gnat_error_handler): Remove
alternate stack setting. There was no support for the tasking cases
and the changes eventually caused a number of side-effect failures in
the non-tasking case too.
2004-04-29 Eric Botcazou <ebotcazou@act-europe.fr>
lang-specs.h: Redirect output to /dev/null if -gnatc or -gnatz or
-gnats is passed.
2004-04-29 Vincent Celier <celier@gnat.com>
* make.adb (Gnatmake): Increase max size of argument array for
gnatbind for the potential addition of -F.
If there are Stand-Alone Library projects, invoke gnatbind with -F to
be sure that elaboration flags will be checked.
* switch-c.adb: Correct call to Scan_Pos for -gnateI
2004-04-29 Thomas Quinot <quinot@act-europe.fr>
* sem_warn.adb (Check_References): Move '<access-variable> may be
null' warning out of under Warn_On_No_Value_Assigned.
2004-04-29 Ed Falis <falis@gnat.com>
* gnat_ugn.texi: Fixed texi error
2004-04-29 Robert Dewar <dewar@gnat.com>
* sem_ch4.adb (Remove_Abstract_Operations): Unconditionally remove
abstract operations if they come from predefined files.
* gnat_rm.texi: Fix bad doc for pragma Elaboration_Checks (should be
Dynamic, not RM).
* s-addope.adb: Correct obvious error in mod function
2004-04-28 Andrew W. Reynolds <awreynolds@mac.com>
* Makefile.in: Add target pairs for powerpc darwin*
tasking support.
* a-intnam-darwin.ads, s-osinte-darwin.adb,
s-osinte-darwin.ads, system-darwin-ppc.ads: New files.
2004-04-28 Ulrich Weigand <uweigand@de.ibm.com> 2004-04-28 Ulrich Weigand <uweigand@de.ibm.com>
* Makefile.in: Add target macro definitions for s390*-linux*. * Makefile.in: Add target macro definitions for s390*-linux*.
......
...@@ -3379,6 +3379,16 @@ package body Checks is ...@@ -3379,6 +3379,16 @@ package body Checks is
if Is_Access_Type (Atyp) then if Is_Access_Type (Atyp) then
Atyp := Designated_Type (Atyp); Atyp := Designated_Type (Atyp);
-- If the prefix is an access to an unconstrained array,
-- perform check unconditionally: it depends on the bounds
-- of an object and we cannot currently recognize whether
-- the test may be redundant.
if not Is_Constrained (Atyp) then
Set_Do_Range_Check (N, True);
return;
end if;
end if; end if;
Indx := First_Index (Atyp); Indx := First_Index (Atyp);
......
...@@ -4998,11 +4998,11 @@ gnat_to_gnu_field (Entity_Id gnat_field, ...@@ -4998,11 +4998,11 @@ gnat_to_gnu_field (Entity_Id gnat_field,
&& TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type)) && TYPE_LEFT_JUSTIFIED_MODULAR_P (gnu_field_type))
gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type)); gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
/* If we are packing this record or we have a specified size that's /* If we are packing this record, have a specified size that's smaller than
smaller than that of the field type and the field type is also a record that of the field type, or a position is specified, and the field type
that's BLKmode and with a small constant size, see if we can get a is also a record that's BLKmode and with a small constant size, see if
better form of the type that allows more packing. If we can, show we can get a better form of the type that allows more packing. If we
a size was specified for it if there wasn't one so we know to can, show a size was specified for it if there wasn't one so we know to
make this a bitfield and avoid making things wider. */ make this a bitfield and avoid making things wider. */
if (TREE_CODE (gnu_field_type) == RECORD_TYPE if (TREE_CODE (gnu_field_type) == RECORD_TYPE
&& TYPE_MODE (gnu_field_type) == BLKmode && TYPE_MODE (gnu_field_type) == BLKmode
...@@ -5010,7 +5010,8 @@ gnat_to_gnu_field (Entity_Id gnat_field, ...@@ -5010,7 +5010,8 @@ gnat_to_gnu_field (Entity_Id gnat_field,
&& compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0 && compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
&& (packed && (packed
|| (gnu_size != 0 && tree_int_cst_lt (gnu_size, || (gnu_size != 0 && tree_int_cst_lt (gnu_size,
TYPE_SIZE (gnu_field_type))))) TYPE_SIZE (gnu_field_type)))
|| Present (Component_Clause (gnat_field))))
{ {
gnu_field_type = make_packable_type (gnu_field_type); gnu_field_type = make_packable_type (gnu_field_type);
......
...@@ -1308,16 +1308,17 @@ debug procedures in the middle of declarations. ...@@ -1308,16 +1308,17 @@ debug procedures in the middle of declarations.
Syntax: Syntax:
@smallexample @c ada @smallexample @c ada
pragma Elaboration_Checks (RM | Static); pragma Elaboration_Checks (Dynamic | Static);
@end smallexample @end smallexample
@noindent @noindent
This is a configuration pragma that provides control over the This is a configuration pragma that provides control over the
elaboration model used by the compilation affected by the elaboration model used by the compilation affected by the
pragma. If the parameter is RM, then the dynamic elaboration pragma. If the parameter is @code{Dynamic},
then the dynamic elaboration
model described in the Ada Reference Manual is used, as though model described in the Ada Reference Manual is used, as though
the @code{-gnatE} switch had been specified on the command the @code{-gnatE} switch had been specified on the command
line. If the parameter is Static, then the default GNAT static line. If the parameter is @code{Static}, then the default GNAT static
model is used. This configuration pragma overrides the setting model is used. This configuration pragma overrides the setting
of the command line. For full details on the elaboration models of the command line. For full details on the elaboration models
used by the GNAT compiler, see section ``Elaboration Order used by the GNAT compiler, see section ``Elaboration Order
......
...@@ -6935,7 +6935,7 @@ See also the packages @code{GNAT.Traceback} and ...@@ -6935,7 +6935,7 @@ See also the packages @code{GNAT.Traceback} and
@ifclear vms @ifclear vms
Note that on x86 ports, you must not use @option{-fomit-frame-pointer} Note that on x86 ports, you must not use @option{-fomit-frame-pointer}
@code{gcc} option. @code{gcc} option.
@end ifclear vms @end ifclear
@item ^-F^/FORCE_ELABS_FLAGS^ @item ^-F^/FORCE_ELABS_FLAGS^
@cindex @option{^-F^/FORCE_ELABS_FLAGS^} (@command{gnatbind}) @cindex @option{^-F^/FORCE_ELABS_FLAGS^} (@command{gnatbind})
......
...@@ -386,7 +386,6 @@ __gnat_initialize (void) ...@@ -386,7 +386,6 @@ __gnat_initialize (void)
exclude this case in the above test. */ exclude this case in the above test. */
#include <signal.h> #include <signal.h>
#include <setjmp.h>
#include <sys/siginfo.h> #include <sys/siginfo.h>
static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *); static void __gnat_error_handler (int, siginfo_t *, struct sigcontext *);
...@@ -404,7 +403,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context) ...@@ -404,7 +403,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
static int recurse = 0; static int recurse = 0;
struct sigcontext *mstate; struct sigcontext *mstate;
const char *msg; const char *msg;
jmp_buf handler_jmpbuf;
/* If this was an explicit signal from a "kill", just resignal it. */ /* If this was an explicit signal from a "kill", just resignal it. */
if (SI_FROMUSER (sip)) if (SI_FROMUSER (sip))
...@@ -414,43 +412,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context) ...@@ -414,43 +412,6 @@ __gnat_error_handler (int sig, siginfo_t *sip, struct sigcontext *context)
} }
/* Otherwise, treat it as something we handle. */ /* Otherwise, treat it as something we handle. */
/* We are now going to raise the exception corresponding to the signal we
caught, which may eventually end up resuming the application code if the
exception is handled.
When the exception is handled, merely arranging for the *exception*
handler's context (stack pointer, program counter, other registers, ...)
to be installed is *not* enough to let the kernel think we've left the
*signal* handler. This has annoying implications if an alternate stack
has been setup for this *signal* handler, because the kernel thinks we
are still running on that alternate stack even after the jump, which
causes trouble at least as soon as another signal is raised.
We deal with this by forcing a "local" longjmp within the signal handler
below, forcing the "on alternate stack" indication to be reset (kernel
wise) on the way. If no alternate stack has been setup, this should be a
neutral operation. Otherwise, we will be in a delicate situation for a
short while because we are going to run the exception propagation code
within the alternate stack area (that is, with the stack pointer inside
the alternate stack bounds), but with the corresponding flag off from the
kernel's standpoint. We expect this to be ok as long as the propagation
code does not trigger a signal itself, which is expected.
??? A better approach would be to at least delay this operation until the
last second, that is, until just before we jump to the exception handler,
if any. */
if (setjmp (handler_jmpbuf) == 0)
{
#define JB_ONSIGSTK 0
/* Arrange for the "on alternate stack" flag to be reset. See the
comments around "jmp_buf offsets" in /usr/include/setjmp.h. */
handler_jmpbuf [JB_ONSIGSTK] = 0;
longjmp (handler_jmpbuf, 1);
}
switch (sig) switch (sig)
{ {
case SIGSEGV: case SIGSEGV:
...@@ -510,36 +471,12 @@ __gnat_install_handler (void) ...@@ -510,36 +471,12 @@ __gnat_install_handler (void)
{ {
struct sigaction act; struct sigaction act;
/* stack-checking on this platform is performed by the back-end and conforms
to what the ABI *mandates* (DEC OSF/1 Calling standard for AXP systems,
chapter 6: Stack Limits in Multihtreaded Execution Environments). This
does not include a "stack reserve" region, so nothing guarantees that
enough room remains on the current stack to propagate an exception when
a stack-overflow is signaled. We deal with this by requesting the use of
an alternate stack region for signal handlers.
??? The actual use of this alternate region depends on the act.sa_flags
including SA_ONSTACK below. Care should be taken to update s-intman if
we want this to happen for tasks also. */
static char sig_stack [8*1024];
/* 8K is a mininum to be able to propagate an exception using the GCC/ZCX
scheme. */
struct sigaltstack ss;
ss.ss_sp = (void *) sig_stack;
ss.ss_size = sizeof (sig_stack);
ss.ss_flags = 0;
sigaltstack (&ss, 0);
/* Setup signal handler to map synchronous signals to appropriate /* Setup signal handler to map synchronous signals to appropriate
exceptions. Make sure that the handler isn't interrupted by another exceptions. Make sure that the handler isn't interrupted by another
signal that might cause a scheduling event! */ signal that might cause a scheduling event! */
act.sa_handler = (void (*) (int)) __gnat_error_handler; act.sa_handler = (void (*) (int)) __gnat_error_handler;
act.sa_flags = SA_ONSTACK | SA_RESTART | SA_NODEFER | SA_SIGINFO; act.sa_flags = SA_RESTART | SA_NODEFER | SA_SIGINFO;
sigemptyset (&act.sa_mask); sigemptyset (&act.sa_mask);
/* Do not install handlers if interrupt state is "System" */ /* Do not install handlers if interrupt state is "System" */
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* C Header File * * C Header File *
* * * *
* Copyright (C) 1992-2003 Free Software Foundation, Inc. * * Copyright (C) 1992-2004 Free Software Foundation, Inc. *
* * * *
* GNAT is free software; you can redistribute it and/or modify it under * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -40,4 +40,5 @@ ...@@ -40,4 +40,5 @@
%{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\ %{g*} %{O*} %{W*} %{w} %{p} %{pg:-p} %{m*} %{a} %{f*} %{d*}\
%{!S:%{o*:%w%*-gnatO}} \ %{!S:%{o*:%w%*-gnatO}} \
%i %{S:%W{o*}%{!o*:-o %b.s}} \ %i %{S:%W{o*}%{!o*:-o %b.s}} \
%{!S:%{gnatc*|gnatz*|gnats*: -o %j}} \
%{!gnatc*:%{!gnatz*:%{!gnats*:%(invoke_as)}}}", 0, 0, 0}, %{!gnatc*:%{!gnatz*:%{!gnats*:%(invoke_as)}}}", 0, 0, 0},
...@@ -344,6 +344,7 @@ package body Make is ...@@ -344,6 +344,7 @@ package body Make is
-- These flags are reset to True for each invokation of procedure Gnatmake. -- These flags are reset to True for each invokation of procedure Gnatmake.
Shared_String : aliased String := "-shared"; Shared_String : aliased String := "-shared";
Force_Elab_Flags_String : aliased String := "-F";
No_Shared_Switch : aliased Argument_List := (1 .. 0 => null); No_Shared_Switch : aliased Argument_List := (1 .. 0 => null);
Shared_Switch : aliased Argument_List := (1 => Shared_String'Access); Shared_Switch : aliased Argument_List := (1 => Shared_String'Access);
...@@ -3323,6 +3324,8 @@ package body Make is ...@@ -3323,6 +3324,8 @@ package body Make is
-- The current working directory, used to modify some relative path -- The current working directory, used to modify some relative path
-- switches on the command line when a project file is used. -- switches on the command line when a project file is used.
There_Are_Stand_Alone_Libraries : Boolean := False;
begin begin
Gnatmake_Called := True; Gnatmake_Called := True;
...@@ -4428,6 +4431,10 @@ package body Make is ...@@ -4428,6 +4431,10 @@ package body Make is
for Proj1 in Projects.First .. Projects.Last loop for Proj1 in Projects.First .. Projects.Last loop
if Projects.Table (Proj1).Standalone_Library then
There_Are_Stand_Alone_Libraries := True;
end if;
if Projects.Table (Proj1).Library if Projects.Table (Proj1).Library
and then not Projects.Table (Proj1).Flag1 and then not Projects.Table (Proj1).Flag1
then then
...@@ -4643,7 +4650,7 @@ package body Make is ...@@ -4643,7 +4650,7 @@ package body Make is
if Do_Bind_Step then if Do_Bind_Step then
Bind_Step : declare Bind_Step : declare
Args : Argument_List Args : Argument_List
(Binder_Switches.First .. Binder_Switches.Last + 1); (Binder_Switches.First .. Binder_Switches.Last + 2);
-- The arguments for the invocation of gnatbind -- The arguments for the invocation of gnatbind
Last_Arg : Natural := Binder_Switches.Last; Last_Arg : Natural := Binder_Switches.Last;
...@@ -4704,6 +4711,11 @@ package body Make is ...@@ -4704,6 +4711,11 @@ package body Make is
Args (J) := Binder_Switches.Table (J); Args (J) := Binder_Switches.Table (J);
end loop; end loop;
if There_Are_Stand_Alone_Libraries then
Last_Arg := Last_Arg + 1;
Args (Last_Arg) := Force_Elab_Flags_String'Access;
end if;
if Main_Project /= No_Project then if Main_Project /= No_Project then
-- Put all the source directories in ADA_INCLUDE_PATH, -- Put all the source directories in ADA_INCLUDE_PATH,
......
...@@ -81,7 +81,7 @@ package body System.Address_Operations is ...@@ -81,7 +81,7 @@ package body System.Address_Operations is
function ModA (Left, Right : Address) return Address is function ModA (Left, Right : Address) return Address is
begin begin
return A (I (Left) and I (Right)); return A (I (Left) mod I (Right));
end ModA; end ModA;
--------- ---------
......
...@@ -30,7 +30,9 @@ with Debug; use Debug; ...@@ -30,7 +30,9 @@ with Debug; use Debug;
with Einfo; use Einfo; with Einfo; use Einfo;
with Errout; use Errout; with Errout; use Errout;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Fname; use Fname;
with Itypes; use Itypes; with Itypes; use Itypes;
with Lib; use Lib;
with Lib.Xref; use Lib.Xref; with Lib.Xref; use Lib.Xref;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
...@@ -4344,22 +4346,32 @@ package body Sem_Ch4 is ...@@ -4344,22 +4346,32 @@ package body Sem_Ch4 is
-------------------------------- --------------------------------
procedure Remove_Abstract_Operations (N : Node_Id) is procedure Remove_Abstract_Operations (N : Node_Id) is
I : Interp_Index; I : Interp_Index;
It : Interp; It : Interp;
Abstract_Op : Entity_Id := Empty; Abstract_Op : Entity_Id := Empty;
-- AI-310: If overloaded, remove abstract non-dispatching -- AI-310: If overloaded, remove abstract non-dispatching
-- operations. -- operations. We activate this if either extensions are
-- enabled, or if the abstract operation in question comes
-- from a predefined file. This latter test allows us to
-- use abstract to make operations invisible to users. In
-- particular, if type Address is non-private and abstract
-- subprograms are used to hide its operators, they will be
-- truly hidden.
begin begin
if Extensions_Allowed if Is_Overloaded (N) then
and then Is_Overloaded (N)
then
Get_First_Interp (N, I, It); Get_First_Interp (N, I, It);
while Present (It.Nam) loop while Present (It.Nam) loop
if not Is_Type (It.Nam) if not Is_Type (It.Nam)
and then Is_Abstract (It.Nam) and then Is_Abstract (It.Nam)
and then not Is_Dispatching_Operation (It.Nam) and then not Is_Dispatching_Operation (It.Nam)
and then
(Extensions_Allowed
or else Is_Predefined_File_Name
(Unit_File_Name (Get_Source_Unit (It.Nam))))
then then
Abstract_Op := It.Nam; Abstract_Op := It.Nam;
Remove_Interp (I); Remove_Interp (I);
......
...@@ -384,8 +384,7 @@ package body Sem_Warn is ...@@ -384,8 +384,7 @@ package body Sem_Warn is
then then
null; null;
elsif Warn_On_No_Value_Assigned elsif Present (UR)
and then Present (UR)
and then Is_Access_Type (Etype (E1)) and then Is_Access_Type (Etype (E1))
then then
......
...@@ -386,7 +386,7 @@ package body Switch.C is ...@@ -386,7 +386,7 @@ package body Switch.C is
when 'I' => when 'I' =>
Ptr := Ptr + 1; Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, 999, Ptr, Multiple_Unit_Index); Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index);
-- -gnatem (mapping file) -- -gnatem (mapping file)
......
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