summaryrefslogtreecommitdiff
path: root/gcc/ada/prep.adb
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-10-21 13:42:24 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2003-10-21 13:42:24 +0000
commit9dfe12ae5b94d03c997ea2903022a5d2d5c5f266 (patch)
treebdfc70477b60f1220cb05dd233a4570dd9c6bb5c /gcc/ada/prep.adb
parent1c662558a1113238a624245a45382d3df90ccf13 (diff)
downloadgcc-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.adb1446
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;