OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2003-12-05  Thomas Quinot  <quinot@act-europe.fr>

	* 3ssoliop.ads: Fix comment (this is the Solaris, not the UnixWare,
	version of this unit).

2003-12-05  Olivier Hainque  <hainque@act-europe.fr>

	* 53osinte.ads, 54osinte.ads, 55osinte.ads, 56osinte.ads, 5bosinte.ads,
	5cosinte.ads, 5hosinte.ads, 5iosinte.ads, 5losinte.ads,
	5tosinte.ads: Define the SA_SIGINFO constant, to allow references from
	the body of System.Interrupt_Management common to several targets.
	Update copyright notice when appropriate.

	* 52osinte.ads, 5posinte.ads: Define a dummy value for the SA_SIGINFO
	constant.

	* 7sintman.adb (elaboration): Set SA_SIGINFO in the sigaction flags,
	to ensure that the kernel fills in the interrupted context structure
	before calling a signal handler, which is necessary to be able to
	unwind past it. Update the copyright notice.

2003-12-05  Jerome Guitton  <guitton@act-europe.fr>

	* a-elchha.ads: New file.

	* a-elchha.adb: New default last chance handler. Contents taken from
	Ada.Exceptions.Exception_Traces.Unhandled_Exception_Terminate.

	* a-exextr.adb (Unhandled_Exception_Terminate): Most of this routine
	is moved to a-elchha.adb to provide a target-independent default last
	chance handler.

	* Makefile.rtl: Add a-elchha.o

	* Make-lang.in (GNAT_ADA_OBJS, GNATBIND_OBJS): Add a-elchha.o.

2003-12-05  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch6.adb (Expand_Call): If the subprogram is inlined and is
	declared in an instance, do not inline the call if the instance is not
	frozen yet, to prevent order of elaboration problems.

	* sem_prag.adb: Add comments for previous fix.

2003-12-05  Samuel Tardieu  <tardieu@act-europe.fr>

	* g-table.adb: Use the right variable in Set_Item.
	Update copyright notice.

2003-12-05  Arnaud Charlet  <charlet@act-europe.fr>

	* Makefile.in: Remove unused rules.

2003-12-05  Vincent Celier  <celier@gnat.com>

	* switch-c.adb (Scan_Front_End_Switches): Remove processing of
	-nostdlib. Not needed here after all.

From-SVN: r74319
This commit is contained in:
Arnaud Charlet 2003-12-05 11:24:05 +01:00
parent b98d4eb5a9
commit 5b4994bc76
25 changed files with 357 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gcc/ada/3ssoliop.ads
View File

@ -34,7 +34,7 @@
-- This package is used to provide target specific linker_options for the
-- support of scokets as required by the package GNAT.Sockets.
-- This is the UnixWare version of this package
-- This is the Solaris version of this package
package GNAT.Sockets.Linker_Options is
private

2
gcc/ada/52osinte.ads
View File

@ -153,6 +153,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#80#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

4
gcc/ada/53osinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -153,6 +153,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#10#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

4
gcc/ada/54osinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2002 Ada Core Technologies, Inc. --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- --
-- GNARL 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- --
@ -157,6 +157,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#0008#;
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;

2
gcc/ada/55osinte.ads
View File

@ -171,6 +171,8 @@ package System.OS_Interface is
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
SA_SIGINFO : constant := 16#0040#;
function sigaction
(sig : Signal;
act : struct_sigaction_ptr;

2
gcc/ada/56osinte.ads
View File

@ -167,6 +167,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#80#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

3
gcc/ada/5bosinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -162,6 +162,7 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#0100#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;

2
gcc/ada/5cosinte.ads
View File

@ -162,6 +162,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#0100#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

1
gcc/ada/5hosinte.ads
View File

@ -164,6 +164,7 @@ package System.OS_Interface is
type struct_sigaction_ptr is access all struct_sigaction;
SA_RESTART : constant := 16#40#;
SA_SIGINFO : constant := 16#10#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;

2
gcc/ada/5iosinte.ads
View File

@ -196,6 +196,8 @@ package System.OS_Interface is
end record;
type Machine_State_Ptr is access all Machine_State;
SA_SIGINFO : constant := 16#04#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

4
gcc/ada/5losinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -162,6 +162,8 @@ package System.OS_Interface is
end record;
type Machine_State_Ptr is access all Machine_State;
SA_SIGINFO : constant := 16#04#;
SIG_BLOCK : constant := 0;
SIG_UNBLOCK : constant := 1;
SIG_SETMASK : constant := 2;

6
gcc/ada/5posinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -155,6 +155,10 @@ package System.OS_Interface is
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
SA_SIGINFO : constant := 0;
-- Dummy constant for a sa_flags bit. A proper definition is needed only
-- for the GCC/ZCX EH scheme (see System.Interrupt_Management).
function sigaction
(sig : Signal;
act : struct_sigaction_ptr;

4
gcc/ada/5tosinte.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2002, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2003, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -249,6 +249,8 @@ package System.OS_Interface is
pragma Convention (C, struct_sigaction);
type struct_sigaction_ptr is access all struct_sigaction;
SA_SIGINFO : constant := 16#08;
SIG_BLOCK : constant := 1;
SIG_UNBLOCK : constant := 2;
SIG_SETMASK : constant := 3;

13
gcc/ada/7sintman.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -175,7 +175,16 @@ begin
act.sa_handler := Notify_Exception'Address;
act.sa_flags := 0;
act.sa_flags := SA_SIGINFO;
-- Setting SA_SIGINFO asks the kernel to pass more than just the signal
-- number argument to the handler when it is called. The set of extra
-- parameters typically includes a pointer to a structure describing
-- the interrupted context. Although the Notify_Exception handler does
-- not use this information, it is actually required for the GCC/ZCX
-- exception propagation scheme because on some targets (at least
-- alpha-tru64), the structure contents are not even filled when this
-- flag is not set.
-- On some targets, we set sa_flags to SA_NODEFER so that during the
-- handler execution we do not change the Signal_Mask to be masked for

58
gcc/ada/ChangeLog
View File

@ -1,3 +1,61 @@
2003-12-05 Thomas Quinot <quinot@act-europe.fr>
* 3ssoliop.ads: Fix comment (this is the Solaris, not the UnixWare,
version of this unit).
2003-12-05 Olivier Hainque <hainque@act-europe.fr>
* 53osinte.ads, 54osinte.ads, 55osinte.ads, 56osinte.ads, 5bosinte.ads,
5cosinte.ads, 5hosinte.ads, 5iosinte.ads, 5losinte.ads,
5tosinte.ads: Define the SA_SIGINFO constant, to allow references from
the body of System.Interrupt_Management common to several targets.
Update copyright notice when appropriate.
* 52osinte.ads, 5posinte.ads: Define a dummy value for the SA_SIGINFO
constant.
* 7sintman.adb (elaboration): Set SA_SIGINFO in the sigaction flags,
to ensure that the kernel fills in the interrupted context structure
before calling a signal handler, which is necessary to be able to
unwind past it. Update the copyright notice.
2003-12-05 Jerome Guitton <guitton@act-europe.fr>
* a-elchha.ads: New file.
* a-elchha.adb: New default last chance handler. Contents taken from
Ada.Exceptions.Exception_Traces.Unhandled_Exception_Terminate.
* a-exextr.adb (Unhandled_Exception_Terminate): Most of this routine
is moved to a-elchha.adb to provide a target-independent default last
chance handler.
* Makefile.rtl: Add a-elchha.o
* Make-lang.in (GNAT_ADA_OBJS, GNATBIND_OBJS): Add a-elchha.o.
2003-12-05 Ed Schonberg <schonberg@gnat.com>
* exp_ch6.adb (Expand_Call): If the subprogram is inlined and is
declared in an instance, do not inline the call if the instance is not
frozen yet, to prevent order of elaboration problems.
* sem_prag.adb: Add comments for previous fix.
2003-12-05 Samuel Tardieu <tardieu@act-europe.fr>
* g-table.adb: Use the right variable in Set_Item.
Update copyright notice.
2003-12-05 Arnaud Charlet <charlet@act-europe.fr>
* Makefile.in: Remove unused rules.
2003-12-05 Vincent Celier <celier@gnat.com>
* switch-c.adb (Scan_Front_End_Switches): Remove processing of
-nostdlib. Not needed here after all.
2003-12-03 Thomas Quinot <quinot@act-europe.fr>
PR ada/11724

3
gcc/ada/Make-lang.in
View File

@ -118,7 +118,7 @@ GNAT1_C_OBJS = ada/b_gnat1.o ada/adadecode.o ada/adaint.o ada/cstreams.o \
# Object files from Ada sources that are used by gnat1
GNAT_ADA_OBJS = ada/ada.o ada/a-charac.o ada/a-chlat1.o ada/a-except.o \
ada/a-ioexce.o \
ada/a-elchha.o ada/a-ioexce.o \
ada/s-memory.o ada/s-carun8.o ada/s-casuti.o ada/s-strcom.o ada/s-purexc.o \
ada/s-htable.o ada/s-traceb.o ada/s-mastop.o ada/s-except.o ada/ali.o \
ada/alloc.o ada/atree.o ada/butil.o ada/casing.o ada/checks.o ada/comperr.o \
@ -173,6 +173,7 @@ GNATBIND_OBJS = \
ada/tracebak.o \
ada/a-except.o \
ada/ada.o \
ada/a-elchha.o \
ada/ali-util.o \
ada/ali.o \
ada/alloc.o \

199
gcc/ada/Makefile.in
View File

@ -589,106 +589,6 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
endif
endif
ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
LIBGNAT_TARGET_PAIRS = \
a-sytaco.ads<4zsytaco.ads \
a-sytaco.adb<4zsytaco.adb \
a-intnam.ads<4zintnam.ads \
a-numaux.ads<4znumaux.ads \
s-inmaop.adb<7sinmaop.adb \
s-interr.adb<5zinterr.adb \
s-intman.ads<5zintman.ads \
s-intman.adb<5zintman.adb \
s-osinte.adb<5zosinte.adb \
s-osinte.ads<5zosinte.ads \
s-osprim.adb<5zosprim.adb \
s-parame.ads<5yparame.ads \
s-taprop.adb<5ztaprop.adb \
s-taspri.ads<5ztaspri.ads \
s-thread.adb<5zthread.adb \
s-tpopsp.adb<5ztpopsp.adb \
s-vxwork.ads<5pvxwork.ads \
g-soccon.ads<3zsoccon.ads \
g-socthi.ads<3zsocthi.ads \
g-socthi.adb<3zsocthi.adb \
system.ads<5ysystem.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<5zml-tgt.adb
EXTRA_HIE_NONE_TARGET_PAIRS= \
system.ads<50system.ads
EXTRA_RAVEN_SOURCES=i-vxwork.ads s-vxwork.ads
EXTRA_RAVEN_OBJS=i-vxwork.o s-vxwork.o
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-thread.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
HIE_RAVEN_TARGET_PAIRS=\
$(HIE_NONE_TARGET_PAIRS) \
a-reatim.ads<1areatim.ads \
a-reatim.adb<1areatim.adb \
a-retide.adb<1aretide.adb \
a-interr.adb<1ainterr.adb \
s-interr.ads<1sinterr.ads \
s-interr.adb<1sinterr.adb \
s-taskin.ads<1staskin.ads \
s-taskin.adb<1staskin.adb \
s-tarest.adb<1starest.adb \
s-tposen.ads<1stposen.ads \
s-tposen.adb<1stposen.adb \
s-osinte.adb<1sosinte.adb \
s-taprop.ads<1staprop.ads \
s-taprop.adb<1staprop.adb \
s-taprob.ads<1staprob.ads \
s-taprob.adb<1staprob.adb \
a-sytaco.ads<1asytaco.ads \
a-sytaco.adb<1asytaco.adb \
a-intnam.ads<4zintnam.ads \
s-osinte.ads<5zosinte.ads \
s-parame.ads<5zparame.ads \
s-taspri.ads<5ztaspri.ads \
s-vxwork.ads<5pvxwork.ads \
a-taside.adb<1ataside.adb \
CERT_LEVEL_B_TARGET_PAIRS=\
a-tags.ads<1atags.ads \
a-tags.adb<1atags.adb \
a-elchha.ads<2aelchha.ads \
a-elchha.adb<2aelchha.adb.empty \
a-elchha.adb.full<2aelchha.adb.full \
a-except.adb<2aexcept.adb \
a-except.ads<2aexcept.ads \
a-excach.adb<2aexcach.adb \
i-c.ads<1ic.ads \
g-io.adb<2gio.adb \
s-init.ads<2sinit.ads \
s-init.adb<5zinit.adb \
s-memory.adb<2smemory.adb \
s-memory.ads<2smemory.ads \
s-osinte.ads<2sosinte.ads \
s-secsta.ads<2ssecsta.ads \
s-secsta.adb<2ssecsta.adb \
s-soflin.adb<2ssoflin.adb \
s-soflin.ads<2ssoflin.ads \
s-stalib.adb<1sstalib.adb \
s-stalib.ads<1sstalib.ads \
s-thread.adb<5zthread.adb \
s-traceb.adb<2straceb.adb \
s-traceb.ads<2straceb.ads \
system.ads<5isystem.ads
CERT_LEVEL_B_EXTRA_OBJECT_FILES=a-elchha.adb
ifeq ($(strip $(filter-out yes,$(TRACE))),)
LIBGNAT_TARGET_PAIRS += \
s-traces.adb<7straces.adb \
s-trafor.adb<7strafor.adb \
s-trafor.ads<7strafor.ads \
s-tratas.adb<7stratas.adb \
s-tfsetr.adb<5ztfsetr.adb
endif
endif
ifeq ($(strip $(filter-out powerpc% unknown elf,$(targ))),)
EXTRA_HIE_NONE_TARGET_PAIRS= \
system.ads<59system.ads
@ -1524,78 +1424,6 @@ RAVEN_OBJS = \
a-sytaco.o \
a-taside.o $(EXTRA_RAVEN_OBJS)
# Files which are needed for the cert level B runtime
COMPILABLE_CERT_LEVEL_B_SOURCES = \
$(COMPILABLE_HIE_SOURCES) \
a-except.adb \
a-except.ads \
a-exctra.ads \
a-exctra.adb \
s-init.adb \
s-init.ads \
s-memory.adb \
s-memory.ads \
s-osinte.ads \
s-soflin.adb \
s-soflin.ads \
s-stalib.adb \
s-stalib.ads \
s-assert.adb \
s-assert.ads \
s-exnint.adb \
s-exnint.ads \
s-strops.adb \
s-strops.ads \
s-thread.adb \
s-thread.ads \
s-traceb.adb \
s-traceb.ads \
s-traent.ads \
s-traent.adb \
g-debuti.ads \
g-debuti.adb \
g-io.adb \
g-io.ads \
$(EXTRA_CERT_LEVEL_B_SOURCES)
NON_COMPILABLE_CERT_LEVEL_B_SOURCES= \
a-elchha.ads \
a-elchha.adb \
a-elchha.adb.full \
a-excach.adb \
$(NON_COMPILABLE_HIE_SOURCES)
CERT_LEVEL_B_SOURCES = \
$(NON_COMPILABLE_CERT_LEVEL_B_SOURCES) \
$(COMPILABLE_CERT_LEVEL_B_SOURCES)
# Objects to generate for the cert level B run time
CERT_LEVEL_B_OBJS = \
$(HIE_OBJS) \
a-except.o \
s-init.o \
s-memory.o \
s-soflin.o \
s-stalib.o \
s-thrini.o \
s-traceb.o \
s-assert.o \
s-exnint.o \
s-strops.o \
s-thread.o \
g-debuti.o \
g-io.o \
$(EXTRA_CERT_LEVEL_B_OBJS)
# C files for the cert level B run time (without the .c extension)
CERT_LEVEL_B_C_FILES = \
2raise \
$(EXTRA_CERT_LEVEL_B_C_FILES)
# Default run time files
ADA_INCLUDE_SRCS =\
@ -2016,33 +1844,6 @@ rts-zfp: force
$(RM) rts-zfp/adalib/*.o
$(CHMOD) a-wx rts-zfp/adalib/*.ali
rts-cert: force
# First compile the Ada files ...
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=cert RTS_SRCS="$(CERT_LEVEL_B_SOURCES)" \
RTS_TARGET_PAIRS="$(CERT_LEVEL_B_TARGET_PAIRS)" \
COMPILABLE_SOURCES="$(COMPILABLE_CERT_LEVEL_B_SOURCES)"
$(GNATMAKE) -Prts-cert/cert.gpr --GCC="../../../xgcc -B../../../"
# ... then the C files. This section will eventually be removed.
$(foreach f,$(CERT_LEVEL_B_C_FILES), \
$(CP) $(fsrcpfx)$(f).c rts-cert/adainclude/ ;)
cd rts-cert/adalib ; \
$(foreach f,$(CERT_LEVEL_B_C_FILES), \
../../../$(GCC_FOR_TARGET) -B../../../ $(TARGET_LIBGCC2_CFLAGS) \
$(ALL_CFLAGS) $(GNATLIBCFLAGS_FOR_C) -c ../adainclude/$(f).c \
-I../adainclude $(INCLUDES_FOR_SUBDIR) -I../../../ ;) \
# ... Finally, generate the libs:
cd rts-cert/adalib ; \
../../../xgcc -B../../../ *.o -o libgnat ; \
$(RM) *.o ; \
$(MV) libgnat libgnat.o ; \
$(AR) $(ARFLAGS) libgnat.a libgnat.o ; \
$(foreach f,$(CERT_LEVEL_B_EXTRA_OBJECT_FILES), \
../../../xgcc -c -B../../../ $(GNATLIBFLAGS) ../adainclude/$(f) \
-I../adainclude; \
$(AR) $(ARFLAGS) libgnat.a $(subst .adb,.o,$(f))) ; \
$(CHMOD) a-wx *.ali *.o *.a ; \
rts-none: force
$(MAKE) $(FLAGS_TO_PASS) prepare-rts \
RTS_NAME=none RTS_SRCS="$(HIE_SOURCES)" \

1
gcc/ada/Makefile.rtl
View File

@ -87,6 +87,7 @@ GNATRTL_NONTASKING_OBJS= \
a-diocst$(objext) \
a-direio$(objext) \
a-einuoc$(objext) \
a-elchha$(objext) \
a-except$(objext) \
a-exctra$(objext) \
a-filico$(objext) \

169
gcc/ada/a-elchha.adb Normal file
View File

@ -0,0 +1,169 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Default version for most targets
procedure Ada.Exceptions.Last_Chance_Handler
(Except : Exception_Occurrence) is
procedure Unhandled_Terminate;
pragma No_Return (Unhandled_Terminate);
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
-- Perform system dependent shutdown code
function Tailored_Exception_Information
(X : Exception_Occurrence)
return String;
-- Exception information to be output in the case of automatic tracing
-- requested through GNAT.Exception_Traces.
--
-- This is the same as Exception_Information if no backtrace decorator
-- is currently in place. Otherwise, this is Exception_Information with
-- the call chain raw addresses replaced by the result of a call to the
-- current decorator provided with the call chain addresses.
pragma Import
(Ada, Tailored_Exception_Information,
"__gnat_tailored_exception_information");
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
Last : in out Integer);
-- Procedural version of the above function. Instead of returning the
-- result, this one is put in Buff (Buff'first .. Buff'first + Last)
procedure To_Stderr (S : String);
pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
-- Little routine to output string to stderr
Nline : constant String := String'(1 => ASCII.LF);
-- Convenient shortcut
Msg : constant String := Except.Msg (1 .. Except.Msg_Length);
Max_Static_Exc_Info : constant := 1024;
-- This should be enough for most exception information cases
-- even though tailoring introduces some uncertainty. The
-- name+message should not exceed 320 chars, so that leaves at
-- least 35 backtrace slots (each slot needs 19 chars for
-- representing a 64 bit address).
subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
type Str_Ptr is access Exc_Info_Type;
Exc_Info : Str_Ptr;
Exc_Info_Last : Natural := 0;
-- Buffer that is allocated to store the tailored exception
-- information while Adafinal is run. This buffer is allocated
-- on the heap only when it is needed. It is better to allocate
-- on the heap than on the stack since stack overflows are more
-- common than heap overflows.
procedure Tailored_Exception_Information
(X : Exception_Occurrence;
Buff : in out String;
Last : in out Integer) is
Info : String := Tailored_Exception_Information (X);
begin
Last := Info'Last;
Buff (1 .. Last) := Info;
end Tailored_Exception_Information;
begin
-- First allocate & store the exception info in a buffer when
-- we know it will be needed. This needs to be done before
-- Adafinal because it implicitly uses the secondary stack.
if Except.Id.Full_Name.all (1) /= '_'
and then Except.Num_Tracebacks /= 0
then
Exc_Info := new Exc_Info_Type;
if Exc_Info /= null then
Tailored_Exception_Information
(Except, Exc_Info.all, Exc_Info_Last);
end if;
end if;
-- Let's shutdown the runtime now. The rest of the procedure
-- needs to be careful not to use anything that would require
-- runtime support. In particular, functions returning strings
-- are banned since the sec stack is no longer functional.
System.Standard_Library.Adafinal;
-- Check for special case of raising _ABORT_SIGNAL, which is not
-- really an exception at all. We recognize this by the fact that
-- it is the only exception whose name starts with underscore.
if Except.Id.Full_Name.all (1) = '_' then
To_Stderr (Nline);
To_Stderr ("Execution terminated by abort of environment task");
To_Stderr (Nline);
-- If no tracebacks, we print the unhandled exception in the old style
-- (i.e. the style used before ZCX was implemented). We do this to
-- retain compatibility.
elsif Except.Num_Tracebacks = 0 then
To_Stderr (Nline);
To_Stderr ("raised ");
To_Stderr (Except.Id.Full_Name.all (1 .. Except.Id.Name_Length - 1));
if Msg'Length /= 0 then
To_Stderr (" : ");
To_Stderr (Msg);
end if;
To_Stderr (Nline);
else
-- Traceback exists
-- Note we can have this whole information output twice if
-- this occurrence gets reraised up to here.
To_Stderr (Nline);
To_Stderr ("Execution terminated by unhandled exception");
To_Stderr (Nline);
To_Stderr (Exc_Info (1 .. Exc_Info_Last));
end if;
Unhandled_Terminate;
end Ada.Exceptions.Last_Chance_Handler;

46
gcc/ada/a-elchha.ads Normal file
View File

@ -0,0 +1,46 @@
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . L A S T _ C H A N C E _ H A N D L E R --
-- --
-- S p e c --
-- --
-- Copyright (C) 2003 Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
-- apply solely to the contents of the part following the private keyword. --
-- --
-- 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 2, 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. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- Last chance handler. Unhandled exceptions are passed to this
-- routine.
procedure Ada.Exceptions.Last_Chance_Handler
(Except : Exception_Occurrence);
pragma Export (C,
Last_Chance_Handler,
"__gnat_last_chance_handler");
pragma No_Return (Last_Chance_Handler);

96
gcc/ada/a-exextr.adb
View File

@ -50,6 +50,14 @@ package body Exception_Traces is
pragma Export
(Ada, Raise_Hook_Initialized, "__gnat_exception_actions_initialized");
procedure Last_Chance_Handler
(Except : Exception_Occurrence);
pragma Import
(C, Last_Chance_Handler, "__gnat_last_chance_handler");
pragma No_Return (Last_Chance_Handler);
-- Users can replace the default version of this routine,
-- Ada.Exceptions.Last_Chance_Handler.
function To_Action is new Unchecked_Conversion
(Raise_Action, Exception_Action);
@ -95,11 +103,6 @@ package body Exception_Traces is
pragma Propagate_Exceptions;
procedure Unhandled_Terminate;
pragma No_Return (Unhandled_Terminate);
pragma Import (C, Unhandled_Terminate, "__gnat_unhandled_terminate");
-- Perform system dependent shutdown code
----------------------
-- Notify_Exception --
----------------------
@ -186,89 +189,8 @@ package body Exception_Traces is
-- could be overwritten if an exception is raised during finalization
-- (even if that exception is caught).
Msg : constant String := Excep.Msg (1 .. Excep.Msg_Length);
Max_Static_Exc_Info : constant := 1024;
-- That should be enough for most exception information cases
-- eventhough tailorising introduces some uncertainty. the
-- name+message should not exceed 320 chars, so that leaves at
-- least 35 backtrace slots (each slot needs 19 chars for
-- representing a 64 bit address).
-- And what happens on overflow ???
subtype Exc_Info_Type is String (1 .. Max_Static_Exc_Info);
type Str_Ptr is access Exc_Info_Type;
Exc_Info : Str_Ptr;
Exc_Info_Last : Natural := 0;
-- Buffer that is allocated to store the tailored exception
-- information while Adafinal is run. This buffer is allocated
-- on the heap only when it is needed. It is better to allocate
-- on the heap than on the stack since stack overflows are more
-- common that heap overflows.
-- Start of processing for Unhandled_Exception_Terminate
begin
-- First allocate & store the exception info in a buffer when
-- we know it will be needed. This needs to be done before
-- Adafinal because it implicitly uses the secondary stack.
if Excep.Id.Full_Name.all (1) /= '_'
and then Excep.Num_Tracebacks /= 0
then
Exc_Info := new Exc_Info_Type;
if Exc_Info /= null then
Tailored_Exception_Information
(Excep.all, Exc_Info.all, Exc_Info_Last);
end if;
end if;
-- Let's shutdown the runtime now. The rest of the procedure
-- needs to be careful not to use anything that would require
-- runtime support. In particular, function returing strings
-- are banned since the sec stack is not functional anymore
System.Standard_Library.Adafinal;
-- Check for special case of raising _ABORT_SIGNAL, which is not
-- really an exception at all. We recognize this by the fact that
-- it is the only exception whose name starts with underscore.
if Excep.Id.Full_Name.all (1) = '_' then
To_Stderr (Nline);
To_Stderr ("Execution terminated by abort of environment task");
To_Stderr (Nline);
-- If no tracebacks, we print the unhandled exception in the old style
-- (i.e. the style used before ZCX was implemented). We do this to
-- retain compatibility, especially with the nightly scripts, but
-- this can be removed at some point ???
elsif Excep.Num_Tracebacks = 0 then
To_Stderr (Nline);
To_Stderr ("raised ");
To_Stderr (Excep.Id.Full_Name.all (1 .. Excep.Id.Name_Length - 1));
if Msg'Length /= 0 then
To_Stderr (" : ");
To_Stderr (Msg);
end if;
To_Stderr (Nline);
else
-- Traceback exists
-- Note we can have this whole information output twice if
-- this occurrence gets reraised up to here.
To_Stderr (Nline);
To_Stderr ("Execution terminated by unhandled exception");
To_Stderr (Nline);
To_Stderr (Exc_Info (1 .. Exc_Info_Last));
end if;
Unhandled_Terminate;
Last_Chance_Handler (Excep.all);
end Unhandled_Exception_Terminate;
---------------

24
gcc/ada/exp_ch6.adb
View File

@ -1941,6 +1941,7 @@ package body Exp_Ch6 is
Bod : Node_Id;
Must_Inline : Boolean := False;
Spec : constant Node_Id := Unit_Declaration_Node (Subp);
Scop : constant Entity_Id := Scope (Subp);
begin
-- Verify that the body to inline has already been seen,
@ -1954,6 +1955,26 @@ package body Exp_Ch6 is
then
Must_Inline := False;
-- If this an inherited function that returns a private
-- type, do not inline if the full view is an unconstrained
-- array, because such calls cannot be inlined.
elsif Present (Orig_Subp)
and then Is_Array_Type (Etype (Orig_Subp))
and then not Is_Constrained (Etype (Orig_Subp))
then
Must_Inline := False;
-- If the subprogram comes from an instance in the same
-- unit, and the instance is not yet frozen, inlining might
-- trigger order-of-elaboration problems in gigi.
elsif Is_Generic_Instance (Scop)
and then Present (Freeze_Node (Scop))
and then not Analyzed (Freeze_Node (Scop))
then
Must_Inline := False;
else
Bod := Body_To_Inline (Spec);
@ -2531,7 +2552,8 @@ package body Exp_Ch6 is
Temp_Typ := Etype (A);
end if;
-- Comments needed here ???
-- If the actual is a simple name or a literal, no need to
-- create a temporary, object can be used directly.
if (Is_Entity_Name (A)
and then

4
gcc/ada/g-table.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2002 Ada Core Technologies, Inc. --
-- Copyright (C) 1998-2003 Ada Core Technologies, 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- --
@ -224,7 +224,7 @@ package body GNAT.Table is
Item : Table_Component_Type)
is
begin
if Integer (Index) > Max then
if Integer (Index) > Last_Val then
Set_Last (Index);
end if;

4
gcc/ada/sem_prag.adb
View File

@ -9631,6 +9631,10 @@ package body Sem_Prag is
E_Id := Expression (Arg2);
Analyze (E_Id);
-- In the expansion of an inlined body, a reference to
-- the formal may be wrapped in a conversion if the actual
-- is a conversion. Retrieve the real entity name.
if In_Instance_Body
and then Nkind (E_Id) = N_Unchecked_Type_Conversion
then

10
gcc/ada/switch-c.adb
View File

@ -97,7 +97,7 @@ package body Switch.C is
when False =>
-- There are few front-end switches that
-- do not start with -gnat: -I, --RTS, -nostdlib
-- do not start with -gnat: -I, --RTS
if Switch_Chars (Ptr) = 'I' then
Store_Switch := False;
@ -119,14 +119,6 @@ package body Switch.C is
Ptr := Max + 1;
-- Processing of -nostdlib
elsif Ptr + 7 = Max
and then Switch_Chars (Ptr .. Ptr + 7) = "nostdlib"
then
Opt.No_Stdlib := True;
Ptr := Max + 1;
-- Processing of the --RTS switch. --RTS has been modified by
-- gcc and is now of the form -fRTS