3psoccon.ads, [...]: Files added.

2003-10-21  Arnaud Charlet  <charlet@act-europe.fr>

	* 3psoccon.ads, 3veacodu.adb, 3vexpect.adb, 3vsoccon.ads,
	3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb, 3zsoccon.ads,
	3zsocthi.adb, 3zsocthi.ads, 50system.ads, 51system.ads,
	55system.ads, 56osinte.adb, 56osinte.ads, 56taprop.adb,
	56taspri.ads, 56tpopsp.adb, 57system.ads, 58system.ads,
	59system.ads, 5aml-tgt.adb, 5bml-tgt.adb, 5csystem.ads,
	5dsystem.ads, 5fosinte.adb, 5gml-tgt.adb, 5hml-tgt.adb,
	5isystem.ads, 5lparame.adb, 5msystem.ads, 5psystem.ads,
	5sml-tgt.adb, 5sosprim.adb, 5stpopsp.adb, 5tsystem.ads,
	5usystem.ads, 5vml-tgt.adb, 5vsymbol.adb, 5vtraent.adb,
	5vtraent.ads, 5wml-tgt.adb, 5xparame.ads, 5xsystem.ads,
	5xvxwork.ads, 5yparame.ads, 5ytiitho.adb, 5zinit.adb,
	5zml-tgt.adb, 5zparame.ads, 5ztaspri.ads, 5ztfsetr.adb,
	5zthrini.adb, 5ztiitho.adb, 5ztpopsp.adb, 7stfsetr.adb,
	7straces.adb, 7strafor.adb, 7strafor.ads, 7stratas.adb,
	a-excach.adb, a-exexda.adb, a-exexpr.adb, a-exextr.adb,
	a-exstat.adb, a-strsup.adb, a-strsup.ads, a-stwisu.adb,
	a-stwisu.ads, bld.adb, bld.ads, bld-io.adb,
	bld-io.ads, clean.adb, clean.ads, ctrl_c.c,
	erroutc.adb, erroutc.ads, errutil.adb, errutil.ads,
	err_vars.ads, final.c, g-arrspl.adb, g-arrspl.ads,
	g-boubuf.adb, g-boubuf.ads, g-boumai.ads, g-bubsor.adb,
	g-bubsor.ads, g-comver.adb, g-comver.ads, g-ctrl_c.ads,
	g-dynhta.adb, g-dynhta.ads, g-eacodu.adb, g-excact.adb,
	g-excact.ads, g-heasor.adb, g-heasor.ads, g-memdum.adb,
	g-memdum.ads, gnatclean.adb, gnatsym.adb, g-pehage.adb,
	g-pehage.ads, g-perhas.ads, gpr2make.adb, gpr2make.ads,
	gprcmd.adb, gprep.adb, gprep.ads, g-semaph.adb,
	g-semaph.ads, g-string.adb, g-string.ads, g-strspl.ads,
	g-wistsp.ads, i-vthrea.adb, i-vthrea.ads, i-vxwoio.adb,
	i-vxwoio.ads, Makefile.generic, Makefile.prolog, Makefile.rtl,
	prep.adb, prep.ads, prepcomp.adb, prepcomp.ads,
	prj-err.adb, prj-err.ads, s-boarop.ads, s-carsi8.adb,
	s-carsi8.ads, s-carun8.adb, s-carun8.ads, s-casi16.adb,
	s-casi16.ads, s-casi32.adb, s-casi32.ads, s-casi64.adb,
	s-casi64.ads, s-casuti.adb, s-casuti.ads, s-caun16.adb,
	s-caun16.ads, s-caun32.adb, s-caun32.ads, s-caun64.adb,
	s-caun64.ads, scng.adb, scng.ads, s-exnint.adb,
	s-exnllf.adb, s-exnlli.adb, s-expint.adb, s-explli.adb,
	s-geveop.adb, s-geveop.ads, s-hibaen.ads, s-htable.adb,
	s-htable.ads, sinput-c.adb, sinput-c.ads, s-memcop.ads,
	socket.c, s-purexc.ads, s-scaval.adb, s-stopoo.adb,
	s-strcom.adb, s-strcom.ads, s-strxdr.adb, s-rident.ads,
	s-thread.adb, s-thread.ads, s-tpae65.adb, s-tpae65.ads,
	s-tporft.adb, s-traent.adb, s-traent.ads, styleg.adb,
	styleg.ads, styleg-c.adb, styleg-c.ads, s-veboop.adb,
	s-veboop.ads, s-vector.ads, symbols.adb, symbols.ads,
	tb-alvms.c, tb-alvxw.c, tempdir.adb, tempdir.ads,
	vms_conv.ads, vms_conv.adb, vms_data.ads,
	vxaddr2line.adb: Files added. Merge with ACT tree.

	* 4dintnam.ads, 4mintnam.ads, 4uintnam.ads, 52system.ads,
	5dosinte.ads, 5etpopse.adb, 5mosinte.ads, 5qosinte.adb,
	5qosinte.ads, 5qstache.adb, 5qtaprop.adb, 5qtaspri.ads,
	5stpopse.adb, 5uintman.adb, 5uosinte.ads, adafinal.c,
	g-enblsp.adb, io-aux.c, scn-nlit.adb, scn-slit.adb,
	s-exnflt.ads, s-exngen.adb, s-exngen.ads, s-exnlfl.ads,
	s-exnlin.ads, s-exnsfl.ads, s-exnsin.ads, s-exnssi.ads,
	s-expflt.ads, s-expgen.adb, s-expgen.ads, s-explfl.ads,
	s-explin.ads, s-expllf.ads, s-expsfl.ads, s-expsin.ads,
	s-expssi.ads, style.adb: Files removed. Merge with ACT tree.

	* 1ic.ads, 31soccon.ads, 31soliop.ads, 3asoccon.ads,
	3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3ssoccon.ads,
	3ssoliop.ads, 3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads,
	3wsoliop.ads, 41intnam.ads, 42intnam.ads, 4aintnam.ads,
	4cintnam.ads, 4gintnam.ads, 4hexcpol.adb, 4hintnam.ads,
	4lintnam.ads, 4nintnam.ads, 4ointnam.ads, 4onumaux.ads,
	4pintnam.ads, 4sintnam.ads, 4vcaldel.adb, 4vcalend.adb,
	4vintnam.ads, 4wexcpol.adb, 4wintnam.ads, 4zintnam.ads,
	51osinte.adb, 51osinte.ads, 52osinte.adb, 52osinte.ads,
	53osinte.ads, 54osinte.ads, 5aosinte.adb, 5aosinte.ads,
	5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads,
	5atpopsp.adb, 5avxwork.ads, 5bosinte.adb, 5bosinte.ads,
	5bsystem.ads, 5cosinte.ads, 5esystem.ads, 5fintman.adb,
	5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads,
	5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gosinte.ads,
	5gproinf.ads, 5gsystem.ads, 5gtaprop.adb, 5gtasinf.ads,
	5gtpgetc.adb, 5hosinte.adb, 5hosinte.ads, 5hsystem.ads,
	5htaprop.adb, 5htaspri.ads, 5htraceb.adb, 5iosinte.adb,
	5itaprop.adb, 5itaspri.ads, 5ksystem.ads, 5kvxwork.ads,
	5lintman.adb, 5lml-tgt.adb, 5losinte.ads, 5lsystem.ads,
	5mvxwork.ads, 5ninmaop.adb, 5nintman.adb, 5nosinte.ads,
	5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb,
	5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb,
	5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads,
	5posprim.adb, 5pvxwork.ads, 5sintman.adb, 5sosinte.adb,
	5sosinte.ads, 5ssystem.ads, 5staprop.adb, 5stasinf.ads,
	5staspri.ads, 5svxwork.ads, 5tosinte.ads, 5vasthan.adb,
	5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads,
	5vmastop.adb, 5vosinte.adb, 5vosinte.ads, 5vosprim.adb,
	5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb,
	5vtpopde.ads, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb,
	5wosprim.adb, 5wsystem.ads, 5wtaprop.adb, 5wtaspri.ads,
	5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zosinte.adb,
	5zosinte.ads, 5zosprim.adb, 5zsystem.ads, 5ztaprop.adb,
	6vcpp.adb, 6vcstrea.adb, 6vinterf.ads, 7sinmaop.adb,
	7sintman.adb, 7sosinte.adb, 7sosprim.adb, 7staprop.adb,
	7staspri.ads, 7stpopsp.adb, 7straceb.adb, 9drpc.adb,
	a-caldel.adb, a-caldel.ads, a-charac.ads, a-colien.ads,
	a-comlin.adb, adaint.c, adaint.h, ada-tree.def,
	a-diocst.adb, a-diocst.ads, a-direio.adb, a-except.adb,
	a-except.ads, a-excpol.adb, a-exctra.adb, a-exctra.ads,
	a-filico.adb, a-interr.adb, a-intsig.adb, a-intsig.ads,
	ali.adb, ali.ads, ali-util.adb, ali-util.ads,
	a-ngcefu.adb, a-ngcoty.adb, a-ngelfu.adb, a-nudira.adb,
	a-nudira.ads, a-nuflra.adb, a-nuflra.ads, a-reatim.adb,
	a-reatim.ads, a-retide.ads, a-sequio.adb, a-siocst.adb,
	a-siocst.ads, a-ssicst.adb, a-ssicst.ads, a-strbou.adb,
	a-strbou.ads, a-strfix.adb, a-strmap.adb, a-strsea.ads,
	a-strunb.adb, a-strunb.ads, a-ststio.adb, a-stunau.adb,
	a-stunau.ads, a-stwibo.adb, a-stwibo.ads, a-stwifi.adb,
	a-stwima.adb, a-stwiun.adb, a-stwiun.ads, a-tags.adb,
	a-tags.ads, a-tasatt.adb, a-taside.adb, a-teioed.adb,
	a-textio.adb, a-textio.ads, a-tienau.adb, a-tifiio.adb,
	a-tiflau.adb, a-tiflio.adb, a-tigeau.adb, a-tigeau.ads,
	a-tiinau.adb, a-timoau.adb, a-tiocst.adb, a-tiocst.ads,
	atree.adb, atree.ads, a-witeio.adb, a-witeio.ads,
	a-wtcstr.adb, a-wtcstr.ads, a-wtdeio.adb, a-wtedit.adb,
	a-wtenau.adb, a-wtflau.adb, a-wtinau.adb, a-wtmoau.adb,
	bcheck.adb, binde.adb, bindgen.adb, bindusg.adb,
	checks.adb, checks.ads, cio.c, comperr.adb,
	comperr.ads, csets.adb, cstand.adb, cstreams.c,
	debug_a.adb, debug_a.ads, debug.adb, decl.c,
	einfo.adb, einfo.ads, errout.adb, errout.ads,
	eval_fat.adb, eval_fat.ads, exp_aggr.adb, expander.adb,
	expander.ads, exp_attr.adb, exp_ch11.adb, exp_ch13.adb,
	exp_ch2.adb, exp_ch3.adb, exp_ch3.ads, exp_ch4.adb,
	exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch7.ads,
	exp_ch8.adb, exp_ch9.adb, exp_code.adb, exp_dbug.adb,
	exp_dbug.ads, exp_disp.adb, exp_dist.adb, expect.c,
	exp_fixd.adb, exp_imgv.adb, exp_intr.adb, exp_pakd.adb,
	exp_prag.adb, exp_strm.adb, exp_strm.ads, exp_tss.adb,
	exp_tss.ads, exp_util.adb, exp_util.ads, exp_vfpt.adb,
	fe.h, fmap.adb, fmap.ads, fname.adb,
	fname.ads, fname-uf.adb, fname-uf.ads, freeze.adb,
	freeze.ads, frontend.adb, g-awk.adb, g-awk.ads,
	g-busora.adb, g-busora.ads, g-busorg.adb, g-busorg.ads,
	g-casuti.adb, g-casuti.ads, g-catiio.adb, g-catiio.ads,
	g-cgi.adb, g-cgi.ads, g-cgicoo.adb, g-cgicoo.ads,
	g-cgideb.adb, g-cgideb.ads, g-comlin.adb, g-comlin.ads,
	g-crc32.adb, g-crc32.ads, g-debpoo.adb, g-debpoo.ads,
	g-debuti.adb, g-debuti.ads, g-diopit.adb, g-diopit.ads,
	g-dirope.adb, g-dirope.ads, g-dyntab.adb, g-dyntab.ads,
	g-except.ads, g-exctra.adb, g-exctra.ads, g-expect.adb,
	g-expect.ads, g-hesora.adb, g-hesora.ads, g-hesorg.adb,
	g-hesorg.ads, g-htable.adb, g-htable.ads, gigi.h,
	g-io.adb, g-io.ads, g-io_aux.adb, g-io_aux.ads,
	g-locfil.adb, g-locfil.ads, g-md5.adb, g-md5.ads,
	gmem.c, gnat1drv.adb, gnatbind.adb, gnatchop.adb,
	gnatcmd.adb, gnatfind.adb, gnatkr.adb, gnatlbr.adb,
	gnatlink.adb, gnatls.adb, gnatmake.adb, gnatmem.adb,
	gnatname.adb, gnatprep.adb, gnatprep.ads, gnatpsta.adb,
	gnatxref.adb, g-os_lib.adb, g-os_lib.ads, g-regexp.adb,
	g-regexp.ads, g-regist.adb, g-regist.ads, g-regpat.adb,
	g-regpat.ads, g-soccon.ads, g-socket.adb, g-socket.ads,
	g-socthi.adb, g-socthi.ads, g-soliop.ads, g-souinf.ads,
	g-speche.adb, g-speche.ads, g-spipat.adb, g-spipat.ads,
	g-spitbo.adb, g-spitbo.ads, g-sptabo.ads, g-sptain.ads,
	g-sptavs.ads, g-table.adb, g-table.ads, g-tasloc.adb,
	g-tasloc.ads, g-thread.adb, g-thread.ads, g-traceb.adb,
	g-traceb.ads, g-trasym.adb, g-trasym.ads, hostparm.ads,
	i-c.ads, i-cobol.adb, i-cpp.adb, i-cstrea.ads,
	i-cstrin.adb, i-cstrin.ads, impunit.adb, init.c,
	inline.adb, interfac.ads, i-pacdec.ads, itypes.adb,
	itypes.ads, i-vxwork.ads, lang.opt, lang-specs.h,
	layout.adb, lib.adb, lib.ads, lib-list.adb,
	lib-load.adb, lib-load.ads, lib-sort.adb, lib-util.adb,
	lib-writ.adb, lib-writ.ads, lib-xref.adb, lib-xref.ads,
	link.c, live.adb, make.adb, make.ads,
	Makefile.adalib, Makefile.in, Make-lang.in, makeusg.adb,
	mdll.adb, mdll-fil.adb, mdll-fil.ads, mdll-utl.adb,
	mdll-utl.ads, memroot.adb, memroot.ads, memtrack.adb,
	misc.c, mkdir.c, mlib.adb, mlib.ads,
	mlib-fil.adb, mlib-fil.ads, mlib-prj.adb, mlib-prj.ads,
	mlib-tgt.adb, mlib-tgt.ads, mlib-utl.adb, mlib-utl.ads,
	namet.adb, namet.ads, namet.h, nlists.ads,
	nlists.h, nmake.adt, opt.adb, opt.ads,
	osint.adb, osint.ads, osint-b.adb, osint-c.adb,
	par.adb, par-ch10.adb, par-ch11.adb, par-ch2.adb,
	par-ch3.adb, par-ch4.adb, par-ch5.adb, par-ch6.adb,
	par-ch9.adb, par-endh.adb, par-labl.adb, par-load.adb,
	par-prag.adb, par-sync.adb, par-tchk.adb, par-util.adb,
	prj.adb, prj.ads, prj-attr.adb, prj-attr.ads,
	prj-com.adb, prj-com.ads, prj-dect.adb, prj-dect.ads,
	prj-env.adb, prj-env.ads, prj-ext.adb, prj-ext.ads,
	prj-makr.adb, prj-makr.ads, prj-nmsc.adb, prj-nmsc.ads,
	prj-pars.adb, prj-pars.ads, prj-part.adb, prj-part.ads,
	prj-pp.adb, prj-pp.ads, prj-proc.adb, prj-proc.ads,
	prj-strt.adb, prj-strt.ads, prj-tree.adb, prj-tree.ads,
	prj-util.adb, prj-util.ads, raise.c, raise.h,
	repinfo.adb, repinfo.h, restrict.adb, restrict.ads,
	rident.ads, rtsfind.adb, rtsfind.ads, s-addima.ads,
	s-arit64.adb, s-assert.adb, s-assert.ads, s-atacco.adb,
	s-atacco.ads, s-auxdec.adb, s-auxdec.ads, s-bitops.adb,
	scans.ads, scn.adb, scn.ads, s-crc32.adb,
	s-crc32.ads, s-direio.adb, sem.adb, sem.ads,
	sem_aggr.adb, sem_attr.adb, sem_attr.ads, sem_case.adb,
	sem_case.ads, sem_cat.adb, sem_cat.ads, sem_ch10.adb,
	sem_ch11.adb, sem_ch12.adb, sem_ch12.ads, sem_ch13.adb,
	sem_ch13.ads, sem_ch3.adb, sem_ch3.ads, sem_ch4.adb,
	sem_ch5.adb, sem_ch5.ads, sem_ch6.adb, sem_ch6.ads,
	sem_ch7.adb, sem_ch7.ads, sem_ch8.adb, sem_ch8.ads,
	sem_ch9.adb, sem_disp.adb, sem_disp.ads, sem_dist.adb,
	sem_elab.adb, sem_eval.adb, sem_eval.ads, sem_intr.adb,
	sem_maps.adb, sem_mech.adb, sem_prag.adb, sem_prag.ads,
	sem_res.adb, sem_res.ads, sem_type.adb, sem_type.ads,
	sem_util.adb, sem_util.ads, sem_warn.adb, s-errrep.adb,
	s-errrep.ads, s-exctab.adb, s-exctab.ads, s-exnint.ads,
	s-exnllf.ads, s-exnlli.ads, s-expint.ads, s-explli.ads,
	s-expuns.ads, s-fatflt.ads, s-fatgen.adb, s-fatgen.ads,
	s-fatlfl.ads, s-fatllf.ads, s-fatsfl.ads, s-fileio.adb,
	s-fileio.ads, s-finimp.adb, s-finimp.ads, s-finroo.adb,
	s-finroo.ads, sfn_scan.adb, s-gloloc.adb, s-gloloc.ads,
	s-imgdec.adb, s-imgenu.adb, s-imgrea.adb, s-imgwch.adb,
	sinfo.adb, sinfo.ads, s-inmaop.ads, sinput.adb,
	sinput.ads, sinput-d.adb, sinput-l.adb, sinput-l.ads,
	sinput-p.adb, sinput-p.ads, s-interr.adb, s-interr.ads,
	s-intman.ads, s-maccod.ads, s-mastop.adb, s-mastop.ads,
	s-memory.adb, s-memory.ads, snames.adb, snames.ads,
	snames.h, s-osprim.ads, s-parame.ads, s-parint.ads,
	s-pooloc.adb, s-pooloc.ads, s-poosiz.adb, sprint.adb,
	s-proinf.ads, s-scaval.ads, s-secsta.adb, s-secsta.ads,
	s-sequio.adb, s-shasto.adb, s-shasto.ads, s-soflin.ads,
	s-stache.adb, s-stache.ads, s-stalib.adb, s-stalib.ads,
	s-stoele.ads, s-stopoo.ads, s-stratt.adb, s-stratt.ads,
	s-strops.adb, s-strops.ads, s-taasde.adb, s-taasde.ads,
	s-tadeca.adb, s-tadeca.ads, s-tadert.adb, s-tadert.ads,
	s-taenca.adb, s-taenca.ads, s-taprob.adb, s-taprob.ads,
	s-taprop.ads, s-tarest.adb, s-tarest.ads, s-tasdeb.adb,
	s-tasdeb.ads, s-tasinf.adb, s-tasinf.ads, s-tasini.adb,
	s-tasini.ads, s-taskin.adb, s-taskin.ads, s-tasque.adb,
	s-tasque.ads, s-tasren.adb, s-tasren.ads, s-tasres.ads,
	s-tassta.adb, s-tassta.ads, s-tasuti.adb, s-tasuti.ads,
	s-tataat.adb, s-tataat.ads, s-tpinop.adb, s-tpinop.ads,
	s-tpoben.adb, s-tpoben.ads, s-tpobop.adb, s-tpobop.ads,
	s-tposen.adb, s-tposen.ads, s-traceb.adb, s-traceb.ads,
	stringt.adb, stringt.ads, stringt.h, style.ads,
	stylesw.adb, stylesw.ads, s-unstyp.ads, s-vaflop.ads,
	s-valrea.adb, s-valuti.adb, s-vercon.adb, s-vmexta.adb,
	s-wchcnv.ads, s-wchcon.ads, s-widcha.adb, switch.adb,
	switch.ads, switch-b.adb, switch-c.adb, switch-m.adb,
	s-wwdcha.adb, s-wwdwch.adb, sysdep.c, system.ads,
	table.adb, table.ads, targparm.adb, targparm.ads,
	targtyps.c, tbuild.adb, tbuild.ads, tracebak.c,
	trans.c, tree_io.adb, treepr.adb, treeprs.adt,
	ttypes.ads, types.ads, types.h, uintp.adb,
	uintp.ads, uintp.h, uname.adb, urealp.adb,
	urealp.ads, urealp.h, usage.adb, utils2.c,
	utils.c, validsw.adb, validsw.ads, widechar.adb,
	xeinfo.adb, xnmake.adb, xref_lib.adb, xref_lib.ads,
	xr_tabls.adb, xr_tabls.ads, xtreeprs.adb, xsnames.adb,
	einfo.h, sinfo.h, treeprs.ads, nmake.ads, nmake.adb,
	gnatvsn.ads: Merge with ACT tree.

	* gnatvsn.adb: Rewritten in a simpler and more efficient way.

From-SVN: r72751

1 files changed, 888 insertions, 394 deletions

diff --git a/gcc/ada/raise.c b/gcc/ada/raise.c
index a984174..751c01d 100644
--- a/gcc/ada/raise.c
+++ b/gcc/ada/raise.c
@@ -6,8 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *                                                                          *
- *             Copyright (C) 1992-2002, Free Software Foundation, Inc.      *
+ *             Copyright (C) 1992-2003, 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- *
@@ -35,6 +34,14 @@
 
 #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;
@@ -88,565 +95,1052 @@ __gnat_unhandled_terminate ()
 }
 
 /* Below is the code related to the integration of the GCC mechanism for
-   exception handling. Still work in progress. */
+   exception handling.  */
 
 #include "unwind.h"
 
-/* If the underlying GCC scheme for exception handling is SJLJ, the standard
-   propagation routine (_Unwind_RaiseException) is actually renamed using a
-   #define directive (see unwing-sjlj.c). We need a consistently named
-   interface to import from a-except, so stubs are defined here, at the end
-   of this file.  */
+/* 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 stubs are defined here.  */
 
-_Unwind_Reason_Code
-__gnat_Unwind_RaiseException PARAMS ((struct _Unwind_Exception *));
+typedef struct _Unwind_Context _Unwind_Context;
+typedef struct _Unwind_Exception _Unwind_Exception;
 
+_Unwind_Reason_Code
+__gnat_Unwind_RaiseException PARAMS ((_Unwind_Exception *));
 
-/* Exception Handling personality routine for Ada.
+_Unwind_Reason_Code
+__gnat_Unwind_ForcedUnwind PARAMS ((_Unwind_Exception *, void *, void *));
 
-   ??? It is currently inspired from the one for C++, needs cleanups and
-   additional comments. It also contains a big bunch of debugging code that
-   we shall get rid of at some point.  */
 
 #ifdef IN_RTS   /* For eh personality routine */
 
-/* ??? Does it make any sense to leave this for the compiler ?   */
-
 #include "dwarf2.h"
 #include "unwind-dw2-fde.h"
 #include "unwind-pe.h"
 
-/* First define a set of useful structures and helper routines.  */
 
-typedef struct _Unwind_Context _Unwind_Context;
+/* --------------------------------------------------------------
+   -- The DB stuff below is there for debugging purposes only. --
+   -------------------------------------------------------------- */
 
-struct lsda_header_info
+#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_Ptr Start;
-  _Unwind_Ptr LPStart;
-  _Unwind_Ptr ttype_base;
-  const unsigned char *TType;
-  const unsigned char *action_table;
-  unsigned char ttype_encoding;
-  unsigned char call_site_encoding;
-};
+  _Unwind_Action phase;
+  char * description;
+} phase_descriptor;
 
-typedef struct lsda_header_info lsda_header_info;
+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 const unsigned char *
-parse_lsda_header (context, p, info)
-     _Unwind_Context *context;
-     const unsigned char *p;
-     lsda_header_info *info;
+static int
+db_accepted_codes (void)
 {
-  _Unwind_Ptr tmp;
-  unsigned char lpstart_encoding;
+  static int accepted_codes = -1;
 
-  info->Start = (context ? _Unwind_GetRegionStart (context) : 0);
+  if (accepted_codes == -1)
+    {
+      char * db_env = getenv ("EH_DEBUG");
 
-  /* Find @LPStart, the base to which landing pad offsets are relative.  */
-  lpstart_encoding = *p++;
-  if (lpstart_encoding != DW_EH_PE_omit)
-    p = read_encoded_value (context, lpstart_encoding, p, &info->LPStart);
-  else
-    info->LPStart = info->Start;
+      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.  */
+    }
 
-  /* Find @TType, the base of the handler and exception spec type data.  */
-  info->ttype_encoding = *p++;
-  if (info->ttype_encoding != DW_EH_PE_omit)
+  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)
     {
-      p = read_uleb128 (p, &tmp);
-      info->TType = p + tmp;
+      current_indentation_level = 0;
     }
-  else
-    info->TType = 0;
 
-  /* The encoding and length of the call-site table; the action table
-     immediately follows.  */
-  info->call_site_encoding = *p++;
-  p = read_uleb128 (p, &tmp);
-  info->action_table = p + tmp;
+  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, " ");
+    }
 
-  return p;
 }
 
-static const _Unwind_Ptr
-get_ttype_entry (context, info, i)
-     _Unwind_Context *context;
-     lsda_header_info *info;
-     long i;
+static void
+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)
 {
-  _Unwind_Ptr ptr;
+  phase_descriptor *a = phase_descriptors;
+
+  if (! (db_accepted_codes() & DB_PHASES))
+    return;
 
-  i *= size_of_encoded_value (info->ttype_encoding);
-  read_encoded_value (context, info->ttype_encoding, info->TType - i, &ptr);
+  db (DB_PHASES, "\n");
+
+  for (; a->description != 0; a++)
+    if (phases & a->phase)
+      db (DB_PHASES, "%s ", a->description);
 
-  return ptr;
+  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 beeing 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 beeing 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 beeing 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 the structure of exception objects as built by the GNAT runtime
-   library (a-except.adb). The layouts should exactly match, and the "common"
+   library (a-exexpr.adb). The layouts should exactly match, and the "common"
    header is mandated by the exception handling ABI.  */
 
-struct _GNAT_Exception
+typedef struct
 {
-  struct _Unwind_Exception common;
+  _Unwind_Exception common;
+  /* ABI header, maximally aligned. */
+
   _Unwind_Ptr id;
-  char handled_by_others;
-  char has_cleanup;
-  char select_cleanups;
-};
+  /* Id of the exception beeing propagated, filled by Propagate_Exception.
+
+     This is compared against the ttype entries associated with actions in the
+     examined context to see if one of these actions matches.  */
+
+  bool handled_by_others;
+  /* Indicates wether a "when others" may catch this exception, also filled by
+     Propagate_Exception.
+
+     This is used to decide if a GNAT_OTHERS ttype entry matches.  */
 
+  int  n_cleanups_to_trigger;
+  /* Number of cleanups on the propagation way for the occurrence. This is
+     initialized to 0 by Propagate_Exception and computed by the personality
+     routine during the first phase of the propagation (incremented for each
+     context in which only cleanup actions match).
+
+     This is used by Propagate_Exception when the occurrence is not handled,
+     to control a forced unwinding phase aimed at triggering all the cleanups
+     before calling Unhandled_Exception_Terminate.
+
+     This is also used by __gnat_eh_personality to identify the point at which
+     the notification routine shall be called for a handled occurrence.  */
+} _GNAT_Exception;
 
 /* The two constants below are specific ttype identifiers for special
    exception ids. Their value is currently hardcoded at the gigi level
    (see N_Exception_Handler).  */
 
-#define GNAT_OTHERS_ID      ((_Unwind_Ptr) 0x0)
-#define GNAT_ALL_OTHERS_ID  ((_Unwind_Ptr) 0x1)
+#define GNAT_OTHERS      ((_Unwind_Ptr) 0x0)
+#define GNAT_ALL_OTHERS  ((_Unwind_Ptr) 0x1)
 
+/* Describe the useful region data associated with an unwind context.  */
 
-/* The DB stuff below is there for debugging purposes only.  */
+typedef struct
+{
+  /* The base pc of the region.  */
+  _Unwind_Ptr base;
 
-#define DB_PHASES     0x1
-#define DB_SEARCH     0x2
-#define DB_ECLASS     0x4
-#define DB_MATCH      0x8
-#define DB_SAW        0x10
-#define DB_FOUND      0x20
-#define DB_INSTALL    0x40
-#define DB_CALLS      0x80
+  /* Pointer to the Language Specific Data for the region.  */
+  _Unwind_Ptr lsda;
 
-#define AEHP_DB_SPECS \
-(DB_PHASES | DB_SEARCH | DB_SAW | DB_FOUND | DB_INSTALL | DB_CALLS | DB_MATCH)
+  /* Call-Site data associated with this region.  */
+  unsigned char call_site_encoding;
+  const unsigned char *call_site_table;
 
-#undef AEHP_DB_SPECS
+  /* The base to which are relative landing pad offsets inside the call-site
+     entries .  */
+  _Unwind_Ptr lp_base;
 
-#ifdef AEHP_DB_SPECS
-static int db_specs = AEHP_DB_SPECS;
-#else
-static int db_specs = 0;
-#endif
+  /* Action-Table associated with this region.  */
+  const unsigned char *action_table;
 
-#define START_DB(what) do { if (what & db_specs) {
-#define END_DB(what)        } \
-                           } while (0);
+  /* 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, uw_context)
+     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, filter)
+     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 (uw_context, region)
+     _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 beeing 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;
 
-/* The "action" stuff below is also there for debugging purposes only.  */
 
 typedef struct
 {
-  _Unwind_Action action;
-  char * description;
-} action_description_t;
+  /* 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 action_description_t action_descriptions[]
-  = {{ _UA_SEARCH_PHASE,  "SEARCH_PHASE" },
-     { _UA_CLEANUP_PHASE, "CLEANUP_PHASE" },
-     { _UA_HANDLER_FRAME, "HANDLER_FRAME" },
-     { _UA_FORCE_UNWIND,  "FORCE_UNWIND" },
-     { -1, 0}};
 
 static void
-decode_actions (actions)
-     _Unwind_Action actions;
+db_action_for (action, uw_context)
+     action_descriptor *action;
+     _Unwind_Context *uw_context;
 {
-  int i;
+  _Unwind_Ptr ip = _Unwind_GetIP (uw_context) - 1;
 
-  action_description_t *a = action_descriptions;
+  db (DB_ACTIONS, "For ip @ 0x%08x => ", ip);
 
-  printf ("\n");
-  for (; a->description != 0; a++)
-    if (actions & a->action)
-      printf ("%s ", a->description);
+  switch (action->kind)
+     {
+     case unknown:
+       db (DB_ACTIONS, "lpad @ 0x%x, record @ 0x%x\n",
+	   ip, 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;
+    }
 
-  printf (" : ");
+  return;
 }
 
-/* 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 PARAMS ((void *, bool, bool));
 
-/* Below is the eh personality routine per se.  */
+/* 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.
 
-_Unwind_Reason_Code
-__gnat_eh_personality (version, actions, exception_class, ue_header, context)
-     int version;
-     _Unwind_Action actions;
-     _Unwind_Exception_Class exception_class;
-     struct _Unwind_Exception *ue_header;
-     struct _Unwind_Context *context;
+   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 (uw_context, region, action)
+     _Unwind_Context *uw_context;
+     region_descriptor *region;
+     action_descriptor *action;
 {
-  enum found_handler_type
-  {
-    found_nothing,
-    found_terminate,
-    found_cleanup,
-    found_handler
-  } found_type;
-  lsda_header_info info;
-  const unsigned char *language_specific_data;
-  const unsigned char *action_record;
-  const unsigned char *p;
-  _Unwind_Ptr landing_pad, ip;
-  int handler_switch_value;
-  bool hit_others_handler;
-  struct _GNAT_Exception *gnat_exception;
-
-  if (version != 1)
-    return _URC_FATAL_PHASE1_ERROR;
+  _Unwind_Ptr call_site
+    = _Unwind_GetIP (uw_context) - 1;
+  /* Subtract 1 because GetIP returns the actual call_site value + 1.  */
 
-  START_DB (DB_PHASES);
-  decode_actions (actions);
-  END_DB (DB_PHASES);
+  /* 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 (strcmp ((char *) &exception_class, "GNU") != 0
-      || strcmp (((char *) &exception_class) + 4, "Ada") != 0)
+  if ((int)call_site < 0)
     {
-      START_DB (DB_SEARCH);
-      printf ("              Exception Class doesn't match for ip = %p\n", ip);
-      END_DB (DB_SEARCH);
-      START_DB (DB_FOUND);
-      printf ("              => FOUND nothing\n");
-      END_DB (DB_FOUND);
-      return _URC_CONTINUE_UNWIND;
+      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;
 
-  gnat_exception = (struct _GNAT_Exception *) ue_header;
+      /* Let the caller know there may be an action to take, but let it
+	 determine the kind.  */
+      action->kind = unknown;
 
-  START_DB (DB_PHASES);
-  if (gnat_exception->select_cleanups)
-    printf ("(select_cleanups) :\n");
-  else
-    printf (" :\n");
-  END_DB (DB_PHASES);
+      /* 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.  */
 
-  language_specific_data
-    = (const unsigned char *) _Unwind_GetLanguageSpecificData (context);
+      const unsigned char * p = region->call_site_table;
 
-  /* If no LSDA, then there are no handlers or cleanups.  */
-  if (! language_specific_data)
-    {
-      ip = _Unwind_GetIP (context) - 1;
-
-      START_DB (DB_SEARCH);
-      printf ("              No Language Specific Data for ip = %p\n", ip);
-      END_DB (DB_SEARCH);
-      START_DB (DB_FOUND);
-      printf ("              => FOUND nothing\n");
-      END_DB (DB_FOUND);
-      return _URC_CONTINUE_UNWIND;
+      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 (uw_context, region, action)
+     _Unwind_Context *uw_context;
+     region_descriptor *region;
+     action_descriptor *action;
+{
+  _Unwind_Ptr ip
+    = _Unwind_GetIP (uw_context) - 1;
+  /* Substract 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.  */
 
-  /* Parse the LSDA header.  */
-  p = parse_lsda_header (context, language_specific_data, &info);
-  info.ttype_base = base_of_encoded_value (info.ttype_encoding, context);
-  ip = _Unwind_GetIP (context) - 1;
-  landing_pad = 0;
-  action_record = 0;
-  handler_switch_value = 0;
+  const unsigned char * p
+    = region->call_site_table;
 
-  /* Search the call-site table for the action associated with this IP.  */
-  while (p < info.action_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, info.call_site_encoding, p, &cs_start);
-      p = read_encoded_value (0, info.call_site_encoding, p, &cs_len);
-      p = read_encoded_value (0, info.call_site_encoding, p, &cs_lp);
+      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 < info.Start + cs_start)
- 	p = info.action_table;
-      else if (ip < info.Start + cs_start + cs_len)
+      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)
-	    landing_pad = info.LPStart + cs_lp;
+	    action->landing_pad = region->lp_base + cs_lp;
+	  else
+	    action->landing_pad = 0;
+
 	  if (cs_action)
-	    action_record = info.action_table + cs_action - 1;
-	  goto found_something;
+	    action->table_entry = region->action_table + cs_action - 1;
+	  else
+	    action->table_entry = 0;
+
+	  db (DB_CSITE, "+++\n");
+	  return;
 	}
     }
 
-  START_DB (DB_SEARCH);
-  printf ("              No Action entry for ip = %p\n", ip);
-  END_DB (DB_SEARCH);
+  db (DB_CSITE, "---\n");
+}
 
-  /* If ip is not present in the table, call terminate.  This is for
-     a destructor inside a cleanup, or a library routine the compiler
-     was not expecting to throw.
+#endif
 
-     found_type = 
-     (actions & _UA_FORCE_UNWIND ? found_nothing : found_terminate);
+/* Fill out the ACTION to be taken from propagating UW_EXCEPTION up to
+   UW_CONTEXT in REGION.  */
 
-     ??? Does this have a mapping in Ada semantics ?  */
+static void
+get_action_description_for (uw_context, uw_exception, region, action)
+     _Unwind_Context *uw_context;
+     _Unwind_Exception *uw_exception;
+     region_descriptor *region;
+     action_descriptor *action;
+{
+  _GNAT_Exception * gnat_exception = (_GNAT_Exception *) uw_exception;
 
-  found_type = found_nothing;
-  goto do_something;
+  /* 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);
 
- found_something:
+  /* If there is not even a call_site entry, we are done.  */
+  if (action->kind == nothing)
+    return;
 
-  found_type = found_nothing;
+  /* Otherwise, check what we have at the place of the call site  */
 
-  if (landing_pad == 0)
+  /* No landing pad => no cleanups or handlers.  */
+  if (action->landing_pad == 0)
     {
-      /* If ip is present, and has a null landing pad, there are
-	 no cleanups or handlers to be run.  */
-      START_DB (DB_SEARCH);
-      printf ("              No Landing Pad for ip = %p\n", ip);
-      END_DB (DB_SEARCH);
+      action->kind = nothing;
+      return;
     }
-  else if (action_record == 0)
+
+  /* Landing pad + null table entry => only cleanups.  */
+  else if (action->table_entry == 0)
     {
-      START_DB (DB_SEARCH);
-      printf ("              Null Action Record for ip = %p <===\n", ip);
-      END_DB (DB_SEARCH);
+      action->kind = cleanup;
+      return;
     }
+
+  /* Landing pad + Table entry => handlers + possible cleanups.  */
   else
     {
-      signed long ar_filter, ar_disp;
-      signed long cleanup_filter = 0;
-      signed long handler_filter = 0;
+      const unsigned char * p = action->table_entry;
 
-      START_DB (DB_SEARCH);
-      printf ("              Landing Pad + Action Record for ip = %p\n", ip);
-      END_DB (DB_SEARCH);
+      _Unwind_Sword ar_filter, ar_disp;
 
-      START_DB (DB_MATCH);
-      printf ("              => Search for exception matching id %p\n", 
-	      gnat_exception->id);
-      END_DB (DB_MATCH);
-
-      /* Otherwise we have a catch handler or exception specification.  */
+      action->kind = nothing;
 
       while (1)
 	{
-	  _Unwind_Word tmp;
-
-	  p = action_record;
-	  p = read_sleb128 (p, &tmp); ar_filter = tmp;
-	  read_sleb128 (p, &tmp); ar_disp = tmp;
-
-	  START_DB (DB_MATCH);
-	  printf ("ar_filter  %d\n", ar_filter);
-	  END_DB (DB_MATCH);
+	  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)
-	    {
-	      /* Zero filter values are cleanups. We should not be seeing
-		 this for GNU-Ada though
-		 saw_cleanup = true;  */
-	      START_DB (DB_SEARCH);
-	      printf ("              Null Filter for ip = %p <===\n", ip);
-	      END_DB (DB_SEARCH);
-	    }
+	    action->kind = cleanup;
+
+	  /* Positive filters are for regular handlers.  */
 	  else if (ar_filter > 0)
 	    {
-	      _Unwind_Ptr lp_id = get_ttype_entry (context, &info, ar_filter);
-
-	      START_DB (DB_MATCH);
-	      printf ("catch_type ");
-
-	      switch (lp_id)
-		{
-		case GNAT_ALL_OTHERS_ID:
-		  printf ("GNAT_ALL_OTHERS_ID\n");		
-		  break;
-
-		case GNAT_OTHERS_ID:
-		  printf ("GNAT_OTHERS_ID\n");
-		  break;
-
-		default:
-		  printf ("%p\n", lp_id);
-		  break;
-		}
-
-	      END_DB (DB_MATCH);
-
-	      if (lp_id == GNAT_ALL_OTHERS_ID)
-		{
-		  START_DB (DB_SAW);
-		  printf ("              => SAW cleanup\n");
-		  END_DB (DB_SAW);
-
-		  cleanup_filter = ar_filter;
-		  gnat_exception->has_cleanup = true;
-		}
-
-	      hit_others_handler
-		= (lp_id == GNAT_OTHERS_ID
-		   && gnat_exception->handled_by_others);
+	      /* See if the filter we have is for an exception which matches
+		 the one we are propagating.  */
+	      _Unwind_Ptr eid = get_ttype_entry_for (region, ar_filter);
 
-	      if (hit_others_handler || lp_id == gnat_exception->id)
+	      if (eid == gnat_exception->id
+		  || eid == GNAT_ALL_OTHERS
+		  || (eid == GNAT_OTHERS && gnat_exception->handled_by_others))
 		{
-		  START_DB (DB_SAW);
-		  printf ("              => SAW handler\n");
-		  END_DB (DB_SAW);
-
-		  handler_filter = ar_filter;     
+		  action->ttype_filter = ar_filter;
+		  action->ttype_entry = eid;
+		  action->kind = handler;
+		  return;
 		}
 	    }
+
+	  /* Negative filter values are for C++ exception specifications.
+	     Should not be there for Ada :/  */
 	  else
-	    /* Negative filter values are for C++ exception specifications.
-	       Should not be there for Ada :/  */
-	    ;
+	    db (DB_ERR, "========> Err, filter < 0 for Ada/dwarf\n");
 
-	  if (actions & _UA_SEARCH_PHASE)
-	    {
-	      if (handler_filter)
-		{
-		  found_type = found_handler;
-		  handler_switch_value = handler_filter;
-		  break;
-		}
+	  if (ar_disp == 0)
+	    return;
 
-	      if (cleanup_filter)
-		found_type = found_cleanup;
-	    }
+	  p += ar_disp;
+	}
+    }
+}
 
-	  if (actions & _UA_CLEANUP_PHASE)
-	    {
-	      if (handler_filter)
-		{
-		  found_type = found_handler;
-		  handler_switch_value = handler_filter;
-		  break;
-		}
+/* 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
+   occured.  */
 
-	      if (cleanup_filter)
-		{
-		  found_type = found_cleanup;
-		  handler_switch_value = cleanup_filter;
-		  break;
-		}
-	    }
+static void
+setup_to_install (uw_context, uw_exception, uw_landing_pad, uw_filter)
+     _Unwind_Context *uw_context;
+     _Unwind_Exception *uw_exception;
+     int uw_filter;
+     _Unwind_Ptr uw_landing_pad;
+{
+#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
+}
 
-	  if (ar_disp == 0)
-	    break;
+/* 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 PARAMS ((void));
+extern void __gnat_notify_unhandled_exception PARAMS ((void));
 
-	  action_record = p + ar_disp;
-	}
-    }
+/* Below is the eh personality routine per se. We currently assume that only
+   GNU-Ada exceptions are met.  */
 
- do_something:
-  if (found_type == found_nothing)
-    {
-      START_DB (DB_FOUND);
-      printf ("              => FOUND nothing\n");
-      END_DB (DB_FOUND);
+_Unwind_Reason_Code
+__gnat_eh_personality (uw_version, uw_phases,
+		       uw_exception_class, uw_exception, uw_context)
+     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;
 
-      return _URC_CONTINUE_UNWIND;
-    }
+  region_descriptor region;
+  action_descriptor action;
 
-  if (actions & _UA_SEARCH_PHASE)
-    {
-      START_DB (DB_FOUND);
-      printf ("              => Computing return for SEARCH\n");
-      END_DB (DB_FOUND);
+  if (uw_version != 1)
+    return _URC_FATAL_PHASE1_ERROR;
 
-      if (found_type == found_cleanup
-	  && !gnat_exception->select_cleanups)
+  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)
 	{
-	  START_DB (DB_FOUND);
-	  printf ("              => FOUND cleanup\n");
-	  END_DB (DB_FOUND);
-
+	  gnat_exception->n_cleanups_to_trigger ++;
 	  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 ();
 
-      START_DB (DB_FOUND);
-      printf ("              => FOUND handler\n");
-      END_DB (DB_FOUND);
-
-      return _URC_HANDLER_FOUND;
+	  return _URC_HANDLER_FOUND;
+	}
     }
 
- install_context:
+  /* 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.  */
 
-   START_DB (DB_INSTALL);
-   printf ("              => INSTALLING context for filter %d\n",
-	   handler_switch_value);
-   END_DB (DB_INSTALL);
+  /* 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)
+    gnat_exception->n_cleanups_to_trigger --;
 
-   if (found_type == found_terminate)
-     {
-       /* Should not have this for Ada ?  */
-       START_DB (DB_INSTALL);
-       printf ("              => FOUND terminate <===\n");
-       END_DB (DB_INSTALL);
-     }
+  setup_to_install
+    (uw_context, uw_exception, action.landing_pad, action.ttype_filter);
 
+  return _URC_INSTALL_CONTEXT;
+}
 
-   /* Signal that we are going to enter a handler, which will typically
-      enable the debugger to take control and possibly output an automatic
-      backtrace. Note that we are supposed to provide the handler's entry
-      point here but we don't have it.  */
-  __gnat_notify_handled_exception ((void *)landing_pad, hit_others_handler,
-				   true);
+/* Define the consistently named stubs imported by Propagate_Exception.  */
 
-   /* The GNU-Ada exception handlers know how to find the exception
-      occurrence without having to pass it as an argument so there
-      is no need to feed any specific register with this information.
+#ifdef __USING_SJLJ_EXCEPTIONS__
 
-      This is why the two following lines are commented out.  */
+#undef _Unwind_RaiseException
 
-   /* _Unwind_SetGR (context, __builtin_eh_return_data_regno (0),
-      (_Unwind_Ptr) &xh->unwindHeader);  */
+_Unwind_Reason_Code
+__gnat_Unwind_RaiseException (e)
+     _Unwind_Exception *e;
+{
+  return _Unwind_SjLj_RaiseException (e);
+}
 
-  _Unwind_SetGR (context, __builtin_eh_return_data_regno (1),
-		 handler_switch_value);
 
-  _Unwind_SetIP (context, landing_pad);
+#undef _Unwind_ForcedUnwind
 
-  return _URC_INSTALL_CONTEXT;
+_Unwind_Reason_Code
+__gnat_Unwind_ForcedUnwind (e, handler, argument)
+     _Unwind_Exception *e;
+     void * handler;
+     void * argument;
+{
+  return _Unwind_SjLj_ForcedUnwind (e, handler, argument);
 }
 
 
-/* Stubs for the libgcc unwinding interface, to be imported by a-except.  */ 
-
-#ifdef __USING_SJLJ_EXCEPTIONS__
+#else /* __USING_SJLJ_EXCEPTIONS__ */
 
 _Unwind_Reason_Code
 __gnat_Unwind_RaiseException (e)
-     struct _Unwind_Exception *e;
+     _Unwind_Exception *e;
 {
-  return _Unwind_SjLj_RaiseException (e);
+  return _Unwind_RaiseException (e);
 }
 
-#else
-/* __USING_SJLJ_EXCEPTIONS__ not defined */
-
 _Unwind_Reason_Code
-__gnat_Unwind_RaiseException (e)
-     struct _Unwind_Exception *e;
+__gnat_Unwind_ForcedUnwind (e, handler, argument)
+     _Unwind_Exception *e;
+     void * handler;
+     void * argument;
 {
-  return _Unwind_RaiseException (e);
+  return _Unwind_ForcedUnwind (e, handler, argument);
 }
- 
-#endif
+
+#endif /* __USING_SJLJ_EXCEPTIONS__ */
 
 #else
-/* IN_RTS not defined */
+/* ! IN_RTS  */
 
 /* The calls to the GCC runtime interface for exception raising are currently
-   issued from a-except.adb, which is used by both the runtime library and
-   the compiler. As the compiler binary is not linked against the GCC runtime
-   library, we need a stub for this interface in the compiler case.  */
+   issued from a-exexpr.adb, which is used by both the runtime library and the
+   compiler.
 
-/* Since we don't link the compiler with a host libgcc, we should not be
-   using the GCC eh mechanism for the compiler and so expect this function
-   never to be called.  */
+   As the compiler binary is not linked against the GCC runtime library, we
+   need also need stubs for this interface in the compiler case. We should not
+   be using the GCC eh mechanism for the compiler, however, so expect these
+   functions never to be called.  */
 
 _Unwind_Reason_Code
 __gnat_Unwind_RaiseException (e)
-     struct _Unwind_Exception *e ATTRIBUTE_UNUSED;
+     _Unwind_Exception *e ATTRIBUTE_UNUSED;
 {
   abort ();
 }
 
-#endif
+
+_Unwind_Reason_Code
+__gnat_Unwind_ForcedUnwind (e, handler, argument)
+     _Unwind_Exception *e ATTRIBUTE_UNUSED;
+     void * handler ATTRIBUTE_UNUSED;
+     void * argument ATTRIBUTE_UNUSED;
+{
+  abort ();
+}
+
+#endif /* IN_RTS */