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/gnatprep.adb | |
parent | 75a5a481c2048242ed62c7355381160aa1369616 (diff) | |
download | gcc-fbf5a39b3e101719c6bf03cf2cd013b4a312e275.tar.gz |
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/gnatprep.adb')
-rw-r--r-- | gcc/ada/gnatprep.adb | 1529 |
1 files changed, 3 insertions, 1526 deletions
diff --git a/gcc/ada/gnatprep.adb b/gcc/ada/gnatprep.adb index 2502db7cee2..08c15ae56aa 100644 --- a/gcc/ada/gnatprep.adb +++ b/gcc/ada/gnatprep.adb @@ -24,1534 +24,11 @@ -- -- ------------------------------------------------------------------------------ -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Strings.Fixed; -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Heap_Sort_G; -with GNAT.Command_Line; - -with Gnatvsn; +with GPrep; procedure GNATprep is - - type Strptr is access String; - - Usage_Error : exception; - -- Raised if a usage error is detected, causes termination of processing - -- with an appropriate error message and error exit status set. - - Fatal_Error : exception; - -- Exception raised if fatal error detected - - Expression_Error : exception; - -- Exception raised when an invalid boolean expression is found - -- on a preprocessor line - - ------------------------ - -- Argument Line Data -- - ------------------------ - - Outfile_Name : Strptr; - Deffile_Name : Strptr; - -- Names of files - - type Input; - type Input_Ptr is access Input; - type Input is record - File : File_Type; - Next : Input_Ptr; - Prev : Input_Ptr; - Name : Strptr; - Line_Num : Natural := 0; - end record; - -- Data for the current input file (main input file or included file - -- or definition file). - - Infile : Input_Ptr := new Input; - Outfile : File_Type; - Deffile : File_Type; - - Opt_Comment_Deleted_Lines : Boolean := False; -- Set if -c switch set - Blank_Deleted_Lines : Boolean := False; -- Set if -b switch set - List_Symbols : Boolean := False; -- Set if -s switch set - Source_Ref_Pragma : Boolean := False; -- Set if -r switch set - Undefined_Is_False : Boolean := False; -- Set if -u switch set - -- Record command line options - - --------------------------- - -- Definitions File Data -- - --------------------------- - - Num_Syms : Natural := 0; - -- Number of symbols defined in definitions file - - Symbols : array (0 .. 10_000) of Strptr; - Values : array (0 .. 10_000) of Strptr; - -- Symbol names and values. Note that the zero'th element is used only - -- during the call to Sort (to hold a temporary value, as required by - -- the GNAT.Heap_Sort_G interface). - - --------------------- - -- Input File Data -- - --------------------- - - Current_File_Name : Strptr; - -- Holds name of file being read (definitions file or input file) - - Line_Buffer : String (1 .. 20_000); - -- Hold one line - - Line_Length : Natural; - -- Length of line in Line_Buffer - - Ptr : Natural; - -- Input scan pointer for line in Line_Buffer - - type Keyword is (K_Not, K_Then, K_If, K_Else, K_End, K_Elsif, - K_And, K_Or, K_Open_Paren, K_Close_Paren, - K_Defined, K_Andthen, K_Orelse, K_Equal, K_Include, - K_None); - -- Keywords that are recognized on preprocessor lines. K_None indicates - -- that no keyword was present. - - K : Keyword; - -- Scanned keyword - - Start_Sym, End_Sym : Natural; - -- First and last positions of scanned symbol - - Num_Errors : Natural := 0; - -- Number of errors detected - - ----------------------- - -- Preprocessor Data -- - ----------------------- - - -- The following record represents the state of an #if structure: - - type PP_Rec is record - If_Line : Positive; - -- Line number for #if line - - If_Name : Strptr; - -- File name of #if line - - Else_Line : Natural; - -- Line number for #else line, zero = no else seen yet - - Deleting : Boolean; - -- True if lines currently being deleted - - Match_Seen : Boolean; - -- True if either the #if condition or one of the previously seen - -- #elsif lines was true, meaning that any future #elsif sections - -- or the #else section, is to be deleted. - - end record; - - PP_Depth : Natural; - -- Preprocessor #if nesting level. A value of zero means that we are - -- outside any #if structure. - - PP : array (0 .. 100) of PP_Rec; - -- Stack of records showing state of #if structures. PP (1) is the - -- outer level entry, and PP (PP_Depth) is the active entry. PP (0) - -- contains a dummy entry whose Deleting flag is always set to False. - - ----------------- - -- Subprograms -- - ----------------- - - function At_End_Of_Line return Boolean; - -- First advances Ptr using Skip_Spaces. Then returns True if Ptr is - -- either at the end of the line, or at a -- comment sequence. - - procedure Error (Msg : String); - -- Post error message with given text. The line number is taken from - -- Infile.Line_Num, and the column number from Ptr. - - function Eval_Condition - (Parenthesis : Natural := 0; - Do_Eval : Boolean := True) - return Boolean; - -- Eval the condition found in the current Line. The condition can - -- include any of the 'and', 'or', 'not', and parenthesis subexpressions. - -- If Line is an invalid expression, then Expression_Error is raised, - -- after an error message has been printed. Line can include 'then' - -- followed by a comment, which is automatically ignored. If Do_Eval - -- is False, then the expression is not evaluated at all, and symbols - -- are just skipped. - - function Eval_Symbol (Do_Eval : Boolean) return Boolean; - -- Read and evaluate the next symbol or expression (A, A'Defined, A=...) - -- If it is followed by 'Defined or an equality test, read as many symbols - -- as needed. Do_Eval has the same meaning as in Eval_Condition - - procedure Help_Page; - -- Print a help page to summarize the usage of gnatprep - - function Image (N : Natural) return String; - -- Returns Natural'Image (N) without the initial space - - function Is_Preprocessor_Line return Boolean; - -- Tests if current line is a preprocessor line, i.e. that its first - -- non-blank character is a # character. If so, then a result of True - -- is returned, and Ptr is set to point to the character following the - -- # character. If not, False is returned and Ptr is undefined. - - procedure No_Junk; - -- Make sure no junk is present on a preprocessor line. Ptr points past - -- the scanned preprocessor syntax. - - function OK_Identifier (S : String) return Boolean; - -- Tests if given referenced string is valid Ada identifier - - function Matching_Strings (S1, S2 : String) return Boolean; - -- Check if S1 and S2 are the same string (this is a case independent - -- comparison, lower and upper case letters are considered to match). - -- Duplicate quotes in S2 are considered as a single quote ("" => ") - - procedure Parse_Def_File; - -- Parse the deffile given by the user - - function Scan_Keyword return Keyword; - -- Advances Ptr to end of line or next non-blank using Skip_Spaces. Then - -- attempts to scan out a recognized keyword. if a recognized keyword is - -- found, sets Ptr past it, and returns the code for the keyword, if not, - -- then Ptr is left unchanged pointing to a non-blank character or to the - -- end of the line. - - function Symbol_Scanned return Boolean; - -- On entry, Start_Sym is set to the first character of an identifier - -- symbol to be scanned out. On return, End_Sym is set to the last - -- character of the identifier, and the result indicates if the scanned - -- symbol is a valid identifier (True = valid). Ptr is not changed. - - procedure Skip_Spaces; - -- Skips Ptr past tabs and spaces to next non-blank, or one character - -- past the end of line. - - function Variable_Index (Name : String) return Natural; - -- Returns the index of the variable in the table. If the variable is not - -- found, returns Natural'Last - - -------------------- - -- At_End_Of_Line -- - -------------------- - - function At_End_Of_Line return Boolean is - begin - Skip_Spaces; - - return Ptr > Line_Length - or else - (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) = "--"); - end At_End_Of_Line; - - ----------- - -- Error -- - ----------- - - procedure Error (Msg : String) is - L : constant String := Natural'Image (Infile.Line_Num); - C : constant String := Natural'Image (Ptr); - - begin - Put (Standard_Error, Current_File_Name.all); - Put (Standard_Error, ':'); - Put (Standard_Error, L (2 .. L'Length)); - Put (Standard_Error, ':'); - Put (Standard_Error, C (2 .. C'Length)); - Put (Standard_Error, ": "); - - Put_Line (Standard_Error, Msg); - Num_Errors := Num_Errors + 1; - end Error; - - -------------------- - -- Eval_Condition -- - -------------------- - - function Eval_Condition - (Parenthesis : Natural := 0; - Do_Eval : Boolean := True) - return Boolean - is - Symbol_Is_True : Boolean := False; -- init to avoid warning - K : Keyword; - - begin - -- Find the next subexpression - - K := Scan_Keyword; - - case K is - when K_None => - Symbol_Is_True := Eval_Symbol (Do_Eval); - - when K_Not => - - -- Not applies to the next subexpression (either a simple - -- evaluation like A or A'Defined, or a parenthesis expression) - - K := Scan_Keyword; - - if K = K_Open_Paren then - Symbol_Is_True := not Eval_Condition (Parenthesis + 1, Do_Eval); - - elsif K = K_None then - Symbol_Is_True := not Eval_Symbol (Do_Eval); - - else - Ptr := Start_Sym; -- Puts the keyword back - end if; - - when K_Open_Paren => - Symbol_Is_True := Eval_Condition (Parenthesis + 1, Do_Eval); - - when others => - Ptr := Start_Sym; - Error ("invalid syntax in preprocessor line"); - raise Expression_Error; - end case; - - -- Do we have a compound expression with AND, OR, ... - - K := Scan_Keyword; - case K is - when K_None => - if not At_End_Of_Line then - Error ("Invalid Syntax at end of line"); - raise Expression_Error; - end if; - - if Parenthesis /= 0 then - Error ("Unmatched opening parenthesis"); - raise Expression_Error; - end if; - - return Symbol_Is_True; - - when K_Then => - if Parenthesis /= 0 then - Error ("Unmatched opening parenthesis"); - raise Expression_Error; - end if; - - return Symbol_Is_True; - - when K_Close_Paren => - if Parenthesis = 0 then - Error ("Unmatched closing parenthesis"); - raise Expression_Error; - end if; - - return Symbol_Is_True; - - when K_And => - return Symbol_Is_True and Eval_Condition (Parenthesis, Do_Eval); - - when K_Andthen => - if not Symbol_Is_True then - - -- Just skip the symbols for the remaining part - - Symbol_Is_True := Eval_Condition (Parenthesis, False); - return False; - - else - return Eval_Condition (Parenthesis, Do_Eval); - end if; - - when K_Or => - return Symbol_Is_True or Eval_Condition (Parenthesis, Do_Eval); - - when K_Orelse => - if Symbol_Is_True then - - -- Just skip the symbols for the remaining part - - Symbol_Is_True := Eval_Condition (Parenthesis, False); - return True; - - else - return Eval_Condition (Parenthesis, Do_Eval); - end if; - - when others => - Error ("invalid syntax in preprocessor line"); - raise Expression_Error; - end case; - - end Eval_Condition; - - ----------------- - -- Eval_Symbol -- - ----------------- - - function Eval_Symbol (Do_Eval : Boolean) return Boolean is - Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); - K : Keyword; - Index : Natural; - Symbol_Defined : Boolean := False; - Symbol_Is_True : Boolean := False; - - begin - -- Read the symbol - - Skip_Spaces; - Start_Sym := Ptr; - - if not Symbol_Scanned then - Error ("invalid symbol name"); - raise Expression_Error; - end if; - - Ptr := End_Sym + 1; - - -- Test if we have a simple test (A) or a more complicated one - -- (A'Defined) - - K := Scan_Keyword; - - if K /= K_Defined and then K /= K_Equal then - Ptr := Start_Sym; -- Puts the keyword back - end if; - - Index := Variable_Index (Sym); - - case K is - when K_Defined => - Symbol_Defined := Index /= Natural'Last; - Symbol_Is_True := Symbol_Defined; - - when K_Equal => - - -- Read the second part of the statement - - Skip_Spaces; - Start_Sym := Ptr; - - if not Symbol_Scanned - and then End_Sym < Start_Sym - then - Error ("No right part for the equality test"); - raise Expression_Error; - end if; - - Ptr := End_Sym + 1; - - -- If the variable was not found - - if Do_Eval then - if Index = Natural'Last then - if not Undefined_Is_False then - Error ("symbol name """ & Sym & - """ is not defined in definitions file"); - end if; - - else - declare - Right : constant String - := Line_Buffer (Start_Sym .. End_Sym); - Index_R : Natural; - begin - if Right (Right'First) = '"' then - Symbol_Is_True := - Matching_Strings - (Values (Index).all, - Right (Right'First + 1 .. Right'Last - 1)); - else - Index_R := Variable_Index (Right); - if Index_R = Natural'Last then - Error ("Variable " & Right & " in test is " - & "not defined"); - raise Expression_Error; - else - Symbol_Is_True := - Matching_Strings (Values (Index).all, - Values (Index_R).all); - end if; - end if; - end; - end if; - end if; - - when others => - - if Index = Natural'Last then - - Symbol_Defined := False; - if Do_Eval and then not Symbol_Defined then - if Undefined_Is_False then - Symbol_Defined := True; - Symbol_Is_True := False; - - else - Error - ("symbol name """ & Sym & - """ is not defined in definitions file"); - end if; - end if; - - elsif not Do_Eval then - Symbol_Is_True := True; - - elsif Matching_Strings (Values (Index).all, "True") then - Symbol_Is_True := True; - - elsif Matching_Strings (Values (Index).all, "False") then - Symbol_Is_True := False; - - else - Error ("symbol value is not True or False"); - Symbol_Is_True := False; - end if; - - end case; - - return Symbol_Is_True; - end Eval_Symbol; - - --------------- - -- Help_Page -- - --------------- - - procedure Help_Page is - begin - Put_Line (Standard_Error, - "GNAT Preprocessor " & - Gnatvsn.Gnat_Version_String & - " Copyright 1996-2002 Free Software Foundation, Inc."); - Put_Line (Standard_Error, - "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " & - "outfile [deffile]"); - New_Line (Standard_Error); - Put_Line (Standard_Error, " infile Name of the input file"); - Put_Line (Standard_Error, " outfile Name of the output file"); - Put_Line (Standard_Error, " deffile Name of the definition file"); - New_Line (Standard_Error); - Put_Line (Standard_Error, "gnatprep switches:"); - Put_Line (Standard_Error, " -b Replace preprocessor lines by " & - "blank lines"); - Put_Line (Standard_Error, " -c Keep preprocessor lines as comments"); - Put_Line (Standard_Error, " -D Associate symbol with value"); - Put_Line (Standard_Error, " -r Generate Source_Reference pragma"); - Put_Line (Standard_Error, " -s Print a sorted list of symbol names " & - "and values"); - Put_Line (Standard_Error, " -u Treat undefined symbols as FALSE"); - New_Line (Standard_Error); - end Help_Page; - - ----------- - -- Image -- - ----------- - - function Image (N : Natural) return String is - Result : constant String := Natural'Image (N); - begin - return Result (Result'First + 1 .. Result'Last); - end Image; - - -------------------------- - -- Is_Preprocessor_Line -- - -------------------------- - - function Is_Preprocessor_Line return Boolean is - begin - Ptr := 1; - - while Ptr <= Line_Length loop - if Line_Buffer (Ptr) = '#' then - Ptr := Ptr + 1; - return True; - - elsif Line_Buffer (Ptr) > ' ' then - return False; - - else - Ptr := Ptr + 1; - end if; - end loop; - - return False; - end Is_Preprocessor_Line; - - ---------------------- - -- Matching_Strings -- - ---------------------- - - function Matching_Strings (S1, S2 : String) return Boolean is - S2_Index : Integer := S2'First; - - begin - for S1_Index in S1'Range loop - - if To_Upper (S1 (S1_Index)) /= To_Upper (S2 (S2_Index)) then - return False; - - else - if S2 (S2_Index) = '"' - and then S2_Index < S2'Last - and then S2 (S2_Index + 1) = '"' - then - S2_Index := S2_Index + 2; - else - S2_Index := S2_Index + 1; - end if; - - -- If S2 was too short then - - if S2_Index > S2'Last and then S1_Index < S1'Last then - return False; - end if; - end if; - end loop; - - return S2_Index = S2'Last + 1; - end Matching_Strings; - - ------------- - -- No_Junk -- - ------------- - - procedure No_Junk is - begin - Skip_Spaces; - - if Ptr = Line_Length - or else (Ptr < Line_Length - and then Line_Buffer (Ptr .. Ptr + 1) /= "--") - then - Error ("extraneous text on preprocessor line ignored"); - end if; - end No_Junk; - - ------------------- - -- OK_Identifier -- - ------------------- - - function OK_Identifier (S : String) return Boolean is - P : Natural := S'First; - - begin - if S'Length /= 0 and then S (P) = Character'Val (39) then -- ''' - P := P + 1; - end if; - - if S'Length = 0 - or else not Is_Letter (S (P)) - then - return False; - - else - while P <= S'Last loop - if Is_Letter (S (P)) or Is_Digit (S (P)) then - null; - - elsif S (P) = '_' - and then P < S'Last - and then S (P + 1) /= '_' - then - null; - - else - return False; - end if; - - P := P + 1; - end loop; - - return True; - end if; - end OK_Identifier; - - -------------------- - -- Parse_Def_File -- - -------------------- - - procedure Parse_Def_File is - begin - Open (Deffile, In_File, Deffile_Name.all); - - -- Initialize data for procedure Error - - Infile.Line_Num := 0; - Current_File_Name := Deffile_Name; - - -- Loop through lines in symbol definitions file - - while not End_Of_File (Deffile) loop - Get_Line (Deffile, Line_Buffer, Line_Length); - Infile.Line_Num := Infile.Line_Num + 1; - - Ptr := 1; - Skip_Spaces; - - if Ptr > Line_Length - or else (Ptr < Line_Length - and then - Line_Buffer (Ptr .. Ptr + 1) = "--") - then - goto Continue; - end if; - - Start_Sym := Ptr; - - if not Symbol_Scanned then - Error ("invalid symbol identifier """ & - Line_Buffer (Start_Sym .. End_Sym) & - '"'); - goto Continue; - end if; - - Ptr := End_Sym + 1; - Skip_Spaces; - - if Ptr >= Line_Length - or else Line_Buffer (Ptr .. Ptr + 1) /= ":=" - then - Error ("missing "":="" in symbol definition line"); - goto Continue; - end if; - - Ptr := Ptr + 2; - Skip_Spaces; - - Num_Syms := Num_Syms + 1; - Symbols (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); - - Start_Sym := Ptr; - End_Sym := Ptr - 1; - - if At_End_Of_Line then - null; - - elsif Line_Buffer (Start_Sym) = '"' then - End_Sym := End_Sym + 1; - loop - End_Sym := End_Sym + 1; - - if End_Sym > Line_Length then - Error ("no closing quote for string constant"); - goto Continue; - - elsif End_Sym < Line_Length - and then Line_Buffer (End_Sym .. End_Sym + 1) = """""" - then - End_Sym := End_Sym + 1; - - elsif Line_Buffer (End_Sym) = '"' then - exit; - end if; - end loop; - - else - End_Sym := Ptr - 1; - - while End_Sym < Line_Length - and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) - or else - Line_Buffer (End_Sym + 1) = '_' - or else - Line_Buffer (End_Sym + 1) = '.') - loop - End_Sym := End_Sym + 1; - end loop; - - Ptr := End_Sym + 1; - - if not At_End_Of_Line then - Error ("incorrect symbol value syntax"); - goto Continue; - end if; - end if; - - Values (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym)); - - <<Continue>> - null; - end loop; - - exception - -- Could not open the file - - when Name_Error => - Put_Line (Standard_Error, "cannot open " & Deffile_Name.all); - raise Fatal_Error; - end Parse_Def_File; - - ------------------ - -- Scan_Keyword -- - ------------------ - - function Scan_Keyword return Keyword is - Kptr : constant Natural := Ptr; - - begin - Skip_Spaces; - Start_Sym := Ptr; - - if Symbol_Scanned then - - -- If the symbol was the last thing on the line, End_Sym will - -- point too far in Line_Buffer - - if End_Sym > Line_Length then - End_Sym := Line_Length; - end if; - - Ptr := End_Sym + 1; - - declare - Sym : constant String := Line_Buffer (Start_Sym .. End_Sym); - - begin - if Matching_Strings (Sym, "not") then - return K_Not; - - elsif Matching_Strings (Sym, "then") then - return K_Then; - - elsif Matching_Strings (Sym, "if") then - return K_If; - - elsif Matching_Strings (Sym, "else") then - return K_Else; - - elsif Matching_Strings (Sym, "end") then - return K_End; - - elsif Matching_Strings (Sym, "elsif") then - return K_Elsif; - - elsif Matching_Strings (Sym, "and") then - if Scan_Keyword = K_Then then - Start_Sym := Kptr; - return K_Andthen; - else - Ptr := Start_Sym; -- Put back the last keyword read - Start_Sym := Kptr; - return K_And; - end if; - - elsif Matching_Strings (Sym, "or") then - if Scan_Keyword = K_Else then - Start_Sym := Kptr; - return K_Orelse; - else - Ptr := Start_Sym; -- Put back the last keyword read - Start_Sym := Kptr; - return K_Or; - end if; - - elsif Matching_Strings (Sym, "'defined") then - return K_Defined; - - elsif Matching_Strings (Sym, "include") then - return K_Include; - - elsif Sym = "(" then - return K_Open_Paren; - - elsif Sym = ")" then - return K_Close_Paren; - - elsif Sym = "=" then - return K_Equal; - end if; - end; - end if; - - Ptr := Kptr; - return K_None; - end Scan_Keyword; - - ----------------- - -- Skip_Spaces -- - ----------------- - - procedure Skip_Spaces is - begin - while Ptr <= Line_Length loop - if Line_Buffer (Ptr) /= ' ' - and then Line_Buffer (Ptr) /= ASCII.HT - then - return; - else - Ptr := Ptr + 1; - end if; - end loop; - end Skip_Spaces; - - -------------------- - -- Symbol_Scanned -- - -------------------- - - function Symbol_Scanned return Boolean is - begin - End_Sym := Start_Sym - 1; - - case Line_Buffer (End_Sym + 1) is - - when '(' | ')' | '=' => - End_Sym := End_Sym + 1; - return True; - - when '"' => - End_Sym := End_Sym + 1; - while End_Sym < Line_Length loop - - if Line_Buffer (End_Sym + 1) = '"' then - - if End_Sym + 2 < Line_Length - and then Line_Buffer (End_Sym + 2) = '"' - then - End_Sym := End_Sym + 2; - else - exit; - end if; - else - End_Sym := End_Sym + 1; - end if; - end loop; - - if End_Sym >= Line_Length then - Error ("Invalid string "); - raise Expression_Error; - end if; - - End_Sym := End_Sym + 1; - return False; - - when ''' => - End_Sym := End_Sym + 1; - - when others => - null; - end case; - - while End_Sym < Line_Length - and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1)) - or else Line_Buffer (End_Sym + 1) = '_') - loop - End_Sym := End_Sym + 1; - end loop; - - return OK_Identifier (Line_Buffer (Start_Sym .. End_Sym)); - end Symbol_Scanned; - - -------------------- - -- Variable_Index -- - -------------------- - - function Variable_Index (Name : String) return Natural is - begin - for J in 1 .. Num_Syms loop - if Matching_Strings (Symbols (J).all, Name) then - return J; - end if; - end loop; - - return Natural'Last; - end Variable_Index; - --- Start of processing for GNATprep - begin + -- Everything is done in GPrep - -- Parse the switches - - loop - case GNAT.Command_Line.Getopt ("D: b c r s u") is - when ASCII.NUL => - exit; - - when 'D' => - declare - S : String := GNAT.Command_Line.Parameter; - Index : Natural; - - begin - Index := Ada.Strings.Fixed.Index (S, "="); - - if Index = 0 then - Num_Syms := Num_Syms + 1; - Symbols (Num_Syms) := new String'(S); - Values (Num_Syms) := new String'("True"); - - else - Num_Syms := Num_Syms + 1; - Symbols (Num_Syms) := new String'(S (S'First .. Index - 1)); - Values (Num_Syms) := new String'(S (Index + 1 .. S'Last)); - end if; - end; - - when 'b' => - Blank_Deleted_Lines := True; - - when 'c' => - Opt_Comment_Deleted_Lines := True; - - when 'r' => - Source_Ref_Pragma := True; - - when 's' => - List_Symbols := True; - - when 'u' => - Undefined_Is_False := True; - - when others => - raise Usage_Error; - end case; - end loop; - - -- Get the file names - - loop - declare - S : constant String := GNAT.Command_Line.Get_Argument; - - begin - exit when S'Length = 0; - - if Infile.Name = null then - Infile.Name := new String'(S); - elsif Outfile_Name = null then - Outfile_Name := new String'(S); - elsif Deffile_Name = null then - Deffile_Name := new String'(S); - else - raise Usage_Error; - end if; - end; - end loop; - - -- Test we had all the arguments needed - - if Infile.Name = null - or else Outfile_Name = null - then - raise Usage_Error; - end if; - - if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then - Blank_Deleted_Lines := True; - end if; - - -- Get symbol definitions - - if Deffile_Name /= null then - Parse_Def_File; - end if; - - if Num_Errors > 0 then - raise Fatal_Error; - - elsif List_Symbols and then Num_Syms > 0 then - List_Symbols_Case : declare - - function Lt (Op1, Op2 : Natural) return Boolean; - -- Comparison routine for sort call - - procedure Move (From : Natural; To : Natural); - -- Move routine for sort call - - function Lt (Op1, Op2 : Natural) return Boolean is - L1 : constant Natural := Symbols (Op1)'Length; - L2 : constant Natural := Symbols (Op2)'Length; - MinL : constant Natural := Natural'Min (L1, L2); - - C1, C2 : Character; - - begin - for J in 0 .. MinL - 1 loop - C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J)); - C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J)); - - if C1 < C2 then - return True; - - elsif C1 > C2 then - return False; - end if; - end loop; - - return L1 < L2; - end Lt; - - procedure Move (From : Natural; To : Natural) is - begin - Symbols (To) := Symbols (From); - Values (To) := Values (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 - Sort_Syms.Sort (Num_Syms); - - Max_L := 7; - for J in 1 .. Num_Syms loop - Max_L := Natural'Max (Max_L, Symbols (J)'Length); - end loop; - - New_Line; - Put ("Symbol"); - - for J in 1 .. Max_L - 5 loop - Put (' '); - end loop; - - Put_Line ("Value"); - - Put ("------"); - - for J in 1 .. Max_L - 5 loop - Put (' '); - end loop; - - Put_Line ("------"); - - for J in 1 .. Num_Syms loop - Put (Symbols (J).all); - - for K in 1 .. Max_L - Symbols (J)'Length + 1 loop - Put (' '); - end loop; - - Put_Line (Values (J).all); - end loop; - - New_Line; - end List_Symbols_Case; - end if; - - -- Open files and initialize preprocessing - - begin - Open (Infile.File, In_File, Infile.Name.all); - - exception - when Name_Error => - Put_Line (Standard_Error, "cannot open " & Infile.Name.all); - raise Fatal_Error; - end; - - begin - Create (Outfile, Out_File, Outfile_Name.all); - - exception - when Name_Error => - Put_Line (Standard_Error, "cannot create " & Outfile_Name.all); - raise Fatal_Error; - end; - - Infile.Line_Num := 0; - Current_File_Name := Infile.Name; - - PP_Depth := 0; - PP (0).Deleting := False; - - -- We return here after we start reading an include file and after - -- we have finished reading an include file. - - <<Read_In_File>> - - -- If we generate Source_Reference pragmas, then generate one - -- either with line number 1 for a newly included file, or - -- with the number of the next line when we have returned to the - -- including file. - - if Source_Ref_Pragma then - Put_Line - (Outfile, "pragma Source_Reference (" & - Image (Infile.Line_Num + 1) & - ", """ & Infile.Name.all & """);"); - end if; - - -- Loop through lines in input file - - while not End_Of_File (Infile.File) loop - Get_Line (Infile.File, Line_Buffer, Line_Length); - Infile.Line_Num := Infile.Line_Num + 1; - - -- Handle preprocessor line - - if Is_Preprocessor_Line then - K := Scan_Keyword; - - case K is - - -- Include file - - when K_Include => - -- Ignore if Deleting is True - - if PP (PP_Depth).Deleting then - goto Output; - end if; - - Skip_Spaces; - - if Ptr >= Line_Length then - Error ("no file to include"); - - elsif Line_Buffer (Ptr) /= '"' then - Error - ("file to include must be specified as a literal string"); - - else - declare - Start_File : constant Positive := Ptr + 1; - - begin - Ptr := Line_Length; - - while Line_Buffer (Ptr) = ' ' - or else Line_Buffer (Ptr) = ASCII.HT - loop - Ptr := Ptr - 1; - end loop; - - if Ptr <= Start_File - or else Line_Buffer (Ptr) /= '"' - then - Error ("no string literal for included file"); - - else - if Infile.Next = null then - Infile.Next := new Input; - Infile.Next.Prev := Infile; - end if; - - Infile := Infile.Next; - Infile.Name := - new String'(Line_Buffer (Start_File .. Ptr - 1)); - - -- Check for circularity: an file including itself, - -- either directly or indirectly. - - declare - File : Input_Ptr := Infile.Prev; - - begin - while File /= null - and then File.Name.all /= Infile.Name.all - loop - File := File.Prev; - end loop; - - if File /= null then - Infile := Infile.Prev; - Error ("circularity in included files"); - - while File.Prev /= null loop - File := File.Prev; - end loop; - - while File /= Infile.Next loop - Error ('"' & File.Name.all & - """ includes """ & - File.Next.Name.all & '"'); - File := File.Next; - end loop; - - else - -- We have a file name and no circularity. - -- Open the file and record an error if the - -- file cannot be opened. - - begin - Open (Infile.File, In_File, Infile.Name.all); - Current_File_Name := Infile.Name; - Infile.Line_Num := 0; - - -- If we use Source_Reference pragma, - -- we need to output one for this new file. - goto Read_In_File; - - exception - when Name_Error => - - -- We need to set the input file to - -- the including file, so that the - -- line number is correct when reporting - -- the error. - - Infile := Infile.Prev; - Error ("cannot open """ & - Infile.Next.Name.all & '"'); - end; - end if; - end; - end if; - end; - end if; - - -- If/Elsif processing - - when K_If | K_Elsif => - - -- If differs from elsif only in that an initial stack entry - -- must be made for the new if range. We set the match seen - -- entry to a copy of the deleting status in the range above - -- us. If we are deleting in the range above us, then we want - -- all the branches of the nested #if to delete. - - if K = K_If then - PP_Depth := PP_Depth + 1; - PP (PP_Depth) := - (If_Line => Infile.Line_Num, - If_Name => Infile.Name, - Else_Line => 0, - Deleting => False, - Match_Seen => PP (PP_Depth - 1).Deleting); - - elsif PP_Depth = 0 then - Error ("no matching #if for this #elsif"); - goto Output; - - end if; - - PP (PP_Depth).Deleting := True; - - if not PP (PP_Depth).Match_Seen - and then Eval_Condition = True - then - - -- Case of match and no match yet in this #if - - PP (PP_Depth).Deleting := False; - PP (PP_Depth).Match_Seen := True; - No_Junk; - end if; - - -- Processing for #else - - when K_Else => - - if PP_Depth = 0 then - Error ("no matching #if for this #else"); - - elsif PP (PP_Depth).Else_Line /= 0 then - Error ("duplicate #else line (previous was on line" & - Natural'Image (PP (PP_Depth).Else_Line) & - ")"); - - else - PP (PP_Depth).Else_Line := Infile.Line_Num; - PP (PP_Depth).Deleting := PP (PP_Depth).Match_Seen; - end if; - - No_Junk; - - -- Process for #end - - when K_End => - - if PP_Depth = 0 then - Error ("no matching #if for this #end"); - - else - Skip_Spaces; - - if Scan_Keyword /= K_If then - Error ("expected if after #end"); - Ptr := Line_Length + 1; - end if; - - Skip_Spaces; - - if Ptr > Line_Length - or else Line_Buffer (Ptr) /= ';' - then - Error ("missing semicolon after #end if"); - else - Ptr := Ptr + 1; - end if; - - No_Junk; - - PP_Depth := PP_Depth - 1; - end if; - - when others => - Error ("invalid preprocessor keyword syntax"); - - end case; - - -- Handle symbol substitution - - -- Substitution is not allowed in string (which we simply skip), - -- but is allowed inside character constants. The last case is - -- because there is no way to know whether the user want to - -- substitute the name of an attribute ('Min or 'Max for instance) - -- or actually meant to substitue a character ('$name' is probably - -- a character constant, but my_type'$name'Min is probably an - -- attribute, with $name=Base) - - else - Ptr := 1; - - while Ptr < Line_Length loop - exit when At_End_Of_Line; - - case Line_Buffer (Ptr) is - - when ''' => - - -- Two special cases here: - -- '"' => we don't want the " sign to appear as belonging - -- to a string. - -- '$' => this is obviously not a substitution, just skip it - - if Ptr < Line_Length - 1 - and then Line_Buffer (Ptr + 1) = '"' - then - Ptr := Ptr + 2; - elsif Ptr < Line_Length - 2 - and then Line_Buffer (Ptr + 1 .. Ptr + 2) = "$'" - then - Ptr := Ptr + 2; - end if; - - when '"' => - - -- The special case of "" inside the string is easy to - -- handle: just ignore them. The second one will be seen - -- as the beginning of a second string - - Ptr := Ptr + 1; - while Ptr < Line_Length - and then Line_Buffer (Ptr) /= '"' - loop - Ptr := Ptr + 1; - end loop; - - when '$' => - - -- $ found, so scan out possible following symbol - - Start_Sym := Ptr + 1; - - if Symbol_Scanned then - - -- Look up symbol in table and if found do replacement - - for J in 1 .. Num_Syms loop - if Matching_Strings - (Symbols (J).all, Line_Buffer (Start_Sym .. End_Sym)) - then - declare - OldL : constant Positive := - End_Sym - Start_Sym + 2; - NewL : constant Positive := Values (J)'Length; - AdjL : constant Integer := NewL - OldL; - NewP : constant Positive := Ptr + NewL - 1; - - begin - Line_Buffer (NewP + 1 .. Line_Length + AdjL) := - Line_Buffer (End_Sym + 1 .. Line_Length); - Line_Buffer (Ptr .. NewP) := Values (J).all; - - Ptr := NewP; - Line_Length := Line_Length + AdjL; - end; - - exit; - end if; - end loop; - end if; - - when others => - null; - - end case; - Ptr := Ptr + 1; - end loop; - end if; - - -- Here after dealing with preprocessor line, output current line - - <<Output>> - - if Is_Preprocessor_Line or else PP (PP_Depth).Deleting then - if Blank_Deleted_Lines then - New_Line (Outfile); - - elsif Opt_Comment_Deleted_Lines then - if Line_Length = 0 then - Put_Line (Outfile, "--!"); - else - Put (Outfile, "--! "); - Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); - end if; - end if; - - else - Put_Line (Outfile, Line_Buffer (1 .. Line_Length)); - end if; - end loop; - - -- If we have finished reading an included file, close it and continue - -- with the next line of the including file. - - if Infile.Prev /= null then - Close (Infile.File); - Infile := Infile.Prev; - Current_File_Name := Infile.Name; - goto Read_In_File; - end if; - - for J in 1 .. PP_Depth loop - if PP (J).If_Name = Infile.Name then - Error ("no matching #end for #if at line" & - Natural'Image (PP (J).If_Line)); - else - Error ("no matching #end for #if at line" & - Natural'Image (PP (J).If_Line) & - " of file """ & PP (J).If_Name.all & '"'); - end if; - end loop; - - if Num_Errors = 0 then - Close (Outfile); - Set_Exit_Status (0); - else - Delete (Outfile); - Set_Exit_Status (1); - end if; - -exception - when Usage_Error => - Help_Page; - Set_Exit_Status (1); - - when GNAT.Command_Line.Invalid_Parameter => - Put_Line (Standard_Error, "No parameter given for -" - & GNAT.Command_Line.Full_Switch); - Help_Page; - Set_Exit_Status (1); - - when GNAT.Command_Line.Invalid_Switch => - Put_Line (Standard_Error, "Invalid Switch: -" - & GNAT.Command_Line.Full_Switch); - Help_Page; - Set_Exit_Status (1); - - when Fatal_Error => - Set_Exit_Status (1); - - when Expression_Error => - Set_Exit_Status (1); - + GPrep.Gnatprep; end GNATprep; |