diff options
author | Arnaud Charlet <charlet@act-europe.fr> | 2003-10-21 15:42:24 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2003-10-21 15:42:24 +0200 |
commit | fbf5a39b3e101719c6bf03cf2cd013b4a312e275 (patch) | |
tree | bdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/utils.c | |
parent | 75a5a481c2048242ed62c7355381160aa1369616 (diff) | |
download | gcc-fbf5a39b3e101719c6bf03cf2cd013b4a312e275.zip gcc-fbf5a39b3e101719c6bf03cf2cd013b4a312e275.tar.gz gcc-fbf5a39b3e101719c6bf03cf2cd013b4a312e275.tar.bz2 |
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
Diffstat (limited to 'gcc/ada/utils.c')
-rw-r--r-- | gcc/ada/utils.c | 405 |
1 files changed, 289 insertions, 116 deletions
diff --git a/gcc/ada/utils.c b/gcc/ada/utils.c index 186b0fd..c1c5ccf 100644 --- a/gcc/ada/utils.c +++ b/gcc/ada/utils.c @@ -6,7 +6,6 @@ * * * C Implementation File * * * - * * * Copyright (C) 1992-2003, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * @@ -154,18 +153,16 @@ static tree convert_to_fat_pointer PARAMS ((tree, tree)); static tree convert_to_thin_pointer PARAMS ((tree, tree)); static tree make_descriptor_field PARAMS ((const char *,tree, tree, tree)); +static int value_factor_p PARAMS ((tree, int)); +static int potential_alignment_gap PARAMS ((tree, tree, tree)); /* Initialize the association of GNAT nodes to GCC trees. */ void init_gnat_to_gnu () { - Node_Id gnat_node; - - associate_gnat_to_gnu = (tree *) ggc_alloc (max_gnat_nodes * sizeof (tree)); - - for (gnat_node = 0; gnat_node < max_gnat_nodes; gnat_node++) - associate_gnat_to_gnu[gnat_node] = NULL_TREE; + associate_gnat_to_gnu + = (tree *) ggc_alloc_cleared (max_gnat_nodes * sizeof (tree)); pending_elaborations = build_tree_list (NULL_TREE, NULL_TREE); } @@ -182,6 +179,10 @@ save_gnu_tree (gnat_entity, gnu_decl, no_check) tree gnu_decl; int no_check; { + /* Check that GNAT_ENTITY is not already defined and that it is being set + to something which is a decl. Raise gigi 401 if not. Usually, this + means GNAT_ENTITY is defined twice, but occasionally is due to some + Gigi problem. */ if (gnu_decl && (associate_gnat_to_gnu[gnat_entity - First_Node_Id] || (! no_check && ! DECL_P (gnu_decl)))) @@ -491,9 +492,11 @@ gnat_init_decl_processing () build_common_tree_nodes (0); /* In Ada, we use a signed type for SIZETYPE. Use the signed type - corresponding to the size of ptr_mode. Make this here since we need + corresponding to the size of Pmode. In most cases when ptr_mode and + Pmode differ, C will use the width of ptr_mode as sizetype. But we get + far better code using the width of Pmode. Make this here since we need this before we can expand the GNAT types. */ - set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (ptr_mode), 0)); + set_sizetype (gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0)); build_common_tree_nodes_2 (0); pushdecl (build_decl (TYPE_DECL, get_identifier (SIZE_TYPE), sizetype)); @@ -562,7 +565,6 @@ init_gigi_decls (long_long_float_type, exception_type) NULL_TREE, 0, 1, 1, 0); /* free is a function declaration tree for a function to free memory. */ - free_decl = create_subprog_decl (get_identifier ("__gnat_free"), NULL_TREE, build_function_type (void_type_node, @@ -611,6 +613,23 @@ init_gigi_decls (long_long_float_type, exception_type) endlink)), NULL_TREE, 0, 1, 1, 0); + /* Hooks to call when entering/leaving an exception handler. */ + begin_handler_decl + = create_subprog_decl (get_identifier ("__gnat_begin_handler"), NULL_TREE, + build_function_type (void_type_node, + tree_cons (NULL_TREE, + ptr_void_type_node, + endlink)), + NULL_TREE, 0, 1, 1, 0); + + end_handler_decl + = create_subprog_decl (get_identifier ("__gnat_end_handler"), NULL_TREE, + build_function_type (void_type_node, + tree_cons (NULL_TREE, + ptr_void_type_node, + endlink)), + NULL_TREE, 0, 1, 1, 0); + /* If in no exception handlers mode, all raise statements are redirected to __gnat_last_chance_handler. No need to redefine raise_nodefer_decl, since this procedure will never be called in this mode. */ @@ -681,19 +700,6 @@ init_gigi_decls (long_long_float_type, exception_type) main_identifier_node = get_identifier ("main"); } -/* This function is called indirectly from toplev.c to handle incomplete - declarations, i.e. VAR_DECL nodes whose DECL_SIZE is zero. To be precise, - compile_file in toplev.c makes an indirect call through the function pointer - incomplete_decl_finalize_hook which is initialized to this routine in - init_decl_processing. */ - -void -gnat_finish_incomplete_decl (dont_care) - tree dont_care ATTRIBUTE_UNUSED; -{ - gigi_abort (405); -} - /* Given a record type (RECORD_TYPE) and a chain of FIELD_DECL nodes (FIELDLIST), finish constructing the record or union type. If HAS_REP is nonzero, this record has a rep clause; don't call @@ -741,6 +747,10 @@ finish_record_type (record_type, fieldlist, has_rep, defer_debug) TYPE_SIZE (record_type) = bitsize_zero_node; TYPE_SIZE_UNIT (record_type) = size_zero_node; } + /* For all-repped records with a size specified, lay the QUAL_UNION_TYPE + out just like a UNION_TYPE, since the size will be fixed. */ + else if (code == QUAL_UNION_TYPE) + code = UNION_TYPE; } else { @@ -847,29 +857,31 @@ finish_record_type (record_type, fieldlist, has_rep, defer_debug) && ! TYPE_CONTAINS_TEMPLATE_P (record_type)) SET_TYPE_ADA_SIZE (record_type, ada_size); - size = round_up (size, TYPE_ALIGN (record_type)); - size_unit = round_up (size_unit, TYPE_ALIGN (record_type) / BITS_PER_UNIT); - - if (has_rep - && ! (TREE_CODE (record_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (record_type) - && TREE_CODE (size) != INTEGER_CST - && contains_placeholder_p (size))) + if (has_rep) { - TYPE_SIZE (record_type) = size; - TYPE_SIZE_UNIT (record_type) = size_unit; - } + if (! (TREE_CODE (record_type) == RECORD_TYPE + && TYPE_IS_PADDING_P (record_type) + && CONTAINS_PLACEHOLDER_P (size))) + { + TYPE_SIZE (record_type) = round_up (size, TYPE_ALIGN (record_type)); + TYPE_SIZE_UNIT (record_type) + = round_up (size_unit, + TYPE_ALIGN (record_type) / BITS_PER_UNIT); + } - if (has_rep) - compute_record_mode (record_type); + compute_record_mode (record_type); + } if (! defer_debug) { /* If this record is of variable size, rename it so that the debugger knows it is and make a new, parallel, record that tells the debugger how the record is laid out. See - exp_dbug.ads. */ - if (var_size) + exp_dbug.ads. But don't do this for records that are padding + since they confuse GDB. */ + if (var_size + && ! (TREE_CODE (record_type) == RECORD_TYPE + && TYPE_IS_PADDING_P (record_type))) { tree new_record_type = make_node (TREE_CODE (record_type) == QUAL_UNION_TYPE @@ -881,6 +893,7 @@ finish_record_type (record_type, fieldlist, has_rep, defer_debug) ? "XVU" : "XVE"); tree last_pos = bitsize_zero_node; tree old_field; + tree prev_old_field = 0; TYPE_NAME (new_record_type) = new_id; TYPE_ALIGN (new_record_type) = BIGGEST_ALIGNMENT; @@ -940,6 +953,13 @@ finish_record_type (record_type, fieldlist, has_rep, defer_debug) pos = compute_related_constant (curpos, round_up (last_pos, align)); } + else if (potential_alignment_gap (prev_old_field, old_field, + pos)) + { + align = TYPE_ALIGN (field_type); + pos = compute_related_constant (curpos, + round_up (last_pos, align)); + } /* If we can't compute a position, set it to zero. @@ -987,6 +1007,7 @@ finish_record_type (record_type, fieldlist, has_rep, defer_debug) == QUAL_UNION_TYPE) ? bitsize_zero_node : DECL_SIZE (old_field)); + prev_old_field = old_field; } TYPE_FIELDS (new_record_type) @@ -1016,26 +1037,33 @@ merge_sizes (last_size, first_bit, size, special, has_rep) int has_rep; { tree type = TREE_TYPE (last_size); + tree new; if (! special || TREE_CODE (size) != COND_EXPR) { - tree new = size_binop (PLUS_EXPR, first_bit, size); - + new = size_binop (PLUS_EXPR, first_bit, size); if (has_rep) new = size_binop (MAX_EXPR, last_size, new); - - return new; } - return fold (build (COND_EXPR, type, TREE_OPERAND (size, 0), - integer_zerop (TREE_OPERAND (size, 1)) - ? last_size : merge_sizes (last_size, first_bit, - TREE_OPERAND (size, 1), - 1, has_rep), - integer_zerop (TREE_OPERAND (size, 2)) + else + new = fold (build (COND_EXPR, type, TREE_OPERAND (size, 0), + integer_zerop (TREE_OPERAND (size, 1)) + ? last_size : merge_sizes (last_size, first_bit, + TREE_OPERAND (size, 1), + 1, has_rep), + integer_zerop (TREE_OPERAND (size, 2)) ? last_size : merge_sizes (last_size, first_bit, TREE_OPERAND (size, 2), 1, has_rep))); + + /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially + when fed through substitute_in_expr) into thinking that a constant + size is not constant. */ + while (TREE_CODE (new) == NON_LVALUE_EXPR) + new = TREE_OPERAND (new, 0); + + return new; } /* Utility function of above to see if OP0 and OP1, both of SIZETYPE, are @@ -1060,24 +1088,26 @@ compute_related_constant (op0, op1) /* Utility function of above to split a tree OP which may be a sum, into a constant part, which is returned, and a variable part, which is stored - in *PVAR. *PVAR may be size_zero_node. All operations must be of - sizetype. */ + in *PVAR. *PVAR may be bitsize_zero_node. All operations must be of + bitsizetype. */ static tree split_plus (in, pvar) tree in; tree *pvar; { - tree result = bitsize_zero_node; + /* Strip NOPS in order to ease the tree traversal and maximize the + potential for constant or plus/minus discovery. We need to be careful + to always return and set *pvar to bitsizetype trees, but it's worth + the effort. */ + STRIP_NOPS (in); - while (TREE_CODE (in) == NON_LVALUE_EXPR) - in = TREE_OPERAND (in, 0); + *pvar = convert (bitsizetype, in); - *pvar = in; if (TREE_CODE (in) == INTEGER_CST) { *pvar = bitsize_zero_node; - return in; + return convert (bitsizetype, in); } else if (TREE_CODE (in) == PLUS_EXPR || TREE_CODE (in) == MINUS_EXPR) { @@ -1085,15 +1115,12 @@ split_plus (in, pvar) tree lhs_con = split_plus (TREE_OPERAND (in, 0), &lhs_var); tree rhs_con = split_plus (TREE_OPERAND (in, 1), &rhs_var); - result = size_binop (PLUS_EXPR, result, lhs_con); - result = size_binop (TREE_CODE (in), result, rhs_con); - if (lhs_var == TREE_OPERAND (in, 0) && rhs_var == TREE_OPERAND (in, 1)) return bitsize_zero_node; *pvar = size_binop (TREE_CODE (in), lhs_var, rhs_var); - return result; + return size_binop (TREE_CODE (in), lhs_con, rhs_con); } else return bitsize_zero_node; @@ -1385,16 +1412,9 @@ create_field_decl (field_name, field_type, record_type, packed, size, pos, TREE_READONLY (field_decl) = TREE_READONLY (field_type); /* If FIELD_TYPE is BLKmode, we must ensure this is aligned to at least a - byte boundary since GCC cannot handle less-aligned BLKmode bitfields. - If it is a padding type where the inner field is of variable size, it - must be at its natural alignment. Just handle the packed case here; we - will disallow non-aligned rep clauses elsewhere. */ + byte boundary since GCC cannot handle less-aligned BLKmode bitfields. */ if (packed && TYPE_MODE (field_type) == BLKmode) - DECL_ALIGN (field_decl) - = ((TREE_CODE (field_type) == RECORD_TYPE - && TYPE_IS_PADDING_P (field_type) - && ! TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (field_type)))) - ? TYPE_ALIGN (field_type) : BITS_PER_UNIT); + DECL_ALIGN (field_decl) = BITS_PER_UNIT; /* If a size is specified, use it. Otherwise, see if we have a size to use that may differ from the natural size of the object. */ @@ -1478,6 +1498,11 @@ create_field_decl (field_name, field_type, record_type, packed, size, pos, if (must_pass_by_ref (field_type) || default_pass_by_ref (field_type)) addressable = 1; + /* ??? For now, we say that any field of aggregate type is addressable + because the front end may take 'Reference of it. */ + if (AGGREGATE_TYPE_P (field_type)) + addressable = 1; + /* Mark the decl as nonaddressable if it either is indicated so semantically or if it is a bit field. */ DECL_NONADDRESSABLE_P (field_decl) @@ -1512,6 +1537,30 @@ create_param_decl (param_name, param_type, readonly) { tree param_decl = build_decl (PARM_DECL, param_name, param_type); + /* Honor the PROMOTE_PROTOTYPES target macro, as not doing so can + lead to various ABI violations. */ +#ifdef PROMOTE_PROTOTYPES + if ((TREE_CODE (param_type) == INTEGER_TYPE + || TREE_CODE (param_type) == ENUMERAL_TYPE) + && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node)) + { + /* We have to be careful about biased types here. Make a subtype + of integer_type_node with the proper biasing. */ + if (TREE_CODE (param_type) == INTEGER_TYPE + && TYPE_BIASED_REPRESENTATION_P (param_type)) + { + param_type + = copy_type (build_range_type (integer_type_node, + TYPE_MIN_VALUE (param_type), + TYPE_MAX_VALUE (param_type))); + + TYPE_BIASED_REPRESENTATION_P (param_type) = 1; + } + else + param_type = integer_type_node; + } +#endif + DECL_ARG_TYPE (param_decl) = param_type; DECL_ARG_TYPE_AS_WRITTEN (param_decl) = param_type; TREE_READONLY (param_decl) = readonly; @@ -1588,6 +1637,73 @@ get_pending_elaborations () return result; } +/* Return true if VALUE is a multiple of FACTOR. FACTOR must be a power + of 2. */ + +static int +value_factor_p (value, factor) + tree value; + int factor; +{ + if (host_integerp (value, 1)) + return tree_low_cst (value, 1) % factor == 0; + + if (TREE_CODE (value) == MULT_EXPR) + return (value_factor_p (TREE_OPERAND (value, 0), factor) + || value_factor_p (TREE_OPERAND (value, 1), factor)); + + return 0; +} + +/* Given 2 consecutive field decls PREV_FIELD and CURR_FIELD, return true + unless we can prove these 2 fields are laid out in such a way that no gap + exist between the end of PREV_FIELD and the begining of CURR_FIELD. OFFSET + is the distance in bits between the end of PREV_FIELD and the starting + position of CURR_FIELD. It is ignored if null. */ + +static int +potential_alignment_gap (prev_field, curr_field, offset) + tree prev_field; + tree curr_field; + tree offset; +{ + /* If this is the first field of the record, there cannot be any gap */ + if (!prev_field) + return 0; + + /* If the previous field is a union type, then return False: The only + time when such a field is not the last field of the record is when + there are other components at fixed positions after it (meaning there + was a rep clause for every field), in which case we don't want the + alignment constraint to override them. */ + if (TREE_CODE (TREE_TYPE (prev_field)) == QUAL_UNION_TYPE) + return 0; + + /* If the distance between the end of prev_field and the begining of + curr_field is constant, then there is a gap if the value of this + constant is not null. */ + if (offset && host_integerp (offset, 1)) + return (!integer_zerop (offset)); + + /* If the size and position of the previous field are constant, + then check the sum of this size and position. There will be a gap + iff it is not multiple of the current field alignment. */ + if (host_integerp (DECL_SIZE (prev_field), 1) + && host_integerp (bit_position (prev_field), 1)) + return ((tree_low_cst (bit_position (prev_field), 1) + + tree_low_cst (DECL_SIZE (prev_field), 1)) + % DECL_ALIGN (curr_field) != 0); + + /* If both the position and size of the previous field are multiples + of the current field alignment, there can not be any gap. */ + if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field)) + && value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field))) + return 0; + + /* Fallback, return that there may be a potential gap */ + return 1; +} + /* Return nonzero if there are pending elaborations. */ int @@ -2052,10 +2168,9 @@ max_size (exp, max_p) case 'r': /* If this contains a PLACEHOLDER_EXPR, it is the thing we want to - modify. Otherwise, we abort since it is something we can't - handle. */ - if (! contains_placeholder_p (exp)) - gigi_abort (406); + modify. Otherwise, we treat it like a variable. */ + if (! CONTAINS_PLACEHOLDER_P (exp)) + return exp; type = TREE_TYPE (TREE_OPERAND (exp, 1)); return @@ -2102,7 +2217,7 @@ max_size (exp, max_p) else if (max_p && code == MIN_EXPR && TREE_OVERFLOW (lhs)) return rhs; else if ((code == MINUS_EXPR || code == PLUS_EXPR) - && (TREE_OVERFLOW (lhs) + && ((TREE_CONSTANT (lhs) && TREE_OVERFLOW (lhs)) || operand_equal_p (lhs, TYPE_MAX_VALUE (type), 0)) && ! TREE_CONSTANT (rhs)) return lhs; @@ -2183,9 +2298,9 @@ build_template (template_type, array_type, expr) /* If either MIN or MAX involve a PLACEHOLDER_EXPR, we must surround them with a WITH_RECORD_EXPR giving EXPR as the OBJECT. */ - if (! TREE_CONSTANT (min) && contains_placeholder_p (min)) + if (CONTAINS_PLACEHOLDER_P (min)) min = build (WITH_RECORD_EXPR, TREE_TYPE (min), min, expr); - if (! TREE_CONSTANT (max) && contains_placeholder_p (max)) + if (CONTAINS_PLACEHOLDER_P (max)) max = build (WITH_RECORD_EXPR, TREE_TYPE (max), max, expr); template_elts = tree_cons (TREE_CHAIN (field), max, @@ -2552,17 +2667,39 @@ update_pointer_to (old_type, new_type) type = TYPE_NEXT_VARIANT (type)) update_pointer_to (type, new_type); - /* If no pointer or reference, we are done. Otherwise, get the new type with - the same qualifiers as the old type and see if it is the same as the old - type. */ + /* If no pointer or reference, we are done. */ if (ptr == 0 && ref == 0) return; - new_type = build_qualified_type (new_type, TYPE_QUALS (old_type)); + /* Merge the old type qualifiers in the new type. + + Each old variant has qualifiers for specific reasons, and the new + designated type as well. Each set of qualifiers represents useful + information grabbed at some point, and merging the two simply unifies + these inputs into the final type description. + + Consider for instance a volatile type frozen after an access to constant + type designating it. After the designated type freeze, we get here with a + volatile new_type and a dummy old_type with a readonly variant, created + when the access type was processed. We shall make a volatile and readonly + designated type, because that's what it really is. + + We might also get here for a non-dummy old_type variant with different + qualifiers than the new_type ones, for instance in some cases of pointers + to private record type elaboration (see the comments around the call to + this routine from gnat_to_gnu_entity/E_Access_Type). We have to merge the + qualifiers in thoses cases too, to avoid accidentally discarding the + initial set, and will often end up with old_type == new_type then. */ + new_type = build_qualified_type (new_type, + TYPE_QUALS (old_type) + | TYPE_QUALS (new_type)); + + /* If the new type and the old one are identical, there is nothing to + update. */ if (old_type == new_type) return; - /* First handle the simple case. */ + /* Otherwise, first handle the simple case. */ if (TREE_CODE (new_type) != UNCONSTRAINED_ARRAY_TYPE) { if (ptr != 0) @@ -2699,12 +2836,24 @@ convert_to_fat_pointer (type, expr) template_addr = build_unary_op (ADDR_EXPR, NULL_TREE, template); - /* The result is a CONSTRUCTOR for the fat pointer. */ - return - gnat_build_constructor (type, - tree_cons (TYPE_FIELDS (type), expr, - tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), - template_addr, NULL_TREE))); + /* The result is a CONSTRUCTOR for the fat pointer. + + If expr is an argument of a foreign convention subprogram, the type it + points to is directly the component type. In this case, the expression + type may not match the corresponding FIELD_DECL type at this point, so we + call "convert" here to fix that up if necessary. This type consistency is + required, for instance because it ensures that possible later folding of + component_refs against this constructor always yields something of the + same type as the initial reference. + + Note that the call to "build_template" above is still fine, because it + will only refer to the provided template_type in this case. */ + return + gnat_build_constructor + (type, tree_cons (TYPE_FIELDS (type), + convert (TREE_TYPE (TYPE_FIELDS (type)), expr), + tree_cons (TREE_CHAIN (TYPE_FIELDS (type)), + template_addr, NULL_TREE))); } /* Convert to a thin pointer type, TYPE. The only thing we know how to convert @@ -2747,10 +2896,14 @@ convert (type, expr) /* If EXPR is already the right type, we are done. */ if (type == etype) return expr; - + /* If we're converting between two aggregate types that have the same main + variant, just make a NOP_EXPR. */ + else if (AGGREGATE_TYPE_P (type) + && TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (etype)) + return build1 (NOP_EXPR, type, expr); /* If EXPR is a WITH_RECORD_EXPR, do the conversion inside and then make a new one. */ - if (TREE_CODE (expr) == WITH_RECORD_EXPR) + else if (TREE_CODE (expr) == WITH_RECORD_EXPR) return build (WITH_RECORD_EXPR, type, convert (type, TREE_OPERAND (expr, 0)), TREE_OPERAND (expr, 1)); @@ -2759,7 +2912,7 @@ convert (type, expr) to the field. If the output type has padding, make a constructor to build the record. If both input and output have padding and are of variable size, do this as an unchecked conversion. */ - if (ecode == RECORD_TYPE && code == RECORD_TYPE + else if (ecode == RECORD_TYPE && code == RECORD_TYPE && TYPE_IS_PADDING_P (type) && TYPE_IS_PADDING_P (etype) && (! TREE_CONSTANT (TYPE_SIZE (type)) || ! TREE_CONSTANT (TYPE_SIZE (etype)))) @@ -2797,10 +2950,9 @@ convert (type, expr) /* If the result type is a padded type with a self-referentially-sized field and the expression type is a record, do this as an unchecked converstion. */ - else if (TREE_CODE (DECL_SIZE (TYPE_FIELDS (type))) != INTEGER_CST - && contains_placeholder_p (DECL_SIZE (TYPE_FIELDS (type))) - && TREE_CODE (etype) == RECORD_TYPE) - return unchecked_convert (type, expr); + else if (TREE_CODE (etype) == RECORD_TYPE + && CONTAINS_PLACEHOLDER_P (DECL_SIZE (TYPE_FIELDS (type)))) + return unchecked_convert (type, expr, 0); else return @@ -2827,13 +2979,17 @@ convert (type, expr) return convert (type, build_component_ref (expr, NULL_TREE, TYPE_FIELDS (etype))); - /* If converting a type that does not contain a template into one - that does, convert to the data type and then build the template. */ - if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type) - && ! (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype))) + /* If converting to a type that contains a template, convert to the data + type and then build the template. */ + if (code == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (type)) { tree obj_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); + /* If the source already has a template, get a reference to the + associated array only, as we are going to rebuild a template + for the target type anyway. */ + expr = maybe_unconstrained_array (expr); + return gnat_build_constructor (type, @@ -2856,6 +3012,7 @@ convert (type, expr) /* Just set its type here. For TRANSFORM_EXPR, we will do the actual conversion in gnat_expand_expr. NULL_EXPR does not represent and actual value, so no conversion is needed. */ + expr = copy_node (expr); TREE_TYPE (expr) = type; return expr; @@ -2944,8 +3101,9 @@ convert (type, expr) case INTEGER_TYPE: if (TYPE_HAS_ACTUAL_BOUNDS_P (type) - && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE)) - return unchecked_convert (type, expr); + && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE + || (ecode == RECORD_TYPE && TYPE_CONTAINS_TEMPLATE_P (etype)))) + return unchecked_convert (type, expr, 0); else if (TYPE_BIASED_REPRESENTATION_P (type)) return fold (build1 (CONVERT_EXPR, type, fold (build (MINUS_EXPR, TREE_TYPE (type), @@ -3009,14 +3167,22 @@ convert (type, expr) /* In these cases, assume the front-end has validated the conversion. If the conversion is valid, it will be a bit-wise conversion, so it can be viewed as an unchecked conversion. */ - return unchecked_convert (type, expr); + return unchecked_convert (type, expr, 0); case UNION_TYPE: /* Just validate that the type is indeed that of a field of the type. Then make the simple conversion. */ for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem)) - if (TREE_TYPE (tem) == etype) - return build1 (CONVERT_EXPR, type, expr); + { + if (TREE_TYPE (tem) == etype) + return build1 (CONVERT_EXPR, type, expr); + else if (TREE_CODE (TREE_TYPE (tem)) == RECORD_TYPE + && (TYPE_LEFT_JUSTIFIED_MODULAR_P (TREE_TYPE (tem)) + || TYPE_IS_PADDING_P (TREE_TYPE (tem))) + && TREE_TYPE (TYPE_FIELDS (TREE_TYPE (tem))) == etype) + return build1 (CONVERT_EXPR, type, + convert (TREE_TYPE (tem), expr)); + } gigi_abort (413); @@ -3131,17 +3297,21 @@ maybe_unconstrained_array (exp) TREE_OPERAND (exp, 1)); case RECORD_TYPE: - if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp))) + /* If this is a padded type, convert to the unpadded type and see if + it contains a template. */ + if (TYPE_IS_PADDING_P (TREE_TYPE (exp))) { - new - = build_component_ref (exp, NULL_TREE, - TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)))); + new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (exp))), exp); if (TREE_CODE (TREE_TYPE (new)) == RECORD_TYPE - && TYPE_IS_PADDING_P (TREE_TYPE (new))) - new = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (new))), new); - - return new; + && TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (new))) + return + build_component_ref (new, NULL_TREE, + TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (new)))); } + else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp))) + return + build_component_ref (exp, NULL_TREE, + TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)))); break; default: @@ -3151,12 +3321,14 @@ maybe_unconstrained_array (exp) return exp; } -/* Return an expression that does an unchecked converstion of EXPR to TYPE. */ +/* Return an expression that does an unchecked converstion of EXPR to TYPE. + If NOTRUNC_P is set, truncation operations should be suppressed. */ tree -unchecked_convert (type, expr) +unchecked_convert (type, expr, notrunc_p) tree type; tree expr; + int notrunc_p; { tree etype = TREE_TYPE (expr); @@ -3168,7 +3340,7 @@ unchecked_convert (type, expr) new one. */ if (TREE_CODE (expr) == WITH_RECORD_EXPR) return build (WITH_RECORD_EXPR, type, - unchecked_convert (type, TREE_OPERAND (expr, 0)), + unchecked_convert (type, TREE_OPERAND (expr, 0), notrunc_p), TREE_OPERAND (expr, 1)); /* If both types types are integral just do a normal conversion. @@ -3226,7 +3398,7 @@ unchecked_convert (type, expr) TYPE_FIELDS (rec_type) = field; layout_type (rec_type); - expr = unchecked_convert (rec_type, expr); + expr = unchecked_convert (rec_type, expr, notrunc_p); expr = build_component_ref (expr, NULL_TREE, field); } @@ -3245,7 +3417,7 @@ unchecked_convert (type, expr) layout_type (rec_type); expr = gnat_build_constructor (rec_type, build_tree_list (field, expr)); - expr = unchecked_convert (type, expr); + expr = unchecked_convert (type, expr, notrunc_p); } /* We have a special case when we are converting between two @@ -3269,7 +3441,8 @@ unchecked_convert (type, expr) the result. We need not do this in the case where the input is an integral type of the same precision and signedness or if the output is a biased type or if both the input and output are unsigned. */ - if (INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) != 0 + if (! notrunc_p + && INTEGRAL_TYPE_P (type) && TYPE_RM_SIZE (type) != 0 && ! (TREE_CODE (type) == INTEGER_TYPE && TYPE_BIASED_REPRESENTATION_P (type)) && 0 != compare_tree_int (TYPE_RM_SIZE (type), |