diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-21 13:42:24 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2003-10-21 13:42:24 +0000 |
commit | 9dfe12ae5b94d03c997ea2903022a5d2d5c5f266 (patch) | |
tree | bdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/prep.adb | |
parent | 1c662558a1113238a624245a45382d3df90ccf13 (diff) | |
download | gcc-9dfe12ae5b94d03c997ea2903022a5d2d5c5f266.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@72751 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/prep.adb')
-rw-r--r-- | gcc/ada/prep.adb | 1446 |
1 files changed, 1446 insertions, 0 deletions
diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb new file mode 100644 index 00000000000..6b9000c7a0c --- /dev/null +++ b/gcc/ada/prep.adb @@ -0,0 +1,1446 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P R E P -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Csets; use Csets; +with Err_Vars; use Err_Vars; +with Namet; use Namet; +with Opt; use Opt; +with Osint; use Osint; +with Output; use Output; +with Scans; use Scans; +with Snames; use Snames; +with Sinput; +with Stringt; use Stringt; +with Table; +with Types; use Types; + +with GNAT.Heap_Sort_G; + +package body Prep is + + use Symbol_Table; + + type Token_Name_Array is array (Token_Type) of Name_Id; + Token_Names : constant Token_Name_Array := + (Tok_Abort => Name_Abort, + Tok_Abs => Name_Abs, + Tok_Abstract => Name_Abstract, + Tok_Accept => Name_Accept, + Tok_Aliased => Name_Aliased, + Tok_All => Name_All, + Tok_Array => Name_Array, + Tok_And => Name_And, + Tok_At => Name_At, + Tok_Begin => Name_Begin, + Tok_Body => Name_Body, + Tok_Case => Name_Case, + Tok_Constant => Name_Constant, + Tok_Declare => Name_Declare, + Tok_Delay => Name_Delay, + Tok_Delta => Name_Delta, + Tok_Digits => Name_Digits, + Tok_Else => Name_Else, + Tok_Elsif => Name_Elsif, + Tok_End => Name_End, + Tok_Entry => Name_Entry, + Tok_Exception => Name_Exception, + Tok_Exit => Name_Exit, + Tok_For => Name_For, + Tok_Function => Name_Function, + Tok_Generic => Name_Generic, + Tok_Goto => Name_Goto, + Tok_If => Name_If, + Tok_Is => Name_Is, + Tok_Limited => Name_Limited, + Tok_Loop => Name_Loop, + Tok_Mod => Name_Mod, + Tok_New => Name_New, + Tok_Null => Name_Null, + Tok_Of => Name_Of, + Tok_Or => Name_Or, + Tok_Others => Name_Others, + Tok_Out => Name_Out, + Tok_Package => Name_Package, + Tok_Pragma => Name_Pragma, + Tok_Private => Name_Private, + Tok_Procedure => Name_Procedure, + Tok_Protected => Name_Protected, + Tok_Raise => Name_Raise, + Tok_Range => Name_Range, + Tok_Record => Name_Record, + Tok_Rem => Name_Rem, + Tok_Renames => Name_Renames, + Tok_Requeue => Name_Requeue, + Tok_Return => Name_Return, + Tok_Reverse => Name_Reverse, + Tok_Select => Name_Select, + Tok_Separate => Name_Separate, + Tok_Subtype => Name_Subtype, + Tok_Tagged => Name_Tagged, + Tok_Task => Name_Task, + Tok_Terminate => Name_Terminate, + Tok_Then => Name_Then, + Tok_Type => Name_Type, + Tok_Until => Name_Until, + Tok_Use => Name_Use, + Tok_When => Name_When, + Tok_While => Name_While, + Tok_With => Name_With, + Tok_Xor => Name_Xor, + others => No_Name); + + Already_Initialized : Boolean := False; + -- Used to avoid repetition of the part of the initialisation that needs + -- to be done only once. + + Empty_String : String_Id; + -- "", as a string_id + + String_False : String_Id; + -- "false", as a string_id + + Name_Defined : Name_Id; + -- defined, as a name_id + + --------------- + -- Behaviour -- + --------------- + + -- Accesses to procedure specified by procedure Initialize. + + Error_Msg : Error_Msg_Proc; + -- Report an error + + Scan : Scan_Proc; + -- Scan one token + + Set_Ignore_Errors : Set_Ignore_Errors_Proc; + -- Indicate if error should be taken into account + + Put_Char : Put_Char_Proc; + -- Output one character + + New_EOL : New_EOL_Proc; + -- Output an end of line indication + + ------------------------------- + -- State of the Preprocessor -- + ------------------------------- + + type Pp_State is record + If_Ptr : Source_Ptr; + -- The location of the #if statement. + -- Used to flag #if with no corresponding #end if, at the end. + + Else_Ptr : Source_Ptr; + -- The location of the #else statement. + -- Used to detect multiple #else. + + Deleting : Boolean; + -- Set to True when the code should be deleted or commented out. + + Match_Seen : Boolean; + -- Set to True when a condition in an #if or an #elsif is True. + -- Also set to True if Deleting at the previous level is True. + -- Used to decide if Deleting should be set to True in a following + -- #elsif or #else. + + end record; + + type Pp_Depth is new Nat; + + Ground : constant Pp_Depth := 0; + + package Pp_States is new Table.Table + (Table_Component_Type => Pp_State, + Table_Index_Type => Pp_Depth, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 10, + Table_Name => "Prep.Pp_States"); + -- A stack of the states of the preprocessor, for nested #if + + type Operator is (None, Op_Or, Op_And); + + ----------------- + -- Subprograms -- + ----------------- + + function Deleting return Boolean; + -- Return True if code should be deleted or commented out + + function Expression (Evaluate_It : Boolean) return Boolean; + -- Evaluate a condition in an #if or an #elsif statement. + -- If Evaluate_It is False, the condition is effectively evaluated, + -- otherwise, only the syntax is checked. + + procedure Go_To_End_Of_Line; + -- Advance the scan pointer until we reach an end of line or the end + -- of the buffer. + + function Matching_Strings (S1, S2 : String_Id) return Boolean; + -- Returns True if the two string parameters are equal (case insensitive) + + --------------------------------------- + -- Change_Reserved_Keyword_To_Symbol -- + --------------------------------------- + + procedure Change_Reserved_Keyword_To_Symbol + (All_Keywords : Boolean := False) + is + New_Name : constant Name_Id := Token_Names (Token); + + begin + if New_Name /= No_Name then + case Token is + when Tok_If | Tok_Else | Tok_Elsif | Tok_End | + Tok_And | Tok_Or | Tok_Then => + if All_Keywords then + Token := Tok_Identifier; + Token_Name := New_Name; + end if; + + when others => + Token := Tok_Identifier; + Token_Name := New_Name; + end case; + end if; + end Change_Reserved_Keyword_To_Symbol; + + ------------------------------------------ + -- Check_Command_Line_Symbol_Definition -- + ------------------------------------------ + + procedure Check_Command_Line_Symbol_Definition + (Definition : String; + Data : out Symbol_Data) + is + Index : Natural := 0; + Result : Symbol_Data; + + begin + -- Look for the character '=' + + for J in Definition'Range loop + if Definition (J) = '=' then + Index := J; + exit; + end if; + end loop; + + -- If no character '=', then the value is True + + if Index = 0 then + -- Put the symbol in the name buffer + + Name_Len := Definition'Length; + Name_Buffer (1 .. Name_Len) := Definition; + Result := True_Value; + + elsif Index = Definition'First then + Fail ("invalid symbol definition """, Definition, """"); + + else + -- Put the symbol in the name buffer + + Name_Len := Index - Definition'First; + Name_Buffer (1 .. Name_Len) := + String'(Definition (Definition'First .. Index - 1)); + + -- Check the syntax of the value + + if Definition (Index + 1) /= '"' + or else Definition (Definition'Last) /= '"' + then + for J in Index + 1 .. Definition'Last loop + case Definition (J) is + when '_' | '.' | '0' .. '9' | + 'a' .. 'z' | 'A' .. 'Z' => + null; + + when others => + Fail ("illegal value """, + Definition (Index + 1 .. Definition'Last), + """"); + end case; + end loop; + end if; + + -- And put the value in the result + + Result.Is_A_String := False; + Start_String; + Store_String_Chars (Definition (Index + 1 .. Definition'Last)); + Result.Value := End_String; + end if; + + -- Now, check the syntax of the symbol (we don't allow accented and + -- wide characters) + + if Name_Buffer (1) not in 'a' .. 'z' + and then Name_Buffer (1) not in 'A' .. 'Z' + then + Fail ("symbol """, + Name_Buffer (1 .. Name_Len), + """ does not start with a letter"); + end if; + + for J in 2 .. Name_Len loop + case Name_Buffer (J) is + when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' => + null; + + when '_' => + if J = Name_Len then + Fail ("symbol """, + Name_Buffer (1 .. Name_Len), + """ end with a '_'"); + + elsif Name_Buffer (J + 1) = '_' then + Fail ("symbol """, + Name_Buffer (1 .. Name_Len), + """ contains consecutive '_'"); + end if; + + when others => + Fail ("symbol """, + Name_Buffer (1 .. Name_Len), + """ contains illegal character(s)"); + end case; + end loop; + + Result.On_The_Command_Line := True; + + -- Put the symbol name in the result + + declare + Sym : constant String := + Name_Buffer (1 .. Name_Len); + + begin + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); + end loop; + + Result.Symbol := Name_Find; + Name_Len := Sym'Length; + Name_Buffer (1 .. Name_Len) := Sym; + Result.Original := Name_Find; + end; + + Data := Result; + end Check_Command_Line_Symbol_Definition; + + -------------- + -- Deleting -- + -------------- + + function Deleting return Boolean is + begin + -- Always return False when not inside an #if statement + + if Pp_States.Last = Ground then + return False; + + else + return Pp_States.Table (Pp_States.Last).Deleting; + end if; + end Deleting; + + ---------------- + -- Expression -- + ---------------- + + function Expression (Evaluate_It : Boolean) return Boolean is + Evaluation : Boolean := Evaluate_It; + -- Is set to False after an "or else" when left term is True and + -- after an "and then" when left term is False. + + Final_Result : Boolean := False; + + Current_Result : Boolean := False; + -- Value of a term + + Current_Operator : Operator := None; + Symbol1 : Symbol_Id; + Symbol2 : Symbol_Id; + Symbol_Name1 : Name_Id; + Symbol_Name2 : Name_Id; + Symbol_Pos1 : Source_Ptr; + Symbol_Pos2 : Source_Ptr; + Symbol_Value1 : String_Id; + Symbol_Value2 : String_Id; + + begin + -- Loop for each term + + loop + Change_Reserved_Keyword_To_Symbol; + + Current_Result := False; + + case Token is + + when Tok_Left_Paren => + + -- ( expression ) + + Scan.all; + Current_Result := Expression (Evaluation); + + if Token = Tok_Right_Paren then + Scan.all; + + else + Error_Msg ("`)` expected", Token_Ptr); + end if; + + when Tok_Not => + + -- not expression + + Scan.all; + Current_Result := not Expression (Evaluation); + + when Tok_Identifier => + Symbol_Name1 := Token_Name; + Symbol_Pos1 := Token_Ptr; + Scan.all; + + if Token = Tok_Apostrophe then + -- symbol'Defined + + Scan.all; + + if Token = Tok_Identifier + and then Token_Name = Name_Defined + then + Scan.all; + + else + Error_Msg ("identifier `Defined` expected", Token_Ptr); + end if; + + if Evaluation then + Current_Result := Index_Of (Symbol_Name1) /= No_Symbol; + end if; + + elsif Token = Tok_Equal then + Scan.all; + + Change_Reserved_Keyword_To_Symbol; + + if Token = Tok_Identifier then + + -- symbol = symbol + + Symbol_Name2 := Token_Name; + Symbol_Pos2 := Token_Ptr; + Scan.all; + + if Evaluation then + Symbol1 := Index_Of (Symbol_Name1); + + if Symbol1 = No_Symbol then + if Undefined_Symbols_Are_False then + Symbol_Value1 := String_False; + + else + Error_Msg_Name_1 := Symbol_Name1; + Error_Msg ("unknown symbol %", Symbol_Pos1); + Symbol_Value1 := No_String; + end if; + + else + Symbol_Value1 := + Mapping.Table (Symbol1).Value; + end if; + + Symbol2 := Index_Of (Symbol_Name2); + + if Symbol2 = No_Symbol then + if Undefined_Symbols_Are_False then + Symbol_Value2 := String_False; + + else + Error_Msg_Name_1 := Symbol_Name2; + Error_Msg ("unknown symbol %", Symbol_Pos2); + Symbol_Value2 := No_String; + end if; + + else + Symbol_Value2 := Mapping.Table (Symbol2).Value; + end if; + + if Symbol_Value1 /= No_String + and then Symbol_Value2 /= No_String + then + Current_Result := Matching_Strings + (Symbol_Value1, Symbol_Value2); + end if; + end if; + + elsif Token = Tok_String_Literal then + + -- symbol = "value" + + if Evaluation then + Symbol1 := Index_Of (Symbol_Name1); + + if Symbol1 = No_Symbol then + if Undefined_Symbols_Are_False then + Symbol_Value1 := String_False; + + else + Error_Msg_Name_1 := Symbol_Name1; + Error_Msg ("unknown symbol %", Symbol_Pos1); + Symbol_Value1 := No_String; + end if; + + else + Symbol_Value1 := Mapping.Table (Symbol1).Value; + end if; + + if Symbol_Value1 /= No_String then + Current_Result := + Matching_Strings + (Symbol_Value1, + String_Literal_Id); + end if; + end if; + + Scan.all; + + else + Error_Msg + ("symbol or literal string expected", Token_Ptr); + end if; + + else + -- symbol (True or False) + + if Evaluation then + Symbol1 := Index_Of (Symbol_Name1); + + if Symbol1 = No_Symbol then + if Undefined_Symbols_Are_False then + Symbol_Value1 := String_False; + + else + Error_Msg_Name_1 := Symbol_Name1; + Error_Msg ("unknown symbol %", Symbol_Pos1); + Symbol_Value1 := No_String; + end if; + + else + Symbol_Value1 := Mapping.Table (Symbol1).Value; + end if; + + if Symbol_Value1 /= No_String then + String_To_Name_Buffer (Symbol_Value1); + + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := + Fold_Lower (Name_Buffer (Index)); + end loop; + + if Name_Buffer (1 .. Name_Len) = "true" then + Current_Result := True; + + elsif Name_Buffer (1 .. Name_Len) = "false" then + Current_Result := False; + + else + Error_Msg_Name_1 := Symbol_Name1; + Error_Msg + ("value of symbol % is not True or False", + Symbol_Pos1); + end if; + end if; + end if; + end if; + + when others => + Error_Msg ("`(`, NOT or symbol expected", Token_Ptr); + end case; + + -- Update the cumulative final result + + case Current_Operator is + when None => + Final_Result := Current_Result; + + when Op_Or => + Final_Result := Final_Result or Current_Result; + + when Op_And => + Final_Result := Final_Result and Current_Result; + end case; + + -- Check the next operator + + if Token = Tok_And then + if Current_Operator = Op_Or then + Error_Msg ("mixing OR and AND is not allowed", Token_Ptr); + end if; + + Current_Operator := Op_And; + Scan.all; + + if Token = Tok_Then then + Scan.all; + + if Final_Result = False then + Evaluation := False; + end if; + end if; + + elsif Token = Tok_Or then + if Current_Operator = Op_And then + Error_Msg ("mixing AND and OR is not allowed", Token_Ptr); + end if; + + Current_Operator := Op_Or; + Scan.all; + + if Token = Tok_Else then + Scan.all; + + if Final_Result then + Evaluation := False; + end if; + end if; + + else + -- No operator: exit the term loop + + exit; + end if; + end loop; + + return Final_Result; + end Expression; + + ----------------------- + -- Go_To_End_Of_Line -- + ----------------------- + + procedure Go_To_End_Of_Line is + begin + -- Scan until we get an end of line or we reach the end of the buffer + + while Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + loop + Scan.all; + end loop; + end Go_To_End_Of_Line; + + -------------- + -- Index_Of -- + -------------- + + function Index_Of (Symbol : Name_Id) return Symbol_Id is + begin + if Mapping.Table /= null then + for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop + if Mapping.Table (J).Symbol = Symbol then + return J; + end if; + end loop; + end if; + + return No_Symbol; + end Index_Of; + + ---------------- + -- Preprocess -- + ---------------- + + procedure Preprocess is + Start_Of_Processing : Source_Ptr; + Cond : Boolean; + Preprocessor_Line : Boolean := False; + + procedure Output (From, To : Source_Ptr); + -- Output the characters with indices From .. To in the buffer + -- to the output file. + + procedure Output_Line (From, To : Source_Ptr); + -- Output a line or the end of a line from the buffer to the output + -- file, followed by an end of line terminator. + -- Depending on the value of Deleting and the switches, the line + -- may be commented out, blank or not output at all. + + ------------ + -- Output -- + ------------ + + procedure Output (From, To : Source_Ptr) is + begin + for J in From .. To loop + Put_Char (Sinput.Source (J)); + end loop; + end Output; + + ----------------- + -- Output_Line -- + ----------------- + + procedure Output_Line (From, To : Source_Ptr) is + begin + if Deleting or Preprocessor_Line then + if Blank_Deleted_Lines then + New_EOL.all; + + elsif Comment_Deleted_Lines then + Put_Char ('-'); + Put_Char ('-'); + Put_Char ('!'); + + if From < To then + Put_Char (' '); + Output (From, To); + end if; + + New_EOL.all; + end if; + + else + Output (From, To); + New_EOL.all; + end if; + end Output_Line; + + -- Start of processing for Preprocess + + begin + Start_Of_Processing := Scan_Ptr; + + -- We need to call Scan for the first time, because Initialyze_Scanner + -- is no longer doing it. + + Scan.all; + + Input_Line_Loop : + loop + exit Input_Line_Loop when Token = Tok_EOF; + + Preprocessor_Line := False; + + if Token /= Tok_End_Of_Line then + + -- Preprocessor line + + if Token = Tok_Special and then Special_Character = '#' then + Preprocessor_Line := True; + Scan.all; + + case Token is + + when Tok_If => + -- #if + + declare + If_Ptr : constant Source_Ptr := Token_Ptr; + + begin + Scan.all; + Cond := Expression (not Deleting); + + -- Check for an eventual "then" + + if Token = Tok_Then then + Scan.all; + end if; + + -- It is an error to have trailing characters after + -- the condition or "then". + + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + Go_To_End_Of_Line; + end if; + + declare + -- Set the initial state of this new "#if". + -- This must be done before incrementing the + -- Last of the table, otherwise function + -- Deleting does not report the correct value. + + New_State : constant Pp_State := + (If_Ptr => If_Ptr, + Else_Ptr => 0, + Deleting => Deleting or (not Cond), + Match_Seen => Deleting or Cond); + + begin + Pp_States.Increment_Last; + Pp_States.Table (Pp_States.Last) := New_State; + end; + end; + + when Tok_Elsif => + -- #elsif + + Cond := False; + + if Pp_States.Last = 0 + or else Pp_States.Table (Pp_States.Last).Else_Ptr + /= 0 + then + Error_Msg ("no IF for this ELSIF", Token_Ptr); + + else + Cond := + not Pp_States.Table (Pp_States.Last).Match_Seen; + end if; + + Scan.all; + Cond := Expression (Cond); + + -- Check for an eventual "then" + + if Token = Tok_Then then + Scan.all; + end if; + + -- It is an error to have trailing characters after + -- the condition or "then". + + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + + Go_To_End_Of_Line; + end if; + + -- Depending on the value of the condition, set the + -- new values of Deleting and Match_Seen. + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := + True; + else + if Cond then + Pp_States.Table (Pp_States.Last).Match_Seen := + True; + Pp_States.Table (Pp_States.Last).Deleting := + False; + end if; + end if; + end if; + + when Tok_Else => + -- #else + + if Pp_States.Last = 0 then + Error_Msg ("no IF for this ELSE", Token_Ptr); + + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 + then + Error_Msg ("duplicate ELSE line", Token_Ptr); + end if; + + -- Set the possibly new values of Deleting and + -- Match_Seen. + + if Pp_States.Last > 0 then + if Pp_States.Table (Pp_States.Last).Match_Seen then + Pp_States.Table (Pp_States.Last).Deleting := + True; + + else + Pp_States.Table (Pp_States.Last).Match_Seen := + True; + Pp_States.Table (Pp_States.Last).Deleting := + False; + end if; + + -- Set the Else_Ptr to check for illegal #elsif + -- later. + + Pp_States.Table (Pp_States.Last).Else_Ptr := + Token_Ptr; + end if; + + Scan.all; + + -- It is an error to have characters after "#else" + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + Go_To_End_Of_Line; + end if; + + when Tok_End => + -- #end if; + + if Pp_States.Last = 0 then + Error_Msg ("no IF for this END", Token_Ptr); + end if; + + Scan.all; + + if Token /= Tok_If then + Error_Msg ("IF expected", Token_Ptr); + + else + Scan.all; + + if Token /= Tok_Semicolon then + Error_Msg ("`;` Expected", Token_Ptr); + + else + Scan.all; + + -- It is an error to have character after + -- "#end if;". + if Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + then + Error_Msg + ("extraneous text on preprocessor line", + Token_Ptr); + end if; + end if; + end if; + + -- In case of one of the errors above, skip the tokens + -- until the end of line is reached. + + Go_To_End_Of_Line; + + -- Decrement the depth of the #if stack. + + if Pp_States.Last > 0 then + Pp_States.Decrement_Last; + end if; + + when others => + -- Illegal preprocessor line + + if Pp_States.Last = 0 then + Error_Msg ("IF expected", Token_Ptr); + + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr = 0 + then + Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected", + Token_Ptr); + + else + Error_Msg ("IF or `END IF` expected", Token_Ptr); + end if; + + -- Skip to the end of this illegal line + + Go_To_End_Of_Line; + end case; + + -- Not a preprocessor line + + else + -- Do not report errors for those lines, even if there are + -- Ada parsing errors. + + Set_Ignore_Errors (To => True); + + if Deleting then + Go_To_End_Of_Line; + + else + while Token /= Tok_End_Of_Line + and then Token /= Tok_EOF + loop + if Token = Tok_Special + and then Special_Character = '$' + then + declare + Dollar_Ptr : constant Source_Ptr := Token_Ptr; + Symbol : Symbol_Id; + + begin + Scan.all; + Change_Reserved_Keyword_To_Symbol; + + if Token = Tok_Identifier + and then Token_Ptr = Dollar_Ptr + 1 + then + -- $symbol + + Symbol := Index_Of (Token_Name); + + -- If there is such a symbol, replace it by its + -- value. + + if Symbol /= No_Symbol then + Output (Start_Of_Processing, Dollar_Ptr - 1); + Start_Of_Processing := Scan_Ptr; + String_To_Name_Buffer + (Mapping.Table (Symbol).Value); + + if Mapping.Table (Symbol).Is_A_String then + + -- Value is an Ada string + + Put_Char ('"'); + + for J in 1 .. Name_Len loop + Put_Char (Name_Buffer (J)); + + if Name_Buffer (J) = '"' then + Put_Char ('"'); + end if; + end loop; + + Put_Char ('"'); + + else + -- Value is a sequence of characters, not + -- an Ada string. + + for J in 1 .. Name_Len loop + Put_Char (Name_Buffer (J)); + end loop; + end if; + end if; + end if; + end; + end if; + + Scan.all; + end loop; + end if; + + Set_Ignore_Errors (To => False); + end if; + end if; + + pragma Assert (Token = Tok_End_Of_Line or Token = Tok_EOF); + + -- At this point, the token is either end of line or EOF. + -- The line to possibly output stops just before the token. + + Output_Line (Start_Of_Processing, Token_Ptr - 1); + + -- If we are at the end of a line, the scan pointer is at the first + -- non blank character, not necessarily the first character of the + -- line; so, we have to deduct Start_Of_Processing from the token + -- pointer. + + if Token = Tok_End_Of_Line then + if (Sinput.Source (Token_Ptr) = ASCII.CR + and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) + or else + (Sinput.Source (Token_Ptr) = ASCII.CR + and then Sinput.Source (Token_Ptr + 1) = ASCII.LF) + then + Start_Of_Processing := Token_Ptr + 2; + + else + Start_Of_Processing := Token_Ptr + 1; + end if; + end if; + + -- Now, we scan the first token of the next line. + -- If the token is EOF, the scan ponter will not move, and the token + -- will still be EOF. + + Scan.all; + end loop Input_Line_Loop; + + -- Report an error for any missing some "#end if;" + + for Level in reverse 1 .. Pp_States.Last loop + Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr); + end loop; + end Preprocess; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (Error_Msg : Error_Msg_Proc; + Scan : Scan_Proc; + Set_Ignore_Errors : Set_Ignore_Errors_Proc; + Put_Char : Put_Char_Proc; + New_EOL : New_EOL_Proc) + is + begin + if not Already_Initialized then + Start_String; + Store_String_Chars ("True"); + True_Value.Value := End_String; + + Start_String; + Empty_String := End_String; + + Name_Len := 7; + Name_Buffer (1 .. Name_Len) := "defined"; + Name_Defined := Name_Find; + + Start_String; + Store_String_Chars ("False"); + String_False := End_String; + + Already_Initialized := True; + end if; + + Prep.Error_Msg := Error_Msg; + Prep.Scan := Scan; + Prep.Set_Ignore_Errors := Set_Ignore_Errors; + Prep.Put_Char := Put_Char; + Prep.New_EOL := New_EOL; + end Initialize; + + ------------------ + -- List_Symbols -- + ------------------ + + procedure List_Symbols (Foreword : String) is + Order : array (0 .. Integer (Symbol_Table.Last (Mapping))) + of Symbol_Id; + -- After alphabetical sorting, this array stores thehe indices of + -- the symbols in the order they are displayed. + + function Lt (Op1, Op2 : Natural) return Boolean; + -- Comparison routine for sort call + + procedure Move (From : Natural; To : Natural); + -- Move routine for sort call + + -------- + -- Lt -- + -------- + + function Lt (Op1, Op2 : Natural) return Boolean is + S1 : constant String := + Get_Name_String (Mapping.Table (Order (Op1)).Symbol); + S2 : constant String := + Get_Name_String (Mapping.Table (Order (Op2)).Symbol); + + begin + return S1 < S2; + end Lt; + + ---------- + -- Move -- + ---------- + + procedure Move (From : Natural; To : Natural) is + begin + Order (To) := Order (From); + end Move; + + package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt); + + Max_L : Natural; + -- Maximum length of any symbol + + -- Start of processing for List_Symbols_Case + + begin + if Symbol_Table.Last (Mapping) = 0 then + return; + end if; + + if Foreword'Length > 0 then + Write_Eol; + Write_Line (Foreword); + + for J in Foreword'Range loop + Write_Char ('='); + end loop; + end if; + + -- Initialize the order + + for J in Order'Range loop + Order (J) := Symbol_Id (J); + end loop; + + -- Sort alphabetically + + Sort_Syms.Sort (Order'Last); + + Max_L := 7; + + for J in 1 .. Symbol_Table.Last (Mapping) loop + Get_Name_String (Mapping.Table (J).Original); + Max_L := Integer'Max (Max_L, Name_Len); + end loop; + + Write_Eol; + Write_Str ("Symbol"); + + for J in 1 .. Max_L - 5 loop + Write_Char (' '); + end loop; + + Write_Line ("Value"); + + Write_Str ("------"); + + for J in 1 .. Max_L - 5 loop + Write_Char (' '); + end loop; + + Write_Line ("------"); + + for J in 1 .. Order'Last loop + declare + Data : constant Symbol_Data := Mapping.Table (Order (J)); + + begin + Get_Name_String (Data.Original); + Write_Str (Name_Buffer (1 .. Name_Len)); + + for K in Name_Len .. Max_L loop + Write_Char (' '); + end loop; + + String_To_Name_Buffer (Data.Value); + + if Data.Is_A_String then + Write_Char ('"'); + + for J in 1 .. Name_Len loop + Write_Char (Name_Buffer (J)); + + if Name_Buffer (J) = '"' then + Write_Char ('"'); + end if; + end loop; + + Write_Char ('"'); + + else + Write_Str (Name_Buffer (1 .. Name_Len)); + end if; + end; + + Write_Eol; + end loop; + + Write_Eol; + end List_Symbols; + + ---------------------- + -- Matching_Strings -- + ---------------------- + + function Matching_Strings (S1, S2 : String_Id) return Boolean is + begin + String_To_Name_Buffer (S1); + + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); + end loop; + + declare + String1 : constant String := Name_Buffer (1 .. Name_Len); + + begin + String_To_Name_Buffer (S2); + + for Index in 1 .. Name_Len loop + Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index)); + end loop; + + return String1 = Name_Buffer (1 .. Name_Len); + end; + end Matching_Strings; + + -------------------- + -- Parse_Def_File -- + -------------------- + + procedure Parse_Def_File is + Symbol : Symbol_Id; + Symbol_Name : Name_Id; + Original_Name : Name_Id; + Data : Symbol_Data; + Value_Start : Source_Ptr; + Value_End : Source_Ptr; + Ch : Character; + + use ASCII; + + begin + Def_Line_Loop : + loop + Scan.all; + + exit Def_Line_Loop when Token = Tok_EOF; + + if Token /= Tok_End_Of_Line then + Change_Reserved_Keyword_To_Symbol; + + if Token /= Tok_Identifier then + Error_Msg ("identifier expected", Token_Ptr); + goto Cleanup; + end if; + + Symbol_Name := Token_Name; + Name_Len := 0; + + for Ptr in Token_Ptr .. Scan_Ptr - 1 loop + Name_Len := Name_Len + 1; + Name_Buffer (Name_Len) := Sinput.Source (Ptr); + end loop; + + Original_Name := Name_Find; + Scan.all; + + if Token /= Tok_Colon_Equal then + Error_Msg ("`:=` expected", Token_Ptr); + goto Cleanup; + end if; + + Scan.all; + + if Token = Tok_String_Literal then + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => True, + Value => String_Literal_Id); + + Scan.all; + + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then + Error_Msg ("extraneous text in definition", Token_Ptr); + goto Cleanup; + end if; + + elsif Token = Tok_End_Of_Line or Token = Tok_EOF then + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => False, + Value => Empty_String); + + else + Value_Start := Token_Ptr; + Value_End := Token_Ptr - 1; + Scan_Ptr := Token_Ptr; + + Value_Chars_Loop : + loop + Ch := Sinput.Source (Scan_Ptr); + + case Ch is + when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' => + Value_End := Scan_Ptr; + Scan_Ptr := Scan_Ptr + 1; + + when ' ' | HT | VT | CR | LF | FF => + exit Value_Chars_Loop; + + when others => + Error_Msg ("illegal character", Scan_Ptr); + goto Cleanup; + end case; + end loop Value_Chars_Loop; + + Scan.all; + + if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then + Error_Msg ("extraneous text in definition", Token_Ptr); + goto Cleanup; + end if; + + Start_String; + + while Value_Start <= Value_End loop + Store_String_Char (Sinput.Source (Value_Start)); + Value_Start := Value_Start + 1; + end loop; + + Data := (Symbol => Symbol_Name, + Original => Original_Name, + On_The_Command_Line => False, + Is_A_String => False, + Value => End_String); + end if; + + -- Now that we have the value, get the symbol index + + Symbol := Index_Of (Symbol_Name); + + if Symbol /= No_Symbol then + -- If we already have an entry for this symbol, replace it + -- with the new value, except if the symbol was declared + -- on the command line. + + if Mapping.Table (Symbol).On_The_Command_Line then + goto Continue; + end if; + + else + -- As it is the first time we see this symbol, create a new + -- entry in the table. + + if Mapping.Table = null then + Symbol_Table.Init (Mapping); + end if; + + Symbol_Table.Increment_Last (Mapping); + Symbol := Symbol_Table.Last (Mapping); + end if; + + Mapping.Table (Symbol) := Data; + goto Continue; + + <<Cleanup>> + Set_Ignore_Errors (To => True); + + while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop + Scan.all; + end loop; + + Set_Ignore_Errors (To => False); + + <<Continue>> + null; + end if; + end loop Def_Line_Loop; + end Parse_Def_File; + +end Prep; |