Skip to content

R
riscv-gcc-1
Commit 982f26e4 by Arnaud Charlet
Options

a-except.adb (Zero_Cost_Exceptions): Removed, no longer used. 

	* a-except.adb (Zero_Cost_Exceptions): Removed, no longer used.
	(builtin_longjmp, Process_Raise_Exceeption): Move setjmp/longjmp
	related code to a-exexpr.adb
	(Save_Occurrence_And_Private): Move GCC EH related code to
	a-exexpr-gcc.adb
	(Raise_Current_Excep): Add new variable Id with pragma
        volatile, to ensure that the variable lives on stack.

	* a-exexpr-gcc.adb, raise-gcc.c: New file.

	* a-exexpr.adb (builtin_longjmp, Propagate_Exception): Moved here code
	from a-except.adb.
	Move GCC EH related code to a-exexpr-gcc.adb

	* Makefile.in: Add or update g-soccon LIBGNAT pairs for Linux/PPC and
	64-bit Solaris
	Split the Linux version of g-soccon into separate variants for 32 and 64
	bit platforms.
	(gnatlib): Use $(AR_FOR_TARGET) and $(RANLIB_FOR_TARGET)
	vice $(AR) and $(RANLIB). Remove use of host variable $(RANLIB_FLAGS).
	install-gnatlib: Use $(RANLIB_FOR_TARGET) vice $(RANLIB). Remove use
	of host variable $(RANLIB_FLAGS).
	(alpha64-dec-*vms*): Fix translations for 64 bit compiler.
	Code clean up: remove unused/obsolete targets.
	(EH_MECHANISM): New variable introduced to differenciate between the
	two EH mechanisms statically.
	(gnatlib-zcx, gnatlib-sjlj): Force EH_MECHANISM manually.
	(LIBGNAT_OBJS): Add raise-gcc.o
	(LIBGNAT_TARGET_PAIRS for ppc-vxworks): Use an specialized version of
	s-osinte.adb, s-tpopsp.adb, and system.ads for the run time that
	supports VxWorks 6 RTPs.
	(EXTRA_GNATRTL_NONTASKING_OBJS for ppc-vxworks): Remove the use of
	i-vxworks and i-vxwoio from the run time that supports VxWorks 6 RTPs.

	* raise.c: Move all GCC EH-related routines to raise-gcc.c

From-SVN: r106959
parent c01b085f
Showing with 2040 additions and 2103 deletions
gcc/ada/Makefile.in
...@@ -348,6 +348,11 @@ s-osprim.adb<s-osprim-posix.adb \ ...@@ -348,6 +348,11 @@ s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-dummy.adb \ s-taprop.adb<s-taprop-dummy.adb \
s-taspri.ads<s-taspri-dummy.ads s-taspri.ads<s-taspri-dummy.ads
# When using the GCC exception handling mechanism, we need to use an
# alternate body for a-exexpr.adb (a-exexpr-gcc.adb)
EH_MECHANISM=
# Default shared object option. Note that we rely on the fact that the "soname" # Default shared object option. Note that we rely on the fact that the "soname"
# option will always be present and last in this flag, so that we can have # option will always be present and last in this flag, so that we can have
# $(SO_OPTS)libgnat-x.xx # $(SO_OPTS)libgnat-x.xx
...@@ -381,103 +386,6 @@ LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)gnatvsn.ads | ...@@ -381,103 +386,6 @@ LIB_VERSION = $(strip $(shell grep ' Library_Version :' $(fsrcpfx)gnatvsn.ads |
# $(strip STRING) removes leading and trailing spaces from STRING. # $(strip STRING) removes leading and trailing spaces from STRING.
# If what's left is null then it's a match. # If what's left is null then it's a match.
ifeq ($(strip $(filter-out %86 os2 OS2 os2_emx,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-excpol.adb<a-excpol-abort.adb \
a-intnam.ads<a-intnam-dummy.ads \
a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \
s-inmaop.adb<s-inmaop-dummy.adb \
s-interr.adb<s-interr-dummy.adb \
s-intman.adb<s-intman-dummy.adb \
s-osinte.adb<s-osinte-os2.adb \
s-osinte.ads<s-osinte-os2.ads \
s-osprim.adb<s-osprim-os2.adb \
s-parame.adb<s-parame-os2.adb \
system.ads<system-os2.ads \
s-taprop.adb<s-taprop-os2.adb \
s-taspri.ads<s-taspri-os2.ads
EXTRA_GNATRTL_NONTASKING_OBJS = \
i-os2err.o \
i-os2lib.o \
i-os2syn.o \
i-os2thr.o
endif
ifeq ($(strip $(filter-out %86 interix%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-excpol.adb<a-excpol-interix.adb \
a-intnam.ads<a-intnam-interix.ads \
a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \
g-soccon.ads<g-soccon-interix.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-fsu.adb \
s-osinte.ads<s-osinte-interix.ads \
s-osprim.adb<s-osprim-unix.adb \
s-taprop.adb<s-taprop-posix.adb \
system.ads<system-interix.ads \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix.adb
THREADSLIB = -lgthreads -lmalloc
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
endif
# sysv5uw is SCO UnixWare 7
ifeq ($(strip $(filter-out %86 sysv5uw%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \
a-excpol.adb<a-excpol-abort.adb \
a-intnam.ads<a-intnam-unixware.ads \
a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.ads<s-osinte-unixware.ads \
s-osinte.adb<s-osinte-unixware.adb \
s-osprim.adb<s-osprim-unix.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
system.ads<system-unixware.ads \
g-soccon.ads<g-soccon-unixware.ads \
g-soliop.ads<g-soliop-unixware.ads
THREADSLIB = -lthread
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
SO_OPTS = -Wl,-h,
GNATLIB_SHARED = gnatlib-shared-dual
LIBRARY_VERSION := $(LIB_VERSION)
endif
ifeq ($(strip $(filter-out alpha% dec vx%,$(targ))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-interr.adb<s-interr-vxworks.adb \
s-intman.ads<s-intman-vxworks.ads \
s-intman.adb<s-intman-vxworks.adb \
s-osinte.adb<s-osinte-vxworks.adb \
s-osinte.ads<s-osinte-vxworks.ads \
s-osprim.adb<s-osprim-vxworks.adb \
s-parame.ads<s-parame-vxworks.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-taspri.ads<s-taspri-vxworks.ads \
s-vxwork.ads<s-vxwork-alpha.ads \
g-soccon.ads<g-soccon-vxworks.ads \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
system.ads<system-vxworks-alpha.ads
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
endif
ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),) ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \ a-intnam.ads<a-intnam-vxworks.ads \
...@@ -523,19 +431,16 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -523,19 +431,16 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-interr.adb<s-interr-vxworks.adb \ s-interr.adb<s-interr-vxworks.adb \
s-intman.ads<s-intman-vxworks.ads \ s-intman.ads<s-intman-vxworks.ads \
s-intman.adb<s-intman-vxworks.adb \ s-intman.adb<s-intman-vxworks.adb \
s-osinte.adb<s-osinte-vxworks.adb \
s-osinte.ads<s-osinte-vxworks.ads \ s-osinte.ads<s-osinte-vxworks.ads \
s-osprim.adb<s-osprim-vxworks.adb \ s-osprim.adb<s-osprim-vxworks.adb \
s-parame.ads<s-parame-vxworks.ads \ s-parame.ads<s-parame-vxworks.ads \
s-stchop.adb<s-stchop-vxworks.adb \ s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \ s-taprop.adb<s-taprop-vxworks.adb \
s-taspri.ads<s-taspri-vxworks.ads \ s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-ppc.ads \ s-vxwork.ads<s-vxwork-ppc.ads \
g-soccon.ads<g-soccon-vxworks.ads \ g-soccon.ads<g-soccon-vxworks.ads \
g-socthi.ads<g-socthi-vxworks.ads \ g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \ g-socthi.adb<g-socthi-vxworks.adb
system.ads<system-vxworks-ppc.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-vxworks.adb
...@@ -548,7 +453,22 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -548,7 +453,22 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
s-tfsetr.adb<s-tfsetr-vxworks.adb s-tfsetr.adb<s-tfsetr-vxworks.adb
endif endif
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o ifeq ($(strip $(filter-out rtp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-osinte.adb<s-osinte-vxworks-rtp.adb \
s-tpopsp.adb<s-tpopsp-vxworks-rtp.adb \
system.ads<system-vxworks-ppc-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
else
LIBGNAT_TARGET_PAIRS += \
s-osinte.adb<s-osinte-vxworks.adb \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
system.ads<system-vxworks-ppc.ads
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
endif
EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o
endif endif
...@@ -695,6 +615,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),) ...@@ -695,6 +615,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-solaris.adb TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-solaris.adb
EH_MECHANISM=-gcc
THREADSLIB = -lposix4 -lthread THREADSLIB = -lposix4 -lthread
MISCLIB = -lposix4 -lnsl -lsocket MISCLIB = -lposix4 -lnsl -lsocket
SO_OPTS = -Wl,-h, SO_OPTS = -Wl,-h,
...@@ -703,24 +624,6 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),) ...@@ -703,24 +624,6 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(LIB_VERSION) LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-solaris.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-solaris.adb \
s-osinte.adb<s-osinte-fsu.adb \
s-osinte.ads<s-osinte-solaris-fsu.ads \
s-osprim.adb<s-osprim-solaris.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix.adb \
g-soccon.ads<g-soccon-solaris.ads \
g-soliop.ads<g-soliop-solaris.ads \
system.ads<system-solaris-sparc.ads
THREADSLIB = -lgthreads -lmalloc
endif
ifeq ($(strip $(filter-out pthread PTHREAD,$(THREAD_KIND))),) ifeq ($(strip $(filter-out pthread PTHREAD,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-solaris.ads \ a-intnam.ads<a-intnam-solaris.ads \
...@@ -753,7 +656,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),) ...@@ -753,7 +656,7 @@ ifeq ($(strip $(filter-out sparc sun solaris%,$(targ))),)
s-tasinf.ads<s-tasinf-solaris.ads \ s-tasinf.ads<s-tasinf-solaris.ads \
s-taspri.ads<s-taspri-solaris.ads \ s-taspri.ads<s-taspri-solaris.ads \
s-tpopsp.adb<s-tpopsp-solaris.adb \ s-tpopsp.adb<s-tpopsp-solaris.adb \
g-soccon.ads<g-soccon-solaris.ads \ g-soccon.ads<g-soccon-solaris-64.ads \
g-soliop.ads<g-soliop-solaris.ads \ g-soliop.ads<g-soliop-solaris.ads \
system.ads<system-solaris-sparcv9.ads system.ads<system-solaris-sparcv9.ads
endif endif
...@@ -795,6 +698,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) ...@@ -795,6 +698,7 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
a-intnam.ads<a-intnam-linux.ads \ a-intnam.ads<a-intnam-linux.ads \
a-numaux.adb<a-numaux-x86.adb \ a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \ a-numaux.ads<a-numaux-x86.ads \
g-soccon.ads<g-soccon-linux-x86.ads \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-posix.adb \ s-osinte.adb<s-osinte-posix.adb \
...@@ -810,29 +714,12 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),) ...@@ -810,29 +714,12 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
THREADSLIB = -lpthread THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(LIB_VERSION) LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-linux.ads \
a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-fsu.adb \
s-osinte.ads<s-osinte-linux-fsu.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix.adb \
system.ads<system-linux-x86.ads
THREADSLIB = -lgthreads -lmalloc
endif
endif endif
ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),) ifeq ($(strip $(filter-out %86 freebsd%,$(arch) $(osys))),)
...@@ -923,26 +810,15 @@ ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),) ...@@ -923,26 +810,15 @@ ifeq ($(strip $(filter-out mips sgi irix%,$(targ))),)
GNATLIB_SHARED = gnatlib-shared-default GNATLIB_SHARED = gnatlib-shared-default
else else
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS += \
a-intnam.ads<a-intnam-irix.ads \
s-inmaop.adb<s-inmaop-dummy.adb \
s-interr.adb<s-interr-sigaction.adb \
s-intman.adb<s-intman-irix-athread.adb \
s-mastop.adb<s-mastop-irix.adb \ s-mastop.adb<s-mastop-irix.adb \
s-osinte.adb<s-osinte-irix.adb \
s-osinte.ads<s-osinte-irix-athread.ads \
s-osprim.adb<s-osprim-posix.adb \ s-osprim.adb<s-osprim-posix.adb \
s-proinf.adb<s-proinf-irix-athread.adb \
s-proinf.ads<s-proinf-irix-athread.ads \
s-taprop.adb<s-taprop-irix-athread.adb \
s-tasinf.adb<s-tasinf-irix-athread.adb \
s-tasinf.ads<s-tasinf-irix-athread.ads \
s-taspri.ads<s-taspri-posix.ads \
s-traceb.adb<s-traceb-mastop.adb \ s-traceb.adb<s-traceb-mastop.adb \
g-soccon.ads<g-soccon-irix.ads \ g-soccon.ads<g-soccon-irix.ads \
system.ads<system-irix-o32.ads system.ads<system-irix-o32.ads
endif endif
EH_MECHANISM=-gcc
TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-irix.adb TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-irix.adb
TGT_LIB = -lexc TGT_LIB = -lexc
MISCLIB = -lexc MISCLIB = -lexc
...@@ -967,6 +843,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux10%,$(targ))),) ...@@ -967,6 +843,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux10%,$(targ))),)
g-soccon.ads<g-soccon-hpux.ads \ g-soccon.ads<g-soccon-hpux.ads \
system.ads<system-hpux.ads system.ads<system-hpux.ads
EH_MECHANISM=-gcc
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
endif endif
...@@ -987,6 +864,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),) ...@@ -987,6 +864,7 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),)
system.ads<system-hpux.ads system.ads<system-hpux.ads
TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-hpux.adb TOOLS_TARGET_PAIRS = mlib-tgt.adb<mlib-tgt-hpux.adb
EH_MECHANISM=-gcc
TGT_LIB = /usr/lib/libcl.a TGT_LIB = /usr/lib/libcl.a
THREADSLIB = -lpthread THREADSLIB = -lpthread
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
...@@ -995,27 +873,6 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),) ...@@ -995,27 +873,6 @@ ifeq ($(strip $(filter-out hppa% hp hpux11%,$(targ))),)
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
GNATLIB_SHARED = gnatlib-shared-dual GNATLIB_SHARED = gnatlib-shared-dual
LIBRARY_VERSION := $(LIB_VERSION) LIBRARY_VERSION := $(LIB_VERSION)
ifeq ($(strip $(filter-out dce DCE,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
a-excpol.adb<a-excpol-abort.adb \
a-intnam.ads<a-intnam-hpux.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-interr.adb<s-interr-sigaction.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-hpux-dce.adb \
s-osinte.ads<s-osinte-hpux-dce.ads \
s-parame.ads<s-parame-hpux.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-hpux-dce.adb \
s-taspri.ads<s-taspri-hpux-dce.ads \
s-tpopsp.adb<s-tpopsp-posix.adb \
g-soccon.ads<g-soccon-hpux.ads \
system.ads<system-hpux.ads
TGT_LIB =
THREADSLIB = -lcma
endif
endif endif
ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),) ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
...@@ -1035,23 +892,6 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),) ...@@ -1035,23 +892,6 @@ ifeq ($(strip $(filter-out ibm aix%,$(manu) $(osys))),)
THREADSLIB = -lpthreads THREADSLIB = -lpthreads
PREFIX_OBJS=$(PREFIX_REAL_OBJS) PREFIX_OBJS=$(PREFIX_REAL_OBJS)
ifeq ($(strip $(filter-out fsu FSU,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-aix.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-fsu.adb \
s-osinte.ads<s-osinte-aix-fsu.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-posix.adb \
s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix.adb \
g-soccon.ads<g-soccon-aix.ads \
system.ads<system-aix.ads
THREADSLIB = -lgthreads -lmalloc
endif
TOOLS_TARGET_PAIRS = \ TOOLS_TARGET_PAIRS = \
mlib-tgt.adb<mlib-tgt-aix.adb \ mlib-tgt.adb<mlib-tgt-aix.adb \
indepsw.adb<indepsw-aix.adb indepsw.adb<indepsw-aix.adb
...@@ -1086,27 +926,13 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),) ...@@ -1086,27 +926,13 @@ ifeq ($(strip $(filter-out lynxos,$(osys))),)
a-intnam.ads<a-intnam-lynxos.ads \ a-intnam.ads<a-intnam-lynxos.ads \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos-3.adb \ s-osinte.adb<s-osinte-lynxos.adb \
s-osinte.ads<s-osinte-lynxos-3.ads \ s-osinte.ads<s-osinte-lynxos.ads \
s-osprim.adb<s-osprim-posix.adb \ s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-posix.adb \ s-taprop.adb<s-taprop-lynxos.adb \
s-taspri.ads<s-taspri-posix.ads \ s-taspri.ads<s-taspri-lynxos.ads \
s-tpopsp.adb<s-tpopsp-posix.adb \ s-tpopsp.adb<s-tpopsp-lynxos.adb \
system.ads<system-lynxos-ppc.ads system.ads<system-lynxos-ppc.ads
ifeq ($(strip $(filter-out pthread PTHREAD,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-lynxos.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
s-osinte.ads<s-osinte-lynxos.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-lynxos.adb \
s-taspri.ads<s-taspri-lynxos.ads \
s-tpopsp.adb<s-tpopsp-lynxos.adb \
system.ads<system-lynxos-ppc.ads
endif
endif endif
endif endif
...@@ -1143,6 +969,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),) ...@@ -1143,6 +969,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-tru64.adb TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-tru64.adb
EH_MECHANISM=-gcc
GMEM_LIB=gmemlib GMEM_LIB=gmemlib
THREADSLIB = -lpthread -lmach -lexc -lrt THREADSLIB = -lpthread -lmach -lexc -lrt
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
...@@ -1150,42 +977,42 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),) ...@@ -1150,42 +977,42 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
LIBRARY_VERSION := $(LIB_VERSION) LIBRARY_VERSION := $(LIB_VERSION)
endif endif
ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(host))),) ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(host))),)
soext = .exe soext = .exe
hyphen = _ hyphen = _
LN = cp -p LN = cp -p
LN_S = cp -p LN_S = cp -p
ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
AR = iar
endif
.SUFFIXES: .sym .SUFFIXES: .sym
.o.sym: .o.sym:
@ gnu:[bin]vmssymvec $< @ gnu:[bin]vmssymvec $<
endif endif
ifeq ($(strip $(filter-out alpha% ia64 dec hp vms% openvms% alphavms%,$(targ))),) ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ))),)
ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),) ifeq ($(strip $(filter-out ia64 hp vms% openvms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX1 = \ LIBGNAT_TARGET_PAIRS_AUX1 = \
g-enblsp.adb<g-enblsp-vms-ia64.adb \ g-enblsp.adb<g-enblsp-vms-ia64.adb \
g-trasym.adb<g-trasym-vms-ia64.adb \
s-auxdec.ads<s-auxdec-vms_64.ads \ s-auxdec.ads<s-auxdec-vms_64.ads \
s-crtl.ads<s-crtl-vms64.ads \ s-crtl.ads<s-crtl-vms64.ads \
s-osinte.adb<s-osinte-vms-ia64.adb \ s-osinte.adb<s-osinte-vms-ia64.adb \
s-osinte.ads<s-osinte-vms-ia64.ads \ s-osinte.ads<s-osinte-vms-ia64.ads \
s-vaflop.adb<s-vaflop-vms-ia64.adb \
system.ads<system-vms_64.ads system.ads<system-vms_64.ads
else else
ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(targ))),) ifeq ($(strip $(filter-out alpha64 dec vms% openvms% alphavms%,$(targ))),)
LIBGNAT_TARGET_PAIRS_AUX1 = \ LIBGNAT_TARGET_PAIRS_AUX1 = \
g-enblsp.adb<g-enblsp-vms-alpha.adb \ g-enblsp.adb<g-enblsp-vms-alpha.adb \
g-trasym.adb<g-trasym-vms-alpha.adb \
s-asthan.adb<s-asthan-vms-alpha.adb \ s-asthan.adb<s-asthan-vms-alpha.adb \
s-crtl.ads<s-crtl-vms.ads \ s-auxdec.ads<s-auxdec-vms_64.ads \
s-crtl.ads<s-crtl-vms64.ads \
s-osinte.adb<s-osinte-vms.adb \ s-osinte.adb<s-osinte-vms.adb \
s-osinte.ads<s-osinte-vms.ads \ s-osinte.ads<s-osinte-vms.ads \
s-vaflop.adb<s-vaflop-vms-alpha.adb \ s-vaflop.adb<s-vaflop-vms-alpha.adb \
system.ads<system-vms-zcx.ads system.ads<system-vms_64.ads
endif endif
endif endif
ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),) ifeq ($(strip $(filter-out express EXPRESS,$(THREAD_KIND))),)
...@@ -1208,10 +1035,7 @@ endif ...@@ -1208,10 +1035,7 @@ endif
g-soccon.ads<g-soccon-vms.ads \ g-soccon.ads<g-soccon-vms.ads \
g-socthi.ads<g-socthi-vms.ads \ g-socthi.ads<g-socthi-vms.ads \
g-socthi.adb<g-socthi-vms.adb \ g-socthi.adb<g-socthi-vms.adb \
g-trasym.adb<g-trasym-vms.adb \
i-cstrea.adb<i-cstrea-vms.adb \ i-cstrea.adb<i-cstrea-vms.adb \
i-cpp.adb<i-cpp-vms.adb \
interfac.ads<interfac-vms.ads \
s-inmaop.adb<s-inmaop-vms.adb \ s-inmaop.adb<s-inmaop-vms.adb \
s-interr.adb<s-interr-vms.adb \ s-interr.adb<s-interr-vms.adb \
s-intman.adb<s-intman-vms.adb \ s-intman.adb<s-intman-vms.adb \
...@@ -1240,8 +1064,9 @@ else ...@@ -1240,8 +1064,9 @@ else
symbols-processing.adb<symbols-processing-vms-alpha.adb symbols-processing.adb<symbols-processing-vms-alpha.adb
endif endif
EH_MECHANISM=-gcc
GNATLIB_SHARED=gnatlib-shared-vms GNATLIB_SHARED=gnatlib-shared-vms
ifeq ($(strip $(filter-out alpha% dec vms% openvms% alphavms%,$(targ))),) ifeq ($(strip $(filter-out alpha64 dec vms% openvms% alphavms%,$(targ))),)
EXTRA_LIBGNAT_SRCS=vmshandler.asm EXTRA_LIBGNAT_SRCS=vmshandler.asm
EXTRA_LIBGNAT_OBJS=vmshandler.o EXTRA_LIBGNAT_OBJS=vmshandler.o
endif endif
...@@ -1285,6 +1110,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) ...@@ -1285,6 +1110,7 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
mlib-tgt.adb<mlib-tgt-mingw.adb \ mlib-tgt.adb<mlib-tgt-mingw.adb \
indepsw.adb<indepsw-mingw.adb indepsw.adb<indepsw-mingw.adb
EH_MECHANISM=-gcc
MISCLIB = -lwsock32 MISCLIB = -lwsock32
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS) PREFIX_OBJS = $(PREFIX_REAL_OBJS)
...@@ -1301,6 +1127,7 @@ endif ...@@ -1301,6 +1127,7 @@ endif
ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),) ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-linux.ads \ a-intnam.ads<a-intnam-linux.ads \
g-soccon.ads<g-soccon-linux-ppc.ads \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-posix.adb \ s-osinte.adb<s-osinte-posix.adb \
...@@ -1316,6 +1143,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),) ...@@ -1316,6 +1143,7 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
THREADSLIB = -lpthread THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
...@@ -1341,6 +1169,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),) ...@@ -1341,6 +1169,7 @@ ifeq ($(strip $(filter-out sparc% linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
THREADSLIB = -lpthread THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
...@@ -1366,6 +1195,7 @@ ifeq ($(strip $(filter-out hppa% linux%,$(arch) $(osys))),) ...@@ -1366,6 +1195,7 @@ ifeq ($(strip $(filter-out hppa% linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
THREADSLIB = -lpthread THREADSLIB = -lpthread
GNATLIB_SHARED = gnatlib-shared-dual GNATLIB_SHARED = gnatlib-shared-dual
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
...@@ -1377,6 +1207,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),) ...@@ -1377,6 +1207,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-linux.ads \ a-intnam.ads<a-intnam-linux.ads \
a-numaux.ads<a-numaux-libc-x86.ads \ a-numaux.ads<a-numaux-libc-x86.ads \
g-soccon.ads<g-soccon-linux-64.ads \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-osinte.ads<s-osinte-linux.ads \ s-osinte.ads<s-osinte-linux.ads \
...@@ -1391,6 +1222,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),) ...@@ -1391,6 +1222,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
MISCLIB= MISCLIB=
THREADSLIB=-lpthread THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual GNATLIB_SHARED=gnatlib-shared-dual
...@@ -1416,6 +1248,7 @@ ifeq ($(strip $(filter-out alpha% linux%,$(arch) $(osys))),) ...@@ -1416,6 +1248,7 @@ ifeq ($(strip $(filter-out alpha% linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
MISCLIB= MISCLIB=
THREADSLIB=-lpthread THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual GNATLIB_SHARED=gnatlib-shared-dual
...@@ -1428,6 +1261,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),) ...@@ -1428,6 +1261,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
a-intnam.ads<a-intnam-linux.ads \ a-intnam.ads<a-intnam-linux.ads \
a-numaux.adb<a-numaux-x86.adb \ a-numaux.adb<a-numaux-x86.adb \
a-numaux.ads<a-numaux-x86.ads \ a-numaux.ads<a-numaux-x86.ads \
g-soccon.ads<g-soccon-linux-64.ads \
s-inmaop.adb<s-inmaop-posix.adb \ s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \ s-intman.adb<s-intman-posix.adb \
s-osinte.ads<s-osinte-linux.ads \ s-osinte.ads<s-osinte-linux.ads \
...@@ -1442,6 +1276,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),) ...@@ -1442,6 +1276,7 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
mlib-tgt.adb<mlib-tgt-linux.adb \ mlib-tgt.adb<mlib-tgt-linux.adb \
indepsw.adb<indepsw-gnu.adb indepsw.adb<indepsw-gnu.adb
EH_MECHANISM=-gcc
THREADSLIB=-lpthread THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib GMEM_LIB = gmemlib
...@@ -1468,6 +1303,7 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),) ...@@ -1468,6 +1303,7 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
TOOLS_TARGET_PAIRS = \ TOOLS_TARGET_PAIRS = \
mlib-tgt.adb<mlib-tgt-darwin.adb mlib-tgt.adb<mlib-tgt-darwin.adb
EH_MECHANISM=-gcc
GNATLIB_SHARED = gnatlib-shared-darwin GNATLIB_SHARED = gnatlib-shared-darwin
SO_OPTS = -Wl,-flat_namespace SO_OPTS = -Wl,-flat_namespace
RANLIB = ranlib -c RANLIB = ranlib -c
...@@ -1477,6 +1313,12 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),) ...@@ -1477,6 +1313,12 @@ ifeq ($(strip $(filter-out powerpc darwin%,$(arch) $(osys))),)
soext = .dylib soext = .dylib
endif endif
ifneq ($(EH_MECHANISM),)
LIBGNAT_TARGET_PAIRS += a-exexpr.adb<a-exexpr$(EH_MECHANISM).adb
EXTRA_LIBGNAT_SRCS+=raise$(EH_MECHANISM).c
EXTRA_LIBGNAT_OBJS+=raise$(EH_MECHANISM).o
endif
# The runtime library for gnat comprises two directories. One contains the # The runtime library for gnat comprises two directories. One contains the
# Ada source files that the compiler (gnat1) needs -- these files are listed # Ada source files that the compiler (gnat1) needs -- these files are listed
# by ADA_INCLUDE_SRCS -- and the other contains the object files and their # by ADA_INCLUDE_SRCS -- and the other contains the object files and their
...@@ -1493,8 +1335,8 @@ LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \ ...@@ -1493,8 +1335,8 @@ LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
$(EXTRA_LIBGNAT_SRCS) $(EXTRA_LIBGNAT_SRCS)
LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \ LIBGNAT_OBJS = adaint.o argv.o cio.o cstreams.o ctrl_c.o errno.o exit.o \
raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o final.o \ raise.o sysdep.o aux-io.o init.o initialize.o seh_init.o cal.o \
tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS) final.o tracebak.o expect.o mkdir.o socket.o $(EXTRA_LIBGNAT_OBJS)
# NOTE ??? - when the -I option for compiling Ada code is made to work, # NOTE ??? - when the -I option for compiling Ada code is made to work,
# the library installation will change and there will be a # the library installation will change and there will be a
...@@ -1665,7 +1507,7 @@ install-gnatlib: ../stamp-gnatlib ...@@ -1665,7 +1507,7 @@ install-gnatlib: ../stamp-gnatlib
-$(INSTALL_DATA) rts/g-trasym$(objext) $(DESTDIR)$(ADA_RTL_OBJ_DIR) -$(INSTALL_DATA) rts/g-trasym$(objext) $(DESTDIR)$(ADA_RTL_OBJ_DIR)
-cd rts; for file in *$(arext);do \ -cd rts; for file in *$(arext);do \
$(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \ $(INSTALL_DATA) $$file $(DESTDIR)$(ADA_RTL_OBJ_DIR); \
$(RANLIB) $(RANLIB_FLAGS) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \ $(RANLIB_FOR_TARGET) $(DESTDIR)$(ADA_RTL_OBJ_DIR)/$$file; \
done done
-$(foreach file, $(EXTRA_ADALIB_FILES), \ -$(foreach file, $(EXTRA_ADALIB_FILES), \
$(INSTALL_DATA_DATE) rts/$(file) $(DESTDIR)$(ADA_RTL_OBJ_DIR) && \ $(INSTALL_DATA_DATE) rts/$(file) $(DESTDIR)$(ADA_RTL_OBJ_DIR) && \
...@@ -1761,19 +1603,21 @@ gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2 ...@@ -1761,19 +1603,21 @@ gnatlib: ../stamp-gnatlib1 ../stamp-gnatlib2
-f ../Makefile \ -f ../Makefile \
$(GNATRTL_OBJS) $(GNATRTL_OBJS)
$(RM) rts/libgnat$(arext) rts/libgnarl$(arext) $(RM) rts/libgnat$(arext) rts/libgnarl$(arext)
$(AR) $(AR_FLAGS) rts/libgnat$(arext) \ $(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnat$(arext) \
$(addprefix rts/,$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS)) $(addprefix rts/,$(GNATRTL_NONTASKING_OBJS) $(LIBGNAT_OBJS))
ifneq ($(PREFIX_OBJS),) ifneq ($(PREFIX_OBJS),)
$(AR) $(AR_FLAGS) rts/libgccprefix$(arext) $(PREFIX_OBJS); $(AR_FOR_TARGET) $(AR_FLAGS) rts/libgccprefix$(arext) \
-$(RANLIB) rts/libgccprefix$(arext) $(PREFIX_OBJS);
$(RANLIB_FOR_TARGET) rts/libgccprefix$(arext)
endif endif
-$(RANLIB) $(RANLIB_FLAGS) rts/libgnat$(arext) $(RANLIB_FOR_TARGET) rts/libgnat$(arext)
$(AR) $(AR_FLAGS) rts/libgnarl$(arext) \ $(AR_FOR_TARGET) $(AR_FLAGS) rts/libgnarl$(arext) \
$(addprefix rts/,$(GNATRTL_TASKING_OBJS)) $(addprefix rts/,$(GNATRTL_TASKING_OBJS))
-$(RANLIB) $(RANLIB_FLAGS) rts/libgnarl$(arext) $(RANLIB_FOR_TARGET) rts/libgnarl$(arext)
ifeq ($(GMEM_LIB),gmemlib) ifeq ($(GMEM_LIB),gmemlib)
$(AR) $(AR_FLAGS) rts/libgmem$(arext) rts/memtrack.o $(AR_FOR_TARGET) $(AR_FLAGS) rts/libgmem$(arext) \
-$(RANLIB) $(RANLIB_FLAGS) rts/libgmem$(arext) rts/memtrack.o
$(RANLIB_FOR_TARGET) rts/libgmem$(arext)
endif endif
$(CHMOD) a-wx rts/*.ali $(CHMOD) a-wx rts/*.ali
touch ../stamp-gnatlib touch ../stamp-gnatlib
...@@ -1914,7 +1758,8 @@ gnatlib-shared: ...@@ -1914,7 +1758,8 @@ gnatlib-shared:
TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \ TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" \
$(GNATLIB_SHARED) $(GNATLIB_SHARED)
gnatlib-sjlj: ../stamp-gnatlib1 gnatlib-sjlj:
$(MAKE) $(FLAGS_TO_PASS) EH_MECHANISM="" ../stamp-gnatlib1
sed -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := False;/' rts/system.ads > rts/s.ads sed -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := False;/' rts/system.ads > rts/s.ads
$(MV) rts/s.ads rts/system.ads $(MV) rts/s.ads rts/system.ads
$(MAKE) $(FLAGS_TO_PASS) \ $(MAKE) $(FLAGS_TO_PASS) \
...@@ -1923,7 +1768,8 @@ gnatlib-sjlj: ../stamp-gnatlib1 ...@@ -1923,7 +1768,8 @@ gnatlib-sjlj: ../stamp-gnatlib1
THREAD_KIND="$(THREAD_KIND)" \ THREAD_KIND="$(THREAD_KIND)" \
TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" gnatlib TARGET_LIBGCC2_CFLAGS="$(TARGET_LIBGCC2_CFLAGS)" gnatlib
gnatlib-zcx: ../stamp-gnatlib1 gnatlib-zcx:
$(MAKE) $(FLAGS_TO_PASS) EH_MECHANISM="-gcc" ../stamp-gnatlib1
sed -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := True;/' rts/system.ads > rts/s.ads sed -e 's/ZCX_By_Default.*/ZCX_By_Default : constant Boolean := True;/' rts/system.ads > rts/s.ads
$(MV) rts/s.ads rts/system.ads $(MV) rts/s.ads rts/system.ads
$(MAKE) $(FLAGS_TO_PASS) \ $(MAKE) $(FLAGS_TO_PASS) \
...@@ -1998,16 +1844,18 @@ adadecode.o : adadecode.c adadecode.h ...@@ -1998,16 +1844,18 @@ adadecode.o : adadecode.c adadecode.h
aux-io.o : aux-io.c aux-io.o : aux-io.c
argv.o : argv.c argv.o : argv.c
cal.o : cal.c cal.o : cal.c
deftarg.o : deftarg.c deftarg.o : deftarg.c
errno.o : errno.c errno.o : errno.c
exit.o : raise.h exit.c exit.o : adaint.h exit.c
expect.o : expect.c expect.o : expect.c
final.o : raise.h final.c final.o : final.c
gmem.o : gmem.c gmem.o : gmem.c
link.o : link.c link.o : link.c
mkdir.o : mkdir.c mkdir.o : mkdir.c
socket.o : socket.c gsocket.h socket.o : socket.c gsocket.h
sysdep.o : sysdep.c sysdep.o : sysdep.c
raise-gcc.o : raise-gcc.c raise.h
raise.o : raise.c raise.h
gen-soccon: gen-soccon.c gsocket.h gen-soccon: gen-soccon.c gsocket.h
$(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(CC) $(ALL_CFLAGS) $(ADA_CFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \
...@@ -2032,10 +1880,6 @@ seh_init.o : seh_init.c raise.h ...@@ -2032,10 +1880,6 @@ seh_init.o : seh_init.c raise.h
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) -O0 \ $(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) -O0 \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
raise.o : raise.c raise.h
$(CC) -c $(ALL_CFLAGS) $(ADA_CFLAGS) \
$(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION)
# Need to keep the frame pointer in this file to pop the stack properly on # Need to keep the frame pointer in this file to pop the stack properly on
# some targets. # some targets.
tracebak.o : tracebak.c tb-alvms.c tb-alvxw.c tracebak.o : tracebak.c tb-alvms.c tb-alvxw.c
......
gcc/ada/a-except.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005, 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- --
...@@ -41,23 +41,11 @@ with System.Soft_Links; use System.Soft_Links; ...@@ -41,23 +41,11 @@ with System.Soft_Links; use System.Soft_Links;
package body Ada.Exceptions is package body Ada.Exceptions is
procedure builtin_longjmp (buffer : Address; Flag : Integer);
pragma No_Return (builtin_longjmp);
pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
pragma Suppress (All_Checks); pragma Suppress (All_Checks);
-- We definitely do not want exceptions occurring within this unit, or -- We definitely do not want exceptions occurring within this unit, or
-- we are in big trouble. If an exceptional situation does occur, better -- we are in big trouble. If an exceptional situation does occur, better
-- that it not be raised, since raising it can cause confusing chaos. -- that it not be raised, since raising it can cause confusing chaos.
Zero_Cost_Exceptions : Integer;
pragma Import (C, Zero_Cost_Exceptions, "__gl_zero_cost_exceptions");
-- Boolean indicating if we are handling exceptions using a zero cost
-- mechanism.
--
-- Note that although we currently do not support it, the GCC3 back-end
-- tables are also potentially useable for setjmp/longjmp processing.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
...@@ -409,12 +397,6 @@ package body Ada.Exceptions is ...@@ -409,12 +397,6 @@ package body Ada.Exceptions is
-- The following procedures provide an internal interface to help making -- The following procedures provide an internal interface to help making
-- this explicit. -- this explicit.
procedure Save_Occurrence_And_Private
(Target : out Exception_Occurrence;
Source : Exception_Occurrence);
-- Copy all the components of Source to Target as well as the
-- Private_Data pointer.
procedure Save_Occurrence_No_Private procedure Save_Occurrence_No_Private
(Target : out Exception_Occurrence; (Target : out Exception_Occurrence;
Source : Exception_Occurrence); Source : Exception_Occurrence);
...@@ -783,81 +765,15 @@ package body Ada.Exceptions is ...@@ -783,81 +765,15 @@ package body Ada.Exceptions is
is is
pragma Inspection_Point (E); pragma Inspection_Point (E);
-- This is so the debugger can reliably inspect the parameter -- This is so the debugger can reliably inspect the parameter
Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
Excep : constant EOA := Get_Current_Excep.all;
begin begin
-- WARNING : There should be no exception handler for this body -- WARNING: There should be no exception handler for this body
-- because this would cause gigi to prepend a setup for a new -- because this would cause gigi to prepend a setup for a new
-- jmpbuf to the sequence of statements. We would then always get -- jmpbuf to the sequence of statements in case of built-in sjljl.
-- this new buf in Jumpbuf_Ptr instead of the one for the exception -- We would then always get this new buf in Jumpbuf_Ptr instead of the
-- we are handling, which would completely break the whole design -- one for the exception we are handling, which would completely break
-- of this procedure. -- the whole design of this procedure.
-- Processing varies between zero cost and setjmp/lonjmp processing
if Zero_Cost_Exceptions /= 0 then
-- Use the GCC back-end to propagate the exception. Backtrace
-- computation is performed, if required, by the underlying routine.
-- Notifications for the debugger are also not performed here,
-- because we do not yet know if the exception is handled.
Exception_Propagation.Propagate_Exception (From_Signal_Handler);
else
-- Compute the backtrace for this occurrence if corresponding binder
-- option has been set. Call_Chain takes care of the reraise case.
Call_Chain (Excep);
-- Note on above call to Call_Chain:
-- We used to only do this if From_Signal_Handler was not set,
-- based on the assumption that backtracing from a signal handler
-- would not work due to stack layout oddities. However, since
-- 1. The flag is never set in tasking programs (Notify_Exception
-- performs regular raise statements), and
-- 2. No problem has shown up in tasking programs around here so
-- far, this turned out to be too strong an assumption.
-- As, in addition, the test was
-- 1. preventing the production of backtraces in non-tasking
-- programs, and
-- 2. introducing a behavior inconsistency between
-- the tasking and non-tasking cases,
-- we have simply removed it Exception_Propagation.Propagate_Exception (From_Signal_Handler);
-- If the jump buffer pointer is non-null, transfer control using
-- it. Otherwise announce an unhandled exception (note that this
-- means that we have no finalizations to do other than at the outer
-- level). Perform the necessary notification tasks in both cases.
if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then
Excep.Exception_Raised := True;
Exception_Traces.Notify_Handled_Exception;
end if;
builtin_longjmp (Jumpbuf_Ptr, 1);
else
-- The pragma Inspection point here ensures that the debugger
-- can inspect the parameter.
pragma Inspection_Point (E);
Exception_Traces.Notify_Unhandled_Exception;
Exception_Traces.Unhandled_Exception_Terminate;
end if;
end if;
end Process_Raise_Exception; end Process_Raise_Exception;
---------------------------- ----------------------------
...@@ -892,8 +808,23 @@ package body Ada.Exceptions is ...@@ -892,8 +808,23 @@ package body Ada.Exceptions is
------------------------- -------------------------
procedure Raise_Current_Excep (E : Exception_Id) is procedure Raise_Current_Excep (E : Exception_Id) is
pragma Inspection_Point (E); pragma Inspection_Point (E);
-- This is so the debugger can reliably inspect the parameter -- This is so the debugger can reliably inspect the parameter when
-- inserting a breakpoint at the start of this procedure.
Id : Exception_Id := E;
pragma Volatile (Id);
pragma Warnings (Off, Id);
-- In order to provide support for breakpoints on unhandled exceptions,
-- the debugger will also need to be able to inspect the value of E from
-- another (inner) frame. So we need to make sure that if E is passed in
-- a register, its value is also spilled on stack. For this, we store
-- the parameter value in a local variable, and add a pragma Volatile to
-- make sure it is spilled. The pragma Warnings (Off) is needed because
-- the compiler knows that Id is not referenced and that this use of
-- pragma Volatile is peculiar!
begin begin
Process_Raise_Exception (E => E, From_Signal_Handler => False); Process_Raise_Exception (E => E, From_Signal_Handler => False);
end Raise_Current_Excep; end Raise_Current_Excep;
...@@ -1263,19 +1194,6 @@ package body Ada.Exceptions is ...@@ -1263,19 +1194,6 @@ package body Ada.Exceptions is
end Save_Occurrence; end Save_Occurrence;
-------------------------------- --------------------------------
-- Save_Occurrence_And_Private --
--------------------------------
procedure Save_Occurrence_And_Private
(Target : out Exception_Occurrence;
Source : Exception_Occurrence)
is
begin
Save_Occurrence_No_Private (Target, Source);
Target.Private_Data := Source.Private_Data;
end Save_Occurrence_And_Private;
--------------------------------
-- Save_Occurrence_No_Private -- -- Save_Occurrence_No_Private --
-------------------------------- --------------------------------
......
gcc/ada/a-exexpr-gcc.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- A D A . E X C E P T I O N S . E X C E P T I O N _ P R O P A G A T I O N --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-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- --
-- 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, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, 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. --
-- --
------------------------------------------------------------------------------
-- This is the version using the GCC EH mechanism
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Storage_Elements; use System.Storage_Elements;
separate (Ada.Exceptions)
package body Exception_Propagation is
------------------------------------------------
-- Entities to interface with the GCC runtime --
------------------------------------------------
-- These come from "C++ ABI for Itanium: Exception handling", which is
-- the reference for GCC. They are used only when we are relying on
-- back-end tables for exception propagation, which in turn is currenly
-- only the case for Zero_Cost_Exceptions in GNAT5.
-- Return codes from the GCC runtime functions used to propagate
-- an exception.
type Unwind_Reason_Code is
(URC_NO_REASON,
URC_FOREIGN_EXCEPTION_CAUGHT,
URC_PHASE2_ERROR,
URC_PHASE1_ERROR,
URC_NORMAL_STOP,
URC_END_OF_STACK,
URC_HANDLER_FOUND,
URC_INSTALL_CONTEXT,
URC_CONTINUE_UNWIND);
pragma Unreferenced
(URC_FOREIGN_EXCEPTION_CAUGHT,
URC_PHASE2_ERROR,
URC_PHASE1_ERROR,
URC_NORMAL_STOP,
URC_END_OF_STACK,
URC_HANDLER_FOUND,
URC_INSTALL_CONTEXT,
URC_CONTINUE_UNWIND);
pragma Convention (C, Unwind_Reason_Code);
-- Phase identifiers
type Unwind_Action is
(UA_SEARCH_PHASE,
UA_CLEANUP_PHASE,
UA_HANDLER_FRAME,
UA_FORCE_UNWIND);
for Unwind_Action use
(UA_SEARCH_PHASE => 1,
UA_CLEANUP_PHASE => 2,
UA_HANDLER_FRAME => 4,
UA_FORCE_UNWIND => 8);
pragma Convention (C, Unwind_Action);
-- Mandatory common header for any exception object handled by the
-- GCC unwinding runtime.
type Exception_Class is mod 2 ** 64;
GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
-- "GNU-Ada\0"
type Unwind_Word is mod 2 ** System.Word_Size;
for Unwind_Word'Size use System.Word_Size;
-- Map the corresponding C type used in Unwind_Exception below
type Unwind_Exception is record
Class : Exception_Class := GNAT_Exception_Class;
Cleanup : System.Address := System.Null_Address;
Private1 : Unwind_Word;
Private2 : Unwind_Word;
end record;
-- Map the GCC struct used for exception handling
for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
-- The C++ ABI mandates the common exception header to be at least
-- doubleword aligned, and the libGCC implementation actually makes it
-- maximally aligned (see unwind.h). See additional comments on the
-- alignment below.
--------------------------------------------------------------
-- GNAT Specific Entities To Deal With The GCC EH Circuitry --
--------------------------------------------------------------
-- A GNAT exception object to be dealt with by the personality routine
-- called by the GCC unwinding runtime.
type GNAT_GCC_Exception is record
Header : Unwind_Exception;
-- ABI Exception header first
Id : Exception_Id;
-- GNAT Exception identifier. This is filled by Propagate_Exception
-- and then used by the personality routine to determine if the context
-- it examines contains a handler for the exception beeing propagated.
N_Cleanups_To_Trigger : Integer;
-- Number of cleanup only frames encountered in SEARCH phase. This is
-- initialized to 0 by Propagate_Exception and maintained by the
-- personality routine to control a forced unwinding phase triggering
-- all the cleanups before calling Unhandled_Exception_Terminate when
-- an exception is not handled.
Next_Exception : EOA;
-- Used to create a linked list of exception occurrences
end record;
pragma Convention (C, GNAT_GCC_Exception);
-- There is a subtle issue with the common header alignment, since the C
-- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
-- Standard'Maximum_Alignment, and those two values don't quite represent
-- the same concepts and so may be decoupled someday. One typical reason
-- is that BIGGEST_ALIGNMENT may be larger than what the underlying system
-- allocator guarantees, and there are extra costs involved in allocating
-- objects aligned to such factors.
-- To deal with the potential alignment differences between the C and Ada
-- representations, the Ada part of the whole structure is only accessed
-- by the personality routine through the accessors declared below. Ada
-- specific fields are thus always accessed through consistent layout, and
-- we expect the actual alignment to always be large enough to avoid traps
-- from the C accesses to the common header. Besides, accessors aleviate
-- the need for a C struct whole conterpart, both painful and errorprone
-- to maintain anyway.
type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
function To_GNAT_GCC_Exception is new
Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
procedure Free is new Unchecked_Deallocation
(GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
procedure Free is new Unchecked_Deallocation
(Exception_Occurrence, EOA);
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
UW_Exception : access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code;
-- Hook called at each step of the forced unwinding we perform to
-- trigger cleanups found during the propagation of an unhandled
-- exception.
-- GCC runtime functions used. These are C non-void functions, actually,
-- but we ignore the return values. See raise.c as to why we are using
-- __gnat stubs for these.
procedure Unwind_RaiseException
(UW_Exception : access GNAT_GCC_Exception);
pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
procedure Unwind_ForcedUnwind
(UW_Exception : access GNAT_GCC_Exception;
UW_Handler : System.Address;
UW_Argument : System.Address);
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
------------------------------------------------------------------
-- Occurrence Stack Management Facilities for the GCC-EH Scheme --
------------------------------------------------------------------
function Remove
(Top : EOA;
Excep : GNAT_GCC_Exception_Access) return Boolean;
-- Remove Excep from the stack starting at Top.
-- Return True if Excep was found and removed, false otherwise.
-- Hooks called when entering/leaving an exception handler for a given
-- occurrence, aimed at handling the stack of active occurrences. The
-- calls are generated by gigi in tree_transform/N_Exception_Handler.
procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
pragma Export (C, Begin_Handler, "__gnat_begin_handler");
procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
pragma Export (C, End_Handler, "__gnat_end_handler");
Setup_Key : constant := 16#DEAD#;
-- To handle the case of a task "transferring" an exception occurrence to
-- another task, for instance via Exceptional_Complete_Rendezvous, we need
-- to be able to identify occurrences which have been Setup and not yet
-- Propagated. We hijack one of the common header fields for that purpose,
-- setting it to a special key value during the setup process, clearing it
-- at the very beginning of the propagation phase, and expecting it never
-- to be reset to the special value later on. A 16-bit value is used rather
-- than a 32-bit value for static compatibility with 16-bit targets such as
-- AAMP (where type Unwind_Word will be 16 bits).
function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
procedure Set_Setup_And_Not_Propagated (E : EOA);
procedure Clear_Setup_And_Not_Propagated (E : EOA);
procedure Save_Occurrence_And_Private
(Target : out Exception_Occurrence;
Source : Exception_Occurrence);
-- Copy all the components of Source to Target as well as the
-- Private_Data pointer.
------------------------------------------------------------
-- Accessors to basic components of a GNAT exception data --
------------------------------------------------------------
-- As of today, these are only used by the C implementation of the
-- GCC propagation personality routine to avoid having to rely on a C
-- counterpart of the whole exception_data structure, which is both
-- painful and error prone. These subprograms could be moved to a
-- more widely visible location if need be.
function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
function Language_For (E : Exception_Data_Ptr) return Character;
pragma Export (C, Language_For, "__gnat_language_for");
function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
pragma Export (C, Import_Code_For, "__gnat_import_code_for");
function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
return Exception_Id;
pragma Export (C, EID_For, "__gnat_eid_for");
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer);
pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
---------------------------------------------------------------------------
-- Objects to materialize "others" and "all others" in the GCC EH tables --
---------------------------------------------------------------------------
-- Currently, these only have their address taken and compared so there is
-- no real point having whole exception data blocks allocated. In any case
-- the types should match what gigi and the personality routine expect.
-- The initial value is an arbitrary value that will not exceed the range
-- of Integer on 16-bit targets (such as AAMP).
Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, Others_Value, "__gnat_others_value");
All_Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, All_Others_Value, "__gnat_all_others_value");
------------
-- Remove --
------------
function Remove
(Top : EOA;
Excep : GNAT_GCC_Exception_Access) return Boolean
is
Prev : GNAT_GCC_Exception_Access := null;
Iter : EOA := Top;
GCC_Exception : GNAT_GCC_Exception_Access;
begin
-- Pop stack
loop
pragma Assert (Iter.Private_Data /= System.Null_Address);
GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
if GCC_Exception = Excep then
if Prev = null then
-- Special case for the top of the stack: shift the contents
-- of the next item to the top, since top is at a fixed
-- location and can't be changed.
Iter := GCC_Exception.Next_Exception;
if Iter = null then
-- Stack is now empty
Top.Private_Data := System.Null_Address;
else
Save_Occurrence_And_Private (Top.all, Iter.all);
Free (Iter);
end if;
else
Prev.Next_Exception := GCC_Exception.Next_Exception;
Free (Iter);
end if;
Free (GCC_Exception);
return True;
end if;
exit when GCC_Exception.Next_Exception = null;
Prev := GCC_Exception;
Iter := GCC_Exception.Next_Exception;
end loop;
return False;
end Remove;
---------------------------
-- CleanupUnwind_Handler --
---------------------------
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
UW_Exception : access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code
is
pragma Unreferenced
(UW_Version, UW_Phases, UW_Eclass, UW_Context, UW_Argument);
begin
-- Terminate as soon as we know there is nothing more to run. The
-- count is maintained by the personality routine.
if UW_Exception.N_Cleanups_To_Trigger = 0 then
Unhandled_Exception_Terminate;
end if;
-- We know there is at least one cleanup further up. Return so that it
-- is searched and entered, after which Unwind_Resume will be called
-- and this hook will gain control (with an updated count) again.
return URC_NO_REASON;
end CleanupUnwind_Handler;
---------------------------------
-- Is_Setup_And_Not_Propagated --
---------------------------------
function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
GCC_E : constant GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
end Is_Setup_And_Not_Propagated;
------------------------------------
-- Clear_Setup_And_Not_Propagated --
------------------------------------
procedure Clear_Setup_And_Not_Propagated (E : EOA) is
GCC_E : constant GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
pragma Assert (GCC_E /= null);
GCC_E.Header.Private1 := 0;
end Clear_Setup_And_Not_Propagated;
----------------------------------
-- Set_Setup_And_Not_Propagated --
----------------------------------
procedure Set_Setup_And_Not_Propagated (E : EOA) is
GCC_E : constant GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
pragma Assert (GCC_E /= null);
GCC_E.Header.Private1 := Setup_Key;
end Set_Setup_And_Not_Propagated;
--------------------------------
-- Save_Occurrence_And_Private --
--------------------------------
procedure Save_Occurrence_And_Private
(Target : out Exception_Occurrence;
Source : Exception_Occurrence)
is
begin
Save_Occurrence_No_Private (Target, Source);
Target.Private_Data := Source.Private_Data;
end Save_Occurrence_And_Private;
---------------------
-- Setup_Exception --
---------------------
-- In the GCC-EH implementation of the propagation scheme, this
-- subprogram should be understood as: Setup the exception occurrence
-- stack headed at Current for a forthcoming raise of Excep.
procedure Setup_Exception
(Excep : EOA;
Current : EOA;
Reraised : Boolean := False)
is
Top : constant EOA := Current;
Next : EOA;
GCC_Exception : GNAT_GCC_Exception_Access;
begin
-- The exception Excep is soon to be propagated, and the
-- storage used for that will be the occurrence statically allocated
-- for the current thread. This storage might currently be used for a
-- still active occurrence, so we need to push it on the thread's
-- occurrence stack (headed at that static occurrence) before it gets
-- clobbered.
-- What we do here is to trigger this push when need be, and allocate a
-- Private_Data block for the forthcoming Propagation.
-- Some tasking rendez-vous attempts lead to an occurrence transfer
-- from the server to the client (see Exceptional_Complete_Rendezvous).
-- In those cases Setup is called twice for the very same occurrence
-- before it gets propagated: once from the server, because this is
-- where the occurrence contents is elaborated and known, and then
-- once from the client when it detects the case and actually raises
-- the exception in its own context.
-- The Is_Setup_And_Not_Propagated predicate tells us when we are in
-- the second call to Setup for a Transferred occurrence, and there is
-- nothing to be done here in this situation. This predicate cannot be
-- True if we are dealing with a Reraise, and we may even be called
-- with a raw uninitialized Excep occurrence in this case so we should
-- not check anyway. Observe the front-end expansion for a "raise;" to
-- see that happening. We get a local occurrence and a direct call to
-- Save_Occurrence without the intermediate init-proc call.
if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
return;
end if;
-- Allocate what will be the Private_Data block for the exception
-- to be propagated.
GCC_Exception := new GNAT_GCC_Exception;
-- If the Top of the occurrence stack is not currently used for an
-- active exception (the stack is empty) we just need to setup the
-- Private_Data pointer.
-- Otherwise, we also need to shift the contents of the Top of the
-- stack in a freshly allocated entry and link everything together.
if Top.Private_Data /= System.Null_Address then
Next := new Exception_Occurrence;
Save_Occurrence_And_Private (Next.all, Top.all);
GCC_Exception.Next_Exception := Next;
Top.Private_Data := GCC_Exception.all'Address;
end if;
Top.Private_Data := GCC_Exception.all'Address;
Set_Setup_And_Not_Propagated (Top);
end Setup_Exception;
-------------------
-- Begin_Handler --
-------------------
procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
pragma Unreferenced (GCC_Exception);
begin
-- Every necessary operation related to the occurrence stack has
-- already been performed by Propagate_Exception. This hook remains for
-- potential future necessity in optimizing the overall scheme, as well
-- a useful debugging tool.
null;
end Begin_Handler;
-----------------
-- End_Handler --
-----------------
procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
Removed : Boolean;
begin
Removed := Remove (Get_Current_Excep.all, GCC_Exception);
pragma Assert (Removed);
end End_Handler;
-------------------------
-- Propagate_Exception --
-------------------------
-- Build an object suitable for the libgcc processing and call
-- Unwind_RaiseException to actually throw, taking care of handling
-- the two phase scheme it implements.
procedure Propagate_Exception (From_Signal_Handler : Boolean) is
pragma Unreferenced (From_Signal_Handler);
Excep : constant EOA := Get_Current_Excep.all;
GCC_Exception : GNAT_GCC_Exception_Access;
begin
pragma Assert (Excep.Private_Data /= System.Null_Address);
-- Retrieve the Private_Data for this occurrence and set the useful
-- flags for the personality routine, which will be called for each
-- frame via Unwind_RaiseException below.
GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
Clear_Setup_And_Not_Propagated (Excep);
GCC_Exception.Id := Excep.Id;
GCC_Exception.N_Cleanups_To_Trigger := 0;
-- Compute the backtrace for this occurrence if the corresponding
-- binder option has been set. Call_Chain takes care of the reraise
-- case.
-- ??? Using Call_Chain here means we are going to walk up the stack
-- once only for backtracing purposes before doing it again for the
-- propagation per se.
-- The first inspection is much lighter, though, as it only requires
-- partial unwinding of each frame. Additionally, although we could use
-- the personality routine to record the addresses while propagating,
-- this method has two drawbacks:
-- 1) the trace is incomplete if the exception is handled since we
-- don't walk past the frame with the handler,
-- and
-- 2) we would miss the frames for which our personality routine is not
-- called, e.g. if C or C++ calls are on the way.
Call_Chain (Excep);
-- Perform a standard raise first. If a regular handler is found, it
-- will be entered after all the intermediate cleanups have run. If
-- there is no regular handler, control will get back to after the
-- call, with N_Cleanups_To_Trigger set to the number of frames with
-- cleanups found on the way up, and none of these already run.
Unwind_RaiseException (GCC_Exception);
-- If we get here we know the exception is not handled, as otherwise
-- Unwind_RaiseException arranges for the handler to be entered. Take
-- the necessary steps to enable the debugger to gain control while the
-- stack is still intact.
Notify_Unhandled_Exception;
-- Now, if cleanups have been found, run a forced unwind to trigger
-- them. Control should not resume there, as the unwinding hook calls
-- Unhandled_Exception_Terminate as soon as the last cleanup has been
-- triggered.
if GCC_Exception.N_Cleanups_To_Trigger /= 0 then
Unwind_ForcedUnwind (GCC_Exception,
CleanupUnwind_Handler'Address,
System.Null_Address);
end if;
-- We get here when there is no handler or cleanup to be run at all.
-- The debugger has been notified before the second step above.
Unhandled_Exception_Terminate;
end Propagate_Exception;
---------------------------
-- Adjust_N_Cleanups_For --
---------------------------
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer)
is
begin
GNAT_Exception.N_Cleanups_To_Trigger :=
GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
end Adjust_N_Cleanups_For;
-------------
-- EID_For --
-------------
function EID_For
(GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
is
begin
return GNAT_Exception.Id;
end EID_For;
---------------------
-- Import_Code_For --
---------------------
function Import_Code_For
(E : SSL.Exception_Data_Ptr) return Exception_Code
is
begin
return E.all.Import_Code;
end Import_Code_For;
--------------------------
-- Is_Handled_By_Others --
--------------------------
function Is_Handled_By_Others (E : SSL.Exception_Data_Ptr) return Boolean is
begin
return not E.all.Not_Handled_By_Others;
end Is_Handled_By_Others;
------------------
-- Language_For --
------------------
function Language_For (E : SSL.Exception_Data_Ptr) return Character is
begin
return E.all.Lang;
end Language_For;
-----------
-- Notes --
-----------
-- The current model implemented for the stack of occurrences is a
-- simplification of previous attempts, which all prooved to be flawed or
-- would have needed significant additional circuitry to be made to work
-- correctly.
-- We now represent every propagation by a new entry on the stack, which
-- means that an exception occurrence may appear more than once (e.g. when
-- it is reraised during the course of its own handler).
-- This may seem overcostly compared to the C++ model as implemented in
-- the g++ v3 libstd. This is actually understandable when one considers
-- the extra variations of possible run-time configurations induced by the
-- freedom offered by the Save_Occurrence/Reraise_Occurrence public
-- interface.
-- The basic point is that arranging for an occurrence to always appear at
-- most once on the stack requires a way to determine if a given occurence
-- is already there, which is not as easy as it might seem.
-- An attempt was made to use the Private_Data pointer for this purpose.
-- It did not work because:
-- 1) The Private_Data has to be saved by Save_Occurrence to be usable
-- as a key in case of a later reraise,
-- 2) There is no easy way to synchronize End_Handler for an occurrence
-- and the data attached to potential copies, so these copies may end
-- up pointing to stale data. Moreover ...
-- 3) The same address may be reused for different occurrences, which
-- defeats the idea of using it as a key.
-- The example below illustrates:
-- Saved_CE : Exception_Occurrence;
-- begin
-- raise Constraint_Error;
-- exception
-- when CE: others =>
-- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
-- end;
-- <= Saved_CE.PDA is stale (!)
-- begin
-- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
-- exception
-- when others =>
-- Reraise_Occurrence (Saved_CE);
-- end;
-- Not releasing the Private_Data via End_Handler could be an option,
-- but making this to work while still avoiding memory leaks is far
-- from trivial.
-- The current scheme has the advantage of beeing simple, and induces
-- extra costs only in reraise cases which is acceptable.
end Exception_Propagation;
gcc/ada/a-exexpr.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- -- Copyright (C) 1992-2005 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- --
...@@ -31,10 +31,8 @@ ...@@ -31,10 +31,8 @@
-- -- -- --
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Interfaces; -- This is the default version, using the __builtin_setjmp/longjmp EH
-- mechanism.
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Storage_Elements; use System.Storage_Elements; with System.Storage_Elements; use System.Storage_Elements;
...@@ -45,681 +43,80 @@ pragma Warnings (Off); ...@@ -45,681 +43,80 @@ pragma Warnings (Off);
separate (Ada.Exceptions) separate (Ada.Exceptions)
package body Exception_Propagation is package body Exception_Propagation is
------------------------------------------------ procedure builtin_longjmp (buffer : Address; Flag : Integer);
-- Entities to interface with the GCC runtime -- pragma No_Return (builtin_longjmp);
------------------------------------------------ pragma Import (C, builtin_longjmp, "_gnat_builtin_longjmp");
-- These come from "C++ ABI for Itanium: Exception handling", which is
-- the reference for GCC. They are used only when we are relying on
-- back-end tables for exception propagation, which in turn is currenly
-- only the case for Zero_Cost_Exceptions in GNAT5.
-- Return codes from the GCC runtime functions used to propagate
-- an exception.
type Unwind_Reason_Code is
(URC_NO_REASON,
URC_FOREIGN_EXCEPTION_CAUGHT,
URC_PHASE2_ERROR,
URC_PHASE1_ERROR,
URC_NORMAL_STOP,
URC_END_OF_STACK,
URC_HANDLER_FOUND,
URC_INSTALL_CONTEXT,
URC_CONTINUE_UNWIND);
pragma Unreferenced
(URC_FOREIGN_EXCEPTION_CAUGHT,
URC_PHASE2_ERROR,
URC_PHASE1_ERROR,
URC_NORMAL_STOP,
URC_END_OF_STACK,
URC_HANDLER_FOUND,
URC_INSTALL_CONTEXT,
URC_CONTINUE_UNWIND);
pragma Convention (C, Unwind_Reason_Code);
-- Phase identifiers
type Unwind_Action is
(UA_SEARCH_PHASE,
UA_CLEANUP_PHASE,
UA_HANDLER_FRAME,
UA_FORCE_UNWIND);
for Unwind_Action use
(UA_SEARCH_PHASE => 1,
UA_CLEANUP_PHASE => 2,
UA_HANDLER_FRAME => 4,
UA_FORCE_UNWIND => 8);
pragma Convention (C, Unwind_Action);
-- Mandatory common header for any exception object handled by the
-- GCC unwinding runtime.
subtype Exception_Class is Interfaces.Unsigned_64;
GNAT_Exception_Class : constant Exception_Class := 16#474e552d41646100#;
-- "GNU-Ada\0"
type Unwind_Word is mod 2 ** System.Word_Size;
for Unwind_Word'Size use System.Word_Size;
-- Map the corresponding C type used in Unwind_Exception below
type Unwind_Exception is record
Class : Exception_Class := GNAT_Exception_Class;
Cleanup : System.Address := System.Null_Address;
Private1 : Unwind_Word;
Private2 : Unwind_Word;
end record;
-- Map the GCC struct used for exception handling
for Unwind_Exception'Alignment use Standard'Maximum_Alignment;
-- The C++ ABI mandates the common exception header to be at least
-- doubleword aligned, and the libGCC implementation actually makes it
-- maximally aligned (see unwind.h). See additional comments on the
-- alignment below.
--------------------------------------------------------------
-- GNAT Specific Entities To Deal With The GCC EH Circuitry --
--------------------------------------------------------------
-- A GNAT exception object to be dealt with by the personality routine
-- called by the GCC unwinding runtime.
type GNAT_GCC_Exception is record
Header : Unwind_Exception;
-- ABI Exception header first
Id : Exception_Id;
-- GNAT Exception identifier. This is filled by Propagate_Exception
-- and then used by the personality routine to determine if the context
-- it examines contains a handler for the exception beeing propagated.
N_Cleanups_To_Trigger : Integer;
-- Number of cleanup only frames encountered in SEARCH phase. This is
-- initialized to 0 by Propagate_Exception and maintained by the
-- personality routine to control a forced unwinding phase triggering
-- all the cleanups before calling Unhandled_Exception_Terminate when
-- an exception is not handled.
Next_Exception : EOA;
-- Used to create a linked list of exception occurrences
end record;
pragma Convention (C, GNAT_GCC_Exception);
-- There is a subtle issue with the common header alignment, since the C
-- version is aligned on BIGGEST_ALIGNMENT, the Ada version is aligned on
-- Standard'Maximum_Alignment, and those two values don't quite represent
-- the same concepts and so may be decoupled someday. One typical reason
-- is that BIGGEST_ALIGNMENT may be larger than what the underlying system
-- allocator guarantees, and there are extra costs involved in allocating
-- objects aligned to such factors.
-- To deal with the potential alignment differences between the C and Ada
-- representations, the Ada part of the whole structure is only accessed
-- by the personality routine through the accessors declared below. Ada
-- specific fields are thus always accessed through consistent layout, and
-- we expect the actual alignment to always be large enough to avoid traps
-- from the C accesses to the common header. Besides, accessors aleviate
-- the need for a C struct whole conterpart, both painful and errorprone
-- to maintain anyway.
type GNAT_GCC_Exception_Access is access all GNAT_GCC_Exception;
function To_GNAT_GCC_Exception is new
Unchecked_Conversion (System.Address, GNAT_GCC_Exception_Access);
procedure Free is new Unchecked_Deallocation
(GNAT_GCC_Exception, GNAT_GCC_Exception_Access);
procedure Free is new Unchecked_Deallocation
(Exception_Occurrence, EOA);
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
UW_Exception : access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code;
-- Hook called at each step of the forced unwinding we perform to
-- trigger cleanups found during the propagation of an unhandled
-- exception.
-- GCC runtime functions used. These are C non-void functions, actually,
-- but we ignore the return values. See raise.c as to why we are using
-- __gnat stubs for these.
procedure Unwind_RaiseException
(UW_Exception : access GNAT_GCC_Exception);
pragma Import (C, Unwind_RaiseException, "__gnat_Unwind_RaiseException");
procedure Unwind_ForcedUnwind
(UW_Exception : access GNAT_GCC_Exception;
UW_Handler : System.Address;
UW_Argument : System.Address);
pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind");
------------------------------------------------------------------
-- Occurrence Stack Management Facilities for the GCC-EH Scheme --
------------------------------------------------------------------
function Remove
(Top : EOA;
Excep : GNAT_GCC_Exception_Access) return Boolean;
-- Remove Excep from the stack starting at Top.
-- Return True if Excep was found and removed, false otherwise.
-- Hooks called when entering/leaving an exception handler for a given
-- occurrence, aimed at handling the stack of active occurrences. The
-- calls are generated by gigi in tree_transform/N_Exception_Handler.
procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
pragma Export (C, Begin_Handler, "__gnat_begin_handler");
procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access);
pragma Export (C, End_Handler, "__gnat_end_handler");
Setup_Key : constant := 16#DEAD#;
-- To handle the case of a task "transferring" an exception occurrence to
-- another task, for instance via Exceptional_Complete_Rendezvous, we need
-- to be able to identify occurrences which have been Setup and not yet
-- Propagated. We hijack one of the common header fields for that purpose,
-- setting it to a special key value during the setup process, clearing it
-- at the very beginning of the propagation phase, and expecting it never
-- to be reset to the special value later on. A 16-bit value is used rather
-- than a 32-bit value for static compatibility with 16-bit targets such as
-- AAMP (where type Unwind_Word will be 16 bits).
function Is_Setup_And_Not_Propagated (E : EOA) return Boolean;
procedure Set_Setup_And_Not_Propagated (E : EOA);
procedure Clear_Setup_And_Not_Propagated (E : EOA);
------------------------------------------------------------
-- Accessors to basic components of a GNAT exception data --
------------------------------------------------------------
-- As of today, these are only used by the C implementation of the
-- GCC propagation personality routine to avoid having to rely on a C
-- counterpart of the whole exception_data structure, which is both
-- painful and error prone. These subprograms could be moved to a
-- more widely visible location if need be.
function Is_Handled_By_Others (E : Exception_Data_Ptr) return Boolean;
pragma Export (C, Is_Handled_By_Others, "__gnat_is_handled_by_others");
function Language_For (E : Exception_Data_Ptr) return Character;
pragma Export (C, Language_For, "__gnat_language_for");
function Import_Code_For (E : Exception_Data_Ptr) return Exception_Code;
pragma Export (C, Import_Code_For, "__gnat_import_code_for");
function EID_For (GNAT_Exception : GNAT_GCC_Exception_Access)
return Exception_Id;
pragma Export (C, EID_For, "__gnat_eid_for");
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer);
pragma Export (C, Adjust_N_Cleanups_For, "__gnat_adjust_n_cleanups_for");
---------------------------------------------------------------------------
-- Objects to materialize "others" and "all others" in the GCC EH tables --
---------------------------------------------------------------------------
-- Currently, these only have their address taken and compared so there is
-- no real point having whole exception data blocks allocated. In any case
-- the types should match what gigi and the personality routine expect.
-- The initial value is an arbitrary value that will not exceed the range
-- of Integer on 16-bit targets (such as AAMP).
Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, Others_Value, "__gnat_others_value");
All_Others_Value : constant Integer := 16#7FFF#;
pragma Export (C, All_Others_Value, "__gnat_all_others_value");
------------
-- Remove --
------------
function Remove
(Top : EOA;
Excep : GNAT_GCC_Exception_Access) return Boolean
is
Prev : GNAT_GCC_Exception_Access := null;
Iter : EOA := Top;
GCC_Exception : GNAT_GCC_Exception_Access;
begin
-- Pop stack
loop
pragma Assert (Iter.Private_Data /= System.Null_Address);
GCC_Exception := To_GNAT_GCC_Exception (Iter.Private_Data);
if GCC_Exception = Excep then
if Prev = null then
-- Special case for the top of the stack: shift the contents
-- of the next item to the top, since top is at a fixed
-- location and can't be changed.
Iter := GCC_Exception.Next_Exception;
if Iter = null then
-- Stack is now empty
Top.Private_Data := System.Null_Address;
else
Save_Occurrence_And_Private (Top.all, Iter.all);
Free (Iter);
end if;
else
Prev.Next_Exception := GCC_Exception.Next_Exception;
Free (Iter);
end if;
Free (GCC_Exception);
return True;
end if;
exit when GCC_Exception.Next_Exception = null;
Prev := GCC_Exception;
Iter := GCC_Exception.Next_Exception;
end loop;
return False;
end Remove;
---------------------------
-- CleanupUnwind_Handler --
---------------------------
function CleanupUnwind_Handler
(UW_Version : Integer;
UW_Phases : Unwind_Action;
UW_Eclass : Exception_Class;
UW_Exception : access GNAT_GCC_Exception;
UW_Context : System.Address;
UW_Argument : System.Address) return Unwind_Reason_Code
is
begin
-- Terminate as soon as we know there is nothing more to run. The
-- count is maintained by the personality routine.
if UW_Exception.N_Cleanups_To_Trigger = 0 then
Unhandled_Exception_Terminate;
end if;
-- We know there is at least one cleanup further up. Return so that it
-- is searched and entered, after which Unwind_Resume will be called
-- and this hook will gain control (with an updated count) again.
return URC_NO_REASON;
end CleanupUnwind_Handler;
---------------------------------
-- Is_Setup_And_Not_Propagated --
---------------------------------
function Is_Setup_And_Not_Propagated (E : EOA) return Boolean is
GCC_E : GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
return GCC_E /= null and then GCC_E.Header.Private1 = Setup_Key;
end Is_Setup_And_Not_Propagated;
------------------------------------
-- Clear_Setup_And_Not_Propagated --
------------------------------------
procedure Clear_Setup_And_Not_Propagated (E : EOA) is
GCC_E : GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
pragma Assert (GCC_E /= null);
GCC_E.Header.Private1 := 0;
end Clear_Setup_And_Not_Propagated;
----------------------------------
-- Set_Setup_And_Not_Propagated --
----------------------------------
procedure Set_Setup_And_Not_Propagated (E : EOA) is
GCC_E : GNAT_GCC_Exception_Access :=
To_GNAT_GCC_Exception (E.Private_Data);
begin
pragma Assert (GCC_E /= null);
GCC_E.Header.Private1 := Setup_Key;
end Set_Setup_And_Not_Propagated;
--------------------- ---------------------
-- Setup_Exception -- -- Setup_Exception --
--------------------- ---------------------
-- In the GCC-EH implementation of the propagation scheme, this
-- subprogram should be understood as : Setup the exception occurrence
-- stack headed at Current for a forthcoming raise of Excep.
-- In the GNAT-SJLJ case this "stack" only exists implicitely, by way of
-- local occurrence declarations together with save/restore operations
-- generated by the front-end, and this routine has nothing to do.
-- The differenciation is done here and not in the callers to avoid having
-- to spread out the test in numerous places.
procedure Setup_Exception procedure Setup_Exception
(Excep : EOA; (Excep : EOA;
Current : EOA; Current : EOA;
Reraised : Boolean := False) Reraised : Boolean := False)
is is
Top : constant EOA := Current; pragma Unreferenced (Excep, Current, Reraised);
Next : EOA;
GCC_Exception : GNAT_GCC_Exception_Access;
begin
-- Just return if we're not in the GCC-EH case. What is otherwise
-- performed is useless and even harmful since it potentially involves
-- dynamic allocations that would never be released, and participates
-- in the Setup_And_Not_Propagated predicate management, only properly
-- handled by the rest of the GCC-EH scheme.
if Zero_Cost_Exceptions = 0 then
return;
end if;
-- Otherwise, the exception Excep is soon to be propagated, and the
-- storage used for that will be the occurrence statically allocated
-- for the current thread. This storage might currently be used for a
-- still active occurrence, so we need to push it on the thread's
-- occurrence stack (headed at that static occurrence) before it gets
-- clobbered.
-- What we do here is to trigger this push when need be, and allocate a
-- Private_Data block for the forthcoming Propagation.
-- Some tasking rendez-vous attempts lead to an occurrence transfer
-- from the server to the client (see Exceptional_Complete_Rendezvous).
-- In those cases Setup is called twice for the very same occurrence
-- before it gets propagated: once from the server, because this is
-- where the occurrence contents is elaborated and known, and then
-- once from the client when it detects the case and actually raises
-- the exception in its own context.
-- The Is_Setup_And_Not_Propagated predicate tells us when we are in
-- the second call to Setup for a Transferred occurrence, and there is
-- nothing to be done here in this situation. This predicate cannot be
-- True if we are dealing with a Reraise, and we may even be called
-- with a raw uninitialized Excep occurrence in this case so we should
-- not check anyway. Observe the front-end expansion for a "raise;" to
-- see that happening. We get a local occurrence and a direct call to
-- Save_Occurrence without the intermediate init-proc call.
if not Reraised and then Is_Setup_And_Not_Propagated (Excep) then
return;
end if;
-- Allocate what will be the Private_Data block for the exception
-- to be propagated.
GCC_Exception := new GNAT_GCC_Exception;
-- If the Top of the occurrence stack is not currently used for an
-- active exception (the stack is empty) we just need to setup the
-- Private_Data pointer.
-- Otherwise, we also need to shift the contents of the Top of the
-- stack in a freshly allocated entry and link everything together.
if Top.Private_Data /= System.Null_Address then
Next := new Exception_Occurrence;
Save_Occurrence_And_Private (Next.all, Top.all);
GCC_Exception.Next_Exception := Next;
Top.Private_Data := GCC_Exception.all'Address;
end if;
Top.Private_Data := GCC_Exception.all'Address;
Set_Setup_And_Not_Propagated (Top);
end Setup_Exception;
-------------------
-- Begin_Handler --
-------------------
procedure Begin_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
begin begin
-- Every necessary operation related to the occurrence stack has -- In the GNAT-SJLJ case this "stack" only exists implicitely, by way of
-- already been performed by Propagate_Exception. This hook remains for -- local occurrence declarations together with save/restore operations
-- potential future necessity in optimizing the overall scheme, as well -- generated by the front-end, and this routine has nothing to do.
-- a useful debugging tool.
null; null;
end Begin_Handler; end Setup_Exception;
-----------------
-- End_Handler --
-----------------
procedure End_Handler (GCC_Exception : GNAT_GCC_Exception_Access) is
Removed : Boolean;
begin
Removed := Remove (Get_Current_Excep.all, GCC_Exception);
pragma Assert (Removed);
end End_Handler;
------------------------- -------------------------
-- Propagate_Exception -- -- Propagate_Exception --
------------------------- -------------------------
-- Build an object suitable for the libgcc processing and call
-- Unwind_RaiseException to actually throw, taking care of handling
-- the two phase scheme it implements.
procedure Propagate_Exception (From_Signal_Handler : Boolean) is procedure Propagate_Exception (From_Signal_Handler : Boolean) is
Excep : EOA := Get_Current_Excep.all; Jumpbuf_Ptr : constant Address := Get_Jmpbuf_Address.all;
GCC_Exception : GNAT_GCC_Exception_Access; Excep : constant EOA := Get_Current_Excep.all;
begin begin
pragma Assert (Excep.Private_Data /= System.Null_Address); -- Compute the backtrace for this occurrence if corresponding binder
-- option has been set. Call_Chain takes care of the reraise case.
-- Retrieve the Private_Data for this occurrence and set the useful Call_Chain (Excep);
-- flags for the personality routine, which will be called for each
-- frame via Unwind_RaiseException below.
GCC_Exception := To_GNAT_GCC_Exception (Excep.Private_Data);
Clear_Setup_And_Not_Propagated (Excep);
GCC_Exception.Id := Excep.Id;
GCC_Exception.N_Cleanups_To_Trigger := 0;
-- Compute the backtrace for this occurrence if the corresponding
-- binder option has been set. Call_Chain takes care of the reraise
-- case.
-- ??? Using Call_Chain here means we are going to walk up the stack -- Note on above call to Call_Chain:
-- once only for backtracing purposes before doing it again for the
-- propagation per se.
-- The first inspection is much lighter, though, as it only requires -- We used to only do this if From_Signal_Handler was not set,
-- partial unwinding of each frame. Additionally, although we could use -- based on the assumption that backtracing from a signal handler
-- the personality routine to record the addresses while propagating, -- would not work due to stack layout oddities. However, since
-- this method has two drawbacks:
-- 1) the trace is incomplete if the exception is handled since we -- 1. The flag is never set in tasking programs (Notify_Exception
-- don't walk past the frame with the handler, -- performs regular raise statements), and
-- and -- 2. No problem has shown up in tasking programs around here so
-- far, this turned out to be too strong an assumption.
-- 2) we would miss the frames for which our personality routine is not -- As, in addition, the test was
-- called, e.g. if C or C++ calls are on the way.
Call_Chain (Excep); -- 1. preventing the production of backtraces in non-tasking
-- programs, and
-- Perform a standard raise first. If a regular handler is found, it -- 2. introducing a behavior inconsistency between
-- will be entered after all the intermediate cleanups have run. If -- the tasking and non-tasking cases,
-- there is no regular handler, control will get back to after the
-- call, with N_Cleanups_To_Trigger set to the number of frames with
-- cleanups found on the way up, and none of these already run.
Unwind_RaiseException (GCC_Exception); -- we have simply removed it
-- If we get here we know the exception is not handled, as otherwise -- If the jump buffer pointer is non-null, transfer control using
-- Unwind_RaiseException arranges for the handler to be entered. Take -- it. Otherwise announce an unhandled exception (note that this
-- the necessary steps to enable the debugger to gain control while the -- means that we have no finalizations to do other than at the outer
-- stack is still intact. -- level). Perform the necessary notification tasks in both cases.
Notify_Unhandled_Exception; if Jumpbuf_Ptr /= Null_Address then
if not Excep.Exception_Raised then
Excep.Exception_Raised := True;
Exception_Traces.Notify_Handled_Exception;
end if;
-- Now, if cleanups have been found, run a forced unwind to trigger builtin_longjmp (Jumpbuf_Ptr, 1);
-- them. Control should not resume there, as the unwinding hook calls
-- Unhandled_Exception_Terminate as soon as the last cleanup has been
-- triggered.
if GCC_Exception.N_Cleanups_To_Trigger /= 0 then else
Unwind_ForcedUnwind (GCC_Exception, Exception_Traces.Notify_Unhandled_Exception;
CleanupUnwind_Handler'Address, Exception_Traces.Unhandled_Exception_Terminate;
System.Null_Address);
end if; end if;
-- We get here when there is no handler or cleanup to be run at
-- all. The debugger has been notified before the second step above.
Unhandled_Exception_Terminate;
end Propagate_Exception; end Propagate_Exception;
---------------------------
-- Adjust_N_Cleanups_For --
---------------------------
procedure Adjust_N_Cleanups_For
(GNAT_Exception : GNAT_GCC_Exception_Access;
Adjustment : Integer)
is
begin
GNAT_Exception.N_Cleanups_To_Trigger :=
GNAT_Exception.N_Cleanups_To_Trigger + Adjustment;
end Adjust_N_Cleanups_For;
-------------
-- EID_For --
-------------
function EID_For
(GNAT_Exception : GNAT_GCC_Exception_Access) return Exception_Id
is
begin
return GNAT_Exception.Id;
end EID_For;
---------------------
-- Import_Code_For --
---------------------
function Import_Code_For
(E : SSL.Exception_Data_Ptr) return Exception_Code
is
begin
return E.all.Import_Code;
end Import_Code_For;
--------------------------
-- Is_Handled_By_Others --
--------------------------
function Is_Handled_By_Others
(E : SSL.Exception_Data_Ptr) return Boolean
is
begin
return not E.all.Not_Handled_By_Others;
end Is_Handled_By_Others;
------------------
-- Language_For --
------------------
function Language_For
(E : SSL.Exception_Data_Ptr) return Character
is
begin
return E.all.Lang;
end Language_For;
-----------
-- Notes --
-----------
-- The current model implemented for the stack of occurrences is a
-- simplification of previous attempts, which all prooved to be flawed or
-- would have needed significant additional circuitry to be made to work
-- correctly.
-- We now represent every propagation by a new entry on the stack, which
-- means that an exception occurrence may appear more than once (e.g. when
-- it is reraised during the course of its own handler).
-- This may seem overcostly compared to the C++ model as implemented in
-- the g++ v3 libstd. This is actually understandable when one considers
-- the extra variations of possible run-time configurations induced by the
-- freedom offered by the Save_Occurrence/Reraise_Occurrence public
-- interface.
-- The basic point is that arranging for an occurrence to always appear at
-- most once on the stack requires a way to determine if a given occurence
-- is already there, which is not as easy as it might seem.
-- An attempt was made to use the Private_Data pointer for this purpose.
-- It did not work because:
-- 1) The Private_Data has to be saved by Save_Occurrence to be usable
-- as a key in case of a later reraise,
-- 2) There is no easy way to synchronize End_Handler for an occurrence
-- and the data attached to potential copies, so these copies may end
-- up pointing to stale data. Moreover ...
-- 3) The same address may be reused for different occurrences, which
-- defeats the idea of using it as a key.
-- The example below illustrates:
-- Saved_CE : Exception_Occurrence;
-- begin
-- raise Constraint_Error;
-- exception
-- when CE: others =>
-- Save_Occurrence (Saved_CE, CE); <= Saved_CE.PDA = CE.PDA
-- end;
-- <= Saved_CE.PDA is stale (!)
-- begin
-- raise Program_Error; <= Saved_CE.PDA = PE.PDA (!!)
-- exception
-- when others =>
-- Reraise_Occurrence (Saved_CE);
-- end;
-- Not releasing the Private_Data via End_Handler could be an option,
-- but making this to work while still avoiding memory leaks is far
-- from trivial.
-- The current scheme has the advantage of beeing simple, and induces
-- extra costs only in reraise cases which is acceptable.
end Exception_Propagation; end Exception_Propagation;
gcc/ada/raise-gcc.c 0 → 100644
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* R A I S E - G C C *
* *
* C Implementation File *
* *
* Copyright (C) 1992-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- *
* 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, 51 Franklin Street, Fifth Floor, *
* Boston, MA 02110-1301, USA. *
* *
* As a special exception, if you link this file with other files to *
* produce an executable, this file does not by itself cause the resulting *
* executable to be covered by the GNU General Public License. This except- *
* ion 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. *
* *
****************************************************************************/
/* Code related to the integration of the GCC mechanism for exception
handling. */
#ifdef IN_RTS
#include "tconfig.h"
/* In the top-of-tree GCC, tconfig does not include tm.h, but in GCC 3.2
it does. To avoid branching raise.c just for that purpose, we kludge by
looking for a symbol always defined by tm.h and if it's not defined,
we include it. */
#ifndef FIRST_PSEUDO_REGISTER
#include "coretypes.h"
#include "tm.h"
#endif
#include "tsystem.h"
#include <sys/stat.h>
typedef char bool;
# define true 1
# define false 0
#else
#include "config.h"
#include "system.h"
#endif
#include "adaint.h"
#include "raise.h"
/* The names of a couple of "standard" routines for unwinding/propagation
actually vary depending on the underlying GCC scheme for exception handling
(SJLJ or DWARF). We need a consistently named interface to import from
a-except, so wrappers are defined here.
Besides, eventhough the compiler is never setup to use the GCC propagation
circuitry, it still relies on exceptions internally and part of the sources
to handle to exceptions are shared with the run-time library. We need
dummy definitions for the wrappers to satisfy the linker in this case.
The types to be used by those wrappers in the run-time library are target
types exported by unwind.h. We used to piggyback on them for the compiler
stubs, but there is no guarantee that unwind.h is always in sight so we
define our own set below. These are dummy types as the wrappers are never
called in the compiler case. */
#ifdef IN_RTS
#include "unwind.h"
typedef struct _Unwind_Context _Unwind_Context;
typedef struct _Unwind_Exception _Unwind_Exception;
#else
typedef void _Unwind_Context;
typedef void _Unwind_Exception;
typedef int _Unwind_Reason_Code;
#endif
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *);
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
#ifdef IN_RTS /* For eh personality routine */
#include "dwarf2.h"
#include "unwind-dw2-fde.h"
#include "unwind-pe.h"
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
#define DB_PHASES 0x1
#define DB_CSITE 0x2
#define DB_ACTIONS 0x4
#define DB_REGIONS 0x8
#define DB_ERR 0x1000
/* The "action" stuff below is also there for debugging purposes only. */
typedef struct
{
_Unwind_Action phase;
char * description;
} phase_descriptor;
static phase_descriptor phase_descriptors[]
= {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
{ _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
{ _UA_HANDLER_FRAME, "HANDLER_FRAME" },
{ _UA_FORCE_UNWIND, "FORCE_UNWIND" },
{ -1, 0}};
static int
db_accepted_codes (void)
{
static int accepted_codes = -1;
if (accepted_codes == -1)
{
char * db_env = (char *) getenv ("EH_DEBUG");
accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
/* Arranged for ERR stuff to always be visible when the variable
is defined. One may just set the variable to 0 to see the ERR
stuff only. */
}
return accepted_codes;
}
#define DB_INDENT_INCREASE 0x01
#define DB_INDENT_DECREASE 0x02
#define DB_INDENT_OUTPUT 0x04
#define DB_INDENT_NEWLINE 0x08
#define DB_INDENT_RESET 0x10
#define DB_INDENT_UNIT 8
static void
db_indent (int requests)
{
static int current_indentation_level = 0;
if (requests & DB_INDENT_RESET)
{
current_indentation_level = 0;
}
if (requests & DB_INDENT_INCREASE)
{
current_indentation_level ++;
}
if (requests & DB_INDENT_DECREASE)
{
current_indentation_level --;
}
if (requests & DB_INDENT_NEWLINE)
{
fprintf (stderr, "\n");
}
if (requests & DB_INDENT_OUTPUT)
{
fprintf (stderr, "%*s",
current_indentation_level * DB_INDENT_UNIT, " ");
}
}
static void ATTRIBUTE_PRINTF_2
db (int db_code, char * msg_format, ...)
{
if (db_accepted_codes () & db_code)
{
va_list msg_args;
db_indent (DB_INDENT_OUTPUT);
va_start (msg_args, msg_format);
vfprintf (stderr, msg_format, msg_args);
va_end (msg_args);
}
}
static void
db_phases (int phases)
{
phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes() & DB_PHASES))
return;
db (DB_PHASES, "\n");
for (; a->description != 0; a++)
if (phases & a->phase)
db (DB_PHASES, "%s ", a->description);
db (DB_PHASES, " :\n");
}
/* ---------------------------------------------------------------
-- Now come a set of useful structures and helper routines. --
--------------------------------------------------------------- */
/* There are three major runtime tables involved, generated by the
GCC back-end. Contents slightly vary depending on the underlying
implementation scheme (dwarf zero cost / sjlj).
=======================================
* Tables for the dwarf zero cost case *
=======================================
call_site []
-------------------------------------------------------------------
* region-start | region-length | landing-pad | first-action-index *
-------------------------------------------------------------------
Identify possible actions to be taken and where to resume control
for that when an exception propagates through a pc inside the region
delimited by start and length.
A null landing-pad indicates that nothing is to be done.
Otherwise, first-action-index provides an entry into the action[]
table which heads a list of possible actions to be taken (see below).
If it is determined that indeed an action should be taken, that
is, if one action filter matches the exception being propagated,
then control should be transfered to landing-pad.
A null first-action-index indicates that there are only cleanups
to run there.
action []
-------------------------------
* action-filter | next-action *
-------------------------------
This table contains lists (called action chains) of possible actions
associated with call-site entries described in the call-site [] table.
There is at most one action list per call-site entry.
A null action-filter indicates a cleanup.
Non null action-filters provide an index into the ttypes [] table
(see below), from which information may be retrieved to check if it
matches the exception being propagated.
action-filter > 0 means there is a regular handler to be run,
action-filter < 0 means there is a some "exception_specification"
data to retrieve, which is only relevant for C++
and should never show up for Ada.
next-action indexes the next entry in the list. 0 indicates there is
no other entry.
ttypes []
---------------
* ttype-value *
---------------
A null value indicates a catch-all handler in C++, and an "others"
handler in Ada.
Non null values are used to match the exception being propagated:
In C++ this is a pointer to some rtti data, while in Ada this is an
exception id.
The special id value 1 indicates an "all_others" handler.
For C++, this table is actually also used to store "exception
specification" data. The differentiation between the two kinds
of entries is made by the sign of the associated action filter,
which translates into positive or negative offsets from the
so called base of the table:
Exception Specification data is stored at positive offsets from
the ttypes table base, which Exception Type data is stored at
negative offsets:
---------------------------------------------------------------------------
Here is a quick summary of the tables organization:
+-- Unwind_Context (pc, ...)
|
|(pc)
|
| CALL-SITE[]
|
| +=============================================================+
| | region-start + length | landing-pad | first-action-index |
| +=============================================================+
+-> | pc range 0 => no-action 0 => cleanups only |
| !0 => jump @ N --+ |
+====================================================== | ====+
|
|
ACTION [] |
|
+==========================================================+ |
| action-filter | next-action | |
+==========================================================+ |
| 0 => cleanup | |
| >0 => ttype index for handler ------+ 0 => end of chain | <-+
| <0 => ttype index for spec data | |
+==================================== | ===================+
|
|
TTYPES [] |
| Offset negated from
+=====================+ | the actual base.
| ttype-value | |
+============+=====================+ |
| | 0 => "others" | |
| ... | 1 => "all others" | <---+
| | X => exception id |
| handlers +---------------------+
| | ... |
| ... | ... |
| | ... |
+============+=====================+ <<------ Table base
| ... | ... |
| specs | ... | (should not see negative filter
| ... | ... | values for Ada).
+============+=====================+
============================
* Tables for the sjlj case *
============================
So called "function contexts" are pushed on a context stack by calls to
_Unwind_SjLj_Register on function entry, and popped off at exit points by
calls to _Unwind_SjLj_Unregister. The current call_site for a function is
updated in the function context as the function's code runs along.
The generic unwinding engine in _Unwind_RaiseException walks the function
context stack and not the actual call chain.
The ACTION and TTYPES tables remain unchanged, which allows to search them
during the propagation phase to determine wether or not the propagated
exception is handled somewhere. When it is, we only "jump" up once directly
to the context where the handler will be found. Besides, this allows "break
exception unhandled" to work also
The CALL-SITE table is setup differently, though: the pc attached to the
unwind context is a direct index into the table, so the entries in this
table do not hold region bounds any more.
A special index (-1) is used to indicate that no action is possibly
connected with the context at hand, so null landing pads cannot appear
in the table.
Additionally, landing pad values in the table do not represent code address
to jump at, but so called "dispatch" indices used by a common landing pad
for the function to switch to the appropriate post-landing-pad.
+-- Unwind_Context (pc, ...)
|
| pc = call-site index
| 0 => terminate (should not see this for Ada)
| -1 => no-action
|
| CALL-SITE[]
|
| +=====================================+
| | landing-pad | first-action-index |
| +=====================================+
+-> | 0 => cleanups only |
| dispatch index N |
+=====================================+
===================================
* Basic organization of this unit *
===================================
The major point of this unit is to provide an exception propagation
personality routine for Ada. This is __gnat_eh_personality.
It is provided with a pointer to the propagated exception, an unwind
context describing a location the propagation is going through, and a
couple of other arguments including a description of the current
propagation phase.
It shall return to the generic propagation engine what is to be performed
next, after possible context adjustments, depending on what it finds in the
traversed context (a handler for the exception, a cleanup, nothing, ...),
and on the propagation phase.
A number of structures and subroutines are used for this purpose, as
sketched below:
o region_descriptor: General data associated with the context (base pc,
call-site table, action table, ttypes table, ...)
o action_descriptor: Data describing the action to be taken for the
propagated exception in the provided context (kind of action: nothing,
handler, cleanup; pointer to the action table entry, ...).
raise
|
... (a-except.adb)
|
Propagate_Exception (a-exexpr.adb)
|
|
_Unwind_RaiseException (libgcc)
|
| (Ada frame)
|
+--> __gnat_eh_personality (context, exception)
|
+--> get_region_descriptor_for (context)
|
+--> get_action_descriptor_for (context, exception, region)
| |
| +--> get_call_site_action_for (context, region)
| (one version for each underlying scheme)
|
+--> setup_to_install (context)
This unit is inspired from the C++ version found in eh_personality.cc,
part of libstdc++-v3.
*/
/* This is an incomplete "proxy" of the structure of exception objects as
built by the GNAT runtime library. Accesses to other fields than the common
header are performed through subprogram calls to alleviate the need of an
exact counterpart here and potential alignment/size issues for the common
header. See a-exexpr.adb. */
typedef struct
{
_Unwind_Exception common;
/* ABI header, maximally aligned. */
} _GNAT_Exception;
/* The two constants below are specific ttype identifiers for special
exception ids. Their type should match what a-exexpr exports. */
extern const int __gnat_others_value;
#define GNAT_OTHERS ((_Unwind_Ptr) &__gnat_others_value)
extern const int __gnat_all_others_value;
#define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
/* Describe the useful region data associated with an unwind context. */
typedef struct
{
/* The base pc of the region. */
_Unwind_Ptr base;
/* Pointer to the Language Specific Data for the region. */
_Unwind_Ptr lsda;
/* Call-Site data associated with this region. */
unsigned char call_site_encoding;
const unsigned char *call_site_table;
/* The base to which are relative landing pad offsets inside the call-site
entries . */
_Unwind_Ptr lp_base;
/* Action-Table associated with this region. */
const unsigned char *action_table;
/* Ttype data associated with this region. */
unsigned char ttype_encoding;
const unsigned char *ttype_table;
_Unwind_Ptr ttype_base;
} region_descriptor;
static void
db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
{
_Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
if (! (db_accepted_codes () & DB_REGIONS))
return;
db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
if (region->lsda)
db (DB_REGIONS, "lsda @ 0x%x", region->lsda);
else
db (DB_REGIONS, "no lsda");
db (DB_REGIONS, "\n");
}
/* Retrieve the ttype entry associated with FILTER in the REGION's
ttype table. */
static const _Unwind_Ptr
get_ttype_entry_for (region_descriptor *region, long filter)
{
_Unwind_Ptr ttype_entry;
filter *= size_of_encoded_value (region->ttype_encoding);
read_encoded_value_with_base
(region->ttype_encoding, region->ttype_base,
region->ttype_table - filter, &ttype_entry);
return ttype_entry;
}
/* Fill out the REGION descriptor for the provided UW_CONTEXT. */
static void
get_region_description_for (_Unwind_Context *uw_context,
region_descriptor *region)
{
const unsigned char * p;
_Unwind_Word tmp;
unsigned char lpbase_encoding;
/* Get the base address of the lsda information. If the provided context
is null or if there is no associated language specific data, there's
nothing we can/should do. */
region->lsda
= (_Unwind_Ptr) (uw_context
? _Unwind_GetLanguageSpecificData (uw_context) : 0);
if (! region->lsda)
return;
/* Parse the lsda and fill the region descriptor. */
p = (char *)region->lsda;
region->base = _Unwind_GetRegionStart (uw_context);
/* Find @LPStart, the base to which landing pad offsets are relative. */
lpbase_encoding = *p++;
if (lpbase_encoding != DW_EH_PE_omit)
p = read_encoded_value
(uw_context, lpbase_encoding, p, &region->lp_base);
else
region->lp_base = region->base;
/* Find @TType, the base of the handler and exception spec type data. */
region->ttype_encoding = *p++;
if (region->ttype_encoding != DW_EH_PE_omit)
{
p = read_uleb128 (p, &tmp);
region->ttype_table = p + tmp;
}
else
region->ttype_table = 0;
region->ttype_base
= base_of_encoded_value (region->ttype_encoding, uw_context);
/* Get the encoding and length of the call-site table; the action table
immediately follows. */
region->call_site_encoding = *p++;
region->call_site_table = read_uleb128 (p, &tmp);
region->action_table = region->call_site_table + tmp;
}
/* Describe an action to be taken when propagating an exception up to
some context. */
typedef enum
{
/* Found some call site base data, but need to analyze further
before being able to decide. */
unknown,
/* There is nothing relevant in the context at hand. */
nothing,
/* There are only cleanups to run in this context. */
cleanup,
/* There is a handler for the exception in this context. */
handler
} action_kind;
/* filter value for cleanup actions. */
const int cleanup_filter = 0;
typedef struct
{
/* The kind of action to be taken. */
action_kind kind;
/* A pointer to the action record entry. */
const unsigned char *table_entry;
/* Where we should jump to actually take an action (trigger a cleanup or an
exception handler). */
_Unwind_Ptr landing_pad;
/* If we have a handler matching our exception, these are the filter to
trigger it and the corresponding id. */
_Unwind_Sword ttype_filter;
_Unwind_Ptr ttype_entry;
} action_descriptor;
static void
db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
{
_Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
switch (action->kind)
{
case unknown:
db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
action->landing_pad, action->table_entry);
break;
case nothing:
db (DB_ACTIONS, "Nothing\n");
break;
case cleanup:
db (DB_ACTIONS, "Cleanup\n");
break;
case handler:
db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter);
break;
default:
db (DB_ACTIONS, "Err? Unexpected action kind !\n");
break;
}
return;
}
/* Search the call_site_table of REGION for an entry appropriate for the
UW_CONTEXT's ip. If one is found, store the associated landing_pad and
action_table entry, and set the ACTION kind to unknown for further
analysis. Otherwise, set the ACTION kind to nothing.
There are two variants of this routine, depending on the underlying
mechanism (dwarf/sjlj), which account for differences in the tables
organization.
*/
#ifdef __USING_SJLJ_EXCEPTIONS__
#define __builtin_eh_return_data_regno(x) x
static void
get_call_site_action_for (_Unwind_Context *uw_context,
region_descriptor *region,
action_descriptor *action)
{
_Unwind_Ptr call_site
= _Unwind_GetIP (uw_context) - 1;
/* Subtract 1 because GetIP returns the actual call_site value + 1. */
/* call_site is a direct index into the call-site table, with two special
values : -1 for no-action and 0 for "terminate". The latter should never
show up for Ada. To test for the former, beware that _Unwind_Ptr might be
unsigned. */
if ((int)call_site < 0)
{
action->kind = nothing;
return;
}
else if (call_site == 0)
{
db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
action->kind = nothing;
return;
}
else
{
_Unwind_Word cs_lp, cs_action;
/* Let the caller know there may be an action to take, but let it
determine the kind. */
action->kind = unknown;
/* We have a direct index into the call-site table, but this table is
made of leb128 values, the encoding length of which is variable. We
can't merely compute an offset from the index, then, but have to read
all the entries before the one of interest. */
const unsigned char * p = region->call_site_table;
do {
p = read_uleb128 (p, &cs_lp);
p = read_uleb128 (p, &cs_action);
} while (--call_site);
action->landing_pad = cs_lp + 1;
if (cs_action)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
return;
}
}
#else
/* ! __USING_SJLJ_EXCEPTIONS__ */
static void
get_call_site_action_for (_Unwind_Context *uw_context,
region_descriptor *region,
action_descriptor *action)
{
_Unwind_Ptr ip
= _Unwind_GetIP (uw_context) - 1;
/* Subtract 1 because GetIP yields a call return address while we are
interested in information for the call point. This does not always yield
the exact call instruction address but always brings the ip back within
the corresponding region.
??? When unwinding up from a signal handler triggered by a trap on some
instruction, we usually have the faulting instruction address here and
subtracting 1 might get us into the wrong region. */
const unsigned char * p
= region->call_site_table;
/* Unless we are able to determine otherwise ... */
action->kind = nothing;
db (DB_CSITE, "\n");
while (p < region->action_table)
{
_Unwind_Ptr cs_start, cs_len, cs_lp;
_Unwind_Word cs_action;
/* Note that all call-site encodings are "absolute" displacements. */
p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
p = read_uleb128 (p, &cs_action);
db (DB_CSITE,
"c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n",
region->base+cs_start, cs_start, cs_len,
region->lp_base+cs_lp, cs_lp);
/* The table is sorted, so if we've passed the ip, stop. */
if (ip < region->base + cs_start)
break;
/* If we have a match, fill the ACTION fields accordingly. */
else if (ip < region->base + cs_start + cs_len)
{
/* Let the caller know there may be an action to take, but let it
determine the kind. */
action->kind = unknown;
if (cs_lp)
action->landing_pad = region->lp_base + cs_lp;
else
action->landing_pad = 0;
if (cs_action)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
db (DB_CSITE, "+++\n");
return;
}
}
db (DB_CSITE, "---\n");
}
#endif
/* With CHOICE an exception choice representing an "exception - when"
argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
occurrence, return true iif the latter matches the former, that is, if
PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
This takes care of the special Non_Ada_Error case on VMS. */
#define Is_Handled_By_Others __gnat_is_handled_by_others
#define Language_For __gnat_language_for
#define Import_Code_For __gnat_import_code_for
#define EID_For __gnat_eid_for
#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
extern char Language_For (_Unwind_Ptr eid);
extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
extern Exception_Id EID_For (_GNAT_Exception * e);
extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
static int
is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
{
/* Pointer to the GNAT exception data corresponding to the propagated
occurrence. */
_Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
/* Base matching rules: An exception data (id) matches itself, "when
all_others" matches anything and "when others" matches anything unless
explicitly stated otherwise in the propagated occurrence. */
bool is_handled =
choice == E
|| choice == GNAT_ALL_OTHERS
|| (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
/* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
may have different exception data pointers that should match for the
same condition code, if both an export and an import have been
registered. The import code for both the choice and the propagated
occurrence are expected to have been masked off regarding severity
bits already (at registration time for the former and from within the
low level exception vector for the latter). */
#ifdef VMS
#define Non_Ada_Error system__aux_dec__non_ada_error
extern struct Exception_Data Non_Ada_Error;
is_handled |=
(Language_For (E) == 'V'
&& choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
&& ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
&& Import_Code_For (choice) == Import_Code_For (E))
|| choice == (_Unwind_Ptr)&Non_Ada_Error));
#endif
return is_handled;
}
/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
UW_CONTEXT in REGION. */
static void
get_action_description_for (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
region_descriptor *region,
action_descriptor *action)
{
_GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
/* Search the call site table first, which may get us a landing pad as well
as the head of an action record list. */
get_call_site_action_for (uw_context, region, action);
db_action_for (action, uw_context);
/* If there is not even a call_site entry, we are done. */
if (action->kind == nothing)
return;
/* Otherwise, check what we have at the place of the call site. */
/* No landing pad => no cleanups or handlers. */
if (action->landing_pad == 0)
{
action->kind = nothing;
return;
}
/* Landing pad + null table entry => only cleanups. */
else if (action->table_entry == 0)
{
action->kind = cleanup;
action->ttype_filter = cleanup_filter;
/* The filter initialization is not strictly necessary, as cleanup-only
landing pads don't look at the filter value. It is there to ensure
we don't pass random values and so trigger potential confusion when
installing the context later on. */
return;
}
/* Landing pad + Table entry => handlers + possible cleanups. */
else
{
const unsigned char * p = action->table_entry;
_Unwind_Sword ar_filter, ar_disp;
action->kind = nothing;
while (1)
{
p = read_sleb128 (p, &ar_filter);
read_sleb128 (p, &ar_disp);
/* Don't assign p here, as it will be incremented by ar_disp
below. */
/* Null filters are for cleanups. */
if (ar_filter == cleanup_filter)
{
action->kind = cleanup;
action->ttype_filter = cleanup_filter;
/* The filter initialization is required here, to ensure
the target landing pad branches to the cleanup code if
we happen not to find a matching handler. */
}
/* Positive filters are for regular handlers. */
else if (ar_filter > 0)
{
/* See if the filter we have is for an exception which matches
the one we are propagating. */
_Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
if (is_handled_by (choice, gnat_exception))
{
action->kind = handler;
action->ttype_filter = ar_filter;
action->ttype_entry = choice;
return;
}
}
/* Negative filter values are for C++ exception specifications.
Should not be there for Ada :/ */
else
db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
if (ar_disp == 0)
return;
p += ar_disp;
}
}
}
/* Setup in UW_CONTEXT the eh return target IP and data registers, which will
be restored with the others and retrieved by the landing pad once the jump
occurred. */
static void
setup_to_install (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
_Unwind_Ptr uw_landing_pad,
int uw_filter)
{
#ifndef EH_RETURN_DATA_REGNO
/* We should not be called if the appropriate underlying support is not
there. */
abort ();
#else
/* 1/ exception object pointer, which might be provided back to
_Unwind_Resume (and thus to this personality routine) if we are jumping
to a cleanup. */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
(_Unwind_Word)uw_exception);
/* 2/ handler switch value register, which will also be used by the target
landing pad to decide what action it shall take. */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
(_Unwind_Word)uw_filter);
/* Setup the address we should jump at to reach the code where there is the
"something" we found. */
_Unwind_SetIP (uw_context, uw_landing_pad);
#endif
}
/* The following is defined from a-except.adb. Its purpose is to enable
automatic backtraces upon exception raise, as provided through the
GNAT.Traceback facilities. */
extern void __gnat_notify_handled_exception (void);
extern void __gnat_notify_unhandled_exception (void);
/* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */
_Unwind_Reason_Code
__gnat_eh_personality (int uw_version,
_Unwind_Action uw_phases,
_Unwind_Exception_Class uw_exception_class,
_Unwind_Exception *uw_exception,
_Unwind_Context *uw_context)
{
_GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
region_descriptor region;
action_descriptor action;
if (uw_version != 1)
return _URC_FATAL_PHASE1_ERROR;
db_indent (DB_INDENT_RESET);
db_phases (uw_phases);
db_indent (DB_INDENT_INCREASE);
/* Get the region description for the context we were provided with. This
will tell us if there is some lsda, call_site, action and/or ttype data
for the associated ip. */
get_region_description_for (uw_context, &region);
db_region_for (&region, uw_context);
/* No LSDA => no handlers or cleanups => we shall unwind further up. */
if (! region.lsda)
return _URC_CONTINUE_UNWIND;
/* Search the call-site and action-record tables for the action associated
with this IP. */
get_action_description_for (uw_context, uw_exception, &region, &action);
db_action_for (&action, uw_context);
/* Whatever the phase, if there is nothing relevant in this frame,
unwinding should just go on. */
if (action.kind == nothing)
return _URC_CONTINUE_UNWIND;
/* If we found something in search phase, we should return a code indicating
what to do next depending on what we found. If we only have cleanups
around, we shall try to unwind further up to find a handler, otherwise,
tell we have a handler, which will trigger the second phase. */
if (uw_phases & _UA_SEARCH_PHASE)
{
if (action.kind == cleanup)
{
Adjust_N_Cleanups_For (gnat_exception, 1);
return _URC_CONTINUE_UNWIND;
}
else
{
/* Trigger the appropriate notification routines before the second
phase starts, which ensures the stack is still intact. */
__gnat_notify_handled_exception ();
return _URC_HANDLER_FOUND;
}
}
/* We found something in cleanup/handler phase, which might be the handler
or a cleanup for a handled occurrence, or a cleanup for an unhandled
occurrence (we are in a FORCED_UNWIND phase in this case). Install the
context to get there. */
/* If we are going to install a cleanup context, decrement the cleanup
count. This is required in a FORCED_UNWINDing phase (for an unhandled
exception), as this is used from the forced unwinding handler in
Ada.Exceptions.Exception_Propagation to decide wether unwinding should
proceed further or Unhandled_Exception_Terminate should be called. */
if (action.kind == cleanup)
Adjust_N_Cleanups_For (gnat_exception, -1);
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
return _URC_INSTALL_CONTEXT;
}
/* Define the consistently named wrappers imported by Propagate_Exception. */
#ifdef __USING_SJLJ_EXCEPTIONS__
#undef _Unwind_RaiseException
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
return _Unwind_SjLj_RaiseException (e);
}
#undef _Unwind_ForcedUnwind
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
void * handler,
void * argument)
{
return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
}
#else /* __USING_SJLJ_EXCEPTIONS__ */
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
return _Unwind_RaiseException (e);
}
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
void * handler,
void * argument)
{
return _Unwind_ForcedUnwind (e, handler, argument);
}
#endif /* __USING_SJLJ_EXCEPTIONS__ */
#else
/* ! IN_RTS */
/* Define the corresponding stubs for the compiler. */
/* We don't want fancy_abort here. */
#undef abort
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e ATTRIBUTE_UNUSED)
{
abort ();
}
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
void * handler ATTRIBUTE_UNUSED,
void * argument ATTRIBUTE_UNUSED)
{
abort ();
}
#endif /* IN_RTS */
gcc/ada/raise.c
...@@ -30,23 +30,15 @@ ...@@ -30,23 +30,15 @@
* * * *
****************************************************************************/ ****************************************************************************/
/* Routines to support runtime exception handling */ /* Shared routines to support exception handling.
Note that _gnat_builtin_longjmp should disappear at some point, replaced
by direct call to __builtin_longjmp from Ada code.
__gnat_unhandled_terminate is code shared between all exception handling
mechanisms */
#ifdef IN_RTS #ifdef IN_RTS
#include "tconfig.h" #include "tconfig.h"
/* In the top-of-tree GCC, tconfig does not include tm.h, but in GCC 3.2
it does. To avoid branching raise.c just for that purpose, we kludge by
looking for a symbol always defined by tm.h and if it's not defined,
we include it. */
#ifndef FIRST_PSEUDO_REGISTER
#include "coretypes.h"
#include "tm.h"
#endif
#include "tsystem.h" #include "tsystem.h"
#include <sys/stat.h>
typedef char bool;
# define true 1
# define false 0
#else #else
#include "config.h" #include "config.h"
#include "system.h" #include "system.h"
...@@ -72,1106 +64,16 @@ _gnat_builtin_longjmp (void *ptr, int flag ATTRIBUTE_UNUSED) ...@@ -72,1106 +64,16 @@ _gnat_builtin_longjmp (void *ptr, int flag ATTRIBUTE_UNUSED)
void void
__gnat_unhandled_terminate (void) __gnat_unhandled_terminate (void)
{ {
/* Special termination handling for VMS */
#ifdef VMS #ifdef VMS
{ /* Special termination handling for VMS */
long prvhnd; long prvhnd;
/* Remove the exception vector so it won't intercept any errors
in the call to exit, and go into and endless loop */
SYS$SETEXV (1, 0, 3, &prvhnd);
__gnat_os_exit (1);
}
/* Termination handling for all other systems. */
#elif !defined (__RT__)
__gnat_os_exit (1);
#endif
}
/* Below is the code related to the integration of the GCC mechanism for
exception handling. */
/* The names of a couple of "standard" routines for unwinding/propagation
actually vary depending on the underlying GCC scheme for exception handling
(SJLJ or DWARF). We need a consistently named interface to import from
a-except, so wrappers are defined here.
Besides, eventhough the compiler is never setup to use the GCC propagation
circuitry, it still relies on exceptions internally and part of the sources
to handle to exceptions are shared with the run-time library. We need
dummy definitions for the wrappers to satisfy the linker in this case.
The types to be used by those wrappers in the run-time library are target
types exported by unwind.h. We used to piggyback on them for the compiler
stubs, but there is no guarantee that unwind.h is always in sight so we
define our own set below. These are dummy types as the wrappers are never
called in the compiler case. */
#ifdef IN_RTS
#include "unwind.h"
typedef struct _Unwind_Context _Unwind_Context;
typedef struct _Unwind_Exception _Unwind_Exception;
#else
typedef void _Unwind_Context;
typedef void _Unwind_Exception;
typedef int _Unwind_Reason_Code;
#endif
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *);
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *, void *, void *);
#ifdef IN_RTS /* For eh personality routine */
#include "dwarf2.h"
#include "unwind-dw2-fde.h"
#include "unwind-pe.h"
/* --------------------------------------------------------------
-- The DB stuff below is there for debugging purposes only. --
-------------------------------------------------------------- */
#define DB_PHASES 0x1
#define DB_CSITE 0x2
#define DB_ACTIONS 0x4
#define DB_REGIONS 0x8
#define DB_ERR 0x1000
/* The "action" stuff below is also there for debugging purposes only. */
typedef struct
{
_Unwind_Action phase;
char * description;
} phase_descriptor;
static phase_descriptor phase_descriptors[]
= {{ _UA_SEARCH_PHASE, "SEARCH_PHASE" },
{ _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
{ _UA_HANDLER_FRAME, "HANDLER_FRAME" },
{ _UA_FORCE_UNWIND, "FORCE_UNWIND" },
{ -1, 0}};
static int
db_accepted_codes (void)
{
static int accepted_codes = -1;
if (accepted_codes == -1)
{
char * db_env = (char *) getenv ("EH_DEBUG");
accepted_codes = db_env ? (atoi (db_env) | DB_ERR) : 0;
/* Arranged for ERR stuff to always be visible when the variable
is defined. One may just set the variable to 0 to see the ERR
stuff only. */
}
return accepted_codes;
}
#define DB_INDENT_INCREASE 0x01
#define DB_INDENT_DECREASE 0x02
#define DB_INDENT_OUTPUT 0x04
#define DB_INDENT_NEWLINE 0x08
#define DB_INDENT_RESET 0x10
#define DB_INDENT_UNIT 8
static void
db_indent (int requests)
{
static int current_indentation_level = 0;
if (requests & DB_INDENT_RESET)
{
current_indentation_level = 0;
}
if (requests & DB_INDENT_INCREASE)
{
current_indentation_level ++;
}
if (requests & DB_INDENT_DECREASE)
{
current_indentation_level --;
}
if (requests & DB_INDENT_NEWLINE)
{
fprintf (stderr, "\n");
}
if (requests & DB_INDENT_OUTPUT)
{
fprintf (stderr, "%*s",
current_indentation_level * DB_INDENT_UNIT, " ");
}
}
static void ATTRIBUTE_PRINTF_2
db (int db_code, char * msg_format, ...)
{
if (db_accepted_codes () & db_code)
{
va_list msg_args;
db_indent (DB_INDENT_OUTPUT);
va_start (msg_args, msg_format);
vfprintf (stderr, msg_format, msg_args);
va_end (msg_args);
}
}
static void
db_phases (int phases)
{
phase_descriptor *a = phase_descriptors;
if (! (db_accepted_codes() & DB_PHASES))
return;
db (DB_PHASES, "\n");
for (; a->description != 0; a++)
if (phases & a->phase)
db (DB_PHASES, "%s ", a->description);
db (DB_PHASES, " :\n");
}
/* ---------------------------------------------------------------
-- Now come a set of useful structures and helper routines. --
--------------------------------------------------------------- */
/* There are three major runtime tables involved, generated by the
GCC back-end. Contents slightly vary depending on the underlying
implementation scheme (dwarf zero cost / sjlj).
=======================================
* Tables for the dwarf zero cost case *
=======================================
call_site []
-------------------------------------------------------------------
* region-start | region-length | landing-pad | first-action-index *
-------------------------------------------------------------------
Identify possible actions to be taken and where to resume control
for that when an exception propagates through a pc inside the region
delimited by start and length.
A null landing-pad indicates that nothing is to be done.
Otherwise, first-action-index provides an entry into the action[]
table which heads a list of possible actions to be taken (see below).
If it is determined that indeed an action should be taken, that
is, if one action filter matches the exception being propagated,
then control should be transfered to landing-pad.
A null first-action-index indicates that there are only cleanups
to run there.
action []
-------------------------------
* action-filter | next-action *
-------------------------------
This table contains lists (called action chains) of possible actions
associated with call-site entries described in the call-site [] table.
There is at most one action list per call-site entry.
A null action-filter indicates a cleanup.
Non null action-filters provide an index into the ttypes [] table
(see below), from which information may be retrieved to check if it
matches the exception being propagated.
action-filter > 0 means there is a regular handler to be run,
action-filter < 0 means there is a some "exception_specification"
data to retrieve, which is only relevant for C++
and should never show up for Ada.
next-action indexes the next entry in the list. 0 indicates there is
no other entry.
ttypes []
---------------
* ttype-value *
---------------
A null value indicates a catch-all handler in C++, and an "others"
handler in Ada.
Non null values are used to match the exception being propagated:
In C++ this is a pointer to some rtti data, while in Ada this is an
exception id.
The special id value 1 indicates an "all_others" handler.
For C++, this table is actually also used to store "exception
specification" data. The differentiation between the two kinds
of entries is made by the sign of the associated action filter,
which translates into positive or negative offsets from the
so called base of the table:
Exception Specification data is stored at positive offsets from
the ttypes table base, which Exception Type data is stored at
negative offsets:
---------------------------------------------------------------------------
Here is a quick summary of the tables organization:
+-- Unwind_Context (pc, ...)
|
|(pc)
|
| CALL-SITE[]
|
| +=============================================================+
| | region-start + length | landing-pad | first-action-index |
| +=============================================================+
+-> | pc range 0 => no-action 0 => cleanups only |
| !0 => jump @ N --+ |
+====================================================== | ====+
|
|
ACTION [] |
|
+==========================================================+ |
| action-filter | next-action | |
+==========================================================+ |
| 0 => cleanup | |
| >0 => ttype index for handler ------+ 0 => end of chain | <-+
| <0 => ttype index for spec data | |
+==================================== | ===================+
|
|
TTYPES [] |
| Offset negated from
+=====================+ | the actual base.
| ttype-value | |
+============+=====================+ |
| | 0 => "others" | |
| ... | 1 => "all others" | <---+
| | X => exception id |
| handlers +---------------------+
| | ... |
| ... | ... |
| | ... |
+============+=====================+ <<------ Table base
| ... | ... |
| specs | ... | (should not see negative filter
| ... | ... | values for Ada).
+============+=====================+
============================
* Tables for the sjlj case *
============================
So called "function contexts" are pushed on a context stack by calls to
_Unwind_SjLj_Register on function entry, and popped off at exit points by
calls to _Unwind_SjLj_Unregister. The current call_site for a function is
updated in the function context as the function's code runs along.
The generic unwinding engine in _Unwind_RaiseException walks the function
context stack and not the actual call chain.
The ACTION and TTYPES tables remain unchanged, which allows to search them
during the propagation phase to determine wether or not the propagated
exception is handled somewhere. When it is, we only "jump" up once directly
to the context where the handler will be found. Besides, this allows "break
exception unhandled" to work also
The CALL-SITE table is setup differently, though: the pc attached to the
unwind context is a direct index into the table, so the entries in this
table do not hold region bounds any more.
A special index (-1) is used to indicate that no action is possibly
connected with the context at hand, so null landing pads cannot appear
in the table.
Additionally, landing pad values in the table do not represent code address
to jump at, but so called "dispatch" indices used by a common landing pad
for the function to switch to the appropriate post-landing-pad.
+-- Unwind_Context (pc, ...)
|
| pc = call-site index
| 0 => terminate (should not see this for Ada)
| -1 => no-action
|
| CALL-SITE[]
|
| +=====================================+
| | landing-pad | first-action-index |
| +=====================================+
+-> | 0 => cleanups only |
| dispatch index N |
+=====================================+
===================================
* Basic organization of this unit *
===================================
The major point of this unit is to provide an exception propagation
personality routine for Ada. This is __gnat_eh_personality.
It is provided with a pointer to the propagated exception, an unwind
context describing a location the propagation is going through, and a
couple of other arguments including a description of the current
propagation phase.
It shall return to the generic propagation engine what is to be performed
next, after possible context adjustments, depending on what it finds in the
traversed context (a handler for the exception, a cleanup, nothing, ...),
and on the propagation phase.
A number of structures and subroutines are used for this purpose, as
sketched below:
o region_descriptor: General data associated with the context (base pc,
call-site table, action table, ttypes table, ...)
o action_descriptor: Data describing the action to be taken for the
propagated exception in the provided context (kind of action: nothing,
handler, cleanup; pointer to the action table entry, ...).
raise
|
... (a-except.adb)
|
Propagate_Exception (a-exexpr.adb)
|
|
_Unwind_RaiseException (libgcc)
|
| (Ada frame)
|
+--> __gnat_eh_personality (context, exception)
|
+--> get_region_descriptor_for (context)
|
+--> get_action_descriptor_for (context, exception, region)
| |
| +--> get_call_site_action_for (context, region)
| (one version for each underlying scheme)
|
+--> setup_to_install (context)
This unit is inspired from the C++ version found in eh_personality.cc,
part of libstdc++-v3.
*/
/* This is an incomplete "proxy" of the structure of exception objects as
built by the GNAT runtime library. Accesses to other fields than the common
header are performed through subprogram calls to alleviate the need of an
exact counterpart here and potential alignment/size issues for the common
header. See a-exexpr.adb. */
typedef struct
{
_Unwind_Exception common;
/* ABI header, maximally aligned. */
} _GNAT_Exception;
/* The two constants below are specific ttype identifiers for special
exception ids. Their type should match what a-exexpr exports. */
extern const int __gnat_others_value;
#define GNAT_OTHERS ((_Unwind_Ptr) &__gnat_others_value)
extern const int __gnat_all_others_value;
#define GNAT_ALL_OTHERS ((_Unwind_Ptr) &__gnat_all_others_value)
/* Describe the useful region data associated with an unwind context. */
typedef struct
{
/* The base pc of the region. */
_Unwind_Ptr base;
/* Pointer to the Language Specific Data for the region. */
_Unwind_Ptr lsda;
/* Call-Site data associated with this region. */
unsigned char call_site_encoding;
const unsigned char *call_site_table;
/* The base to which are relative landing pad offsets inside the call-site
entries . */
_Unwind_Ptr lp_base;
/* Action-Table associated with this region. */
const unsigned char *action_table;
/* Ttype data associated with this region. */
unsigned char ttype_encoding;
const unsigned char *ttype_table;
_Unwind_Ptr ttype_base;
} region_descriptor;
static void
db_region_for (region_descriptor *region, _Unwind_Context *uw_context)
{
_Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
if (! (db_accepted_codes () & DB_REGIONS))
return;
db (DB_REGIONS, "For ip @ 0x%08x => ", ip);
if (region->lsda)
db (DB_REGIONS, "lsda @ 0x%x", region->lsda);
else
db (DB_REGIONS, "no lsda");
db (DB_REGIONS, "\n");
}
/* Retrieve the ttype entry associated with FILTER in the REGION's
ttype table. */
static const _Unwind_Ptr
get_ttype_entry_for (region_descriptor *region, long filter)
{
_Unwind_Ptr ttype_entry;
filter *= size_of_encoded_value (region->ttype_encoding);
read_encoded_value_with_base
(region->ttype_encoding, region->ttype_base,
region->ttype_table - filter, &ttype_entry);
return ttype_entry;
}
/* Fill out the REGION descriptor for the provided UW_CONTEXT. */
static void
get_region_description_for (_Unwind_Context *uw_context,
region_descriptor *region)
{
const unsigned char * p;
_Unwind_Word tmp;
unsigned char lpbase_encoding;
/* Get the base address of the lsda information. If the provided context
is null or if there is no associated language specific data, there's
nothing we can/should do. */
region->lsda
= (_Unwind_Ptr) (uw_context
? _Unwind_GetLanguageSpecificData (uw_context) : 0);
if (! region->lsda)
return;
/* Parse the lsda and fill the region descriptor. */
p = (char *)region->lsda;
region->base = _Unwind_GetRegionStart (uw_context);
/* Find @LPStart, the base to which landing pad offsets are relative. */
lpbase_encoding = *p++;
if (lpbase_encoding != DW_EH_PE_omit)
p = read_encoded_value
(uw_context, lpbase_encoding, p, &region->lp_base);
else
region->lp_base = region->base;
/* Find @TType, the base of the handler and exception spec type data. */
region->ttype_encoding = *p++;
if (region->ttype_encoding != DW_EH_PE_omit)
{
p = read_uleb128 (p, &tmp);
region->ttype_table = p + tmp;
}
else
region->ttype_table = 0;
region->ttype_base
= base_of_encoded_value (region->ttype_encoding, uw_context);
/* Get the encoding and length of the call-site table; the action table
immediately follows. */
region->call_site_encoding = *p++;
region->call_site_table = read_uleb128 (p, &tmp);
region->action_table = region->call_site_table + tmp;
}
/* Describe an action to be taken when propagating an exception up to
some context. */
typedef enum
{
/* Found some call site base data, but need to analyze further
before being able to decide. */
unknown,
/* There is nothing relevant in the context at hand. */
nothing,
/* There are only cleanups to run in this context. */
cleanup,
/* There is a handler for the exception in this context. */
handler
} action_kind;
typedef struct
{
/* The kind of action to be taken. */
action_kind kind;
/* A pointer to the action record entry. */
const unsigned char *table_entry;
/* Where we should jump to actually take an action (trigger a cleanup or an
exception handler). */
_Unwind_Ptr landing_pad;
/* If we have a handler matching our exception, these are the filter to
trigger it and the corresponding id. */
_Unwind_Sword ttype_filter;
_Unwind_Ptr ttype_entry;
} action_descriptor;
static void
db_action_for (action_descriptor *action, _Unwind_Context *uw_context)
{
_Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
switch (action->kind)
{
case unknown:
db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
action->landing_pad, action->table_entry);
break;
case nothing:
db (DB_ACTIONS, "Nothing\n");
break;
case cleanup:
db (DB_ACTIONS, "Cleanup\n");
break;
case handler:
db (DB_ACTIONS, "Handler, filter = %d\n", action->ttype_filter);
break;
default:
db (DB_ACTIONS, "Err? Unexpected action kind !\n");
break;
}
return;
}
/* Search the call_site_table of REGION for an entry appropriate for the
UW_CONTEXT's ip. If one is found, store the associated landing_pad and
action_table entry, and set the ACTION kind to unknown for further
analysis. Otherwise, set the ACTION kind to nothing.
There are two variants of this routine, depending on the underlying
mechanism (dwarf/sjlj), which account for differences in the tables
organization.
*/
#ifdef __USING_SJLJ_EXCEPTIONS__
#define __builtin_eh_return_data_regno(x) x
static void
get_call_site_action_for (_Unwind_Context *uw_context,
region_descriptor *region,
action_descriptor *action)
{
_Unwind_Ptr call_site
= _Unwind_GetIP (uw_context) - 1;
/* Subtract 1 because GetIP returns the actual call_site value + 1. */
/* call_site is a direct index into the call-site table, with two special
values : -1 for no-action and 0 for "terminate". The latter should never
show up for Ada. To test for the former, beware that _Unwind_Ptr might be
unsigned. */
if ((int)call_site < 0)
{
action->kind = nothing;
return;
}
else if (call_site == 0)
{
db (DB_ERR, "========> Err, null call_site for Ada/sjlj\n");
action->kind = nothing;
return;
}
else
{
_Unwind_Word cs_lp, cs_action;
/* Let the caller know there may be an action to take, but let it
determine the kind. */
action->kind = unknown;
/* We have a direct index into the call-site table, but this table is
made of leb128 values, the encoding length of which is variable. We
can't merely compute an offset from the index, then, but have to read
all the entries before the one of interest. */
const unsigned char * p = region->call_site_table;
do {
p = read_uleb128 (p, &cs_lp);
p = read_uleb128 (p, &cs_action);
} while (--call_site);
action->landing_pad = cs_lp + 1;
if (cs_action)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
return;
}
}
#else
/* ! __USING_SJLJ_EXCEPTIONS__ */
static void
get_call_site_action_for (_Unwind_Context *uw_context,
region_descriptor *region,
action_descriptor *action)
{
_Unwind_Ptr ip
= _Unwind_GetIP (uw_context) - 1;
/* Subtract 1 because GetIP yields a call return address while we are
interested in information for the call point. This does not always yield
the exact call instruction address but always brings the ip back within
the corresponding region.
??? When unwinding up from a signal handler triggered by a trap on some
instruction, we usually have the faulting instruction address here and
subtracting 1 might get us into the wrong region. */
const unsigned char * p
= region->call_site_table;
/* Unless we are able to determine otherwise ... */
action->kind = nothing;
db (DB_CSITE, "\n");
while (p < region->action_table)
{
_Unwind_Ptr cs_start, cs_len, cs_lp;
_Unwind_Word cs_action;
/* Note that all call-site encodings are "absolute" displacements. */
p = read_encoded_value (0, region->call_site_encoding, p, &cs_start);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_len);
p = read_encoded_value (0, region->call_site_encoding, p, &cs_lp);
p = read_uleb128 (p, &cs_action);
db (DB_CSITE,
"c_site @ 0x%08x (+0x%03x), len = %3d, lpad @ 0x%08x (+0x%03x)\n",
region->base+cs_start, cs_start, cs_len,
region->lp_base+cs_lp, cs_lp);
/* The table is sorted, so if we've passed the ip, stop. */
if (ip < region->base + cs_start)
break;
/* If we have a match, fill the ACTION fields accordingly. */
else if (ip < region->base + cs_start + cs_len)
{
/* Let the caller know there may be an action to take, but let it
determine the kind. */
action->kind = unknown;
if (cs_lp)
action->landing_pad = region->lp_base + cs_lp;
else
action->landing_pad = 0;
if (cs_action)
action->table_entry = region->action_table + cs_action - 1;
else
action->table_entry = 0;
db (DB_CSITE, "+++\n");
return;
}
}
db (DB_CSITE, "---\n");
}
#endif
/* With CHOICE an exception choice representing an "exception - when"
argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated
occurrence, return true iif the latter matches the former, that is, if
PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE.
This takes care of the special Non_Ada_Error case on VMS. */
#define Is_Handled_By_Others __gnat_is_handled_by_others
#define Language_For __gnat_language_for
#define Import_Code_For __gnat_import_code_for
#define EID_For __gnat_eid_for
#define Adjust_N_Cleanups_For __gnat_adjust_n_cleanups_for
extern bool Is_Handled_By_Others (_Unwind_Ptr eid);
extern char Language_For (_Unwind_Ptr eid);
extern Exception_Code Import_Code_For (_Unwind_Ptr eid);
extern Exception_Id EID_For (_GNAT_Exception * e);
extern void Adjust_N_Cleanups_For (_GNAT_Exception * e, int n);
static int
is_handled_by (_Unwind_Ptr choice, _GNAT_Exception * propagated_exception)
{
/* Pointer to the GNAT exception data corresponding to the propagated
occurrence. */
_Unwind_Ptr E = (_Unwind_Ptr) EID_For (propagated_exception);
/* Base matching rules: An exception data (id) matches itself, "when
all_others" matches anything and "when others" matches anything unless
explicitly stated otherwise in the propagated occurrence. */
bool is_handled =
choice == E
|| choice == GNAT_ALL_OTHERS
|| (choice == GNAT_OTHERS && Is_Handled_By_Others (E));
/* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we
may have different exception data pointers that should match for the
same condition code, if both an export and an import have been
registered. The import code for both the choice and the propagated
occurrence are expected to have been masked off regarding severity
bits already (at registration time for the former and from within the
low level exception vector for the latter). */
#ifdef VMS
#define Non_Ada_Error system__aux_dec__non_ada_error
extern struct Exception_Data Non_Ada_Error;
is_handled |=
(Language_For (E) == 'V'
&& choice != GNAT_OTHERS && choice != GNAT_ALL_OTHERS
&& ((Language_For (choice) == 'V' && Import_Code_For (choice) != 0
&& Import_Code_For (choice) == Import_Code_For (E))
|| choice == (_Unwind_Ptr)&Non_Ada_Error));
#endif
return is_handled;
}
/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
UW_CONTEXT in REGION. */
static void
get_action_description_for (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
region_descriptor *region,
action_descriptor *action)
{
_GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
/* Search the call site table first, which may get us a landing pad as well
as the head of an action record list. */
get_call_site_action_for (uw_context, region, action);
db_action_for (action, uw_context);
/* If there is not even a call_site entry, we are done. */
if (action->kind == nothing)
return;
/* Otherwise, check what we have at the place of the call site */
/* No landing pad => no cleanups or handlers. */
if (action->landing_pad == 0)
{
action->kind = nothing;
return;
}
/* Landing pad + null table entry => only cleanups. */
else if (action->table_entry == 0)
{
action->kind = cleanup;
return;
}
/* Landing pad + Table entry => handlers + possible cleanups. */
else
{
const unsigned char * p = action->table_entry;
_Unwind_Sword ar_filter, ar_disp;
action->kind = nothing;
while (1)
{
p = read_sleb128 (p, &ar_filter);
read_sleb128 (p, &ar_disp);
/* Don't assign p here, as it will be incremented by ar_disp
below. */
/* Null filters are for cleanups. */
if (ar_filter == 0)
action->kind = cleanup;
/* Positive filters are for regular handlers. */
else if (ar_filter > 0)
{
/* See if the filter we have is for an exception which matches
the one we are propagating. */
_Unwind_Ptr choice = get_ttype_entry_for (region, ar_filter);
if (is_handled_by (choice, gnat_exception))
{
action->ttype_filter = ar_filter;
action->ttype_entry = choice;
action->kind = handler;
return;
}
}
/* Negative filter values are for C++ exception specifications.
Should not be there for Ada :/ */
else
db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
if (ar_disp == 0)
return;
p += ar_disp;
}
}
}
/* Setup in UW_CONTEXT the eh return target IP and data registers, which will
be restored with the others and retrieved by the landing pad once the jump
occurred. */
static void
setup_to_install (_Unwind_Context *uw_context,
_Unwind_Exception *uw_exception,
_Unwind_Ptr uw_landing_pad,
int uw_filter)
{
#ifndef EH_RETURN_DATA_REGNO
/* We should not be called if the appropriate underlying support is not
there. */
abort ();
#else
/* 1/ exception object pointer, which might be provided back to
_Unwind_Resume (and thus to this personality routine) if we are jumping
to a cleanup. */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (0),
(_Unwind_Word)uw_exception);
/* 2/ handler switch value register, which will also be used by the target /* Remove the exception vector so it won't intercept any errors
landing pad to decide what action it shall take. */ in the call to exit, and go into and endless loop */
_Unwind_SetGR (uw_context, __builtin_eh_return_data_regno (1),
(_Unwind_Word)uw_filter);
/* Setup the address we should jump at to reach the code where there is the SYS$SETEXV (1, 0, 3, &prvhnd);
"something" we found. */
_Unwind_SetIP (uw_context, uw_landing_pad);
#endif #endif
}
/* The following is defined from a-except.adb. Its purpose is to enable
automatic backtraces upon exception raise, as provided through the
GNAT.Traceback facilities. */
extern void __gnat_notify_handled_exception (void);
extern void __gnat_notify_unhandled_exception (void);
/* Below is the eh personality routine per se. We currently assume that only
GNU-Ada exceptions are met. */
_Unwind_Reason_Code
__gnat_eh_personality (int uw_version,
_Unwind_Action uw_phases,
_Unwind_Exception_Class uw_exception_class,
_Unwind_Exception *uw_exception,
_Unwind_Context *uw_context)
{
_GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
region_descriptor region;
action_descriptor action;
if (uw_version != 1)
return _URC_FATAL_PHASE1_ERROR;
db_indent (DB_INDENT_RESET);
db_phases (uw_phases);
db_indent (DB_INDENT_INCREASE);
/* Get the region description for the context we were provided with. This
will tell us if there is some lsda, call_site, action and/or ttype data
for the associated ip. */
get_region_description_for (uw_context, &region);
db_region_for (&region, uw_context);
/* No LSDA => no handlers or cleanups => we shall unwind further up. */
if (! region.lsda)
return _URC_CONTINUE_UNWIND;
/* Search the call-site and action-record tables for the action associated
with this IP. */
get_action_description_for (uw_context, uw_exception, &region, &action);
db_action_for (&action, uw_context);
/* Whatever the phase, if there is nothing relevant in this frame,
unwinding should just go on. */
if (action.kind == nothing)
return _URC_CONTINUE_UNWIND;
/* If we found something in search phase, we should return a code indicating /* Default termination handling */
what to do next depending on what we found. If we only have cleanups __gnat_os_exit (1);
around, we shall try to unwind further up to find a handler, otherwise,
tell we have a handler, which will trigger the second phase. */
if (uw_phases & _UA_SEARCH_PHASE)
{
if (action.kind == cleanup)
{
Adjust_N_Cleanups_For (gnat_exception, 1);
return _URC_CONTINUE_UNWIND;
}
else
{
/* Trigger the appropriate notification routines before the second
phase starts, which ensures the stack is still intact. */
__gnat_notify_handled_exception ();
return _URC_HANDLER_FOUND;
}
}
/* We found something in cleanup/handler phase, which might be the handler
or a cleanup for a handled occurrence, or a cleanup for an unhandled
occurrence (we are in a FORCED_UNWIND phase in this case). Install the
context to get there. */
/* If we are going to install a cleanup context, decrement the cleanup
count. This is required in a FORCED_UNWINDing phase (for an unhandled
exception), as this is used from the forced unwinding handler in
Ada.Exceptions.Exception_Propagation to decide wether unwinding should
proceed further or Unhandled_Exception_Terminate should be called. */
if (action.kind == cleanup)
Adjust_N_Cleanups_For (gnat_exception, -1);
setup_to_install
(uw_context, uw_exception, action.landing_pad, action.ttype_filter);
return _URC_INSTALL_CONTEXT;
} }
/* Define the consistently named wrappers imported by Propagate_Exception. */
#ifdef __USING_SJLJ_EXCEPTIONS__
#undef _Unwind_RaiseException
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
return _Unwind_SjLj_RaiseException (e);
}
#undef _Unwind_ForcedUnwind
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
void * handler,
void * argument)
{
return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
}
#else /* __USING_SJLJ_EXCEPTIONS__ */
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e)
{
return _Unwind_RaiseException (e);
}
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e,
void * handler,
void * argument)
{
return _Unwind_ForcedUnwind (e, handler, argument);
}
#endif /* __USING_SJLJ_EXCEPTIONS__ */
#else
/* ! IN_RTS */
/* Define the corresponding stubs for the compiler. */
/* We don't want fancy_abort here. */
#undef abort
_Unwind_Reason_Code
__gnat_Unwind_RaiseException (_Unwind_Exception *e ATTRIBUTE_UNUSED)
{
abort ();
}
_Unwind_Reason_Code
__gnat_Unwind_ForcedUnwind (_Unwind_Exception *e ATTRIBUTE_UNUSED,
void * handler ATTRIBUTE_UNUSED,
void * argument ATTRIBUTE_UNUSED)
{
abort ();
}
#endif /* IN_RTS */
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